module DomainCore.TH where

import DomainCore.Model
import DomainCore.Prelude
import qualified DomainCore.Text as Text
import qualified Language.Haskell.TH as TH
import qualified THLego.Helpers as TH

-- |
-- Convert a model type definition into Template Haskell.
typeType ::
  -- | Model type.
  Type ->
  -- | Template Haskell type.
  TH.Type
typeType :: Type -> Type
typeType =
  \case
    AppType NonEmpty Type
a ->
      forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type -> Type -> Type
TH.AppT (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 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
a)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Type
typeType [Type]
a)

-- |
-- Assemble a record field name.
recordFieldName ::
  -- | Prepend with underscore.
  Bool ->
  -- | Prefix with type name.
  Bool ->
  -- | Type name.
  Text ->
  -- | Label.
  Text ->
  -- | Template Haskell name.
  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)

-- |
-- Assemble a sum constructor name.
sumConstructorName ::
  -- | Type name.
  Text ->
  -- | Label.
  Text ->
  -- | Template Haskell name.
  TH.Name
sumConstructorName :: Text -> Text -> Name
sumConstructorName Text
a Text
b =
  Text -> Name
TH.textName (Text -> Text -> Text
Text.sumConstructor Text
a Text
b)