{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

-- | Generic conversion to/from JSON
module Data.Record.Generic.JSON (
    gtoJSON
  , gparseJSON
  ) where

import Data.Aeson
import Data.Aeson.Types
import Data.Proxy

import qualified Data.Text as Text

import Data.Record.Generic
import qualified Data.Record.Generic.Rep as Rep

gtoJSON :: forall a. (Generic a, Constraints a ToJSON) => a -> Value
gtoJSON :: a -> Value
gtoJSON =
      [Pair] -> Value
object
    ([Pair] -> Value) -> (a -> [Pair]) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (K Pair) a -> [Pair]
forall a b. Rep (K a) b -> [a]
Rep.collapse
    (Rep (K Pair) a -> [Pair]) -> (a -> Rep (K Pair) a) -> a -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. K String x -> K Value x -> K Pair x)
-> Rep (K String) a -> Rep (K Value) a -> Rep (K Pair) a
forall a (f :: Type -> Type) (g :: Type -> Type)
       (h :: Type -> Type).
Generic a =>
(forall x. f x -> g x -> h x) -> Rep f a -> Rep g a -> Rep h a
Rep.zipWith ((String -> Value -> Pair) -> K String x -> K Value x -> K Pair x
forall k1 k2 k3 a b c (d :: k1) (e :: k2) (f :: k3).
(a -> b -> c) -> K a d -> K b e -> K c f
mapKKK ((String -> Value -> Pair) -> K String x -> K Value x -> K Pair x)
-> (String -> Value -> Pair) -> K String x -> K Value x -> K Pair x
forall a b. (a -> b) -> a -> b
$ \String
n Value
x -> (String -> Text
Text.pack String
n, Value
x)) (Metadata a -> Rep (K String) a
forall a. Metadata a -> Rep (K String) a
recordFieldNames Metadata a
md)
    (Rep (K Value) a -> Rep (K Pair) a)
-> (a -> Rep (K Value) a) -> a -> Rep (K Pair) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy ToJSON
-> (forall x. ToJSON x => I x -> K Value x)
-> Rep I a
-> Rep (K Value) a
forall a (c :: Type -> Constraint) (f :: Type -> Type)
       (g :: Type -> Type).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x -> g x) -> Rep f a -> Rep g a
Rep.cmap (Proxy ToJSON
forall k (t :: k). Proxy t
Proxy @ToJSON) (Value -> K Value x
forall k a (b :: k). a -> K a b
K (Value -> K Value x) -> (I x -> Value) -> I x -> K Value x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Value
forall a. ToJSON a => a -> Value
toJSON (x -> Value) -> (I x -> x) -> I x -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> x
forall a. I a -> a
unI)
    (Rep I a -> Rep (K Value) a)
-> (a -> Rep I a) -> a -> Rep (K Value) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep I a
forall a. Generic a => a -> Rep I a
from
  where
    md :: Metadata a
md = Proxy a -> Metadata a
forall a (proxy :: Type -> Type).
Generic a =>
proxy a -> Metadata a
metadata (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

gparseJSON :: forall a. (Generic a, Constraints a FromJSON) => Value -> Parser a
gparseJSON :: Value -> Parser a
gparseJSON =
    String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (Metadata a -> String
forall a. Metadata a -> String
recordName Metadata a
md) ((Rep I a -> a) -> Parser (Rep I a) -> Parser a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep I a -> a
forall a. Generic a => Rep I a -> a
to (Parser (Rep I a) -> Parser a)
-> (Object -> Parser (Rep I a)) -> Object -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (Parser :.: I) a -> Parser (Rep I a)
forall (m :: Type -> Type) (f :: Type -> Type) a.
Applicative m =>
Rep (m :.: f) a -> m (Rep f a)
Rep.sequenceA (Rep (Parser :.: I) a -> Parser (Rep I a))
-> (Object -> Rep (Parser :.: I) a) -> Object -> Parser (Rep I a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Rep (Parser :.: I) a
aux)
  where
    md :: Metadata a
md = Proxy a -> Metadata a
forall a (proxy :: Type -> Type).
Generic a =>
proxy a -> Metadata a
metadata (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

    aux :: Object -> Rep (Parser :.: I) a
    aux :: Object -> Rep (Parser :.: I) a
aux Object
obj =
        Proxy FromJSON
-> (forall x. FromJSON x => K String x -> (:.:) Parser I x)
-> Rep (K String) a
-> Rep (Parser :.: I) a
forall a (c :: Type -> Constraint) (f :: Type -> Type)
       (g :: Type -> Type).
(Generic a, Constraints a c) =>
Proxy c -> (forall x. c x => f x -> g x) -> Rep f a -> Rep g a
Rep.cmap
          (Proxy FromJSON
forall k (t :: k). Proxy t
Proxy @FromJSON)
          (\(K fld) -> Parser (I x) -> (:.:) Parser I x
forall l k (f :: l -> Type) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (x -> I x
forall a. a -> I a
I (x -> I x) -> Parser x -> Parser (I x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser x
forall x. FromJSON x => String -> Parser x
getField String
fld))
          (Metadata a -> Rep (K String) a
forall a. Metadata a -> Rep (K String) a
recordFieldNames Metadata a
md)
      where
        getField :: FromJSON x => String -> Parser x
        getField :: String -> Parser x
getField String
fld = Object
obj Object -> Text -> Parser x
forall a. FromJSON a => Object -> Text -> Parser a
.: String -> Text
Text.pack String
fld