-- Template Haskell Types
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.TH
  ( ConsD (..),
    mkConsEnum,
  )
where

import Data.Morpheus.Types.Internal.AST.Base
  ( TypeName,
    hsTypeName,
  )
import Data.Morpheus.Types.Internal.AST.TypeSystem
  ( DataEnumValue (..),
  )
import Relude

data ConsD f = ConsD
  { ConsD f -> TypeName
cName :: TypeName,
    ConsD f -> [f]
cFields :: [f]
  }
  deriving (Int -> ConsD f -> ShowS
[ConsD f] -> ShowS
ConsD f -> String
(Int -> ConsD f -> ShowS)
-> (ConsD f -> String) -> ([ConsD f] -> ShowS) -> Show (ConsD f)
forall f. Show f => Int -> ConsD f -> ShowS
forall f. Show f => [ConsD f] -> ShowS
forall f. Show f => ConsD f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsD f] -> ShowS
$cshowList :: forall f. Show f => [ConsD f] -> ShowS
show :: ConsD f -> String
$cshow :: forall f. Show f => ConsD f -> String
showsPrec :: Int -> ConsD f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> ConsD f -> ShowS
Show)

mkConsEnum :: DataEnumValue s -> ConsD f
mkConsEnum :: DataEnumValue s -> ConsD f
mkConsEnum DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} = ConsD :: forall f. TypeName -> [f] -> ConsD f
ConsD {cName :: TypeName
cName = TypeName -> TypeName
hsTypeName TypeName
enumName, cFields :: [f]
cFields = []}