{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Language.GraphQL.Execute.Transform
( Document(..)
, Field(..)
, Fragment(..)
, Input(..)
, Operation(..)
, QueryError(..)
, Selection(..)
, document
, queryError
) where
import Control.Monad (foldM, unless)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (State, evalStateT, gets, modify)
import Data.Foldable (find)
import Data.Functor.Identity (Identity(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int32)
import Data.Maybe (fromMaybe)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Sequence (Seq, (<|), (><))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.AST (Name)
import qualified Language.GraphQL.Execute.Coerce as Coerce
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Internal as Type
import qualified Language.GraphQL.Type.Out as Out
import qualified Language.GraphQL.Type.Schema as Schema
data Replacement m = Replacement
{ Replacement m -> HashMap Name (Fragment m)
fragments :: HashMap Full.Name (Fragment m)
, Replacement m -> FragmentDefinitions
fragmentDefinitions :: FragmentDefinitions
, Replacement m -> Subs
variableValues :: Type.Subs
, Replacement m -> HashMap Name (Type m)
types :: HashMap Full.Name (Schema.Type m)
}
type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition
data Fragment m
= Fragment (Type.CompositeType m) (Seq (Selection m))
data Selection m
= SelectionFragment (Fragment m)
| SelectionField (Field m)
data Operation m
= Query (Maybe Text) (Seq (Selection m))
| Mutation (Maybe Text) (Seq (Selection m))
| Subscription (Maybe Text) (Seq (Selection m))
data Field m = Field
(Maybe Full.Name) Full.Name (HashMap Full.Name Input) (Seq (Selection m))
data Document m = Document
(HashMap Full.Name (Schema.Type m)) (Out.ObjectType m) (Operation m)
data OperationDefinition = OperationDefinition
Full.OperationType
(Maybe Full.Name)
[Full.VariableDefinition]
[Full.Directive]
Full.SelectionSet
data QueryError
= OperationNotFound Text
| OperationNameRequired
| CoercionError
| TransformationError
| EmptyDocument
| UnsupportedRootOperation
data Input
= Int Int32
| Float Double
| String Text
| Boolean Bool
| Null
| Enum Name
| List [Type.Value]
| Object (HashMap Name Input)
| Variable Type.Value
deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c== :: Input -> Input -> Bool
Eq, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show)
queryError :: QueryError -> Text
queryError :: QueryError -> Name
queryError (OperationNotFound Name
operationName) = [Name] -> Name
Text.unwords
[Name
"Operation", Name
operationName, Name
"couldn't be found in the document."]
queryError QueryError
OperationNameRequired = Name
"Missing operation name."
queryError QueryError
CoercionError = Name
"Coercion error."
queryError QueryError
TransformationError = Name
"Schema transformation error."
queryError QueryError
EmptyDocument =
Name
"The document doesn't contain any executable operations."
queryError QueryError
UnsupportedRootOperation =
Name
"Root operation type couldn't be found in the schema."
getOperation
:: Maybe Full.Name
-> NonEmpty OperationDefinition
-> Either QueryError OperationDefinition
getOperation :: Maybe Name
-> NonEmpty OperationDefinition
-> Either QueryError OperationDefinition
getOperation Maybe Name
Nothing (OperationDefinition
operation' :| []) = OperationDefinition -> Either QueryError OperationDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperationDefinition
operation'
getOperation Maybe Name
Nothing NonEmpty OperationDefinition
_ = QueryError -> Either QueryError OperationDefinition
forall a b. a -> Either a b
Left QueryError
OperationNameRequired
getOperation (Just Name
operationName) NonEmpty OperationDefinition
operations
| Just OperationDefinition
operation' <- (OperationDefinition -> Bool)
-> NonEmpty OperationDefinition -> Maybe OperationDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find OperationDefinition -> Bool
matchingName NonEmpty OperationDefinition
operations = OperationDefinition -> Either QueryError OperationDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperationDefinition
operation'
| Bool
otherwise = QueryError -> Either QueryError OperationDefinition
forall a b. a -> Either a b
Left (QueryError -> Either QueryError OperationDefinition)
-> QueryError -> Either QueryError OperationDefinition
forall a b. (a -> b) -> a -> b
$ Name -> QueryError
OperationNotFound Name
operationName
where
matchingName :: OperationDefinition -> Bool
matchingName (OperationDefinition OperationType
_ Maybe Name
name [VariableDefinition]
_ [Directive]
_ SelectionSet
_) =
Maybe Name
name Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just Name
operationName
coerceVariableValues :: Coerce.VariableValue a
=> forall m
. HashMap Full.Name (Schema.Type m)
-> OperationDefinition
-> HashMap.HashMap Full.Name a
-> Either QueryError Type.Subs
coerceVariableValues :: forall (m :: * -> *).
HashMap Name (Type m)
-> OperationDefinition -> HashMap Name a -> Either QueryError Subs
coerceVariableValues HashMap Name (Type m)
types OperationDefinition
operationDefinition HashMap Name a
variableValues =
let OperationDefinition OperationType
_ Maybe Name
_ [VariableDefinition]
variableDefinitions [Directive]
_ SelectionSet
_ = OperationDefinition
operationDefinition
in Either QueryError Subs
-> (Subs -> Either QueryError Subs)
-> Maybe Subs
-> Either QueryError Subs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (QueryError -> Either QueryError Subs
forall a b. a -> Either a b
Left QueryError
CoercionError) Subs -> Either QueryError Subs
forall a b. b -> Either a b
Right
(Maybe Subs -> Either QueryError Subs)
-> Maybe Subs -> Either QueryError Subs
forall a b. (a -> b) -> a -> b
$ (VariableDefinition -> Maybe Subs -> Maybe Subs)
-> Maybe Subs -> [VariableDefinition] -> Maybe Subs
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VariableDefinition -> Maybe Subs -> Maybe Subs
forEach (Subs -> Maybe Subs
forall a. a -> Maybe a
Just Subs
forall k v. HashMap k v
HashMap.empty) [VariableDefinition]
variableDefinitions
where
forEach :: VariableDefinition -> Maybe Subs -> Maybe Subs
forEach VariableDefinition
variableDefinition Maybe Subs
coercedValues = do
let Full.VariableDefinition Name
variableName Type
variableTypeName Maybe (Node ConstValue)
defaultValue Location
_ =
VariableDefinition
variableDefinition
let defaultValue' :: Maybe Value
defaultValue' = ConstValue -> Value
constValue (ConstValue -> Value)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node (Node ConstValue -> Value)
-> Maybe (Node ConstValue) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Node ConstValue)
defaultValue
Type
variableType <- Type -> HashMap Name (Type m) -> Maybe Type
forall (m :: * -> *). Type -> HashMap Name (Type m) -> Maybe Type
Type.lookupInputType Type
variableTypeName HashMap Name (Type m)
types
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
Coerce.matchFieldValues
Type -> a -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue'
HashMap Name a
variableValues
Name
variableName
Type
variableType
Maybe Value
defaultValue'
Maybe Subs
coercedValues
coerceVariableValue' :: Type -> a -> Maybe Value
coerceVariableValue' Type
variableType a
value'
= Type -> a -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
Coerce.coerceVariableValue Type
variableType a
value'
Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Value -> Maybe Value
Coerce.coerceInputLiteral Type
variableType
constValue :: Full.ConstValue -> Type.Value
constValue :: ConstValue -> Value
constValue (Full.ConstInt Int32
i) = Int32 -> Value
Type.Int Int32
i
constValue (Full.ConstFloat Double
f) = Double -> Value
Type.Float Double
f
constValue (Full.ConstString Name
x) = Name -> Value
Type.String Name
x
constValue (Full.ConstBoolean Bool
b) = Bool -> Value
Type.Boolean Bool
b
constValue ConstValue
Full.ConstNull = Value
Type.Null
constValue (Full.ConstEnum Name
e) = Name -> Value
Type.Enum Name
e
constValue (Full.ConstList [ConstValue]
l) = [Value] -> Value
Type.List ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ConstValue -> Value
constValue (ConstValue -> Value) -> [ConstValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConstValue]
l
constValue (Full.ConstObject [ObjectField ConstValue]
o) =
Subs -> Value
Type.Object (Subs -> Value) -> Subs -> Value
forall a b. (a -> b) -> a -> b
$ [(Name, Value)] -> Subs
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, Value)] -> Subs) -> [(Name, Value)] -> Subs
forall a b. (a -> b) -> a -> b
$ ObjectField ConstValue -> (Name, Value)
constObjectField (ObjectField ConstValue -> (Name, Value))
-> [ObjectField ConstValue] -> [(Name, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField ConstValue]
o
where
constObjectField :: ObjectField ConstValue -> (Name, Value)
constObjectField Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Name
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
location :: Location
name :: Name
..} =
(Name
name, ConstValue -> Value
constValue (ConstValue -> Value) -> ConstValue -> Value
forall a b. (a -> b) -> a -> b
$ Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node Node ConstValue
value')
document :: Coerce.VariableValue a
=> forall m
. Type.Schema m
-> Maybe Full.Name
-> HashMap Full.Name a
-> Full.Document
-> Either QueryError (Document m)
document :: forall (m :: * -> *).
Schema m
-> Maybe Name
-> HashMap Name a
-> Document
-> Either QueryError (Document m)
document Schema m
schema Maybe Name
operationName HashMap Name a
subs Document
ast = do
let referencedTypes :: HashMap Name (Type m)
referencedTypes = Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema
(NonEmpty OperationDefinition
operations, FragmentDefinitions
fragmentTable) <- Document
-> Either
QueryError (NonEmpty OperationDefinition, FragmentDefinitions)
defragment Document
ast
OperationDefinition
chosenOperation <- Maybe Name
-> NonEmpty OperationDefinition
-> Either QueryError OperationDefinition
getOperation Maybe Name
operationName NonEmpty OperationDefinition
operations
Subs
coercedValues <- HashMap Name (Type m)
-> OperationDefinition -> HashMap Name a -> Either QueryError Subs
forall a (m :: * -> *).
VariableValue a =>
HashMap Name (Type m)
-> OperationDefinition -> HashMap Name a -> Either QueryError Subs
coerceVariableValues HashMap Name (Type m)
referencedTypes OperationDefinition
chosenOperation HashMap Name a
subs
let replacement :: Replacement m
replacement = Replacement :: forall (m :: * -> *).
HashMap Name (Fragment m)
-> FragmentDefinitions
-> Subs
-> HashMap Name (Type m)
-> Replacement m
Replacement
{ fragments :: HashMap Name (Fragment m)
fragments = HashMap Name (Fragment m)
forall k v. HashMap k v
HashMap.empty
, fragmentDefinitions :: FragmentDefinitions
fragmentDefinitions = FragmentDefinitions
fragmentTable
, variableValues :: Subs
variableValues = Subs
coercedValues
, types :: HashMap Name (Type m)
types = HashMap Name (Type m)
referencedTypes
}
case OperationDefinition
chosenOperation of
OperationDefinition OperationType
Full.Query Maybe Name
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
_ ->
Document m -> Either QueryError (Document m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document m -> Either QueryError (Document m))
-> Document m -> Either QueryError (Document m)
forall a b. (a -> b) -> a -> b
$ HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
forall (m :: * -> *).
HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
Document HashMap Name (Type m)
referencedTypes (Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema)
(Operation m -> Document m) -> Operation m -> Document m
forall a b. (a -> b) -> a -> b
$ OperationDefinition -> Replacement m -> Operation m
forall (m :: * -> *).
OperationDefinition -> Replacement m -> Operation m
operation OperationDefinition
chosenOperation Replacement m
replacement
OperationDefinition OperationType
Full.Mutation Maybe Name
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
_
| Just ObjectType m
mutationType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema ->
Document m -> Either QueryError (Document m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document m -> Either QueryError (Document m))
-> Document m -> Either QueryError (Document m)
forall a b. (a -> b) -> a -> b
$ HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
forall (m :: * -> *).
HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
Document HashMap Name (Type m)
referencedTypes ObjectType m
mutationType
(Operation m -> Document m) -> Operation m -> Document m
forall a b. (a -> b) -> a -> b
$ OperationDefinition -> Replacement m -> Operation m
forall (m :: * -> *).
OperationDefinition -> Replacement m -> Operation m
operation OperationDefinition
chosenOperation Replacement m
replacement
OperationDefinition OperationType
Full.Subscription Maybe Name
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
_
| Just ObjectType m
subscriptionType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema ->
Document m -> Either QueryError (Document m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document m -> Either QueryError (Document m))
-> Document m -> Either QueryError (Document m)
forall a b. (a -> b) -> a -> b
$ HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
forall (m :: * -> *).
HashMap Name (Type m) -> ObjectType m -> Operation m -> Document m
Document HashMap Name (Type m)
referencedTypes ObjectType m
subscriptionType
(Operation m -> Document m) -> Operation m -> Document m
forall a b. (a -> b) -> a -> b
$ OperationDefinition -> Replacement m -> Operation m
forall (m :: * -> *).
OperationDefinition -> Replacement m -> Operation m
operation OperationDefinition
chosenOperation Replacement m
replacement
OperationDefinition
_ -> QueryError -> Either QueryError (Document m)
forall a b. a -> Either a b
Left QueryError
UnsupportedRootOperation
defragment
:: Full.Document
-> Either QueryError (NonEmpty OperationDefinition, FragmentDefinitions)
defragment :: Document
-> Either
QueryError (NonEmpty OperationDefinition, FragmentDefinitions)
defragment Document
ast =
let ([OperationDefinition]
operations, FragmentDefinitions
fragmentTable) = (Definition
-> ([OperationDefinition], FragmentDefinitions)
-> ([OperationDefinition], FragmentDefinitions))
-> ([OperationDefinition], FragmentDefinitions)
-> Document
-> ([OperationDefinition], FragmentDefinitions)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition
-> ([OperationDefinition], FragmentDefinitions)
-> ([OperationDefinition], FragmentDefinitions)
defragment' ([], FragmentDefinitions
forall k v. HashMap k v
HashMap.empty) Document
ast
nonEmptyOperations :: Maybe (NonEmpty OperationDefinition)
nonEmptyOperations = [OperationDefinition] -> Maybe (NonEmpty OperationDefinition)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [OperationDefinition]
operations
emptyDocument :: Either QueryError b
emptyDocument = QueryError -> Either QueryError b
forall a b. a -> Either a b
Left QueryError
EmptyDocument
in (, FragmentDefinitions
fragmentTable) (NonEmpty OperationDefinition
-> (NonEmpty OperationDefinition, FragmentDefinitions))
-> Either QueryError (NonEmpty OperationDefinition)
-> Either
QueryError (NonEmpty OperationDefinition, FragmentDefinitions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either QueryError (NonEmpty OperationDefinition)
-> (NonEmpty OperationDefinition
-> Either QueryError (NonEmpty OperationDefinition))
-> Maybe (NonEmpty OperationDefinition)
-> Either QueryError (NonEmpty OperationDefinition)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either QueryError (NonEmpty OperationDefinition)
forall b. Either QueryError b
emptyDocument NonEmpty OperationDefinition
-> Either QueryError (NonEmpty OperationDefinition)
forall a b. b -> Either a b
Right Maybe (NonEmpty OperationDefinition)
nonEmptyOperations
where
defragment' :: Definition
-> ([OperationDefinition], FragmentDefinitions)
-> ([OperationDefinition], FragmentDefinitions)
defragment' Definition
definition ([OperationDefinition]
operations, FragmentDefinitions
fragments')
| (Full.ExecutableDefinition ExecutableDefinition
executable) <- Definition
definition
, (Full.DefinitionOperation OperationDefinition
operation') <- ExecutableDefinition
executable =
(OperationDefinition -> OperationDefinition
transform OperationDefinition
operation' OperationDefinition
-> [OperationDefinition] -> [OperationDefinition]
forall a. a -> [a] -> [a]
: [OperationDefinition]
operations, FragmentDefinitions
fragments')
| (Full.ExecutableDefinition ExecutableDefinition
executable) <- Definition
definition
, (Full.DefinitionFragment FragmentDefinition
fragment) <- ExecutableDefinition
executable
, (Full.FragmentDefinition Name
name Name
_ [Directive]
_ SelectionSet
_ Location
_) <- FragmentDefinition
fragment =
([OperationDefinition]
operations, Name
-> FragmentDefinition -> FragmentDefinitions -> FragmentDefinitions
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name FragmentDefinition
fragment FragmentDefinitions
fragments')
defragment' Definition
_ ([OperationDefinition], FragmentDefinitions)
acc = ([OperationDefinition], FragmentDefinitions)
acc
transform :: OperationDefinition -> OperationDefinition
transform = \case
Full.OperationDefinition OperationType
type' Maybe Name
name [VariableDefinition]
variables [Directive]
directives' SelectionSet
selections Location
_ ->
OperationType
-> Maybe Name
-> [VariableDefinition]
-> [Directive]
-> SelectionSet
-> OperationDefinition
OperationDefinition OperationType
type' Maybe Name
name [VariableDefinition]
variables [Directive]
directives' SelectionSet
selections
Full.SelectionSet SelectionSet
selectionSet Location
_ ->
OperationType
-> Maybe Name
-> [VariableDefinition]
-> [Directive]
-> SelectionSet
-> OperationDefinition
OperationDefinition OperationType
Full.Query Maybe Name
forall a. Maybe a
Nothing [VariableDefinition]
forall a. Monoid a => a
mempty [Directive]
forall a. Monoid a => a
mempty SelectionSet
selectionSet
operation :: OperationDefinition -> Replacement m -> Operation m
operation :: OperationDefinition -> Replacement m -> Operation m
operation OperationDefinition
operationDefinition Replacement m
replacement
= Identity (Operation m) -> Operation m
forall a. Identity a -> a
runIdentity
(Identity (Operation m) -> Operation m)
-> Identity (Operation m) -> Operation m
forall a b. (a -> b) -> a -> b
$ StateT (Replacement m) Identity (Operation m)
-> Replacement m -> Identity (Operation m)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (State (Replacement m) ()
forall (m :: * -> *). State (Replacement m) ()
collectFragments State (Replacement m) ()
-> StateT (Replacement m) Identity (Operation m)
-> StateT (Replacement m) Identity (Operation m)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OperationDefinition
-> StateT (Replacement m) Identity (Operation m)
forall (m :: * -> *).
OperationDefinition
-> StateT (Replacement m) Identity (Operation m)
transform OperationDefinition
operationDefinition) Replacement m
replacement
where
transform :: OperationDefinition
-> StateT (Replacement m) Identity (Operation m)
transform (OperationDefinition OperationType
Full.Query Maybe Name
name [VariableDefinition]
_ [Directive]
_ SelectionSet
sels) =
Maybe Name -> Seq (Selection m) -> Operation m
forall (m :: * -> *).
Maybe Name -> Seq (Selection m) -> Operation m
Query Maybe Name
name (Seq (Selection m) -> Operation m)
-> StateT (Replacement m) Identity (Seq (Selection m))
-> StateT (Replacement m) Identity (Operation m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet -> StateT (Replacement m) Identity (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSet
sels
transform (OperationDefinition OperationType
Full.Mutation Maybe Name
name [VariableDefinition]
_ [Directive]
_ SelectionSet
sels) =
Maybe Name -> Seq (Selection m) -> Operation m
forall (m :: * -> *).
Maybe Name -> Seq (Selection m) -> Operation m
Mutation Maybe Name
name (Seq (Selection m) -> Operation m)
-> StateT (Replacement m) Identity (Seq (Selection m))
-> StateT (Replacement m) Identity (Operation m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet -> StateT (Replacement m) Identity (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSet
sels
transform (OperationDefinition OperationType
Full.Subscription Maybe Name
name [VariableDefinition]
_ [Directive]
_ SelectionSet
sels) =
Maybe Name -> Seq (Selection m) -> Operation m
forall (m :: * -> *).
Maybe Name -> Seq (Selection m) -> Operation m
Subscription Maybe Name
name (Seq (Selection m) -> Operation m)
-> StateT (Replacement m) Identity (Seq (Selection m))
-> StateT (Replacement m) Identity (Operation m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet -> StateT (Replacement m) Identity (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSet
sels
selection
:: Full.Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection :: Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection (Full.FieldSelection Field
fieldSelection) =
Either (Seq (Selection m)) (Selection m)
-> (Field m -> Either (Seq (Selection m)) (Selection m))
-> Maybe (Field m)
-> Either (Seq (Selection m)) (Selection m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall a b. a -> Either a b
Left Seq (Selection m)
forall a. Monoid a => a
mempty) (Selection m -> Either (Seq (Selection m)) (Selection m)
forall a b. b -> Either a b
Right (Selection m -> Either (Seq (Selection m)) (Selection m))
-> (Field m -> Selection m)
-> Field m
-> Either (Seq (Selection m)) (Selection m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m -> Selection m
forall (m :: * -> *). Field m -> Selection m
SelectionField) (Maybe (Field m) -> Either (Seq (Selection m)) (Selection m))
-> StateT (Replacement m) Identity (Maybe (Field m))
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> StateT (Replacement m) Identity (Maybe (Field m))
forall (m :: * -> *).
Field -> State (Replacement m) (Maybe (Field m))
field Field
fieldSelection
selection (Full.FragmentSpreadSelection FragmentSpread
fragmentSelection)
= Either (Seq (Selection m)) (Selection m)
-> (Fragment m -> Either (Seq (Selection m)) (Selection m))
-> Maybe (Fragment m)
-> Either (Seq (Selection m)) (Selection m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall a b. a -> Either a b
Left Seq (Selection m)
forall a. Monoid a => a
mempty) (Selection m -> Either (Seq (Selection m)) (Selection m)
forall a b. b -> Either a b
Right (Selection m -> Either (Seq (Selection m)) (Selection m))
-> (Fragment m -> Selection m)
-> Fragment m
-> Either (Seq (Selection m)) (Selection m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment m -> Selection m
forall (m :: * -> *). Fragment m -> Selection m
SelectionFragment)
(Maybe (Fragment m) -> Either (Seq (Selection m)) (Selection m))
-> StateT (Replacement m) Identity (Maybe (Fragment m))
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentSpread
-> StateT (Replacement m) Identity (Maybe (Fragment m))
forall (m :: * -> *).
FragmentSpread -> State (Replacement m) (Maybe (Fragment m))
fragmentSpread FragmentSpread
fragmentSelection
selection (Full.InlineFragmentSelection InlineFragment
fragmentSelection) =
InlineFragment
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (m :: * -> *).
InlineFragment
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
inlineFragment InlineFragment
fragmentSelection
field :: Full.Field -> State (Replacement m) (Maybe (Field m))
field :: Field -> State (Replacement m) (Maybe (Field m))
field (Full.Field Maybe Name
alias Name
name [Argument]
arguments' [Directive]
directives' SelectionSetOpt
selections Location
_) = do
HashMap Name Input
fieldArguments <- (HashMap Name Input
-> Argument
-> StateT (Replacement m) Identity (HashMap Name Input))
-> HashMap Name Input
-> [Argument]
-> StateT (Replacement m) Identity (HashMap Name Input)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap Name Input
-> Argument -> StateT (Replacement m) Identity (HashMap Name Input)
forall (m :: * -> *).
HashMap Name Input
-> Argument -> State (Replacement m) (HashMap Name Input)
go HashMap Name Input
forall k v. HashMap k v
HashMap.empty [Argument]
arguments'
Seq (Selection m)
fieldSelections <- SelectionSetOpt -> State (Replacement m) (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSetOpt
selections
Maybe [Directive]
fieldDirectives <- [Directive] -> Maybe [Directive]
Definition.selection ([Directive] -> Maybe [Directive])
-> StateT (Replacement m) Identity [Directive]
-> StateT (Replacement m) Identity (Maybe [Directive])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directive] -> StateT (Replacement m) Identity [Directive]
forall (m :: * -> *).
[Directive] -> State (Replacement m) [Directive]
directives [Directive]
directives'
let field' :: Field m
field' = Maybe Name
-> Name -> HashMap Name Input -> Seq (Selection m) -> Field m
forall (m :: * -> *).
Maybe Name
-> Name -> HashMap Name Input -> Seq (Selection m) -> Field m
Field Maybe Name
alias Name
name HashMap Name Input
fieldArguments Seq (Selection m)
fieldSelections
Maybe (Field m) -> State (Replacement m) (Maybe (Field m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Field m) -> State (Replacement m) (Maybe (Field m)))
-> Maybe (Field m) -> State (Replacement m) (Maybe (Field m))
forall a b. (a -> b) -> a -> b
$ Field m
field' Field m -> Maybe [Directive] -> Maybe (Field m)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [Directive]
fieldDirectives
where
go :: HashMap Name Input
-> Argument -> State (Replacement m) (HashMap Name Input)
go HashMap Name Input
arguments (Full.Argument Name
name' (Full.Node Value
value' Location
_) Location
_) =
HashMap Name Input
-> Name -> Value -> State (Replacement m) (HashMap Name Input)
forall (m :: * -> *).
HashMap Name Input
-> Name -> Value -> State (Replacement m) (HashMap Name Input)
inputField HashMap Name Input
arguments Name
name' Value
value'
fragmentSpread
:: Full.FragmentSpread
-> State (Replacement m) (Maybe (Fragment m))
fragmentSpread :: FragmentSpread -> State (Replacement m) (Maybe (Fragment m))
fragmentSpread (Full.FragmentSpread Name
name [Directive]
directives' Location
_) = do
Maybe [Directive]
spreadDirectives <- [Directive] -> Maybe [Directive]
Definition.selection ([Directive] -> Maybe [Directive])
-> StateT (Replacement m) Identity [Directive]
-> StateT (Replacement m) Identity (Maybe [Directive])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directive] -> StateT (Replacement m) Identity [Directive]
forall (m :: * -> *).
[Directive] -> State (Replacement m) [Directive]
directives [Directive]
directives'
HashMap Name (Fragment m)
fragments' <- (Replacement m -> HashMap Name (Fragment m))
-> StateT (Replacement m) Identity (HashMap Name (Fragment m))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Replacement m -> HashMap Name (Fragment m)
forall (m :: * -> *). Replacement m -> HashMap Name (Fragment m)
fragments
FragmentDefinitions
fragmentDefinitions' <- (Replacement m -> FragmentDefinitions)
-> StateT (Replacement m) Identity FragmentDefinitions
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Replacement m -> FragmentDefinitions
forall (m :: * -> *). Replacement m -> FragmentDefinitions
fragmentDefinitions
case Name -> HashMap Name (Fragment m) -> Maybe (Fragment m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name HashMap Name (Fragment m)
fragments' of
Just Fragment m
definition -> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Fragment m) -> Identity (Maybe (Fragment m)))
-> Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Fragment m
definition Fragment m -> Maybe [Directive] -> Maybe (Fragment m)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [Directive]
spreadDirectives
Maybe (Fragment m)
Nothing
| Just FragmentDefinition
definition <- Name -> FragmentDefinitions -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name FragmentDefinitions
fragmentDefinitions' -> do
Maybe (Fragment m)
fragDef <- FragmentDefinition -> State (Replacement m) (Maybe (Fragment m))
forall (m :: * -> *).
FragmentDefinition -> State (Replacement m) (Maybe (Fragment m))
fragmentDefinition FragmentDefinition
definition
case Maybe (Fragment m)
fragDef of
Just Fragment m
fragment -> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Fragment m) -> Identity (Maybe (Fragment m)))
-> Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Fragment m
fragment Fragment m -> Maybe [Directive] -> Maybe (Fragment m)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe [Directive]
spreadDirectives
Maybe (Fragment m)
_ -> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fragment m)
forall a. Maybe a
Nothing
| Bool
otherwise -> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fragment m)
forall a. Maybe a
Nothing
inlineFragment
:: Full.InlineFragment
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
inlineFragment :: InlineFragment
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
inlineFragment (Full.InlineFragment Maybe Name
type' [Directive]
directives' SelectionSet
selections Location
_) = do
Maybe [Directive]
fragmentDirectives <- [Directive] -> Maybe [Directive]
Definition.selection ([Directive] -> Maybe [Directive])
-> StateT (Replacement m) Identity [Directive]
-> StateT (Replacement m) Identity (Maybe [Directive])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directive] -> StateT (Replacement m) Identity [Directive]
forall (m :: * -> *).
[Directive] -> State (Replacement m) [Directive]
directives [Directive]
directives'
case Maybe [Directive]
fragmentDirectives of
Maybe [Directive]
Nothing -> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Seq (Selection m)) (Selection m)
-> State
(Replacement m) (Either (Seq (Selection m)) (Selection m)))
-> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall a b. (a -> b) -> a -> b
$ Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall a b. a -> Either a b
Left Seq (Selection m)
forall a. Monoid a => a
mempty
Maybe [Directive]
_ -> do
Seq (Selection m)
fragmentSelectionSet <- SelectionSet -> State (Replacement m) (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSet
selections
case Maybe Name
type' of
Maybe Name
Nothing -> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Seq (Selection m)) (Selection m)
-> State
(Replacement m) (Either (Seq (Selection m)) (Selection m)))
-> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall a b. (a -> b) -> a -> b
$ Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall a b. a -> Either a b
Left Seq (Selection m)
fragmentSelectionSet
Just Name
typeName -> do
HashMap Name (Type m)
types' <- (Replacement m -> HashMap Name (Type m))
-> StateT (Replacement m) Identity (HashMap Name (Type m))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Replacement m -> HashMap Name (Type m)
forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types
case Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Name
typeName HashMap Name (Type m)
types' of
Just CompositeType m
typeCondition -> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Seq (Selection m)) (Selection m)
-> State
(Replacement m) (Either (Seq (Selection m)) (Selection m)))
-> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall a b. (a -> b) -> a -> b
$
CompositeType m
-> Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall (m :: * -> *) a.
CompositeType m -> Seq (Selection m) -> Either a (Selection m)
selectionFragment CompositeType m
typeCondition Seq (Selection m)
fragmentSelectionSet
Maybe (CompositeType m)
Nothing -> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Seq (Selection m)) (Selection m)
-> State
(Replacement m) (Either (Seq (Selection m)) (Selection m)))
-> Either (Seq (Selection m)) (Selection m)
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
forall a b. (a -> b) -> a -> b
$ Seq (Selection m) -> Either (Seq (Selection m)) (Selection m)
forall a b. a -> Either a b
Left Seq (Selection m)
forall a. Monoid a => a
mempty
where
selectionFragment :: CompositeType m -> Seq (Selection m) -> Either a (Selection m)
selectionFragment CompositeType m
typeName = Selection m -> Either a (Selection m)
forall a b. b -> Either a b
Right
(Selection m -> Either a (Selection m))
-> (Seq (Selection m) -> Selection m)
-> Seq (Selection m)
-> Either a (Selection m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment m -> Selection m
forall (m :: * -> *). Fragment m -> Selection m
SelectionFragment
(Fragment m -> Selection m)
-> (Seq (Selection m) -> Fragment m)
-> Seq (Selection m)
-> Selection m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompositeType m -> Seq (Selection m) -> Fragment m
forall (m :: * -> *).
CompositeType m -> Seq (Selection m) -> Fragment m
Fragment CompositeType m
typeName
appendSelection :: Traversable t
=> t Full.Selection
-> State (Replacement m) (Seq (Selection m))
appendSelection :: t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection = (Seq (Selection m)
-> Selection -> State (Replacement m) (Seq (Selection m)))
-> Seq (Selection m)
-> t Selection
-> State (Replacement m) (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq (Selection m)
-> Selection -> State (Replacement m) (Seq (Selection m))
forall (m :: * -> *).
Seq (Selection m)
-> Selection -> StateT (Replacement m) Identity (Seq (Selection m))
go Seq (Selection m)
forall a. Monoid a => a
mempty
where
go :: Seq (Selection m)
-> Selection -> StateT (Replacement m) Identity (Seq (Selection m))
go Seq (Selection m)
acc Selection
sel = Seq (Selection m)
-> Either (Seq (Selection m)) (Selection m) -> Seq (Selection m)
forall a. Seq a -> Either (Seq a) a -> Seq a
append Seq (Selection m)
acc (Either (Seq (Selection m)) (Selection m) -> Seq (Selection m))
-> StateT
(Replacement m) Identity (Either (Seq (Selection m)) (Selection m))
-> StateT (Replacement m) Identity (Seq (Selection m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection
-> StateT
(Replacement m) Identity (Either (Seq (Selection m)) (Selection m))
forall (m :: * -> *).
Selection
-> State (Replacement m) (Either (Seq (Selection m)) (Selection m))
selection Selection
sel
append :: Seq a -> Either (Seq a) a -> Seq a
append Seq a
acc (Left Seq a
list) = Seq a
list Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
acc
append Seq a
acc (Right a
one) = a
one a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
acc
directives :: [Full.Directive] -> State (Replacement m) [Definition.Directive]
directives :: [Directive] -> State (Replacement m) [Directive]
directives = (Directive -> StateT (Replacement m) Identity Directive)
-> [Directive] -> State (Replacement m) [Directive]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Directive -> StateT (Replacement m) Identity Directive
forall (m :: * -> *).
Directive -> StateT (Replacement m) Identity Directive
directive
where
directive :: Directive -> StateT (Replacement m) Identity Directive
directive (Full.Directive Name
directiveName [Argument]
directiveArguments Location
_)
= Name -> Arguments -> Directive
Definition.Directive Name
directiveName (Arguments -> Directive)
-> (Subs -> Arguments) -> Subs -> Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subs -> Arguments
Type.Arguments
(Subs -> Directive)
-> StateT (Replacement m) Identity Subs
-> StateT (Replacement m) Identity Directive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Subs -> Argument -> StateT (Replacement m) Identity Subs)
-> Subs -> [Argument] -> StateT (Replacement m) Identity Subs
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Subs -> Argument -> StateT (Replacement m) Identity Subs
forall (m :: * -> *).
Subs -> Argument -> StateT (Replacement m) Identity Subs
go Subs
forall k v. HashMap k v
HashMap.empty [Argument]
directiveArguments
go :: Subs -> Argument -> StateT (Replacement m) Identity Subs
go Subs
arguments (Full.Argument Name
name (Full.Node Value
value' Location
_) Location
_) = do
Value
substitutedValue <- Value -> State (Replacement m) Value
forall (m :: * -> *). Value -> State (Replacement m) Value
value Value
value'
Subs -> StateT (Replacement m) Identity Subs
forall (m :: * -> *) a. Monad m => a -> m a
return (Subs -> StateT (Replacement m) Identity Subs)
-> Subs -> StateT (Replacement m) Identity Subs
forall a b. (a -> b) -> a -> b
$ Name -> Value -> Subs -> Subs
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name Value
substitutedValue Subs
arguments
collectFragments :: State (Replacement m) ()
collectFragments :: State (Replacement m) ()
collectFragments = do
FragmentDefinitions
fragDefs <- (Replacement m -> FragmentDefinitions)
-> StateT (Replacement m) Identity FragmentDefinitions
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Replacement m -> FragmentDefinitions
forall (m :: * -> *). Replacement m -> FragmentDefinitions
fragmentDefinitions
let nextValue :: FragmentDefinition
nextValue = [FragmentDefinition] -> FragmentDefinition
forall a. [a] -> a
head ([FragmentDefinition] -> FragmentDefinition)
-> [FragmentDefinition] -> FragmentDefinition
forall a b. (a -> b) -> a -> b
$ FragmentDefinitions -> [FragmentDefinition]
forall k v. HashMap k v -> [v]
HashMap.elems FragmentDefinitions
fragDefs
Bool -> State (Replacement m) () -> State (Replacement m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FragmentDefinitions -> Bool
forall k v. HashMap k v -> Bool
HashMap.null FragmentDefinitions
fragDefs) (State (Replacement m) () -> State (Replacement m) ())
-> State (Replacement m) () -> State (Replacement m) ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (Fragment m)
_ <- FragmentDefinition -> State (Replacement m) (Maybe (Fragment m))
forall (m :: * -> *).
FragmentDefinition -> State (Replacement m) (Maybe (Fragment m))
fragmentDefinition FragmentDefinition
nextValue
State (Replacement m) ()
forall (m :: * -> *). State (Replacement m) ()
collectFragments
fragmentDefinition
:: Full.FragmentDefinition
-> State (Replacement m) (Maybe (Fragment m))
fragmentDefinition :: FragmentDefinition -> State (Replacement m) (Maybe (Fragment m))
fragmentDefinition (Full.FragmentDefinition Name
name Name
type' [Directive]
_ SelectionSet
selections Location
_) = do
(Replacement m -> Replacement m)
-> StateT (Replacement m) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify Replacement m -> Replacement m
forall (m :: * -> *). Replacement m -> Replacement m
deleteFragmentDefinition
Seq (Selection m)
fragmentSelection <- SelectionSet -> State (Replacement m) (Seq (Selection m))
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
t Selection -> State (Replacement m) (Seq (Selection m))
appendSelection SelectionSet
selections
HashMap Name (Type m)
types' <- (Replacement m -> HashMap Name (Type m))
-> StateT (Replacement m) Identity (HashMap Name (Type m))
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Replacement m -> HashMap Name (Type m)
forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types
case Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Name
type' HashMap Name (Type m)
types' of
Just CompositeType m
compositeType -> do
let newValue :: Fragment m
newValue = CompositeType m -> Seq (Selection m) -> Fragment m
forall (m :: * -> *).
CompositeType m -> Seq (Selection m) -> Fragment m
Fragment CompositeType m
compositeType Seq (Selection m)
fragmentSelection
(Replacement m -> Replacement m)
-> StateT (Replacement m) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Replacement m -> Replacement m)
-> StateT (Replacement m) Identity ())
-> (Replacement m -> Replacement m)
-> StateT (Replacement m) Identity ()
forall a b. (a -> b) -> a -> b
$ Fragment m -> Replacement m -> Replacement m
forall (m :: * -> *). Fragment m -> Replacement m -> Replacement m
insertFragment Fragment m
newValue
Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Fragment m) -> Identity (Maybe (Fragment m)))
-> Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Fragment m -> Maybe (Fragment m)
forall a. a -> Maybe a
Just Fragment m
newValue
Maybe (CompositeType m)
_ -> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m)))
-> Identity (Maybe (Fragment m))
-> State (Replacement m) (Maybe (Fragment m))
forall a b. (a -> b) -> a -> b
$ Maybe (Fragment m) -> Identity (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fragment m)
forall a. Maybe a
Nothing
where
deleteFragmentDefinition :: Replacement m -> Replacement m
deleteFragmentDefinition replacement :: Replacement m
replacement@Replacement{FragmentDefinitions
Subs
HashMap Name (Type m)
HashMap Name (Fragment m)
types :: HashMap Name (Type m)
variableValues :: Subs
fragmentDefinitions :: FragmentDefinitions
fragments :: HashMap Name (Fragment m)
types :: forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
variableValues :: forall (m :: * -> *). Replacement m -> Subs
fragmentDefinitions :: forall (m :: * -> *). Replacement m -> FragmentDefinitions
fragments :: forall (m :: * -> *). Replacement m -> HashMap Name (Fragment m)
..} =
let newDefinitions :: FragmentDefinitions
newDefinitions = Name -> FragmentDefinitions -> FragmentDefinitions
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete Name
name FragmentDefinitions
fragmentDefinitions
in Replacement m
replacement{ fragmentDefinitions :: FragmentDefinitions
fragmentDefinitions = FragmentDefinitions
newDefinitions }
insertFragment :: Fragment m -> Replacement m -> Replacement m
insertFragment Fragment m
newValue replacement :: Replacement m
replacement@Replacement{FragmentDefinitions
Subs
HashMap Name (Type m)
HashMap Name (Fragment m)
types :: HashMap Name (Type m)
variableValues :: Subs
fragmentDefinitions :: FragmentDefinitions
fragments :: HashMap Name (Fragment m)
types :: forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
variableValues :: forall (m :: * -> *). Replacement m -> Subs
fragmentDefinitions :: forall (m :: * -> *). Replacement m -> FragmentDefinitions
fragments :: forall (m :: * -> *). Replacement m -> HashMap Name (Fragment m)
..} =
let newFragments :: HashMap Name (Fragment m)
newFragments = Name
-> Fragment m
-> HashMap Name (Fragment m)
-> HashMap Name (Fragment m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name Fragment m
newValue HashMap Name (Fragment m)
fragments
in Replacement m
replacement{ fragments :: HashMap Name (Fragment m)
fragments = HashMap Name (Fragment m)
newFragments }
value :: forall m. Full.Value -> State (Replacement m) Type.Value
value :: Value -> State (Replacement m) Value
value (Full.Variable Name
name) =
(Replacement m -> Value) -> State (Replacement m) Value
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Type.Null (Maybe Value -> Value)
-> (Replacement m -> Maybe Value) -> Replacement m -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Subs -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name (Subs -> Maybe Value)
-> (Replacement m -> Subs) -> Replacement m -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement m -> Subs
forall (m :: * -> *). Replacement m -> Subs
variableValues)
value (Full.Int Int32
int) = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> State (Replacement m) Value)
-> Value -> State (Replacement m) Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
int
value (Full.Float Double
float) = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> State (Replacement m) Value)
-> Value -> State (Replacement m) Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
float
value (Full.String Name
string) = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> State (Replacement m) Value)
-> Value -> State (Replacement m) Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
value (Full.Boolean Bool
boolean) = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> State (Replacement m) Value)
-> Value -> State (Replacement m) Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
boolean
value Value
Full.Null = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Type.Null
value (Full.Enum Name
enum) = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> State (Replacement m) Value)
-> Value -> State (Replacement m) Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
value (Full.List [Value]
list) = [Value] -> Value
Type.List ([Value] -> Value)
-> StateT (Replacement m) Identity [Value]
-> State (Replacement m) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> State (Replacement m) Value)
-> [Value] -> StateT (Replacement m) Identity [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> State (Replacement m) Value
forall (m :: * -> *). Value -> State (Replacement m) Value
value [Value]
list
value (Full.Object [ObjectField Value]
object) =
Subs -> Value
Type.Object (Subs -> Value)
-> ([(Name, Value)] -> Subs) -> [(Name, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Value)] -> Subs
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, Value)] -> Value)
-> StateT (Replacement m) Identity [(Name, Value)]
-> State (Replacement m) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectField Value
-> StateT (Replacement m) Identity (Name, Value))
-> [ObjectField Value]
-> StateT (Replacement m) Identity [(Name, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ObjectField Value -> StateT (Replacement m) Identity (Name, Value)
forall (m :: * -> *).
ObjectField Value -> StateT (Replacement m) Identity (Name, Value)
objectField [ObjectField Value]
object
where
objectField :: ObjectField Value -> StateT (Replacement m) Identity (Name, Value)
objectField Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node Value
value', Name
Location
location :: Location
name :: Name
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
..} =
(Name
name,) (Value -> (Name, Value))
-> StateT (Replacement m) Identity Value
-> StateT (Replacement m) Identity (Name, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> StateT (Replacement m) Identity Value
forall (m :: * -> *). Value -> State (Replacement m) Value
value (Node Value -> Value
forall a. Node a -> a
Full.node Node Value
value')
input :: forall m. Full.Value -> State (Replacement m) (Maybe Input)
input :: Value -> State (Replacement m) (Maybe Input)
input (Full.Variable Name
name) =
(Replacement m -> Maybe Input)
-> State (Replacement m) (Maybe Input)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((Value -> Input) -> Maybe Value -> Maybe Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Input
Variable (Maybe Value -> Maybe Input)
-> (Replacement m -> Maybe Value) -> Replacement m -> Maybe Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Subs -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name (Subs -> Maybe Value)
-> (Replacement m -> Subs) -> Replacement m -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement m -> Subs
forall (m :: * -> *). Replacement m -> Subs
variableValues)
input (Full.Int Int32
int) = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Int32 -> Input
Int Int32
int
input (Full.Float Double
float) = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Double -> Input
Float Double
float
input (Full.String Name
string) = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Name -> Input
String Name
string
input (Full.Boolean Bool
boolean) = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Bool -> Input
Boolean Bool
boolean
input Value
Full.Null = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Null
input (Full.Enum Name
enum) = Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Name -> Input
Enum Name
enum
input (Full.List [Value]
list) = Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input)
-> ([Value] -> Input) -> [Value] -> Maybe Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Input
List ([Value] -> Maybe Input)
-> StateT (Replacement m) Identity [Value]
-> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> StateT (Replacement m) Identity Value)
-> [Value] -> StateT (Replacement m) Identity [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> StateT (Replacement m) Identity Value
forall (m :: * -> *). Value -> State (Replacement m) Value
value [Value]
list
input (Full.Object [ObjectField Value]
object) = do
HashMap Name Input
objectFields <- (HashMap Name Input
-> ObjectField Value
-> StateT (Replacement m) Identity (HashMap Name Input))
-> HashMap Name Input
-> [ObjectField Value]
-> StateT (Replacement m) Identity (HashMap Name Input)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap Name Input
-> ObjectField Value
-> StateT (Replacement m) Identity (HashMap Name Input)
forall (m :: * -> *).
HashMap Name Input
-> ObjectField Value -> State (Replacement m) (HashMap Name Input)
objectField HashMap Name Input
forall k v. HashMap k v
HashMap.empty [ObjectField Value]
object
Maybe Input -> State (Replacement m) (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> State (Replacement m) (Maybe Input))
-> Maybe Input -> State (Replacement m) (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ HashMap Name Input -> Input
Object HashMap Name Input
objectFields
where
objectField :: HashMap Name Input
-> ObjectField Value -> State (Replacement m) (HashMap Name Input)
objectField HashMap Name Input
resultMap Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node Value
value', Name
Location
location :: Location
name :: Name
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
..} =
HashMap Name Input
-> Name -> Value -> State (Replacement m) (HashMap Name Input)
forall (m :: * -> *).
HashMap Name Input
-> Name -> Value -> State (Replacement m) (HashMap Name Input)
inputField HashMap Name Input
resultMap Name
name (Value -> State (Replacement m) (HashMap Name Input))
-> Value -> State (Replacement m) (HashMap Name Input)
forall a b. (a -> b) -> a -> b
$ Node Value -> Value
forall a. Node a -> a
Full.node Node Value
value'
inputField :: forall m
. HashMap Full.Name Input
-> Full.Name
-> Full.Value
-> State (Replacement m) (HashMap Full.Name Input)
inputField :: HashMap Name Input
-> Name -> Value -> State (Replacement m) (HashMap Name Input)
inputField HashMap Name Input
resultMap Name
name Value
value' = do
Maybe Input
objectFieldValue <- Value -> State (Replacement m) (Maybe Input)
forall (m :: * -> *). Value -> State (Replacement m) (Maybe Input)
input Value
value'
case Maybe Input
objectFieldValue of
Just Input
fieldValue -> HashMap Name Input -> State (Replacement m) (HashMap Name Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Name Input -> State (Replacement m) (HashMap Name Input))
-> HashMap Name Input -> State (Replacement m) (HashMap Name Input)
forall a b. (a -> b) -> a -> b
$ Name -> Input -> HashMap Name Input -> HashMap Name Input
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name Input
fieldValue HashMap Name Input
resultMap
Maybe Input
Nothing -> HashMap Name Input -> State (Replacement m) (HashMap Name Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Name Input
resultMap