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
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
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) =
    (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
$
      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