module Domain.TH.InstanceDec
where
import Domain.Prelude
import DomainCore.Model
import qualified Language.Haskell.TH as TH
import qualified DomainCore.TH as CoreTH
import qualified Data.Text as Text
import qualified THLego.Instances as Instances
import qualified THLego.Helpers as Helpers
enumHasField :: Text -> Text -> TH.Dec
enumHasField :: Text -> Text -> Dec
enumHasField Text
typeName Text
label =
TyLit -> Type -> Name -> Dec
Instances.enumHasField TyLit
fieldLabel Type
ownerType Name
constructorName
where
fieldLabel :: TyLit
fieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
ownerType :: Type
ownerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
constructorName :: Name
constructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
sumHasField :: Text -> Text -> [Type] -> TH.Dec
sumHasField :: Text -> Text -> [Type] -> Dec
sumHasField Text
typeName Text
label [Type]
memberTypes =
if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
memberTypes
then
TyLit -> Type -> Name -> Dec
Instances.enumHasField TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName
else
TyLit -> Type -> Name -> [Type] -> Dec
Instances.sumHasField TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName [Type]
thMemberTypes
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
thMemberTypes :: [Type]
thMemberTypes =
(Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
CoreTH.typeType [Type]
memberTypes
productHasField :: Text -> Text -> Type -> Int -> Int -> TH.Dec
productHasField :: Text -> Text -> Type -> Int -> Int -> Dec
productHasField Text
typeName Text
fieldName Type
projectionType Int
numMemberTypes Int
offset =
TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
Instances.productHasField TyLit
thFieldLabel Type
thOwnerType Type
thProjectionType
Name
thConstructorName Int
numMemberTypes Int
offset
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
fieldName
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thProjectionType :: Type
thProjectionType =
Type -> Type
CoreTH.typeType Type
projectionType
thConstructorName :: Name
thConstructorName =
Text -> Name
Helpers.textName Text
typeName
productAccessorIsLabel :: Text -> Text -> Type -> Int -> Int -> TH.Dec
productAccessorIsLabel :: Text -> Text -> Type -> Int -> Int -> Dec
productAccessorIsLabel Text
typeName Text
fieldName Type
projectionType Int
numMemberTypes Int
offset =
TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
Instances.productAccessorIsLabel
TyLit
thFieldLabel Type
thOwnerType Type
thProjectionType Name
thConstructorName
Int
numMemberTypes Int
offset
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
fieldName
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thProjectionType :: Type
thProjectionType =
Type -> Type
CoreTH.typeType Type
projectionType
thConstructorName :: Name
thConstructorName =
Text -> Name
Helpers.textName Text
typeName
sumAccessorIsLabel :: Text -> Text -> [Type] -> TH.Dec
sumAccessorIsLabel :: Text -> Text -> [Type] -> Dec
sumAccessorIsLabel Text
typeName Text
label [Type]
memberTypes =
if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
memberTypes
then
TyLit -> Type -> Name -> Dec
Instances.enumAccessorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName
else
TyLit -> Type -> Name -> [Type] -> Dec
Instances.sumAccessorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName [Type]
thMemberTypes
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
thMemberTypes :: [Type]
thMemberTypes =
(Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
CoreTH.typeType [Type]
memberTypes
enumAccessorIsLabel :: Text -> Text -> TH.Dec
enumAccessorIsLabel :: Text -> Text -> Dec
enumAccessorIsLabel Text
typeName Text
label =
TyLit -> Type -> Name -> Dec
Instances.enumAccessorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
curriedSumConstructorIsLabel :: Text -> Text -> [Type] -> TH.Dec
curriedSumConstructorIsLabel :: Text -> Text -> [Type] -> Dec
curriedSumConstructorIsLabel Text
typeName Text
label [Type]
memberTypes =
TyLit -> Type -> Name -> [Type] -> Dec
Instances.sumConstructorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName [Type]
thMemberTypes
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
thMemberTypes :: [Type]
thMemberTypes =
(Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
CoreTH.typeType [Type]
memberTypes
uncurriedSumConstructorIsLabel :: Text -> Text -> [Type] -> TH.Dec
uncurriedSumConstructorIsLabel :: Text -> Text -> [Type] -> Dec
uncurriedSumConstructorIsLabel Text
typeName Text
label [Type]
memberTypes =
TyLit -> Type -> Name -> [Type] -> Dec
Instances.tupleAdtConstructorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName [Type]
thMemberTypes
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
thMemberTypes :: [Type]
thMemberTypes =
(Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
CoreTH.typeType [Type]
memberTypes
enumConstructorIsLabel :: Text -> Text -> TH.Dec
enumConstructorIsLabel :: Text -> Text -> Dec
enumConstructorIsLabel Text
typeName Text
label =
TyLit -> Type -> Name -> Dec
Instances.enumConstructorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
wrapperConstructorIsLabel :: Text -> Type -> TH.Dec
wrapperConstructorIsLabel :: Text -> Type -> Dec
wrapperConstructorIsLabel Text
typeName Type
memberType =
TyLit -> Type -> Name -> Type -> Dec
Instances.newtypeConstructorIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName Type
thMemberType
where
thFieldLabel :: TyLit
thFieldLabel =
String -> TyLit
TH.StrTyLit String
"value"
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Name
Helpers.textName Text
typeName
thMemberType :: Type
thMemberType =
Type -> Type
CoreTH.typeType Type
memberType
wrapperMapperIsLabel :: Text -> Type -> TH.Dec
wrapperMapperIsLabel :: Text -> Type -> Dec
wrapperMapperIsLabel Text
typeName Type
memberType =
TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
Instances.productMapperIsLabel
TyLit
thFieldLabel Type
thOwnerType Type
thMemberType Name
thConstructorName Int
1 Int
0
where
thFieldLabel :: TyLit
thFieldLabel =
String -> TyLit
TH.StrTyLit String
"value"
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Name
Helpers.textName Text
typeName
thMemberType :: Type
thMemberType =
Type -> Type
CoreTH.typeType Type
memberType
productMapperIsLabel :: Text -> Text -> Type -> Int -> Int -> TH.Dec
productMapperIsLabel :: Text -> Text -> Type -> Int -> Int -> Dec
productMapperIsLabel Text
typeName Text
fieldName Type
projectionType Int
numMemberTypes Int
offset =
TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
Instances.productMapperIsLabel
TyLit
thFieldLabel Type
thOwnerType Type
thProjectionType Name
thConstructorName
Int
numMemberTypes Int
offset
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
fieldName
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thProjectionType :: Type
thProjectionType =
Type -> Type
CoreTH.typeType Type
projectionType
thConstructorName :: Name
thConstructorName =
Text -> Name
Helpers.textName Text
typeName
sumMapperIsLabel :: Text -> Text -> [Type] -> TH.Dec
sumMapperIsLabel :: Text -> Text -> [Type] -> Dec
sumMapperIsLabel Text
typeName Text
label [Type]
memberTypes =
TyLit -> Type -> Name -> [Type] -> Dec
Instances.sumMapperIsLabel
TyLit
thFieldLabel Type
thOwnerType Name
thConstructorName [Type]
thMemberTypes
where
thFieldLabel :: TyLit
thFieldLabel =
Text -> TyLit
Helpers.textTyLit Text
label
thOwnerType :: Type
thOwnerType =
Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeName)
thConstructorName :: Name
thConstructorName =
Text -> Text -> Name
CoreTH.sumConstructorName Text
typeName Text
label
thMemberTypes :: [Type]
thMemberTypes =
(Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
CoreTH.typeType [Type]
memberTypes
deriving_ :: TH.Name -> Text -> TH.Dec
deriving_ :: Name -> Text -> Dec
deriving_ Name
className Text
typeNameText =
Maybe DerivStrategy -> [Type] -> Type -> Dec
TH.StandaloneDerivD Maybe DerivStrategy
forall a. Maybe a
Nothing [] Type
headType
where
headType :: Type
headType =
Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT Name
className) (Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeNameText))
empty :: TH.Name -> Text -> TH.Dec
empty :: Name -> Text -> Dec
empty Name
className Text
typeNameText =
Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
TH.InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] Type
headType []
where
headType :: Type
headType =
Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT Name
className) (Name -> Type
TH.ConT (Text -> Name
Helpers.textName Text
typeNameText))