module Stratosphere.NamedItem
  ( NamedItem (..)
  , namedItemToJSON
  )
where

import Stratosphere.Prelude

import qualified Data.Aeson     as JSON
import qualified Data.Aeson.Key as Key

-- | This class defines items with names in them. It is used to extract the
-- name from JSON fields so we can get an Object with the names as keys instead
-- of just an array.
class NamedItem a where
  itemName   :: a -> Text
  nameToJSON :: a -> JSON.Value

namedItemToJSON :: (NamedItem a) => [a] -> JSON.Value
namedItemToJSON :: forall a. NamedItem a => [a] -> Value
namedItemToJSON
  = [Pair] -> Value
JSON.object
  ([Pair] -> Value) -> ([a] -> [Pair]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pair) -> [a] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
item -> (Text -> Key
Key.fromText (a -> Text
forall a. NamedItem a => a -> Text
itemName a
item)) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. NamedItem a => a -> Value
nameToJSON a
item)