{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Jordan.ToJSON.Class
where
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import qualified Data.Map.Strict as Map
import qualified Data.Ratio as Ratio
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import qualified Data.Semigroup as Semi
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Proxy(..), Typeable, tyConModule, tyConName, typeRep, typeRepTyCon)
import Data.Void (Void, absurd)
import GHC.Generics
import Jordan.Generic.Options
class (Contravariant f) => Selectable f where
giveUp :: (arg -> Void) -> f arg
select :: (arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
class (Divisible f) => JSONObjectSerializer f where
writeField
:: Text
-> (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-> f a
class (Divisible f) => JSONTupleSerializer f where
writeItem
:: (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-> f a
class (Selectable f) => JSONSerializer f where
serializeObject
:: Text
-> (forall objSerializer. JSONObjectSerializer objSerializer => objSerializer a)
-> f a
serializeDictionary
:: (Foldable t)
=> (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-> f (t (Text, a))
serializeText
:: f Text
serializeTextConstant
:: Text
-> f a
serializeNull
:: f any
serializeNumber
:: f Scientific
serializeBool
:: f Bool
serializeTuple
:: (forall tupleSerializer. JSONTupleSerializer tupleSerializer => tupleSerializer a)
-> f a
serializeArray
:: (ToJSON a)
=> f [a]
class ToJSON v where
toJSON :: (JSONSerializer f) => f v
default toJSON :: (Generic v, GToJSON (Rep v)) => (JSONSerializer f) => f v
toJSON = (v -> Rep v Any) -> f (Rep v Any) -> f v
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap v -> Rep v Any
forall a x. Generic a => a -> Rep a x
from (f (Rep v Any) -> f v) -> f (Rep v Any) -> f v
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> f (Rep v Any)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
defaultToJSONOptions
instance ToJSON () where
toJSON :: f ()
toJSON = f ()
forall (f :: * -> *) any. JSONSerializer f => f any
serializeNull
instance ToJSON Text where
toJSON :: f Text
toJSON = f Text
forall (f :: * -> *). JSONSerializer f => f Text
serializeText
instance ToJSON Scientific where
toJSON :: f Scientific
toJSON = f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber
instance {-# OVERLAPPABLE #-} (ToJSON a) => ToJSON [a] where
toJSON :: f [a]
toJSON = f [a]
forall (f :: * -> *) a. (JSONSerializer f, ToJSON a) => f [a]
serializeArray
instance (ToJSON a) => ToJSON (Maybe a) where
toJSON :: f (Maybe a)
toJSON = (Maybe a -> Either () a) -> f () -> f a -> f (Maybe a)
forall (f :: * -> *) arg lhs rhs.
Selectable f =>
(arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
select Maybe a -> Either () a
forall b. Maybe b -> Either () b
find f ()
forall (f :: * -> *) any. JSONSerializer f => f any
serializeNull f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
where
find :: Maybe b -> Either () b
find Maybe b
Nothing = () -> Either () b
forall a b. a -> Either a b
Left ()
find (Just b
a) = b -> Either () b
forall a b. b -> Either a b
Right b
a
instance (ToJSON lhs, ToJSON rhs) => ToJSON (Either lhs rhs) where
toJSON :: f (Either lhs rhs)
toJSON = (Either lhs rhs -> Either lhs rhs)
-> f lhs -> f rhs -> f (Either lhs rhs)
forall (f :: * -> *) arg lhs rhs.
Selectable f =>
(arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
select Either lhs rhs -> Either lhs rhs
forall a. a -> a
id f lhs
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON f rhs
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance ToJSON Bool where
toJSON :: f Bool
toJSON = f Bool
forall (f :: * -> *). JSONSerializer f => f Bool
serializeBool
instance ToJSON Int where
toJSON :: f Int
toJSON = (Int -> Scientific) -> f Scientific -> f Int
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber
instance ToJSON Integer where
toJSON :: f Integer
toJSON = (Integer -> Scientific) -> f Scientific -> f Integer
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber
instance ToJSON Float where
toJSON :: f Float
toJSON = (Float -> Scientific) -> f Scientific -> f Float
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Float -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber
instance ToJSON Double where
toJSON :: f Double
toJSON = (Double -> Scientific) -> f Scientific -> f Double
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber
instance {-# OVERLAPPING #-} ToJSON String where
toJSON :: f String
toJSON = (String -> Text) -> f Text -> f String
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap String -> Text
T.pack f Text
forall (f :: * -> *). JSONSerializer f => f Text
serializeText
instance forall a. (ToJSON a, Typeable a) => ToJSON (Ratio.Ratio a) where
toJSON :: f (Ratio a)
toJSON = Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (Ratio a))
-> f (Ratio a)
forall (f :: * -> *) a.
JSONSerializer f =>
Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a)
-> f a
serializeObject Text
objName ((forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (Ratio a))
-> f (Ratio a))
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (Ratio a))
-> f (Ratio a)
forall a b. (a -> b) -> a -> b
$
(Ratio a -> (a, a))
-> objSerializer a -> objSerializer a -> objSerializer (Ratio a)
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide Ratio a -> (a, a)
divider (Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> objSerializer a
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField Text
"num" forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
toJSON) (Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> objSerializer a
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField Text
"denom" forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
toJSON)
where
divider :: Ratio.Ratio a -> (a,a)
divider :: Ratio a -> (a, a)
divider = (,) (a -> a -> (a, a)) -> (Ratio a -> a) -> Ratio a -> a -> (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator (Ratio a -> a -> (a, a)) -> (Ratio a -> a) -> Ratio a -> (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator
objName :: Text
objName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
tyName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Ratio"
tyName :: String
tyName = (TyCon -> String
tyConModule (TyCon -> String) -> (TyCon -> String) -> TyCon -> String
forall a. Semigroup a => a -> a -> a
<> String -> TyCon -> String
forall a b. a -> b -> a
const String
"." (TyCon -> String) -> (TyCon -> String) -> TyCon -> String
forall a. Semigroup a => a -> a -> a
<> TyCon -> String
tyConName) (TyCon -> String) -> TyCon -> String
forall a b. (a -> b) -> a -> b
$ TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance (ToJSON a) => ToJSON (Semi.Min a) where
toJSON :: f (Min a)
toJSON = (Min a -> a) -> f a -> f (Min a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Min a -> a
forall a. Min a -> a
Semi.getMin f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Semi.Max a) where
toJSON :: f (Max a)
toJSON = (Max a -> a) -> f a -> f (Max a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Max a -> a
forall a. Max a -> a
Semi.getMax f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Semi.First a) where
toJSON :: f (First a)
toJSON = (First a -> a) -> f a -> f (First a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap First a -> a
forall a. First a -> a
Semi.getFirst f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Semi.Last a) where
toJSON :: f (Last a)
toJSON = (Last a -> a) -> f a -> f (Last a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Last a -> a
forall a. Last a -> a
Semi.getLast f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Semi.Dual a) where
toJSON :: f (Dual a)
toJSON = (Dual a -> a) -> f a -> f (Dual a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Dual a -> a
forall a. Dual a -> a
Semi.getDual f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance ToJSON Semi.All where
toJSON :: f All
toJSON = (All -> Bool) -> f Bool -> f All
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap All -> Bool
Semi.getAll f Bool
forall (f :: * -> *). JSONSerializer f => f Bool
serializeBool
instance ToJSON Semi.Any where
toJSON :: f Any
toJSON = (Any -> Bool) -> f Bool -> f Any
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Any -> Bool
Semi.getAny f Bool
forall (f :: * -> *). JSONSerializer f => f Bool
serializeBool
instance (ToJSON a) => ToJSON (Semi.Sum a) where
toJSON :: f (Sum a)
toJSON = (Sum a -> a) -> f a -> f (Sum a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Sum a -> a
forall a. Sum a -> a
Semi.getSum f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Semi.Product a) where
toJSON :: f (Product a)
toJSON = (Product a -> a) -> f a -> f (Product a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Product a -> a
forall a. Product a -> a
Semi.getProduct f a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (ToJSON a) => ToJSON (Map.Map Text a) where
toJSON :: f (Map Text a)
toJSON = (Map Text a -> [(Text, a)]) -> f [(Text, a)] -> f (Map Text a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
Map.toList (f [(Text, a)] -> f (Map Text a))
-> f [(Text, a)] -> f (Map Text a)
forall a b. (a -> b) -> a -> b
$ (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f [(Text, a)]
forall (f :: * -> *) (t :: * -> *) a.
(JSONSerializer f, Foldable t) =>
(forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f (t (Text, a))
serializeDictionary forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
toJSON
data ToJSONOptions
= ToJSONOptions
{ ToJSONOptions -> SumTypeEncoding
toJSONEncodeSums :: SumTypeEncoding
, ToJSONOptions -> String
toJSONBaseName :: String
, ToJSONOptions -> String -> String
toJSONRenderEnum :: String -> String
}
defaultToJSONOptions :: ToJSONOptions
defaultToJSONOptions :: ToJSONOptions
defaultToJSONOptions
= SumTypeEncoding -> String -> (String -> String) -> ToJSONOptions
ToJSONOptions SumTypeEncoding
TagInField String
"" String -> String
forall a. a -> a
id
class GToJSON v where
gToJSON :: (JSONSerializer s) => ToJSONOptions -> s (v a)
instance (ToJSON c) => GToJSON (K1 i c) where
gToJSON :: ToJSONOptions -> s (K1 i c a)
gToJSON ToJSONOptions
_ = (K1 i c a -> c) -> s c -> s (K1 i c a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(K1 c
a) -> c
a) s c
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON
instance (GToJSON f, Datatype t) => GToJSON (D1 t f) where
gToJSON :: ToJSONOptions -> s (D1 t f a)
gToJSON = (D1 t f a -> f a) -> s (f a) -> s (D1 t f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(M1 f a
a) -> f a
a) (s (f a) -> s (D1 t f a))
-> (ToJSONOptions -> s (f a)) -> ToJSONOptions -> s (D1 t f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToJSONOptions -> s (f a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON (ToJSONOptions -> s (f a))
-> (ToJSONOptions -> ToJSONOptions) -> ToJSONOptions -> s (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToJSONOptions -> ToJSONOptions
addName
where
addName :: ToJSONOptions -> ToJSONOptions
addName ToJSONOptions
b = ToJSONOptions
b { toJSONBaseName :: String
toJSONBaseName = ToJSONOptions -> String
toJSONBaseName ToJSONOptions
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dtname }
dtname :: String
dtname = M1 D t f Any -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
moduleName M1 D t f Any
forall a. D1 t f a
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> M1 D t f Any -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName M1 D t f Any
forall a. D1 t f a
s
s :: D1 t f a
s :: D1 t f a
s = D1 t f a
forall a. HasCallStack => a
undefined
instance {-# OVERLAPS #-} (Constructor t) => GToJSON (PartOfSum (C1 t U1)) where
gToJSON :: ToJSONOptions -> s (PartOfSum (C1 t U1) a)
gToJSON ToJSONOptions
opts = (PartOfSum (C1 t U1) a -> C1 t U1 a)
-> s (C1 t U1 a) -> s (PartOfSum (C1 t U1) a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap PartOfSum (C1 t U1) a -> C1 t U1 a
forall (f :: * -> *) a. PartOfSum f a -> f a
getPartOfSum (s (C1 t U1 a) -> s (PartOfSum (C1 t U1) a))
-> s (C1 t U1 a) -> s (PartOfSum (C1 t U1) a)
forall a b. (a -> b) -> a -> b
$ Text -> s (C1 t U1 a)
forall (f :: * -> *) a. JSONSerializer f => Text -> f a
serializeTextConstant Text
enumValue
where
enumValue :: Text
enumValue = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> String -> String
toJSONRenderEnum ToJSONOptions
opts (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 C t U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall f. M1 C t U1 f
forall a. HasCallStack => a
undefined :: C1 t U1 f)
instance {-# OVERLAPPABLE #-} (Constructor t, GToJSON (C1 t f)) => GToJSON (PartOfSum (C1 t f)) where
gToJSON :: ToJSONOptions -> s (PartOfSum (C1 t f) a)
gToJSON ToJSONOptions
opts = (PartOfSum (C1 t f) a -> C1 t f a)
-> s (C1 t f a) -> s (PartOfSum (C1 t f) a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap PartOfSum (C1 t f) a -> C1 t f a
forall (f :: * -> *) a. PartOfSum f a -> f a
getPartOfSum s (C1 t f a)
forall a. s (C1 t f a)
encoded
where
encoded :: s (C1 t f a)
encoded = case ToJSONOptions -> SumTypeEncoding
toJSONEncodeSums ToJSONOptions
opts of
SumTypeEncoding
TagVal -> s (C1 t f a)
forall a. s (C1 t f a)
tagged
SumTypeEncoding
TagInField -> s (C1 t f a)
forall a. s (C1 t f a)
field
field :: s (C1 t f a)
field = Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a)
forall (f :: * -> *) a.
JSONSerializer f =>
Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a)
-> f a
serializeObject Text
objName ((forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a))
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a)
forall a b. (a -> b) -> a -> b
$
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer (C1 t f a))
-> objSerializer (C1 t f a)
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField Text
cn (ToJSONOptions -> jsonSerializer (C1 t f a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
opts)
tagged :: s (C1 t f a)
tagged = Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a)
forall (f :: * -> *) a.
JSONSerializer f =>
Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a)
-> f a
serializeObject Text
objName ((forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a))
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (C1 t f a))
-> s (C1 t f a)
forall a b. (a -> b) -> a -> b
$
(C1 t f a -> ((), C1 t f a))
-> objSerializer ((), C1 t f a) -> objSerializer (C1 t f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((),) (objSerializer ((), C1 t f a) -> objSerializer (C1 t f a))
-> objSerializer ((), C1 t f a) -> objSerializer (C1 t f a)
forall a b. (a -> b) -> a -> b
$
objSerializer ()
-> objSerializer (C1 t f a) -> objSerializer ((), C1 t f a)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided
(Text
-> (forall (f :: * -> *). JSONSerializer f => f ())
-> objSerializer ()
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField Text
"key" ((forall (f :: * -> *). JSONSerializer f => f ())
-> objSerializer ())
-> (forall (f :: * -> *). JSONSerializer f => f ())
-> objSerializer ()
forall a b. (a -> b) -> a -> b
$ Text -> jsonSerializer ()
forall (f :: * -> *) a. JSONSerializer f => Text -> f a
serializeTextConstant Text
cn)
(Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer (C1 t f a))
-> objSerializer (C1 t f a)
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField Text
"value" ((forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer (C1 t f a))
-> objSerializer (C1 t f a))
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer (C1 t f a))
-> objSerializer (C1 t f a)
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> jsonSerializer (C1 t f a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
opts)
objName :: Text
objName = String -> Text
T.pack (ToJSONOptions -> String
toJSONBaseName ToJSONOptions
opts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Output"
cn :: Text
cn = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 C t f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. M1 C t f a
forall a. HasCallStack => a
undefined :: C1 t f a)
sumToEither :: (l :+: r) a -> Either (l a) (r a)
sumToEither :: (:+:) l r a -> Either (l a) (r a)
sumToEither (:+:) l r a
f = case (:+:) l r a
f of
L1 l a
a -> l a -> Either (l a) (r a)
forall a b. a -> Either a b
Left l a
a
R1 r a
a -> r a -> Either (l a) (r a)
forall a b. b -> Either a b
Right r a
a
instance forall l r. (GToJSON (PartOfSum l), GToJSON (PartOfSum r)) => GToJSON (l :+: r) where
gToJSON :: forall f a. (JSONSerializer f) => ToJSONOptions -> f ((l :+: r) a)
gToJSON :: ToJSONOptions -> f ((:+:) l r a)
gToJSON ToJSONOptions
opts =
((:+:) l r a -> Either (l a) (r a))
-> f (l a) -> f (r a) -> f ((:+:) l r a)
forall (f :: * -> *) arg lhs rhs.
Selectable f =>
(arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
select
(:+:) l r a -> Either (l a) (r a)
forall (l :: * -> *) (r :: * -> *) a.
(:+:) l r a -> Either (l a) (r a)
sumToEither
((l a -> PartOfSum l a) -> f (PartOfSum l a) -> f (l a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap l a -> PartOfSum l a
forall (f :: * -> *) a. f a -> PartOfSum f a
PartOfSum (f (PartOfSum l a) -> f (l a)) -> f (PartOfSum l a) -> f (l a)
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> f (PartOfSum l a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
opts)
((r a -> PartOfSum r a) -> f (PartOfSum r a) -> f (r a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap r a -> PartOfSum r a
forall (f :: * -> *) a. f a -> PartOfSum f a
PartOfSum (f (PartOfSum r a) -> f (r a)) -> f (PartOfSum r a) -> f (r a)
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> f (PartOfSum r a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
opts)
instance (GToJSON (PartOfSum l), GToJSON (PartOfSum r)) => GToJSON (PartOfSum (l :+: r)) where
gToJSON :: ToJSONOptions -> s (PartOfSum (l :+: r) a)
gToJSON ToJSONOptions
opts = (PartOfSum (l :+: r) a -> (:+:) l r a)
-> s ((:+:) l r a) -> s (PartOfSum (l :+: r) a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap PartOfSum (l :+: r) a -> (:+:) l r a
forall (f :: * -> *) a. PartOfSum f a -> f a
getPartOfSum (ToJSONOptions -> s ((:+:) l r a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
opts)
instance (GToJSON s) => GToJSON (S1 whatever s) where
gToJSON :: ToJSONOptions -> s (S1 whatever s a)
gToJSON = (S1 whatever s a -> s a) -> s (s a) -> s (S1 whatever s a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(M1 s a
a) -> s a
a) (s (s a) -> s (S1 whatever s a))
-> (ToJSONOptions -> s (s a))
-> ToJSONOptions
-> s (S1 whatever s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToJSONOptions -> s (s a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON
instance GToJSON V1 where
gToJSON :: ToJSONOptions -> s (V1 a)
gToJSON ToJSONOptions
_ = (V1 a -> Void) -> s (V1 a)
forall (f :: * -> *) arg. Selectable f => (arg -> Void) -> f arg
giveUp (String -> V1 a -> Void
forall a. HasCallStack => String -> a
error String
"how the hell did you construct a void data type?")
class GToJSONObject v where
gToJSONObject :: (JSONObjectSerializer f) => ToJSONOptions -> f (v a)
instance (GToJSON f, Selector t) => GToJSONObject (S1 t f) where
gToJSONObject :: ToJSONOptions -> f (S1 t f a)
gToJSONObject ToJSONOptions
o
= (S1 t f a -> f a) -> f (f a) -> f (S1 t f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(M1 f a
a) -> f a
a)
(f (f a) -> f (S1 t f a)) -> f (f a) -> f (S1 t f a)
forall a b. (a -> b) -> a -> b
$ Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer (f a))
-> f (f a)
forall (f :: * -> *) a.
JSONObjectSerializer f =>
Text
-> (forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a)
-> f a
writeField (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 S t f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S t f Any
forall a. M1 S t f a
v) (ToJSONOptions -> jsonSerializer (f a)
forall (v :: * -> *) (s :: * -> *) a.
(GToJSON v, JSONSerializer s) =>
ToJSONOptions -> s (v a)
gToJSON ToJSONOptions
o)
where
v :: M1 S t f a
v :: M1 S t f a
v = M1 S t f a
forall a. HasCallStack => a
undefined
instance (GToJSONObject lhs, GToJSONObject rhs) => GToJSONObject (lhs :*: rhs) where
gToJSONObject :: ToJSONOptions -> f ((:*:) lhs rhs a)
gToJSONObject ToJSONOptions
o = ((:*:) lhs rhs a -> (lhs a, rhs a))
-> f (lhs a) -> f (rhs a) -> f ((:*:) lhs rhs a)
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (:*:) lhs rhs a -> (lhs a, rhs a)
forall (f :: * -> *) (g :: * -> *) p. (:*:) f g p -> (f p, g p)
div (ToJSONOptions -> f (lhs a)
forall (v :: * -> *) (f :: * -> *) a.
(GToJSONObject v, JSONObjectSerializer f) =>
ToJSONOptions -> f (v a)
gToJSONObject ToJSONOptions
o) (ToJSONOptions -> f (rhs a)
forall (v :: * -> *) (f :: * -> *) a.
(GToJSONObject v, JSONObjectSerializer f) =>
ToJSONOptions -> f (v a)
gToJSONObject ToJSONOptions
o)
where
div :: (:*:) f g p -> (f p, g p)
div (f p
a :*: g p
b) = (f p
a,g p
b)
instance {-# OVERLAPPABLE #-} (GToJSONObject inner, Constructor t) => GToJSON (C1 t inner) where
gToJSON :: ToJSONOptions -> s (C1 t inner a)
gToJSON ToJSONOptions
opts
= (C1 t inner a -> inner a) -> s (inner a) -> s (C1 t inner a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(M1 inner a
a) -> inner a
a)
(s (inner a) -> s (C1 t inner a))
-> s (inner a) -> s (C1 t inner a)
forall a b. (a -> b) -> a -> b
$ Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (inner a))
-> s (inner a)
forall (f :: * -> *) a.
JSONSerializer f =>
Text
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a)
-> f a
serializeObject Text
name
((forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (inner a))
-> s (inner a))
-> (forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer (inner a))
-> s (inner a)
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> objSerializer (inner a)
forall (v :: * -> *) (f :: * -> *) a.
(GToJSONObject v, JSONObjectSerializer f) =>
ToJSONOptions -> f (v a)
gToJSONObject ToJSONOptions
opts
where
name :: Text
name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ToJSONOptions -> String
toJSONBaseName ToJSONOptions
opts String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> M1 C t inner Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. M1 C t inner a
forall a. HasCallStack => a
undefined :: C1 t inner a) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Output"
instance {-# OVERLAPS #-} (ToJSON i) => GToJSON (C1 c (S1 (MetaSel 'Nothing su ss ds) (Rec0 i))) where
gToJSON :: ToJSONOptions
-> s (C1 c (S1 ('MetaSel 'Nothing su ss ds) (Rec0 i)) a)
gToJSON ToJSONOptions
_ = (C1 c (S1 ('MetaSel 'Nothing su ss ds) (Rec0 i)) a -> i)
-> s i -> s (C1 c (S1 ('MetaSel 'Nothing su ss ds) (Rec0 i)) a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(M1 (M1 (K1 i
s))) -> i
s) s i
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON