module DomainCore.TH
where
import DomainCore.Prelude
import DomainCore.Model
import qualified Language.Haskell.TH as TH
import qualified THLego.Helpers as TH
import qualified DomainCore.Text as Text
import qualified Data.Text as Text
import qualified Data.Char as Char
typeType ::
Type ->
TH.Type
typeType :: Type -> Type
typeType =
\ case
AppType NonEmpty Type
a ->
(Type -> Type -> Type) -> NonEmpty Type -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type -> Type -> Type
TH.AppT ((Type -> Type) -> NonEmpty Type -> NonEmpty Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
typeType NonEmpty Type
a)
RefType Text
a ->
Name -> Type
TH.ConT (Text -> Name
TH.textName Text
a)
ListType Type
a ->
Type -> Type -> Type
TH.AppT Type
TH.ListT (Type -> Type
typeType Type
a)
TupleType [Type]
a ->
Type -> [Type] -> Type
TH.multiAppT (Int -> Type
TH.TupleT ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
a)) ((Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
typeType [Type]
a)
recordFieldName ::
Bool ->
Bool ->
Text ->
Text ->
TH.Name
recordFieldName :: Bool -> Bool -> Text -> Text -> Name
recordFieldName Bool
underscore Bool
prefixWithTypeName Text
a Text
b =
Text -> Name
TH.textName (Bool -> Bool -> Text -> Text -> Text
Text.recordField Bool
underscore Bool
prefixWithTypeName Text
a Text
b)
sumConstructorName ::
Text ->
Text ->
TH.Name
sumConstructorName :: Text -> Text -> Name
sumConstructorName Text
a Text
b =
Text -> Name
TH.textName (Text -> Text -> Text
Text.sumConstructor Text
a Text
b)