109 lines
3.8 KiB
Haskell
109 lines
3.8 KiB
Haskell
-- {-# OPTIONS_GHC -fdefer-type-errors -w #-}
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
module Language.GraphQL.Reflection (document, schemaDocument) where
|
|
|
|
import Data.Text (Text)
|
|
import GraphQL.Internal.Name
|
|
import GraphQL.Internal.Syntax.AST
|
|
import Language.Haskell.Exts.Syntax as Haskell
|
|
import qualified Data.Text as Text
|
|
|
|
import Debug.Trace
|
|
|
|
document :: QueryDocument -> [Haskell.Decl ()]
|
|
document (QueryDocument defs) = fmap definition defs
|
|
|
|
definition :: Definition -> Haskell.Decl ()
|
|
definition = \case
|
|
DefinitionOperation def -> operationDefinition def
|
|
DefinitionFragment def -> fragmentDefinition def
|
|
|
|
operationDefinition :: OperationDefinition -> Haskell.Decl ()
|
|
operationDefinition = \case
|
|
Query n -> node n
|
|
Mutation n -> node n
|
|
AnonymousQuery s -> selectionSet s
|
|
|
|
node :: Node -> Haskell.Decl ()
|
|
node = showDie
|
|
|
|
selectionSet :: SelectionSet -> Haskell.Decl ()
|
|
selectionSet = undefined
|
|
|
|
fragmentDefinition :: FragmentDefinition -> Haskell.Decl ()
|
|
fragmentDefinition = undefined
|
|
|
|
schemaDocument :: SchemaDocument -> [Haskell.Decl ()]
|
|
schemaDocument (SchemaDocument defs) = fmap typeDefinition defs
|
|
|
|
typeDefinition :: TypeDefinition -> Haskell.Decl ()
|
|
typeDefinition = \case
|
|
TypeDefinitionObject x -> objectTypeDefinition x
|
|
TypeDefinitionInterface x -> interfaceTypeDefinition x
|
|
TypeDefinitionUnion x -> unionTypeDefinition x
|
|
TypeDefinitionScalar x -> scalarTypeDefinition x
|
|
TypeDefinitionEnum x -> enumTypeDefinition x
|
|
TypeDefinitionInputObject x -> inputObjectTypeDefinition x
|
|
TypeDefinitionTypeExtension x -> typeExtensionDefinition x
|
|
|
|
objectTypeDefinition :: ObjectTypeDefinition -> Haskell.Decl ()
|
|
objectTypeDefinition (ObjectTypeDefinition (Name name) _interfaces fields)
|
|
= DataDecl () (DataType ()) Nothing (DHead () (Ident () name')) (pure qualConDecl) []
|
|
where
|
|
name' = Text.unpack name
|
|
qualConDecl = QualConDecl () Nothing Nothing (RecDecl () (Ident () name') (fmap fieldDefinition fields))
|
|
|
|
fieldDefinition :: FieldDefinition -> FieldDecl ()
|
|
fieldDefinition (FieldDefinition (Name name) argumentsDefinition gType)
|
|
= FieldDecl () [Ident () (Text.unpack name)] (fieldType argumentsDefinition gType)
|
|
|
|
fieldType :: [InputValueDefinition] -> GType -> Type ()
|
|
fieldType xs gType = foldr (TyFun () . inputValueDefinition) (baseType gType) xs
|
|
|
|
inputValueDefinition :: InputValueDefinition -> Type ()
|
|
inputValueDefinition (InputValueDefinition _name gType _maybeDefaultValue)
|
|
= baseType gType
|
|
|
|
baseType :: GType -> Type ()
|
|
baseType = \case
|
|
TypeNamed (NamedType (Name name)) -> maybeOf $ namedType name
|
|
TypeList (ListType listType) -> maybeOf $ listOf $ baseType listType
|
|
TypeNonNull gType -> nonNullType gType
|
|
|
|
nonNullType :: NonNullType -> Type ()
|
|
nonNullType = \case
|
|
NonNullTypeNamed (NamedType (Name name)) -> namedType name
|
|
NonNullTypeList (ListType listType) -> listOf $ baseType listType
|
|
|
|
namedType :: Text -> Type ()
|
|
namedType name = TyCon () (UnQual () (Ident () (Text.unpack name)))
|
|
|
|
-- FIXME: Given a concrete type `t` it should create the type `[t]`.
|
|
listOf :: Type () -> Type ()
|
|
listOf = id
|
|
|
|
-- FIXME: Given a concrete type `t` it should create the type `Maybe t`.
|
|
maybeOf :: Type () -> Type ()
|
|
maybeOf = id
|
|
|
|
interfaceTypeDefinition :: InterfaceTypeDefinition -> Haskell.Decl a
|
|
interfaceTypeDefinition = showDie
|
|
|
|
unionTypeDefinition :: UnionTypeDefinition -> Haskell.Decl a
|
|
unionTypeDefinition = showDie
|
|
|
|
scalarTypeDefinition :: ScalarTypeDefinition -> Haskell.Decl a
|
|
scalarTypeDefinition = showDie
|
|
|
|
enumTypeDefinition :: EnumTypeDefinition -> Haskell.Decl a
|
|
enumTypeDefinition = showDie
|
|
|
|
inputObjectTypeDefinition :: InputObjectTypeDefinition -> Haskell.Decl a
|
|
inputObjectTypeDefinition = showDie
|
|
|
|
typeExtensionDefinition :: TypeExtensionDefinition -> Haskell.Decl a
|
|
typeExtensionDefinition = showDie
|
|
|
|
showDie :: Show a => a -> b
|
|
showDie a = traceShow a undefined
|