{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

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

import Data.Morpheus.Internal.Utils (elems)
import Data.Morpheus.Types.Internal.AST.Base
  ( FieldName,
    TypeName,
    TypeRef (..),
    hsTypeName,
  )
import Data.Morpheus.Types.Internal.AST.Fields
  ( FieldDefinition (..),
    FieldsDefinition,
  )
import Data.Morpheus.Types.Internal.AST.TypeSystem
  ( DataEnumValue (..),
  )
import Relude

toHSFieldDefinition :: FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition :: FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition field :: FieldDefinition cat s
field@FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = tyRef :: TypeRef
tyRef@TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}} =
  FieldDefinition cat s
field
    { fieldType :: TypeRef
fieldType = TypeRef
tyRef {typeConName :: TypeName
typeConName = TypeName -> TypeName
hsTypeName TypeName
typeConName}
    }

data TypeNameTH = TypeNameTH
  { TypeNameTH -> [FieldName]
namespace :: [FieldName],
    TypeNameTH -> TypeName
typename :: TypeName
  }
  deriving (Int -> TypeNameTH -> ShowS
[TypeNameTH] -> ShowS
TypeNameTH -> String
(Int -> TypeNameTH -> ShowS)
-> (TypeNameTH -> String)
-> ([TypeNameTH] -> ShowS)
-> Show TypeNameTH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeNameTH] -> ShowS
$cshowList :: [TypeNameTH] -> ShowS
show :: TypeNameTH -> String
$cshow :: TypeNameTH -> String
showsPrec :: Int -> TypeNameTH -> ShowS
$cshowsPrec :: Int -> TypeNameTH -> ShowS
Show)

-- Template Haskell Types

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

mkCons :: TypeName -> FieldsDefinition cat s -> ConsD cat s
mkCons :: TypeName -> FieldsDefinition cat s -> ConsD cat s
mkCons TypeName
typename FieldsDefinition cat s
fields =
  ConsD :: forall (cat :: TypeCategory) (s :: Stage).
TypeName -> [FieldDefinition cat s] -> ConsD cat s
ConsD
    { cName :: TypeName
cName = TypeName -> TypeName
hsTypeName TypeName
typename,
      cFields :: [FieldDefinition cat s]
cFields = (FieldDefinition cat s -> FieldDefinition cat s)
-> [FieldDefinition cat s] -> [FieldDefinition cat s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition cat s -> FieldDefinition cat s
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition (FieldsDefinition cat s -> [FieldDefinition cat s]
forall a coll. Elems a coll => coll -> [a]
elems FieldsDefinition cat s
fields)
    }

isEnum :: [ConsD cat s] -> Bool
isEnum :: [ConsD cat s] -> Bool
isEnum = (ConsD cat s -> Bool) -> [ConsD cat s] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([FieldDefinition cat s] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FieldDefinition cat s] -> Bool)
-> (ConsD cat s -> [FieldDefinition cat s]) -> ConsD cat s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsD cat s -> [FieldDefinition cat s]
forall (cat :: TypeCategory) (s :: Stage).
ConsD cat s -> [FieldDefinition cat s]
cFields)

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