module Domain.TH.InstanceDecs
where
import Domain.Prelude
import DomainCore.Model
import qualified Domain.TH.InstanceDec as InstanceDec
import qualified Language.Haskell.TH as TH (Dec, Name)
hasField :: TypeDec -> [TH.Dec]
hasField :: TypeDec -> [Dec]
hasField (TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
ProductTypeDef [(Text, Type)]
members ->
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Text, Type) -> Dec
zipper (forall a. Enum a => a -> [a]
enumFrom Int
0) [(Text, Type)]
members
where
numMembers :: Int
numMembers =
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Type)]
members
zipper :: Int -> (Text, Type) -> Dec
zipper Int
offset (Text
fieldName, Type
fieldType) =
Text -> Text -> Type -> Int -> Int -> Dec
InstanceDec.productHasField Text
typeName Text
fieldName Type
fieldType Int
numMembers Int
offset
SumTypeDef [(Text, [Type])]
variants ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, [Type]) -> Dec
mapper [(Text, [Type])]
variants
where
mapper :: (Text, [Type]) -> Dec
mapper (Text
variantName, [Type]
memberTypes) =
Text -> Text -> [Type] -> Dec
InstanceDec.sumHasField Text
typeName Text
variantName [Type]
memberTypes
accessorIsLabel :: TypeDec -> [TH.Dec]
accessorIsLabel :: TypeDec -> [Dec]
accessorIsLabel (TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
ProductTypeDef [(Text, Type)]
members ->
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Text, Type) -> Dec
zipper (forall a. Enum a => a -> [a]
enumFrom Int
0) [(Text, Type)]
members
where
numMembers :: Int
numMembers =
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Type)]
members
zipper :: Int -> (Text, Type) -> Dec
zipper Int
offset (Text
fieldName, Type
fieldType) =
Text -> Text -> Type -> Int -> Int -> Dec
InstanceDec.productAccessorIsLabel Text
typeName Text
fieldName Type
fieldType Int
numMembers Int
offset
SumTypeDef [(Text, [Type])]
variants ->
[(Text, [Type])]
variants forall a b. a -> (a -> b) -> b
&
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Text
variantName, [Type]
memberTypes) ->
Text -> Text -> [Type] -> Dec
InstanceDec.sumAccessorIsLabel Text
typeName Text
variantName [Type]
memberTypes
)
constructorIsLabel :: TypeDec -> [TH.Dec]
constructorIsLabel :: TypeDec -> [Dec]
constructorIsLabel (TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
ProductTypeDef [(Text, Type)]
members ->
[]
SumTypeDef [(Text, [Type])]
variants ->
[(Text, [Type])]
variants forall a b. a -> (a -> b) -> b
&
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Text
variantName, [Type]
memberTypes) ->
Text -> Text -> [Type] -> Dec
InstanceDec.curriedSumConstructorIsLabel Text
typeName Text
variantName [Type]
memberTypes)
variantConstructorIsLabel :: Text -> (Text, [Type]) -> [TH.Dec]
variantConstructorIsLabel :: Text -> (Text, [Type]) -> [Dec]
variantConstructorIsLabel Text
typeName (Text
variantName, [Type]
memberTypes) =
let
curried :: Dec
curried =
Text -> Text -> [Type] -> Dec
InstanceDec.curriedSumConstructorIsLabel Text
typeName Text
variantName [Type]
memberTypes
uncurried :: Dec
uncurried =
Text -> Text -> [Type] -> Dec
InstanceDec.uncurriedSumConstructorIsLabel Text
typeName Text
variantName [Type]
memberTypes
in case [Type]
memberTypes of
[] ->
[Dec
curried]
[Type
_] ->
[Dec
curried]
[Type]
_ ->
[Dec
curried, Dec
uncurried]
mapperIsLabel :: TypeDec -> [TH.Dec]
mapperIsLabel :: TypeDec -> [Dec]
mapperIsLabel (TypeDec Text
typeName TypeDef
typeDef) =
case TypeDef
typeDef of
ProductTypeDef [(Text, Type)]
members ->
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Text, Type) -> Dec
zipper (forall a. Enum a => a -> [a]
enumFrom Int
0) [(Text, Type)]
members
where
numMembers :: Int
numMembers =
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Type)]
members
zipper :: Int -> (Text, Type) -> Dec
zipper Int
offset (Text
fieldName, Type
fieldType) =
Text -> Text -> Type -> Int -> Int -> Dec
InstanceDec.productMapperIsLabel Text
typeName Text
fieldName Type
fieldType Int
numMembers Int
offset
SumTypeDef [(Text, [Type])]
variants ->
do
(Text
variantName, [Type]
memberTypes) <- [(Text, [Type])]
variants
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
memberTypes
then forall (f :: * -> *) a. Alternative f => f a
empty
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> [Type] -> Dec
InstanceDec.sumMapperIsLabel Text
typeName Text
variantName [Type]
memberTypes)
byNonAliasName :: (Text -> TH.Dec) -> TypeDec -> [TH.Dec]
byNonAliasName :: (Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName Text -> Dec
cont (TypeDec Text
a TypeDef
b) =
[Text -> Dec
cont Text
a]
byEnumName :: (Text -> TH.Dec) -> TypeDec -> [TH.Dec]
byEnumName :: (Text -> Dec) -> TypeDec -> [Dec]
byEnumName Text -> Dec
cont (TypeDec Text
name TypeDef
def) =
case TypeDef
def of
SumTypeDef [(Text, [Type])]
variants | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> b
snd) [(Text, [Type])]
variants ->
[Text -> Dec
cont Text
name]
TypeDef
_ ->
[]
enum :: TypeDec -> [Dec]
enum =
(Text -> Dec) -> TypeDec -> [Dec]
byEnumName (Name -> Text -> Dec
InstanceDec.deriving_ ''Enum)
bounded :: TypeDec -> [Dec]
bounded =
(Text -> Dec) -> TypeDec -> [Dec]
byEnumName (Name -> Text -> Dec
InstanceDec.deriving_ ''Bounded)
show :: TypeDec -> [Dec]
show =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Show)
eq :: TypeDec -> [Dec]
eq =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Eq)
ord :: TypeDec -> [Dec]
ord =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Ord)
generic :: TypeDec -> [Dec]
generic =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Generic)
data_ :: TypeDec -> [Dec]
data_ =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Data)
typeable :: TypeDec -> [Dec]
typeable =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Typeable)
hashable :: TypeDec -> [Dec]
hashable =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.empty ''Hashable)
lift :: TypeDec -> [Dec]
lift =
(Text -> Dec) -> TypeDec -> [Dec]
byNonAliasName (Name -> Text -> Dec
InstanceDec.deriving_ ''Lift)