{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.TH.Declare.GQLType
  ( deriveGQLType,
  )
where

--
-- MORPHEUS
import Control.Applicative (Applicative (..))
import Control.Monad (Monad ((>>=)))
import Data.Functor ((<$>), fmap)
import Data.Map (Map, empty, fromList)
import Data.Maybe (Maybe (..), maybe)
import Data.Morpheus.Internal.TH
  ( apply,
    applyVars,
    funDProxy,
    toName,
    tyConArgs,
    typeInstanceDec,
  )
import Data.Morpheus.Internal.Utils
  ( elems,
    stripConstructorNamespace,
    stripFieldNamespace,
  )
import Data.Morpheus.Server.Internal.TH.Types
  ( ServerDecContext (..),
    ServerTypeDefinition (..),
  )
import Data.Morpheus.Server.Internal.TH.Utils
  ( kindName,
    mkTypeableConstraints,
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLType (..),
    GQLTypeOptions (..),
    defaultTypeOptions,
  )
import Data.Morpheus.Types (Resolver, interface)
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ArgumentsDefinition,
    DataEnumValue (..),
    Description,
    Directives,
    FieldContent (..),
    FieldDefinition (..),
    FieldName (..),
    FieldsDefinition,
    IN,
    OUT,
    QUERY,
    TRUE,
    Token,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName (..),
    Value,
  )
import Data.Proxy (Proxy (..))
import Language.Haskell.TH
import Prelude
  ( ($),
    (&&),
    (.),
    Eq (..),
    concatMap,
    null,
    otherwise,
  )

interfaceF :: Name -> ExpQ
interfaceF :: Name -> ExpQ
interfaceF Name
name = [|interface (Proxy :: (Proxy ($(conT name) (Resolver QUERY () Maybe))))|]

introspectInterface :: TypeName -> ExpQ
introspectInterface :: TypeName -> ExpQ
introspectInterface = Name -> ExpQ
interfaceF (Name -> ExpQ) -> (TypeName -> Name) -> TypeName -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Name
forall a. ToName a => a -> Name
toName

deriveGQLType :: ServerDecContext -> ServerTypeDefinition cat s -> Q [Dec]
deriveGQLType :: ServerDecContext -> ServerTypeDefinition cat s -> Q [Dec]
deriveGQLType
  ServerDecContext {Bool
namespace :: ServerDecContext -> Bool
namespace :: Bool
namespace}
  ServerTypeDefinition {TypeName
tName :: forall (cat :: TypeCategory) (s :: Stage).
ServerTypeDefinition cat s -> TypeName
tName :: TypeName
tName, TypeKind
tKind :: forall (cat :: TypeCategory) (s :: Stage).
ServerTypeDefinition cat s -> TypeKind
tKind :: TypeKind
tKind, Maybe (TypeDefinition ANY s)
typeOriginal :: forall (cat :: TypeCategory) (s :: Stage).
ServerTypeDefinition cat s -> Maybe (TypeDefinition ANY s)
typeOriginal :: Maybe (TypeDefinition ANY s)
typeOriginal} =
    Dec -> [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> [Dec]) -> Q Dec -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CxtQ -> TypeQ -> [Q Dec] -> Q Dec
instanceD CxtQ
constrains TypeQ
iHead (Q Dec
typeFamilies Q Dec -> [Q Dec] -> [Q Dec]
forall a. a -> [a] -> [a]
: [Q Dec]
functions)
    where
      functions :: [Q Dec]
functions =
        [(Name, ExpQ)] -> [Q Dec]
funDProxy
          [ ('description, [|tDescription|]),
            ('implements, ExpQ
implementsFunc),
            ('typeOptions, ExpQ
typeOptionsFunc),
            ('getDescriptions, ExpQ
fieldDescriptionsFunc),
            ('getDirectives, ExpQ
fieldDirectivesFunc),
            ('getFieldContents, ExpQ
getFieldContentsFunc)
          ]
        where
          tDescription :: Maybe Description
tDescription = Maybe (TypeDefinition ANY s)
typeOriginal Maybe (TypeDefinition ANY s)
-> (TypeDefinition ANY s -> Maybe Description) -> Maybe Description
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY s -> Maybe Description
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription
          implementsFunc :: ExpQ
implementsFunc = [ExpQ] -> ExpQ
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ (TypeName -> ExpQ) -> [TypeName] -> [ExpQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeName -> ExpQ
introspectInterface (Maybe (TypeDefinition ANY s) -> [TypeName]
forall (s :: Stage). Maybe (TypeDefinition ANY s) -> [TypeName]
interfacesFrom Maybe (TypeDefinition ANY s)
typeOriginal)
          typeOptionsFunc :: ExpQ
typeOptionsFunc
            | Bool
namespace Bool -> Bool -> Bool
&& TypeKind
tKind TypeKind -> TypeKind -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind
KindEnum = [|GQLTypeOptions id (stripConstructorNamespace tName)|]
            | Bool
namespace = [|GQLTypeOptions (stripFieldNamespace tName) id|]
            | Bool
otherwise = [|defaultTypeOptions|]
          fieldDescriptionsFunc :: ExpQ
fieldDescriptionsFunc = [|value|]
            where
              value :: Map Description Description
value = Maybe (TypeDefinition ANY s) -> Map Description Description
forall (c :: TypeCategory) (s :: Stage).
Maybe (TypeDefinition c s) -> Map Description Description
getDesc Maybe (TypeDefinition ANY s)
typeOriginal
          fieldDirectivesFunc :: ExpQ
fieldDirectivesFunc = [|value|]
            where
              value :: Map Description (Directives s)
value = Maybe (TypeDefinition ANY s) -> Map Description (Directives s)
forall (c :: TypeCategory) (s :: Stage).
Maybe (TypeDefinition c s) -> Map Description (Directives s)
getDirs Maybe (TypeDefinition ANY s)
typeOriginal
          getFieldContentsFunc :: ExpQ
getFieldContentsFunc = [|value|]
            where
              value :: Map FieldName (Maybe (Value s), Maybe (ArgumentsDefinition s))
value =
                (FieldDefinition IN s
 -> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> (FieldDefinition OUT s
    -> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> Maybe (TypeDefinition ANY s)
-> Map FieldName (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall (s :: Stage) a (c :: TypeCategory).
(FieldDefinition IN s -> Maybe a)
-> (FieldDefinition OUT s -> Maybe a)
-> Maybe (TypeDefinition c s)
-> Map FieldName a
fmapFieldValues
                  ((FieldContent TRUE IN s
 -> (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> Maybe (FieldContent TRUE IN s)
-> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldContent TRUE IN s
-> (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall (c :: TypeCategory) (s :: Stage).
FieldContent TRUE c s
-> (Maybe (Value s), Maybe (ArgumentsDefinition s))
getDefaultValue (Maybe (FieldContent TRUE IN s)
 -> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> (FieldDefinition IN s -> Maybe (FieldContent TRUE IN s))
-> FieldDefinition IN s
-> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition IN s -> Maybe (FieldContent TRUE IN s)
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent)
                  ((FieldContent TRUE OUT s
 -> (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> Maybe (FieldContent TRUE OUT s)
-> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldContent TRUE OUT s
-> (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall (c :: TypeCategory) (s :: Stage).
FieldContent TRUE c s
-> (Maybe (Value s), Maybe (ArgumentsDefinition s))
getDefaultValue (Maybe (FieldContent TRUE OUT s)
 -> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s)))
-> (FieldDefinition OUT s -> Maybe (FieldContent TRUE OUT s))
-> FieldDefinition OUT s
-> Maybe (Maybe (Value s), Maybe (ArgumentsDefinition s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition OUT s -> Maybe (FieldContent TRUE OUT s)
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent)
                  Maybe (TypeDefinition ANY s)
typeOriginal
      --------------------------------
      typeArgs :: [String]
typeArgs = TypeKind -> [String]
tyConArgs TypeKind
tKind
      --------------------------------
      iHead :: TypeQ
iHead = Name -> [TypeQ] -> TypeQ
forall a i. (Apply a, ToCon i a) => i -> [a] -> a
apply ''GQLType [TypeName -> [String] -> TypeQ
forall con var res.
(ToName con, ToName var, Apply res, ToCon con res,
 ToVar var res) =>
con -> [var] -> res
applyVars TypeName
tName [String]
typeArgs]
      headSig :: TypeQ
headSig = TypeName -> [String] -> TypeQ
forall con var res.
(ToName con, ToName var, Apply res, ToCon con res,
 ToVar var res) =>
con -> [var] -> res
applyVars TypeName
tName [String]
typeArgs
      ---------------------------------------------------
      constrains :: CxtQ
constrains = [String] -> CxtQ
mkTypeableConstraints [String]
typeArgs
      -------------------------------------------------
      typeFamilies :: Q Dec
typeFamilies = Name -> Name -> Q Dec
deriveInstance ''KIND (TypeKind -> Name
kindName TypeKind
tKind)
        where
          deriveInstance :: Name -> Name -> Q Dec
          deriveInstance :: Name -> Name -> Q Dec
deriveInstance Name
insName Name
tyName = do
            Type
typeN <- TypeQ
headSig
            Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type -> Type -> Dec
typeInstanceDec Name
insName Type
typeN (Name -> Type
ConT Name
tyName)

interfacesFrom :: Maybe (TypeDefinition ANY s) -> [TypeName]
interfacesFrom :: Maybe (TypeDefinition ANY s) -> [TypeName]
interfacesFrom (Just TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements}}) = [TypeName]
objectImplements
interfacesFrom Maybe (TypeDefinition ANY s)
_ = []

fmapFieldValues :: (FieldDefinition IN s -> Maybe a) -> (FieldDefinition OUT s -> Maybe a) -> Maybe (TypeDefinition c s) -> Map FieldName a
fmapFieldValues :: (FieldDefinition IN s -> Maybe a)
-> (FieldDefinition OUT s -> Maybe a)
-> Maybe (TypeDefinition c s)
-> Map FieldName a
fmapFieldValues FieldDefinition IN s -> Maybe a
f FieldDefinition OUT s -> Maybe a
g = Map FieldName a
-> (TypeDefinition c s -> Map FieldName a)
-> Maybe (TypeDefinition c s)
-> Map FieldName a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map FieldName a
forall k a. Map k a
empty ((FieldDefinition IN s -> Maybe a)
-> (FieldDefinition OUT s -> Maybe a)
-> TypeDefinition c s
-> Map FieldName a
forall (s :: Stage) a (c :: TypeCategory).
(FieldDefinition IN s -> Maybe a)
-> (FieldDefinition OUT s -> Maybe a)
-> TypeDefinition c s
-> Map FieldName a
collectFieldValues FieldDefinition IN s -> Maybe a
f FieldDefinition OUT s -> Maybe a
g)

getDesc :: Maybe (TypeDefinition c s) -> Map Token Description
getDesc :: Maybe (TypeDefinition c s) -> Map Description Description
getDesc = [(Description, Description)] -> Map Description Description
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Description, Description)] -> Map Description Description)
-> (Maybe (TypeDefinition c s) -> [(Description, Description)])
-> Maybe (TypeDefinition c s)
-> Map Description Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (TypeDefinition c s) -> [(Description, Description)]
forall a v. Meta a v => a -> [(Description, v)]
get

getDirs :: Maybe (TypeDefinition c s) -> Map Token (Directives s)
getDirs :: Maybe (TypeDefinition c s) -> Map Description (Directives s)
getDirs = [(Description, Directives s)] -> Map Description (Directives s)
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Description, Directives s)] -> Map Description (Directives s))
-> (Maybe (TypeDefinition c s) -> [(Description, Directives s)])
-> Maybe (TypeDefinition c s)
-> Map Description (Directives s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (TypeDefinition c s) -> [(Description, Directives s)]
forall a v. Meta a v => a -> [(Description, v)]
get

class Meta a v where
  get :: a -> [(Token, v)]

instance (Meta a v) => Meta (Maybe a) v where
  get :: Maybe a -> [(Description, v)]
get (Just a
x) = a -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get a
x
  get Maybe a
_ = []

instance
  ( Meta (FieldsDefinition IN s) v,
    Meta (FieldsDefinition OUT s) v,
    Meta (DataEnumValue s) v
  ) =>
  Meta (TypeDefinition c s) v
  where
  get :: TypeDefinition c s -> [(Description, v)]
get TypeDefinition {TypeContent TRUE c s
typeContent :: TypeContent TRUE c s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE c s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get TypeContent TRUE c s
typeContent

instance
  ( Meta (FieldsDefinition IN s) v,
    Meta (FieldsDefinition OUT s) v,
    Meta (DataEnumValue s) v
  ) =>
  Meta (TypeContent a c s) v
  where
  get :: TypeContent a c s -> [(Description, v)]
get DataObject {FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields} = FieldsDefinition OUT s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition OUT s
objectFields
  get DataInputObject {FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields} = FieldsDefinition IN s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition IN s
inputObjectFields
  get DataInterface {FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields} = FieldsDefinition OUT s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition OUT s
interfaceFields
  get DataEnum {DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> DataEnum s
enumMembers :: DataEnum s
enumMembers} = (DataEnumValue s -> [(Description, v)])
-> DataEnum s -> [(Description, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataEnumValue s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get DataEnum s
enumMembers
  get TypeContent a c s
_ = []

instance Meta (DataEnumValue s) Description where
  get :: DataEnumValue s -> [(Description, Description)]
get DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName, enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Description
enumDescription = Just Description
x} = [(TypeName -> Description
readTypeName TypeName
enumName, Description
x)]
  get DataEnumValue s
_ = []

instance Meta (DataEnumValue s) (Directives s) where
  get :: DataEnumValue s -> [(Description, Directives s)]
get DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName, Directives s
enumDirectives :: forall (s :: Stage). DataEnumValue s -> [Directive s]
enumDirectives :: Directives s
enumDirectives}
    | Directives s -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
enumDirectives = []
    | Bool
otherwise = [(TypeName -> Description
readTypeName TypeName
enumName, Directives s
enumDirectives)]

instance
  Meta (FieldDefinition c s) v =>
  Meta (FieldsDefinition c s) v
  where
  get :: FieldsDefinition c s -> [(Description, v)]
get = (FieldDefinition c s -> [(Description, v)])
-> [FieldDefinition c s] -> [(Description, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDefinition c s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get ([FieldDefinition c s] -> [(Description, v)])
-> (FieldsDefinition c s -> [FieldDefinition c s])
-> FieldsDefinition c s
-> [(Description, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldsDefinition c s -> [FieldDefinition c s]
forall a coll. Elems a coll => coll -> [a]
elems

instance Meta (FieldDefinition c s) Description where
  get :: FieldDefinition c s -> [(Description, Description)]
get FieldDefinition {FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName :: FieldName
fieldName, fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDescription = Just Description
x} = [(FieldName -> Description
readName FieldName
fieldName, Description
x)]
  get FieldDefinition c s
_ = []

instance Meta (FieldDefinition c s) (Directives s) where
  get :: FieldDefinition c s -> [(Description, Directives s)]
get FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, Directives s
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> [Directive s]
fieldDirectives :: Directives s
fieldDirectives}
    | Directives s -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
fieldDirectives = []
    | Bool
otherwise = [(FieldName -> Description
readName FieldName
fieldName, Directives s
fieldDirectives)]

collectFieldValues ::
  (FieldDefinition IN s -> Maybe a) ->
  (FieldDefinition OUT s -> Maybe a) ->
  TypeDefinition c s ->
  Map FieldName a
collectFieldValues :: (FieldDefinition IN s -> Maybe a)
-> (FieldDefinition OUT s -> Maybe a)
-> TypeDefinition c s
-> Map FieldName a
collectFieldValues FieldDefinition IN s -> Maybe a
_ FieldDefinition OUT s -> Maybe a
g TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields}} = (FieldDefinition OUT s -> Maybe a)
-> FieldsDefinition OUT s -> Map FieldName a
forall (c :: TypeCategory) (s :: Stage) a.
(FieldDefinition c s -> Maybe a)
-> FieldsDefinition c s -> Map FieldName a
getFieldValues FieldDefinition OUT s -> Maybe a
g FieldsDefinition OUT s
objectFields
collectFieldValues FieldDefinition IN s -> Maybe a
f FieldDefinition OUT s -> Maybe a
_ TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> FieldsDefinition IN s
inputObjectFields}} = (FieldDefinition IN s -> Maybe a)
-> FieldsDefinition IN s -> Map FieldName a
forall (c :: TypeCategory) (s :: Stage) a.
(FieldDefinition c s -> Maybe a)
-> FieldsDefinition c s -> Map FieldName a
getFieldValues FieldDefinition IN s -> Maybe a
f FieldsDefinition IN s
inputObjectFields
collectFieldValues FieldDefinition IN s -> Maybe a
_ FieldDefinition OUT s -> Maybe a
g TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
interfaceFields}} = (FieldDefinition OUT s -> Maybe a)
-> FieldsDefinition OUT s -> Map FieldName a
forall (c :: TypeCategory) (s :: Stage) a.
(FieldDefinition c s -> Maybe a)
-> FieldsDefinition c s -> Map FieldName a
getFieldValues FieldDefinition OUT s -> Maybe a
g FieldsDefinition OUT s
interfaceFields
collectFieldValues FieldDefinition IN s -> Maybe a
_ FieldDefinition OUT s -> Maybe a
_ TypeDefinition c s
_ = Map FieldName a
forall k a. Map k a
empty

getFieldValues :: (FieldDefinition c s -> Maybe a) -> FieldsDefinition c s -> Map FieldName a
getFieldValues :: (FieldDefinition c s -> Maybe a)
-> FieldsDefinition c s -> Map FieldName a
getFieldValues FieldDefinition c s -> Maybe a
f = [(FieldName, a)] -> Map FieldName a
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(FieldName, a)] -> Map FieldName a)
-> (FieldsDefinition c s -> [(FieldName, a)])
-> FieldsDefinition c s
-> Map FieldName a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldName, Maybe a)] -> [(FieldName, a)]
forall k a. [(k, Maybe a)] -> [(k, a)]
notNulls ([(FieldName, Maybe a)] -> [(FieldName, a)])
-> (FieldsDefinition c s -> [(FieldName, Maybe a)])
-> FieldsDefinition c s
-> [(FieldName, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDefinition c s -> (FieldName, Maybe a))
-> [FieldDefinition c s] -> [(FieldName, Maybe a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldDefinition c s -> Maybe a)
-> FieldDefinition c s -> (FieldName, Maybe a)
forall (c :: TypeCategory) (s :: Stage) a.
(FieldDefinition c s -> Maybe a)
-> FieldDefinition c s -> (FieldName, Maybe a)
getFieldValue FieldDefinition c s -> Maybe a
f) ([FieldDefinition c s] -> [(FieldName, Maybe a)])
-> (FieldsDefinition c s -> [FieldDefinition c s])
-> FieldsDefinition c s
-> [(FieldName, Maybe a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldsDefinition c s -> [FieldDefinition c s]
forall a coll. Elems a coll => coll -> [a]
elems

notNulls :: [(k, Maybe a)] -> [(k, a)]
notNulls :: [(k, Maybe a)] -> [(k, a)]
notNulls [] = []
notNulls ((k
_, Maybe a
Nothing) : [(k, Maybe a)]
xs) = [(k, Maybe a)] -> [(k, a)]
forall k a. [(k, Maybe a)] -> [(k, a)]
notNulls [(k, Maybe a)]
xs
notNulls ((k
name, Just a
x) : [(k, Maybe a)]
xs) = (k
name, a
x) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, Maybe a)] -> [(k, a)]
forall k a. [(k, Maybe a)] -> [(k, a)]
notNulls [(k, Maybe a)]
xs

getFieldValue :: (FieldDefinition c s -> Maybe a) -> FieldDefinition c s -> (FieldName, Maybe a)
getFieldValue :: (FieldDefinition c s -> Maybe a)
-> FieldDefinition c s -> (FieldName, Maybe a)
getFieldValue FieldDefinition c s -> Maybe a
f FieldDefinition c s
field = (FieldDefinition c s -> FieldName
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName FieldDefinition c s
field, FieldDefinition c s -> Maybe a
f FieldDefinition c s
field)

getDefaultValue :: FieldContent TRUE c s -> (Maybe (Value s), Maybe (ArgumentsDefinition s))
getDefaultValue :: FieldContent TRUE c s
-> (Maybe (Value s), Maybe (ArgumentsDefinition s))
getDefaultValue DefaultInputValue {Value s
defaultInputValue :: forall (cat :: TypeCategory) (s :: Stage).
FieldContent (ELEM IN cat) cat s -> Value s
defaultInputValue :: Value s
defaultInputValue} = (Value s -> Maybe (Value s)
forall a. a -> Maybe a
Just Value s
defaultInputValue, Maybe (ArgumentsDefinition s)
forall a. Maybe a
Nothing)
getDefaultValue (FieldArgs ArgumentsDefinition s
args) = (Maybe (Value s)
forall a. Maybe a
Nothing, ArgumentsDefinition s -> Maybe (ArgumentsDefinition s)
forall a. a -> Maybe a
Just ArgumentsDefinition s
args)