{-# LANGUAGE CPP #-}
module Composite.Aeson.Record
  ( ToJsonField(..), FromJsonField(..), JsonField(..)
  , field, field', fromField, fromField', toField, toField'
  , optionalField, optionalField', fromOptionalField, fromOptionalField', toOptionalField, toOptionalField'
  , JsonFormatRecord, ToJsonFormatRecord, FromJsonFormatRecord, zipJsonFormatRecord, toJsonFormatRecord, fromJsonFormatRecord
  , DefaultJsonFormatRecord, defaultJsonFormatRecord
  , RecordToJsonObject, recordToJsonObject, recordToJson
  , RecordFromJson, recordFromJson
  , recordJsonFormat
  ) where

import Composite.Aeson.Base
  ( JsonProfunctor(JsonProfunctor)
  , JsonFormat(JsonFormat)
  , wrappedJsonFormat
  )
import Composite.Aeson.Formats.Default (DefaultJsonFormat(defaultJsonFormat))
import Composite.Record ((:->))
import Control.Lens (Wrapped(type Unwrapped, _Wrapped'), from, review, view)
import Control.Monad (join)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.BetterErrors as ABE
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
#else
import qualified Data.HashMap.Strict as HM
#endif
import Data.Functor.Contravariant (Contravariant, contramap)
import Data.Functor.Identity (Identity(Identity))
import Data.Proxy (Proxy(Proxy))
import Data.Text (Text, pack)
import Data.Vinyl (RApply, RMap, Rec((:&), RNil), rmap, rzipWith)
import GHC.TypeLits (KnownSymbol, symbolVal)

-- |Function to encode a single field of a record, possibly choosing to elide the field with @Nothing@.
newtype ToJsonField a = ToJsonField { ToJsonField a -> a -> Maybe Value
unToJsonField :: a -> Maybe Aeson.Value }

instance Contravariant ToJsonField where
  contramap :: (a -> b) -> ToJsonField b -> ToJsonField a
contramap a -> b
f (ToJsonField b -> Maybe Value
g) = (a -> Maybe Value) -> ToJsonField a
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField (b -> Maybe Value
g (b -> Maybe Value) -> (a -> b) -> a -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- |Function to decode a single field of a record.
newtype FromJsonField e a = FromJsonField { FromJsonField e a -> Text -> Parse e a
unFromJsonField :: Text -> ABE.Parse e a }

instance Functor (FromJsonField e) where
  fmap :: (a -> b) -> FromJsonField e a -> FromJsonField e b
fmap a -> b
f (FromJsonField Text -> Parse e a
g) = (Text -> Parse e b) -> FromJsonField e b
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField ((a -> b) -> Parse e a -> Parse e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Parse e a -> Parse e b)
-> (Text -> Parse e a) -> Text -> Parse e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parse e a
g)

-- |Descriptor of how to handle a single record field with functions to parse and emit the field which can handle missing fields on parse and elide fields on
-- encode.
data JsonField e a = JsonField (a -> Maybe Aeson.Value) (Text -> ABE.Parse e a)

-- |Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @a@ which fails if the field is missing and never elides the field.
field :: (Wrapped a', Unwrapped a' ~ a) => JsonFormat e a -> JsonField e a'
field :: JsonFormat e a -> JsonField e a'
field JsonFormat e a
fmt = JsonFormat e a' -> JsonField e a'
forall e a. JsonFormat e a -> JsonField e a
field' (JsonFormat e (Unwrapped a') -> JsonFormat e a'
forall a e.
Wrapped a =>
JsonFormat e (Unwrapped a) -> JsonFormat e a
wrappedJsonFormat JsonFormat e a
JsonFormat e (Unwrapped a')
fmt)

-- |Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @a@ which fails if the field is missing and never elides the field.
field' :: JsonFormat e a -> JsonField e a
field' :: JsonFormat e a -> JsonField e a
field' (JsonFormat (JsonProfunctor a -> Value
o Parse e a
i)) = (a -> Maybe Value) -> (Text -> Parse e a) -> JsonField e a
forall e a.
(a -> Maybe Value) -> (Text -> Parse e a) -> JsonField e a
JsonField (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (a -> Value) -> a -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
o) (Text -> Parse e a -> Parse e a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
`ABE.key` Parse e a
i)

-- |Given a parser for @'Unwrapped' a@, produce a @'FromField' e a@.
fromField :: Wrapped a => ABE.Parse e (Unwrapped a) -> FromJsonField e a
fromField :: Parse e (Unwrapped a) -> FromJsonField e a
fromField = (Text -> Parse e a) -> FromJsonField e a
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField ((Text -> Parse e a) -> FromJsonField e a)
-> (Parse e (Unwrapped a) -> Text -> Parse e a)
-> Parse e (Unwrapped a)
-> FromJsonField e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Parse e a -> Parse e a) -> Parse e a -> Text -> Parse e a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Parse e a -> Parse e a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
ABE.key (Parse e a -> Text -> Parse e a)
-> (Parse e (Unwrapped a) -> Parse e a)
-> Parse e (Unwrapped a)
-> Text
-> Parse e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped a -> a) -> Parse e (Unwrapped a) -> Parse e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AReview a (Unwrapped a) -> Unwrapped a -> a
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview a (Unwrapped a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')

-- |Given a parser for @a@, produce a @'FromField' e a@.
fromField' :: ABE.Parse e a -> FromJsonField e a
fromField' :: Parse e a -> FromJsonField e a
fromField' = (Text -> Parse e a) -> FromJsonField e a
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField ((Text -> Parse e a) -> FromJsonField e a)
-> (Parse e a -> Text -> Parse e a)
-> Parse e a
-> FromJsonField e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Parse e a -> Parse e a) -> Parse e a -> Text -> Parse e a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Parse e a -> Parse e a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
ABE.key

-- |Given a parser for @'Unwrapped' a@, produce a @'FromField' e a@.
toField :: (Wrapped a', Unwrapped a' ~ a) => (a -> Aeson.Value) -> ToJsonField a'
toField :: (a -> Value) -> ToJsonField a'
toField a -> Value
o = (a' -> Maybe Value) -> ToJsonField a'
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField ((a' -> Maybe Value) -> ToJsonField a')
-> (a' -> Maybe Value) -> ToJsonField a'
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (a' -> Value) -> a' -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
o (a -> Value) -> (a' -> a) -> a' -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a a' a -> a' -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a a' a
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'

-- |Given a parser for @a@, produce a @'ToField' a@.
toField' :: (a -> Aeson.Value) -> ToJsonField a
toField' :: (a -> Value) -> ToJsonField a
toField' = (a -> Maybe Value) -> ToJsonField a
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField ((a -> Maybe Value) -> ToJsonField a)
-> ((a -> Value) -> a -> Maybe Value)
-> (a -> Value)
-> ToJsonField a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Value) -> (a -> Value) -> a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Maybe Value
forall a. a -> Maybe a
Just

-- |Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @Maybe a@ which substitutes @Nothing@ for either @null@ or missing field,
-- and which elides the field on @Nothing@.
optionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => JsonFormat e a -> JsonField e a'
optionalField :: JsonFormat e a -> JsonField e a'
optionalField (JsonFormat (JsonProfunctor a -> Value
o Parse e a
i)) =
  (a' -> Maybe Value) -> (Text -> Parse e a') -> JsonField e a'
forall e a.
(a -> Maybe Value) -> (Text -> Parse e a) -> JsonField e a
JsonField
    ((a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
o (Maybe a -> Maybe Value) -> (a' -> Maybe a) -> a' -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe a) a' (Maybe a) -> a' -> Maybe a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe a) a' (Maybe a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')
    (\ Text
k -> Getting a' (Maybe a) a' -> Maybe a -> a'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AnIso a' a' (Maybe a) (Maybe a) -> Iso (Maybe a) (Maybe a) a' a'
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso a' a' (Maybe a) (Maybe a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Maybe a -> a')
-> (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> a')
-> ParseT e Identity (Maybe (Maybe a)) -> Parse e a'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParseT e Identity (Maybe a)
-> ParseT e Identity (Maybe (Maybe a))
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
ABE.keyMay Text
k (Parse e a -> ParseT e Identity (Maybe a)
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
ABE.perhaps Parse e a
i))

-- |Given a 'JsonFormat' for some type @a@, produce a 'JsonField' for fields of type @Maybe a@ which substitutes @Nothing@ for either @null@ or missing field,
-- and which elides the field on @Nothing@.
optionalField' :: JsonFormat e a -> JsonField e (Maybe a)
optionalField' :: JsonFormat e a -> JsonField e (Maybe a)
optionalField' (JsonFormat (JsonProfunctor a -> Value
o Parse e a
i)) =
  (Maybe a -> Maybe Value)
-> (Text -> Parse e (Maybe a)) -> JsonField e (Maybe a)
forall e a.
(a -> Maybe Value) -> (Text -> Parse e a) -> JsonField e a
JsonField
    ((a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
o)
    (\ Text
k -> Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> ParseT e Identity (Maybe (Maybe a)) -> Parse e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e (Maybe a) -> ParseT e Identity (Maybe (Maybe a))
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
ABE.keyMay Text
k (Parse e a -> Parse e (Maybe a)
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
ABE.perhaps Parse e a
i))

-- |Given a parser for @a@, produce a @'FromField' e b@ where @b@ is a 'Wrapped' around @Maybe a@.
fromOptionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => ABE.Parse e a -> FromJsonField e a'
fromOptionalField :: Parse e a -> FromJsonField e a'
fromOptionalField Parse e a
i = (Text -> Parse e a') -> FromJsonField e a'
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField Text -> Parse e a'
f
  where
    f :: Text -> Parse e a'
f Text
k = Getting a' (Maybe a) a' -> Maybe a -> a'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AnIso a' a' (Maybe a) (Maybe a) -> Iso (Maybe a) (Maybe a) a' a'
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso a' a' (Maybe a) (Maybe a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (Maybe a -> a')
-> (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> a')
-> ParseT e Identity (Maybe (Maybe a)) -> Parse e a'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParseT e Identity (Maybe a)
-> ParseT e Identity (Maybe (Maybe a))
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
ABE.keyMay Text
k (Parse e a -> ParseT e Identity (Maybe a)
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
ABE.perhaps Parse e a
i)

-- |Given a parser for @a@, produce a @'FromField' e (Maybe a)@ which represents an optional field.
fromOptionalField' :: ABE.Parse e a -> FromJsonField e (Maybe a)
fromOptionalField' :: Parse e a -> FromJsonField e (Maybe a)
fromOptionalField' Parse e a
i = (Text -> Parse e (Maybe a)) -> FromJsonField e (Maybe a)
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField Text -> Parse e (Maybe a)
f
  where
    f :: Text -> Parse e (Maybe a)
f Text
k = Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> ParseT e Identity (Maybe (Maybe a)) -> Parse e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e (Maybe a) -> ParseT e Identity (Maybe (Maybe a))
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
ABE.keyMay Text
k (Parse e a -> Parse e (Maybe a)
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
ABE.perhaps Parse e a
i)

-- |Given an encoding function for some type @a@, produce a 'ToField' for fields of type @Maybe a@ which elides the field on @Nothing@.
toOptionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => (a -> Aeson.Value) -> ToJsonField a'
toOptionalField :: (a -> Value) -> ToJsonField a'
toOptionalField a -> Value
o = (a' -> Maybe Value) -> ToJsonField a'
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField ((a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
o (Maybe a -> Maybe Value) -> (a' -> Maybe a) -> a' -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe a) a' (Maybe a) -> a' -> Maybe a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe a) a' (Maybe a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')

-- |Given an encoding function for some type @a@, produce a 'ToField' for fields of type @Maybe a@ which elides the field on @Nothing@.
toOptionalField' :: (a -> Aeson.Value) -> ToJsonField (Maybe a)
toOptionalField' :: (a -> Value) -> ToJsonField (Maybe a)
toOptionalField' a -> Value
o = (Maybe a -> Maybe Value) -> ToJsonField (Maybe a)
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField ((a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
o)

-- |Type of a Vinyl record which describes how to map fields of a record to JSON and back.
--
--
-- This record type has the same field names and types as a regular record with 'Identity' but instead of 'Identity' uses 'JsonFormat e'.
--
-- For example, given:
--
-- > type FId   = "id"   :-> Int
-- > type FName = "name" :-> Text
-- > type User = '[FId, FName]
--
-- A 'JsonFormatRecord' for @User@ might be:
--
-- @
--   userFormatRec :: 'JsonFormatRecord' e User
--   userFormatRec = 'field' 'Composite.Aeson.Default.integralJsonFormat'
--                :& 'field' 'Composite.Aeson.Default.textJsonFormat'
--                :& RNil
-- @
--
-- Or, using the default mappings for each field type:
--
-- @
--   userFormatRec :: 'JsonFormatRecord' e User
--   userFormatRec = 'defaultJsonFormatRecord'
-- @
--
-- Such a record is a first-class value like any other record, so can be composed into larger records, modified, etc. This is particularly useful in
-- combination with 'defaultJsonFormatRecord', where you can automatically derive a format record for all fields you want defaults for and then extend or
-- override formats for particular fields, e.g.
--
-- @
--   fId :: Proxy FId
--   fId = Proxy
--
--   userFormatRec :: 'JsonFormatRecord' e User
--   userFormatRec = 'Control.Lens.over' ('Frames.rlens' fId) ('Composite.Aeson.Base.dimapJsonFormat (+10) (subtract 10)) 'defaultJsonFormatRecord'
-- @
--
-- Would use the same JSON schema as the other examples, but the @id@ field would be encoded in JSON as 10 higher.
--
-- Once you've produced an appropriate 'JsonFormatRecord' for your case, use 'recordJsonFormat' to make a @'JsonFormat' e (Record '[…])@ of it.
type JsonFormatRecord e rs = Rec (JsonField e) rs

-- |Zip up a matching 'FromJsonFormatRecord' and 'ToJsonFormatRecord' into a 'JsonFormatRecord'.
--
-- Reverse operation of 'fromJsonFormatRecord' and 'toJsonFormatRecord'.
zipJsonFormatRecord :: (RMap rs, RApply rs) => ToJsonFormatRecord rs -> FromJsonFormatRecord e rs -> JsonFormatRecord e rs
zipJsonFormatRecord :: ToJsonFormatRecord rs
-> FromJsonFormatRecord e rs -> JsonFormatRecord e rs
zipJsonFormatRecord = (forall x. ToJsonField x -> FromJsonField e x -> JsonField e x)
-> ToJsonFormatRecord rs
-> FromJsonFormatRecord e rs
-> JsonFormatRecord e rs
forall u (xs :: [u]) (f :: u -> *) (g :: u -> *) (h :: u -> *).
(RMap xs, RApply xs) =>
(forall (x :: u). f x -> g x -> h x)
-> Rec f xs -> Rec g xs -> Rec h xs
rzipWith (\ (ToJsonField o) (FromJsonField i) -> (x -> Maybe Value) -> (Text -> Parse e x) -> JsonField e x
forall e a.
(a -> Maybe Value) -> (Text -> Parse e a) -> JsonField e a
JsonField x -> Maybe Value
o Text -> Parse e x
i)

-- |Type of a Vinyl record which describes how to map fields of a record from a JSON object.
--
-- 'fromJsonFrmaOnce you've produced an appropriate 'FromJsonFormatRecord' for your case, use recordFromJson' to make a @'FromJson' e (Record '[…])@ of it.
type FromJsonFormatRecord e rs = Rec (FromJsonField e) rs

-- |Given a @'JsonFormatRecord' rs@ which describes how to encode or decode a record, produce a @'FromJsonFormatRecord' rs@ which describes
-- only how to decode the record.
fromJsonFormatRecord :: RMap rs => JsonFormatRecord e rs -> FromJsonFormatRecord e rs
fromJsonFormatRecord :: JsonFormatRecord e rs -> FromJsonFormatRecord e rs
fromJsonFormatRecord = (forall x. JsonField e x -> FromJsonField e x)
-> JsonFormatRecord e rs -> FromJsonFormatRecord e rs
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\ (JsonField _ i) -> (Text -> Parse e x) -> FromJsonField e x
forall e a. (Text -> Parse e a) -> FromJsonField e a
FromJsonField Text -> Parse e x
i)

-- |Type of a Vinyl record which describes how to map fields of a record from a JSON object.
--
-- Once you've produced an appropriate 'ToJsonFormatRecord' for your case, use recordToJson' to make a @'ToJson' (Record '[…])@ of it.
type ToJsonFormatRecord rs = Rec ToJsonField rs

-- |Given a @'Rec' ('JsonField' e) rs@ which describes how to encode or decode a record, produce a @'Rec' 'ToField' rs@ which describes
-- only how to encode the record.
toJsonFormatRecord :: RMap rs => JsonFormatRecord e rs -> ToJsonFormatRecord rs
toJsonFormatRecord :: JsonFormatRecord e rs -> ToJsonFormatRecord rs
toJsonFormatRecord = (forall x. JsonField e x -> ToJsonField x)
-> JsonFormatRecord e rs -> ToJsonFormatRecord rs
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\ (JsonField o _) -> (x -> Maybe Value) -> ToJsonField x
forall a. (a -> Maybe Value) -> ToJsonField a
ToJsonField x -> Maybe Value
o)

-- |Helper class which induces over the structure of a record, reflecting the name of each field and applying each 'ToJson' to its corresponding value to
-- produce JSON.
class RecordToJsonObject rs where
  -- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to 'Aeson.Object'.
  recordToJsonObject :: Rec ToJsonField rs -> Rec Identity rs -> Aeson.Object

instance RecordToJsonObject '[] where
  recordToJsonObject :: Rec ToJsonField '[] -> Rec Identity '[] -> Object
recordToJsonObject Rec ToJsonField '[]
_ = Object -> Rec Identity '[] -> Object
forall a b. a -> b -> a
const Object
forall a. Monoid a => a
mempty

instance forall s a rs. (KnownSymbol s, RecordToJsonObject rs) => RecordToJsonObject (s :-> a ': rs) where
  recordToJsonObject :: Rec ToJsonField ((s :-> a) : rs)
-> Rec Identity ((s :-> a) : rs) -> Object
recordToJsonObject (ToJsonField r -> Maybe Value
aToField :& Rec ToJsonField rs
fs) (Identity r
a :& Rec Identity rs
as) =
#if MIN_VERSION_aeson(2,0,0)
    (Object -> Object)
-> (Value -> Object -> Object) -> Maybe Value -> Object -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object -> Object
forall a. a -> a
id (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.KeyMap.insert (String -> Key
Aeson.Key.fromString (String -> Key) -> (Proxy s -> String) -> Proxy s -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> Key) -> Proxy s -> Key
forall a b. (a -> b) -> a -> b
$ (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))) (r -> Maybe Value
aToField r
r
a) (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$
#else
    maybe id (HM.insert (pack . symbolVal $ (Proxy :: Proxy s))) (aToField a) $
#endif
      Rec ToJsonField rs -> Rec Identity rs -> Object
forall (rs :: [*]).
RecordToJsonObject rs =>
Rec ToJsonField rs -> Rec Identity rs -> Object
recordToJsonObject Rec ToJsonField rs
fs Rec Identity rs
Rec Identity rs
as

-- |Given a record of 'ToField' functions for each field in @rs@, convert an 'Identity' record to JSON. Equivalent to @Aeson.Object . 'recordToJsonObject' fmt@
recordToJson :: RecordToJsonObject rs => Rec ToJsonField rs -> Rec Identity rs -> Aeson.Value
recordToJson :: Rec ToJsonField rs -> Rec Identity rs -> Value
recordToJson = (Object -> Value)
-> (Rec Identity rs -> Object) -> Rec Identity rs -> Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Value
Aeson.Object ((Rec Identity rs -> Object) -> Rec Identity rs -> Value)
-> (Rec ToJsonField rs -> Rec Identity rs -> Object)
-> Rec ToJsonField rs
-> Rec Identity rs
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec ToJsonField rs -> Rec Identity rs -> Object
forall (rs :: [*]).
RecordToJsonObject rs =>
Rec ToJsonField rs -> Rec Identity rs -> Object
recordToJsonObject

-- |Class which induces over the structure of a record, parsing fields using a record of 'FromJson' and assembling an 'Identity' record.
class RecordFromJson rs where
  -- |Given a record of 'FromJson' parsers for each field in @rs@, produce an 'ABE.Parse' to make an 'Identity' record.
  recordFromJson :: Rec (FromJsonField e) rs -> ABE.Parse e (Rec Identity rs)

instance RecordFromJson '[] where
  recordFromJson :: Rec (FromJsonField e) '[] -> Parse e (Rec Identity '[])
recordFromJson Rec (FromJsonField e) '[]
_ = Rec Identity '[] -> Parse e (Rec Identity '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec Identity '[]
forall u (a :: u -> *). Rec a '[]
RNil

instance forall s a rs. (KnownSymbol s, RecordFromJson rs) => RecordFromJson (s :-> a ': rs) where
  recordFromJson :: Rec (FromJsonField e) ((s :-> a) : rs)
-> Parse e (Rec Identity ((s :-> a) : rs))
recordFromJson (FromJsonField Text -> Parse e r
aFromField :& Rec (FromJsonField e) rs
fs) =
    Identity r -> Rec Identity rs -> Rec Identity (r : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&)
      (Identity r -> Rec Identity rs -> Rec Identity (r : rs))
-> ParseT e Identity (Identity r)
-> ParseT e Identity (Rec Identity rs -> Rec Identity (r : rs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> Identity r
forall a. a -> Identity a
Identity (r -> Identity r) -> Parse e r -> ParseT e Identity (Identity r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e r
aFromField (String -> Text
pack (String -> Text) -> (Proxy s -> String) -> Proxy s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s -> Text) -> Proxy s -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)))
      ParseT e Identity (Rec Identity rs -> Rec Identity (r : rs))
-> ParseT e Identity (Rec Identity rs)
-> ParseT e Identity (Rec Identity (r : rs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rec (FromJsonField e) rs -> ParseT e Identity (Rec Identity rs)
forall (rs :: [*]) e.
RecordFromJson rs =>
Rec (FromJsonField e) rs -> Parse e (Rec Identity rs)
recordFromJson Rec (FromJsonField e) rs
fs

-- |Take a 'JsonFormatRecord' describing how to map a record with field @rs@ to and from JSON and produce a @'JsonFormat' e (Record rs)@.
--
-- See 'JsonFormatRecord' for more.
recordJsonFormat :: (RMap rs, RecordToJsonObject rs, RecordFromJson rs) => JsonFormatRecord e rs -> JsonFormat e (Rec Identity rs)
recordJsonFormat :: JsonFormatRecord e rs -> JsonFormat e (Rec Identity rs)
recordJsonFormat JsonFormatRecord e rs
formatRec =
  JsonProfunctor e (Rec Identity rs) (Rec Identity rs)
-> JsonFormat e (Rec Identity rs)
forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat (JsonProfunctor e (Rec Identity rs) (Rec Identity rs)
 -> JsonFormat e (Rec Identity rs))
-> JsonProfunctor e (Rec Identity rs) (Rec Identity rs)
-> JsonFormat e (Rec Identity rs)
forall a b. (a -> b) -> a -> b
$ (Rec Identity rs -> Value)
-> Parse e (Rec Identity rs)
-> JsonProfunctor e (Rec Identity rs) (Rec Identity rs)
forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor
    (Rec ToJsonField rs -> Rec Identity rs -> Value
forall (rs :: [*]).
RecordToJsonObject rs =>
Rec ToJsonField rs -> Rec Identity rs -> Value
recordToJson   (Rec ToJsonField rs -> Rec Identity rs -> Value)
-> (JsonFormatRecord e rs -> Rec ToJsonField rs)
-> JsonFormatRecord e rs
-> Rec Identity rs
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonFormatRecord e rs -> Rec ToJsonField rs
forall (rs :: [*]) e.
RMap rs =>
JsonFormatRecord e rs -> ToJsonFormatRecord rs
toJsonFormatRecord   (JsonFormatRecord e rs -> Rec Identity rs -> Value)
-> JsonFormatRecord e rs -> Rec Identity rs -> Value
forall a b. (a -> b) -> a -> b
$ JsonFormatRecord e rs
formatRec)
    (Rec (FromJsonField e) rs -> Parse e (Rec Identity rs)
forall (rs :: [*]) e.
RecordFromJson rs =>
Rec (FromJsonField e) rs -> Parse e (Rec Identity rs)
recordFromJson (Rec (FromJsonField e) rs -> Parse e (Rec Identity rs))
-> (JsonFormatRecord e rs -> Rec (FromJsonField e) rs)
-> JsonFormatRecord e rs
-> Parse e (Rec Identity rs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonFormatRecord e rs -> Rec (FromJsonField e) rs
forall (rs :: [*]) e.
RMap rs =>
JsonFormatRecord e rs -> FromJsonFormatRecord e rs
fromJsonFormatRecord (JsonFormatRecord e rs -> Parse e (Rec Identity rs))
-> JsonFormatRecord e rs -> Parse e (Rec Identity rs)
forall a b. (a -> b) -> a -> b
$ JsonFormatRecord e rs
formatRec)

-- |Class to make a 'JsonFormatRecord' with 'defaultJsonFormat' for each field.
class DefaultJsonFormatRecord rs where
  -- |Produce a 'JsonFormatRecord' for a record with fields @rs@ by using the default 'JsonFormat' for each field in @rs@, as provided by 'DefaultJsonFormat'.
  defaultJsonFormatRecord :: JsonFormatRecord e rs

instance (KnownSymbol s, DefaultJsonFormat a, DefaultJsonFormatRecord rs) => DefaultJsonFormatRecord (s :-> a ': rs) where
  defaultJsonFormatRecord :: JsonFormatRecord e ((s :-> a) : rs)
defaultJsonFormatRecord = JsonFormat e a -> JsonField e (s :-> a)
forall a' a e.
(Wrapped a', Unwrapped a' ~ a) =>
JsonFormat e a -> JsonField e a'
field JsonFormat e a
forall a e. DefaultJsonFormat a => JsonFormat e a
defaultJsonFormat JsonField e (s :-> a)
-> Rec (JsonField e) rs -> JsonFormatRecord e ((s :-> a) : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (JsonField e) rs
forall (rs :: [*]) e.
DefaultJsonFormatRecord rs =>
JsonFormatRecord e rs
defaultJsonFormatRecord

instance DefaultJsonFormatRecord '[] where
  defaultJsonFormatRecord :: JsonFormatRecord e '[]
defaultJsonFormatRecord = JsonFormatRecord e '[]
forall u (a :: u -> *). Rec a '[]
RNil