module DomainAeson.TH where
import DomainAeson.Prelude
import qualified DomainAeson.Util.AesonTH as AesonTH
import qualified DomainCore.Model as Model
import qualified DomainCore.TH as DomainTH
import Language.Haskell.TH.Syntax
import THLego.Helpers
toJsonDec :: Model.TypeDec -> Dec
toJsonDec :: TypeDec -> Dec
toJsonDec (Model.TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
Model.ProductTypeDef [(Text, Type)]
members ->
Type -> Name -> [Text] -> Dec
AesonTH.productToJsonInstanceDec
(Name -> Type
ConT (Text -> Name
textName Text
typeName))
(Text -> Name
textName Text
typeName)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(Text, Type)]
members)
Model.SumTypeDef [(Text, [Type])]
members ->
Type -> [(Text, Name, Int)] -> Dec
AesonTH.sumToJsonInstanceDec
(Name -> Type
ConT (Text -> Name
textName Text
typeName))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, [Type]) -> (Text, Name, Int)
member [(Text, [Type])]
members)
where
member :: (Text, [Type]) -> (Text, Name, Int)
member (Text
memberName, [Type]
memberComponentTypes) =
( Text
memberName,
Text -> Text -> Name
DomainTH.sumConstructorName Text
typeName Text
memberName,
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
memberComponentTypes
)
fromJsonDec :: Model.TypeDec -> Dec
fromJsonDec :: TypeDec -> Dec
fromJsonDec (Model.TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
Model.ProductTypeDef [(Text, Type)]
members ->
Type -> Name -> [(Text, Bool)] -> Dec
AesonTH.productFromJsonInstanceDec
(Name -> Type
ConT (Text -> Name
textName Text
typeName))
(Text -> Name
textName Text
typeName)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Type -> Bool
typeIsRequired) [(Text, Type)]
members)
Model.SumTypeDef [(Text, [Type])]
members ->
Type -> [(Text, Name, Int)] -> Dec
AesonTH.sumFromJsonInstanceDec
(Name -> Type
ConT (Text -> Name
textName Text
typeName))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, [Type]) -> (Text, Name, Int)
member [(Text, [Type])]
members)
where
member :: (Text, [Type]) -> (Text, Name, Int)
member (Text
memberName, [Type]
memberComponentTypes) =
( Text
memberName,
Text -> Text -> Name
DomainTH.sumConstructorName Text
typeName Text
memberName,
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
memberComponentTypes
)
typeIsRequired :: Model.Type -> Bool
typeIsRequired :: Type -> Bool
typeIsRequired = \case
Model.AppType (Model.RefType Text
ref :| [Type]
_) ->
case Text
ref of
Text
"Maybe" -> Bool
False
Text
_ -> Bool
True
Type
_ -> Bool
True