module Miso.GraphQL.TH where

import Data.Char (toUpper)
import Data.Foldable (for_, msum, toList)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.List.NonEmpty (nonEmpty)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, isNothing, listToMaybe, mapMaybe)
import Data.Traversable (for)
import GHC.Generics (Generic)
import Language.Haskell.TH hiding (Name, Type)
import Language.Haskell.TH qualified as TH hiding (Type)
import Language.Haskell.TH.Syntax
    ( Quasi (qAddDependentFile)
    , addModFinalizer
    , makeRelativeToProject
    )
import Miso.GraphQL.AST hiding (rootOperationType)
import Miso.GraphQL.Class (ToGraphQL (..))
import Miso.GraphQL.JSON (Operation (..))
import Miso.GraphQL.Lexer qualified as Lexer
import Miso.GraphQL.Parser qualified as Parser
import Miso.JSON (FromJSON, ToJSON)
import Miso.Prelude hiding (for)
import Miso.String (ToMisoString)
import Miso.String qualified as MisoString

documentFile :: FilePath -> DecsQ
documentFile :: String -> DecsQ
documentFile String
f = do
    String
f <- String -> Q String
makeRelativeToProject String
f
    String -> Q ()
forall (m :: * -> *). Quasi m => String -> m ()
qAddDependentFile String
f
    String
src <- IO String -> Q String
forall a. IO a -> Q a
runIO (IO String -> Q String) -> IO String -> Q String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
f
    IO () -> Q ()
forall a. IO a -> Q a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Q ()) -> IO () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
src
    let src' :: MisoString
src' = String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString String
src
    Document
doc <-
        (ParseError Document Token -> Q Document)
-> (Document -> Q Document)
-> Either (ParseError Document Token) Document
-> Q Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Document
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Document)
-> (ParseError Document Token -> String)
-> ParseError Document Token
-> Q Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ParseError Document Token -> String
forall a. Show a => a -> String
show) Document -> Q Document
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseError Document Token) Document -> Q Document)
-> Either (ParseError Document Token) Document -> Q Document
forall a b. (a -> b) -> a -> b
$ Lexer [Token]
-> Parser Token Document
-> MisoString
-> Either (ParseError Document Token) Document
forall token a.
Lexer [token]
-> Parser token a -> MisoString -> Either (ParseError a token) a
Parser.parse' Lexer [Token]
Lexer.tokens Parser Token Document
Parser.document MisoString
src'
    Document -> DecsQ
document Document
doc

typeDefinitionName :: TypeDefinition -> Name
typeDefinitionName :: TypeDefinition -> Name
typeDefinitionName (DefinitionScalarType (ScalarTypeDefinition Maybe Description
_ Name
name Maybe Directives
_)) = Name
name
typeDefinitionName (DefinitionObjectType (ObjectTypeDefinition Maybe Description
_ Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
_)) = Name
name
typeDefinitionName (DefinitionInterfaceType (InterfaceTypeDefinition Maybe Description
_ Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
_)) = Name
name
typeDefinitionName (DefinitionUnionType (UnionTypeDefinition Maybe Description
_ Name
name Maybe Directives
_ Maybe UnionMemberTypes
_)) = Name
name
typeDefinitionName (DefinitionEnumType (EnumTypeDefinition Maybe Description
_ Name
name Maybe Directives
_ Maybe EnumValuesDefinition
_)) = Name
name
typeDefinitionName (DefinitionInputObjectType (InputObjectTypeDefinition Maybe Description
_ Name
name Maybe Directives
_ Maybe InputFieldsDefinition
_)) = Name
name

typeExtensionName :: TypeExtension -> Name
typeExtensionName :: TypeExtension -> Name
typeExtensionName (ExtensionScalarType (ScalarTypeExtension Name
name Directives
_)) = Name
name
typeExtensionName (ExtensionObjectType (ObjectTypeExtension Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
_)) = Name
name
typeExtensionName (ExtensionInterfaceType (InterfaceTypeExtension Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
_)) = Name
name
typeExtensionName (ExtensionUnionType (UnionTypeExtension Name
name Maybe Directives
_ Maybe UnionMemberTypes
_)) = Name
name
typeExtensionName (ExtensionEnumType (EnumTypeExtension Name
name Maybe Directives
_ Maybe EnumValuesDefinition
_)) = Name
name
typeExtensionName (ExtensionInputObjectType (InputObjectTypeExtension Name
name Maybe Directives
_ Maybe InputFieldsDefinition
_)) = Name
name

maybeConcat :: (Semigroup a) => Maybe a -> Maybe a -> Maybe a
maybeConcat :: forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
maybeConcat Maybe a
Nothing Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
maybeConcat (Just a
a) Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeConcat Maybe a
Nothing (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just a
b
maybeConcat (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)

applyExtension :: TypeExtension -> TypeDefinition -> TypeDefinition
applyExtension :: TypeExtension -> TypeDefinition -> TypeDefinition
applyExtension
    (ExtensionScalarType (ScalarTypeExtension Name
name' Directives
directives'))
    (DefinitionScalarType (ScalarTypeDefinition Maybe Description
desc Name
name Maybe Directives
directives))
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            ScalarTypeDefinition -> TypeDefinition
DefinitionScalarType
                (ScalarTypeDefinition -> TypeDefinition)
-> ScalarTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name -> Maybe Directives -> ScalarTypeDefinition
ScalarTypeDefinition Maybe Description
desc Name
name (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Directives -> Maybe Directives
forall a. a -> Maybe a
Just Directives
directives')
applyExtension
    ( ExtensionObjectType
            (ObjectTypeExtension Name
name' Maybe ImplementsInterfaces
implementsInterfaces' Maybe Directives
directives' Maybe FieldsDefinition
fieldsDefinition')
        )
    ( DefinitionObjectType
            (ObjectTypeDefinition Maybe Description
desc Name
name Maybe ImplementsInterfaces
implementsInterfaces Maybe Directives
directives Maybe FieldsDefinition
fieldsDefinition)
        )
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            ObjectTypeDefinition -> TypeDefinition
DefinitionObjectType
                (ObjectTypeDefinition -> TypeDefinition)
-> ObjectTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> Maybe ImplementsInterfaces
-> Maybe Directives
-> Maybe FieldsDefinition
-> ObjectTypeDefinition
ObjectTypeDefinition
                    Maybe Description
desc
                    Name
name
                    (Maybe ImplementsInterfaces
implementsInterfaces Maybe ImplementsInterfaces
-> Maybe ImplementsInterfaces -> Maybe ImplementsInterfaces
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe ImplementsInterfaces
implementsInterfaces')
                    (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe Directives
directives')
                    (Maybe FieldsDefinition
fieldsDefinition Maybe FieldsDefinition
-> Maybe FieldsDefinition -> Maybe FieldsDefinition
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe FieldsDefinition
fieldsDefinition')
applyExtension
    ( ExtensionInterfaceType
            (InterfaceTypeExtension Name
name' Maybe ImplementsInterfaces
implementsInterfaces' Maybe Directives
directives' Maybe FieldsDefinition
fieldsDefinition')
        )
    ( DefinitionInterfaceType
            ( InterfaceTypeDefinition
                    Maybe Description
desc
                    Name
name
                    Maybe ImplementsInterfaces
implementsInterfaces
                    Maybe Directives
directives
                    Maybe FieldsDefinition
fieldsDefinition
                )
        )
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            InterfaceTypeDefinition -> TypeDefinition
DefinitionInterfaceType
                (InterfaceTypeDefinition -> TypeDefinition)
-> InterfaceTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> Maybe ImplementsInterfaces
-> Maybe Directives
-> Maybe FieldsDefinition
-> InterfaceTypeDefinition
InterfaceTypeDefinition
                    Maybe Description
desc
                    Name
name
                    (Maybe ImplementsInterfaces
implementsInterfaces Maybe ImplementsInterfaces
-> Maybe ImplementsInterfaces -> Maybe ImplementsInterfaces
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe ImplementsInterfaces
implementsInterfaces')
                    (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe Directives
directives')
                    (Maybe FieldsDefinition
fieldsDefinition Maybe FieldsDefinition
-> Maybe FieldsDefinition -> Maybe FieldsDefinition
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe FieldsDefinition
fieldsDefinition')
applyExtension
    ( ExtensionUnionType
            (UnionTypeExtension Name
name' Maybe Directives
directives' Maybe UnionMemberTypes
unionMemberTypes')
        )
    ( DefinitionUnionType
            (UnionTypeDefinition Maybe Description
desc Name
name Maybe Directives
directives Maybe UnionMemberTypes
unionMemberTypes)
        )
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            UnionTypeDefinition -> TypeDefinition
DefinitionUnionType
                (UnionTypeDefinition -> TypeDefinition)
-> UnionTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> Maybe Directives
-> Maybe UnionMemberTypes
-> UnionTypeDefinition
UnionTypeDefinition
                    Maybe Description
desc
                    Name
name
                    (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe Directives
directives')
                    (Maybe UnionMemberTypes
unionMemberTypes Maybe UnionMemberTypes
-> Maybe UnionMemberTypes -> Maybe UnionMemberTypes
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe UnionMemberTypes
unionMemberTypes')
applyExtension
    ( ExtensionEnumType
            (EnumTypeExtension Name
name' Maybe Directives
directives' Maybe EnumValuesDefinition
enumValuesDefinition')
        )
    ( DefinitionEnumType
            (EnumTypeDefinition Maybe Description
desc Name
name Maybe Directives
directives Maybe EnumValuesDefinition
enumValuesDefinition)
        )
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            EnumTypeDefinition -> TypeDefinition
DefinitionEnumType
                (EnumTypeDefinition -> TypeDefinition)
-> EnumTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> Maybe Directives
-> Maybe EnumValuesDefinition
-> EnumTypeDefinition
EnumTypeDefinition
                    Maybe Description
desc
                    Name
name
                    (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe Directives
directives')
                    (Maybe EnumValuesDefinition
enumValuesDefinition Maybe EnumValuesDefinition
-> Maybe EnumValuesDefinition -> Maybe EnumValuesDefinition
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe EnumValuesDefinition
enumValuesDefinition')
applyExtension
    ( ExtensionInputObjectType
            (InputObjectTypeExtension Name
name' Maybe Directives
directives' Maybe InputFieldsDefinition
fieldsDefinition')
        )
    ( DefinitionInputObjectType
            (InputObjectTypeDefinition Maybe Description
desc Name
name Maybe Directives
directives Maybe InputFieldsDefinition
fieldsDefinition)
        )
        | Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name' =
            InputObjectTypeDefinition -> TypeDefinition
DefinitionInputObjectType
                (InputObjectTypeDefinition -> TypeDefinition)
-> InputObjectTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> Maybe Directives
-> Maybe InputFieldsDefinition
-> InputObjectTypeDefinition
InputObjectTypeDefinition
                    Maybe Description
desc
                    Name
name
                    (Maybe Directives
directives Maybe Directives -> Maybe Directives -> Maybe Directives
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe Directives
directives')
                    (Maybe InputFieldsDefinition
fieldsDefinition Maybe InputFieldsDefinition
-> Maybe InputFieldsDefinition -> Maybe InputFieldsDefinition
forall a. Semigroup a => Maybe a -> Maybe a -> Maybe a
`maybeConcat` Maybe InputFieldsDefinition
fieldsDefinition')
applyExtension TypeExtension
_ TypeDefinition
t = TypeDefinition
t

document :: Document -> DecsQ
document :: Document -> DecsQ
document (Document NonEmpty Definition
definitions) =
    [DecsQ] -> DecsQ
forall a. Monoid a => [a] -> a
mconcat
        ([DecsQ] -> DecsQ) -> ([[DecsQ]] -> [DecsQ]) -> [[DecsQ]] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[DecsQ]] -> [DecsQ]
forall a. Monoid a => [a] -> a
mconcat
        ([[DecsQ]] -> DecsQ) -> [[DecsQ]] -> DecsQ
forall a b. (a -> b) -> a -> b
$ [ Map Name TypeDefinition
typeDefinitions
                Map Name TypeDefinition
-> (Map Name TypeDefinition -> [(Name, TypeDefinition)])
-> [(Name, TypeDefinition)]
forall a b. a -> (a -> b) -> b
& Map Name TypeDefinition -> [(Name, TypeDefinition)]
forall k a. Map k a -> [(k, a)]
Map.toList
                [(Name, TypeDefinition)]
-> ([(Name, TypeDefinition)] -> [(Name, TypeDefinition)])
-> [(Name, TypeDefinition)]
forall a b. a -> (a -> b) -> b
& ((Name, TypeDefinition) -> Bool)
-> [(Name, TypeDefinition)] -> [(Name, TypeDefinition)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
name, TypeDefinition
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Bool
isRootOperationType Name
name)
                [(Name, TypeDefinition)]
-> ((Name, TypeDefinition) -> DecsQ) -> [DecsQ]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
_, TypeDefinition
typeDefinition) ->
                    case TypeDefinition
typeDefinition of
                        DefinitionScalarType ScalarTypeDefinition
_ -> [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                        DefinitionObjectType ObjectTypeDefinition
typeDefinition ->
                            ObjectTypeDefinition -> DecsQ
objectTypeDefinition ObjectTypeDefinition
typeDefinition
                        DefinitionInterfaceType InterfaceTypeDefinition
_ -> [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                        DefinitionUnionType UnionTypeDefinition
typeDefinition ->
                            UnionTypeDefinition -> DecsQ
unionTypeDefinition UnionTypeDefinition
typeDefinition
                        DefinitionEnumType EnumTypeDefinition
typeDefinition ->
                            EnumTypeDefinition -> DecsQ
enumTypeDefinition EnumTypeDefinition
typeDefinition
                        DefinitionInputObjectType InputObjectTypeDefinition
typeDefinition ->
                            InputObjectTypeDefinition -> DecsQ
inputObjectTypeDefinition InputObjectTypeDefinition
typeDefinition
          , [(OperationType, NamedType)]
rootOperationTypes [(OperationType, NamedType)]
-> ((OperationType, NamedType) -> DecsQ) -> [DecsQ]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(OperationType
operationType, NamedType Name
name) -> do
                ObjectTypeDefinition
typeDefinition <- case Name -> Map Name TypeDefinition -> Maybe TypeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name TypeDefinition
typeDefinitions of
                    Just (DefinitionObjectType ObjectTypeDefinition
typeDefinition) -> ObjectTypeDefinition -> Q ObjectTypeDefinition
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectTypeDefinition
typeDefinition
                    Just TypeDefinition
_ -> String -> Q ObjectTypeDefinition
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q ObjectTypeDefinition)
-> String -> Q ObjectTypeDefinition
forall a b. (a -> b) -> a -> b
$ String
"Expected object type for root operation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OperationType -> String
forall a. Show a => a -> String
show OperationType
operationType
                    Maybe TypeDefinition
Nothing -> String -> Q ObjectTypeDefinition
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q ObjectTypeDefinition)
-> String -> Q ObjectTypeDefinition
forall a b. (a -> b) -> a -> b
$ String
"Cannot find type for root operation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OperationType -> String
forall a. Show a => a -> String
show OperationType
operationType
                Map Name TypeDefinition
-> OperationType -> ObjectTypeDefinition -> DecsQ
rootOperationType Map Name TypeDefinition
typeDefinitions OperationType
operationType ObjectTypeDefinition
typeDefinition
          ]
  where
    typeDefinitions :: Map Name TypeDefinition
    typeDefinitions :: Map Name TypeDefinition
typeDefinitions =
        [(Name, TypeDefinition)] -> Map Name TypeDefinition
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Name
name, Name -> TypeDefinition -> TypeDefinition
applyExtensions Name
name TypeDefinition
t)
            | DefinitionTypeSystem (DefinitionType TypeDefinition
t) <- NonEmpty Definition -> [Definition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Definition
definitions
            , let name :: Name
name = TypeDefinition -> Name
typeDefinitionName TypeDefinition
t
            ]
    typeExtensions :: Map Name [TypeExtension]
    typeExtensions :: Map Name [TypeExtension]
typeExtensions =
        ([TypeExtension] -> [TypeExtension] -> [TypeExtension])
-> [(Name, [TypeExtension])] -> Map Name [TypeExtension]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
            [TypeExtension] -> [TypeExtension] -> [TypeExtension]
forall a. Semigroup a => a -> a -> a
(<>)
            [ (TypeExtension -> Name
typeExtensionName TypeExtension
t, TypeExtension -> [TypeExtension]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeExtension
t)
            | ExtensionTypeSystem (ExtensionType TypeExtension
t) <- NonEmpty Definition -> [Definition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Definition
definitions
            ]
    applyExtensions :: Name -> TypeDefinition -> TypeDefinition
    applyExtensions :: Name -> TypeDefinition -> TypeDefinition
applyExtensions Name
name TypeDefinition
t = (TypeExtension -> TypeDefinition -> TypeDefinition)
-> TypeDefinition -> [TypeExtension] -> TypeDefinition
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypeExtension -> TypeDefinition -> TypeDefinition
applyExtension TypeDefinition
t ([TypeExtension] -> TypeDefinition)
-> (Maybe [TypeExtension] -> [TypeExtension])
-> Maybe [TypeExtension]
-> TypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [TypeExtension] -> Maybe [TypeExtension] -> [TypeExtension]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TypeExtension] -> TypeDefinition)
-> Maybe [TypeExtension] -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ Name -> Map Name [TypeExtension] -> Maybe [TypeExtension]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name [TypeExtension]
typeExtensions
    rootOperations :: [RootOperationTypeDefinition]
    rootOperations :: [RootOperationTypeDefinition]
rootOperations =
        [[RootOperationTypeDefinition]] -> [RootOperationTypeDefinition]
forall a. Monoid a => [a] -> a
mconcat
            [ NonEmpty RootOperationTypeDefinition
-> [RootOperationTypeDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty RootOperationTypeDefinition
tds
            | DefinitionTypeSystem (DefinitionSchema (SchemaDefinition Maybe Description
_ Maybe Directives
_ NonEmpty RootOperationTypeDefinition
tds)) <-
                NonEmpty Definition -> [Definition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Definition
definitions
            ]
    rootOperationTypes :: [(OperationType, NamedType)]
    rootOperationTypes :: [(OperationType, NamedType)]
rootOperationTypes = ((OperationType -> Maybe (OperationType, NamedType))
 -> [OperationType] -> [(OperationType, NamedType)])
-> [OperationType]
-> (OperationType -> Maybe (OperationType, NamedType))
-> [(OperationType, NamedType)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OperationType -> Maybe (OperationType, NamedType))
-> [OperationType] -> [(OperationType, NamedType)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [OperationType
forall a. Bounded a => a
minBound .. OperationType
forall a. Bounded a => a
maxBound] \OperationType
ot ->
        (OperationType
ot,)
            (NamedType -> (OperationType, NamedType))
-> Maybe NamedType -> Maybe (OperationType, NamedType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe NamedType] -> Maybe NamedType
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
                [ [NamedType] -> Maybe NamedType
forall a. [a] -> Maybe a
listToMaybe
                    [ NamedType
t
                    | RootOperationTypeDefinition OperationType
o NamedType
t <- [RootOperationTypeDefinition] -> [RootOperationTypeDefinition]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [RootOperationTypeDefinition]
rootOperations
                    , OperationType
o OperationType -> OperationType -> Bool
forall a. Eq a => a -> a -> Bool
== OperationType
ot
                    ]
                , let defaultName :: Name
defaultName = MisoString -> Name
Name (MisoString -> Name) -> (String -> MisoString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ OperationType -> String
forall a. Show a => a -> String
show OperationType
ot
                   in Name -> NamedType
NamedType Name
defaultName NamedType -> Maybe TypeDefinition -> Maybe NamedType
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name -> Map Name TypeDefinition -> Maybe TypeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
defaultName Map Name TypeDefinition
typeDefinitions
                ]
    isRootOperationType :: Name -> Bool
    isRootOperationType :: Name -> Bool
isRootOperationType = (Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (NamedType -> Name
namedTypeName (NamedType -> Name)
-> ((OperationType, NamedType) -> NamedType)
-> (OperationType, NamedType)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (OperationType, NamedType) -> NamedType
forall a b. (a, b) -> b
snd ((OperationType, NamedType) -> Name)
-> [(OperationType, NamedType)] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(OperationType, NamedType)]
rootOperationTypes))

putDoc' :: TH.Name -> String -> Q ()
putDoc' :: Name -> String -> Q ()
putDoc' Name
name = Q () -> Q ()
addModFinalizer (Q () -> Q ()) -> (String -> Q ()) -> String -> Q ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DocLoc -> String -> Q ()
putDoc (Name -> DocLoc
DeclDoc Name
name)

description :: TH.Name -> Description -> Q ()
description :: Name -> Description -> Q ()
description Name
name =
    Name -> String -> Q ()
putDoc' Name
name (String -> Q ()) -> (Description -> String) -> Description -> Q ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> String
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> String)
-> (Description -> MisoString) -> Description -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
        Description (SingleLineString MisoString
s) -> MisoString
s
        Description (BlockString MisoString
s) -> MisoString
s

mkName' :: (ToMisoString s) => s -> TH.Name
mkName' :: forall s. ToMisoString s => s -> Name
mkName' = String -> Name
mkName (String -> Name) -> (s -> String) -> s -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> String
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> String) -> (s -> MisoString) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString

objectTypeDefinition :: ObjectTypeDefinition -> DecsQ
objectTypeDefinition :: ObjectTypeDefinition -> DecsQ
objectTypeDefinition (ObjectTypeDefinition Maybe Description
desc Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
fields) = do
    Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
    case [FieldDefinition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDefinition]
fields' of
        Int
0 -> [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Int
1 -> Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing Q Con
con [Q DerivClause]
derivs
        Int
_ -> Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing [Q Con
con] [Q DerivClause]
derivs
  where
    name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
    fields' :: [FieldDefinition]
fields' =
        Maybe FieldsDefinition
fields Maybe FieldsDefinition
-> (Maybe FieldsDefinition -> [FieldDefinition])
-> [FieldDefinition]
forall a b. a -> (a -> b) -> b
& (FieldsDefinition -> [FieldDefinition])
-> Maybe FieldsDefinition -> [FieldDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(FieldsDefinition NonEmpty FieldDefinition
xs) ->
            NonEmpty FieldDefinition
xs NonEmpty FieldDefinition
-> (NonEmpty FieldDefinition -> [FieldDefinition])
-> [FieldDefinition]
forall a b. a -> (a -> b) -> b
& NonEmpty FieldDefinition -> [FieldDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [FieldDefinition]
-> ([FieldDefinition] -> [FieldDefinition]) -> [FieldDefinition]
forall a b. a -> (a -> b) -> b
& (FieldDefinition -> Bool) -> [FieldDefinition] -> [FieldDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter \(FieldDefinition Maybe Description
_ Name
_ Maybe ArgumentsDefinition
args Type
_ Maybe Directives
_) ->
                Maybe ArgumentsDefinition -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ArgumentsDefinition
args
    con :: ConQ
    con :: Q Con
con =
        Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name' ([Q VarBangType] -> Q Con) -> [Q VarBangType] -> Q Con
forall a b. (a -> b) -> a -> b
$ [FieldDefinition]
fields' [FieldDefinition]
-> (FieldDefinition -> Q VarBangType) -> [Q VarBangType]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(FieldDefinition Maybe Description
desc Name
name Maybe ArgumentsDefinition
_ Type
t Maybe Directives
_) -> do
            let name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
            Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
            (Name
name',Bang
defaultBang,) (Kind -> VarBangType) -> Q Kind -> Q VarBangType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Kind
type' Type
t
    derivs :: [DerivClauseQ]
    derivs :: [Q DerivClause]
derivs =
        [ Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Eq, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Generic]
        , Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause
            (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy)
            [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''FromJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToGraphQL]
        ]

unionTypeDefinition :: UnionTypeDefinition -> DecsQ
unionTypeDefinition :: UnionTypeDefinition -> DecsQ
unionTypeDefinition (UnionTypeDefinition Maybe Description
desc Name
name Maybe Directives
_ Maybe UnionMemberTypes
members) = do
    let name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
    Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
    Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [NamedType]
members' of
            [NamedType
member] -> Name -> [TyVarBndr BndrVis] -> Q Kind -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr BndrVis] -> m Kind -> m Dec
tySynD Name
name' [] (Q Kind -> Q Dec) -> Q Kind -> Q Dec
forall a b. (a -> b) -> a -> b
$ NamedType -> Q Kind
namedType NamedType
member
            [NamedType]
_ -> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q Cxt
forall a. Monoid a => a
mempty Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing [Q Con]
cons [Q DerivClause]
derivs
  where
    members' :: [NamedType]
members' = Maybe UnionMemberTypes
members Maybe UnionMemberTypes
-> (Maybe UnionMemberTypes -> [NamedType]) -> [NamedType]
forall a b. a -> (a -> b) -> b
& (UnionMemberTypes -> [NamedType])
-> Maybe UnionMemberTypes -> [NamedType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(UnionMemberTypes NonEmpty NamedType
xs) -> NonEmpty NamedType -> [NamedType]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty NamedType
xs
    cons :: [ConQ]
    cons :: [Q Con]
cons =
        [NamedType]
members' [NamedType] -> (NamedType -> Q Con) -> [Q Con]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \nt :: NamedType
nt@(NamedType Name
memberName) -> do
            let memberName' :: Name
memberName' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
memberName
            Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
memberName' ([Q BangType] -> Q Con)
-> (Q BangType -> [Q BangType]) -> Q BangType -> Q Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Q BangType -> [Q BangType]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q BangType -> Q Con) -> Q BangType -> Q Con
forall a b. (a -> b) -> a -> b
$ (Bang
defaultBang,) (Kind -> BangType) -> Q Kind -> Q BangType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedType -> Q Kind
namedType NamedType
nt
    derivs :: [DerivClauseQ]
    derivs :: [Q DerivClause]
derivs =
        [ Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Eq, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Generic]
        , Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy) [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToGraphQL]
        ]

enumTypeDefinition :: EnumTypeDefinition -> DecsQ
enumTypeDefinition :: EnumTypeDefinition -> DecsQ
enumTypeDefinition (EnumTypeDefinition Maybe Description
desc Name
name Maybe Directives
_ Maybe EnumValuesDefinition
values) = do
    let name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
    Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
    Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q Cxt
forall a. Monoid a => a
mempty Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing [Q Con]
cons [Q DerivClause]
derivs
  where
    values' :: [EnumValueDefinition]
values' = Maybe EnumValuesDefinition
values Maybe EnumValuesDefinition
-> (Maybe EnumValuesDefinition -> [EnumValueDefinition])
-> [EnumValueDefinition]
forall a b. a -> (a -> b) -> b
& (EnumValuesDefinition -> [EnumValueDefinition])
-> Maybe EnumValuesDefinition -> [EnumValueDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(EnumValuesDefinition NonEmpty EnumValueDefinition
xs) -> NonEmpty EnumValueDefinition -> [EnumValueDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty EnumValueDefinition
xs
    cons :: [ConQ]
    cons :: [Q Con]
cons =
        [EnumValueDefinition]
values' [EnumValueDefinition] -> (EnumValueDefinition -> Q Con) -> [Q Con]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(EnumValueDefinition Maybe Description
desc (EnumValue Name
name) Maybe Directives
_) -> do
            let name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
            Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
            Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
name' []
    derivs :: [DerivClauseQ]
    derivs :: [Q DerivClause]
derivs =
        [ Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause
            (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy)
            [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Generic, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Eq, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Bounded, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Enum]
        , Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause
            (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy)
            [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''FromJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToGraphQL]
        ]

inputObjectTypeDefinition :: InputObjectTypeDefinition -> DecsQ
inputObjectTypeDefinition :: InputObjectTypeDefinition -> DecsQ
inputObjectTypeDefinition (InputObjectTypeDefinition Maybe Description
desc Name
name Maybe Directives
_ Maybe InputFieldsDefinition
fields) = do
    Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
    case [InputValueDefinition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InputValueDefinition]
fields' of
        Int
0 -> [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Int
1 -> Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing Q Con
con [Q DerivClause]
forall a. Monoid a => a
mempty
        Int
_ -> Dec -> [Dec]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing [Q Con
con] [Q DerivClause]
forall a. Monoid a => a
mempty
  where
    name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
    fields' :: [InputValueDefinition]
fields' = Maybe InputFieldsDefinition
fields Maybe InputFieldsDefinition
-> (Maybe InputFieldsDefinition -> [InputValueDefinition])
-> [InputValueDefinition]
forall a b. a -> (a -> b) -> b
& (InputFieldsDefinition -> [InputValueDefinition])
-> Maybe InputFieldsDefinition -> [InputValueDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(InputFieldsDefinition NonEmpty InputValueDefinition
xs) -> NonEmpty InputValueDefinition -> [InputValueDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty InputValueDefinition
xs
    con :: ConQ
    con :: Q Con
con =
        Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name' ([Q VarBangType] -> Q Con) -> [Q VarBangType] -> Q Con
forall a b. (a -> b) -> a -> b
$ [InputValueDefinition]
fields' [InputValueDefinition]
-> (InputValueDefinition -> Q VarBangType) -> [Q VarBangType]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(InputValueDefinition Maybe Description
desc Name
name Type
t Maybe DefaultValue
_ Maybe Directives
_) -> do
            let name' :: Name
name' = Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name
            Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
            (Name
name',Bang
defaultBang,) (Kind -> VarBangType) -> Q Kind -> Q VarBangType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Kind
type' Type
t

rootOperationType
    :: Map Name TypeDefinition
    -> OperationType
    -> ObjectTypeDefinition
    -> DecsQ
rootOperationType :: Map Name TypeDefinition
-> OperationType -> ObjectTypeDefinition -> DecsQ
rootOperationType Map Name TypeDefinition
typeDefinitions OperationType
ot (ObjectTypeDefinition Maybe Description
_ Name
name Maybe ImplementsInterfaces
_ Maybe Directives
_ Maybe FieldsDefinition
fields) =
    [[Dec]] -> [Dec]
forall a. Monoid a => [a] -> a
mconcat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition] -> (FieldDefinition -> DecsQ) -> Q [[Dec]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FieldDefinition]
fields' (Map Name TypeDefinition
-> OperationType -> Name -> FieldDefinition -> DecsQ
rootOperation Map Name TypeDefinition
typeDefinitions OperationType
ot Name
name)
  where
    fields' :: [FieldDefinition]
fields' = Maybe FieldsDefinition
fields Maybe FieldsDefinition
-> (Maybe FieldsDefinition -> [FieldDefinition])
-> [FieldDefinition]
forall a b. a -> (a -> b) -> b
& (FieldsDefinition -> [FieldDefinition])
-> Maybe FieldsDefinition -> [FieldDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(FieldsDefinition NonEmpty FieldDefinition
xs) -> NonEmpty FieldDefinition -> [FieldDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FieldDefinition
xs

rootOperation
    :: Map Name TypeDefinition
    -> OperationType
    -> Name
    -> FieldDefinition
    -> DecsQ
rootOperation :: Map Name TypeDefinition
-> OperationType -> Name -> FieldDefinition -> DecsQ
rootOperation Map Name TypeDefinition
_ OperationType
Subscription Name
_ FieldDefinition
_ = [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
rootOperation Map Name TypeDefinition
typeDefinitions OperationType
ot (Name MisoString
name) (FieldDefinition Maybe Description
desc (Name MisoString
fieldName) Maybe ArgumentsDefinition
args Type
t Maybe Directives
_) = do
    Maybe Description -> (Description -> Q ()) -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Description
desc ((Description -> Q ()) -> Q ()) -> (Description -> Q ()) -> Q ()
forall a b. (a -> b) -> a -> b
$ Name -> Description -> Q ()
description Name
name'
    [Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ case [((Name, Name), Type)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((Name, Name), Type)]
args' of
            Int
1 -> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing Q Con
con [Q DerivClause]
derivs
            Int
_ -> Q Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cxt
forall a. Monoid a => a
mempty) Name
name' [TyVarBndr BndrVis]
forall a. Monoid a => a
mempty Maybe Kind
forall a. Maybe a
Nothing [Q Con
con] [Q DerivClause]
derivs
        , Q Cxt -> Q Kind -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Kind -> [m Dec] -> m Dec
instanceD
            Q Cxt
forall a. Monoid a => a
mempty
            (Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Operation Q Kind -> Q Kind -> Q Kind
forall (m :: * -> *). Quote m => m Kind -> m Kind -> m Kind
`appT` Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name')
            [ Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD (Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Kind -> Q Kind -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Kind -> m Kind -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing (Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ReturnType Q Kind -> Q Kind -> Q Kind
forall (m :: * -> *). Quote m => m Kind -> m Kind -> m Kind
`appT` Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name') (Type -> Q Kind
type' Type
t)
            , Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'toOperation
                ([Q Clause] -> Q Dec)
-> (Q Clause -> [Q Clause]) -> Q Clause -> Q Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Q Clause -> [Q Clause]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (Q Clause -> Q Dec) -> Q Clause -> Q Dec
forall a b. (a -> b) -> a -> b
$ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
name' [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
f | ((Name
_, Name
f), Type
_) <- [((Name, Name), Type)]
args']] Q Body
toOperationBody []
            ]
        ]
  where
    capitalise :: MisoString -> MisoString
    capitalise :: MisoString -> MisoString
capitalise MisoString
s
        | Just (Char
x, MisoString
xs) <- MisoString -> Maybe (Char, MisoString)
MisoString.uncons MisoString
s = Char -> MisoString -> MisoString
MisoString.cons (Char -> Char
toUpper Char
x) MisoString
xs
        | Bool
otherwise = MisoString
s
    name' :: Name
name' = MisoString -> Name
forall s. ToMisoString s => s -> Name
mkName' (MisoString -> Name) -> MisoString -> Name
forall a b. (a -> b) -> a -> b
$ MisoString
name MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString -> MisoString
capitalise MisoString
fieldName
    con :: ConQ
    con :: Q Con
con =
        Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name' ([Q VarBangType] -> Q Con) -> [Q VarBangType] -> Q Con
forall a b. (a -> b) -> a -> b
$ [((Name, Name), Type)]
args' [((Name, Name), Type)]
-> (((Name, Name), Type) -> Q VarBangType) -> [Q VarBangType]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((Name
_, Name
n), Type
t) -> (Name
n,Bang
defaultBang,) (Kind -> VarBangType) -> Q Kind -> Q VarBangType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Kind
type' Type
t
    derivs :: [DerivClauseQ]
    derivs :: [Q DerivClause]
derivs =
        [ Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
StockStrategy) [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Eq, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Generic]
        , Maybe DerivStrategy -> [Q Kind] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Kind] -> m DerivClause
derivClause
            (DerivStrategy -> Maybe DerivStrategy
forall a. a -> Maybe a
Just DerivStrategy
AnyclassStrategy)
            [Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''FromJSON, Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ToGraphQL]
        ]
    args' :: [((Name, TH.Name), Type)]
    args' :: [((Name, Name), Type)]
args' =
        case Maybe ArgumentsDefinition
args of
            Maybe ArgumentsDefinition
Nothing -> []
            Just (ArgumentsDefinition NonEmpty InputValueDefinition
args) ->
                NonEmpty InputValueDefinition -> [InputValueDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty InputValueDefinition
args [InputValueDefinition]
-> (InputValueDefinition -> ((Name, Name), Type))
-> [((Name, Name), Type)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(InputValueDefinition Maybe Description
_ Name
n Type
t Maybe DefaultValue
_ Maybe Directives
_) -> ((Name
n, Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
n), Type
t)
    otE :: Q Exp
otE =
        Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ case OperationType
ot of
            OperationType
Query -> 'Query
            OperationType
Mutation -> 'Mutation
    stringE' :: (ToMisoString s) => s -> ExpQ
    stringE' :: forall s. ToMisoString s => s -> Q Exp
stringE' = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> (s -> String) -> s -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> String
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> String) -> (s -> MisoString) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString
    argsE :: ExpQ
    argsE :: Q Exp
argsE =
        case [((Name, Name), Type)]
args' of
            [] -> Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'Nothing
            [((Name, Name), Type)]
_ ->
                Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'nonEmpty
                    Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE
                        [ [|Argument (Name $(Name -> Q Exp
forall s. ToMisoString s => s -> Q Exp
stringE' Name
name)) (toGraphQL $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
thName))|]
                        | ((Name
name, Name
thName), Type
_) <- [((Name, Name), Type)]
args'
                        ]
    fields :: Type -> [FieldDefinition]
    fields :: Type -> [FieldDefinition]
fields Type
t =
        Name -> Map Name TypeDefinition -> Maybe TypeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Type -> Name
typeName Type
t) Map Name TypeDefinition
typeDefinitions
            Maybe TypeDefinition
-> (Maybe TypeDefinition -> [FieldDefinition]) -> [FieldDefinition]
forall a b. a -> (a -> b) -> b
& (TypeDefinition -> [FieldDefinition])
-> Maybe TypeDefinition -> [FieldDefinition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \case
                ( DefinitionObjectType
                        (ObjectTypeDefinition Maybe Description
_ Name
_ Maybe ImplementsInterfaces
_ Maybe Directives
_ (Just (FieldsDefinition NonEmpty FieldDefinition
fields)))
                    ) -> NonEmpty FieldDefinition -> [FieldDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FieldDefinition
fields
                TypeDefinition
_ -> []
    selE :: Type -> ExpQ
    selE :: Type -> Q Exp
selE Type
t =
        case Type -> [FieldDefinition]
fields Type
t of
            [] -> Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'Nothing
            [FieldDefinition]
fields ->
                Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'nonEmpty
                    Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE
                        [ [|
                            SelectionField
                                $ Field
                                    Nothing
                                    (Name $(Name -> Q Exp
forall s. ToMisoString s => s -> Q Exp
stringE' Name
name))
                                    Nothing
                                    Nothing
                                    $(Type -> Q Exp
selE Type
t)
                            |]
                        | FieldDefinition Maybe Description
_ Name
name Maybe ArgumentsDefinition
_ Type
t Maybe Directives
_ <- [FieldDefinition]
fields
                        ]
    toOperationBody :: BodyQ
    toOperationBody :: Q Body
toOperationBody =
        Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
            [|
                OperationDefinition
                    Nothing
                    $(Q Exp
otE)
                    Nothing
                    Nothing
                    Nothing
                    . pure
                    . SelectionField
                    $ Field Nothing $(MisoString -> Q Exp
forall s. ToMisoString s => s -> Q Exp
stringE' MisoString
fieldName) $(Q Exp
argsE) Nothing $(Type -> Q Exp
selE Type
t)
                |]

defaultBang :: Bang
defaultBang :: Bang
defaultBang = SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness

type ID = MisoString

namedType :: NamedType -> TypeQ
namedType :: NamedType -> Q Kind
namedType (NamedType (Name MisoString
"Int")) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Int
namedType (NamedType (Name MisoString
"Float")) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Double
namedType (NamedType (Name MisoString
"String")) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''MisoString
namedType (NamedType (Name MisoString
"Boolean")) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''Bool
namedType (NamedType (Name MisoString
"ID")) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT ''ID
namedType (NamedType Name
name) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT (Name -> Q Kind) -> Name -> Q Kind
forall a b. (a -> b) -> a -> b
$ Name -> Name
forall s. ToMisoString s => s -> Name
mkName' Name
name

listType :: ListType -> TypeQ
listType :: ListType -> Q Kind
listType (ListType Type
t) = Q Kind
forall (m :: * -> *). Quote m => m Kind
listT Q Kind -> Q Kind -> Q Kind
forall (m :: * -> *). Quote m => m Kind -> m Kind -> m Kind
`appT` Type -> Q Kind
type' Type
t

type' :: Miso.GraphQL.AST.Type -> TypeQ
type' :: Type -> Q Kind
type' (TypeNamed NamedType
t) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT (String -> Name
mkName String
"Maybe") Q Kind -> Q Kind -> Q Kind
forall (m :: * -> *). Quote m => m Kind -> m Kind -> m Kind
`appT` NamedType -> Q Kind
namedType NamedType
t
type' (TypeList ListType
t) = Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT (String -> Name
mkName String
"Maybe") Q Kind -> Q Kind -> Q Kind
forall (m :: * -> *). Quote m => m Kind -> m Kind -> m Kind
`appT` ListType -> Q Kind
listType ListType
t
type' (TypeNonNull (NonNullTypeNamed NamedType
t)) = NamedType -> Q Kind
namedType NamedType
t
type' (TypeNonNull (NonNullTypeList ListType
t)) = ListType -> Q Kind
listType ListType
t