{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | After the document is parsed, before getting executed, the AST is
-- transformed into a similar, simpler AST. Performed transformations include:
--
--   * Replacing variables with their values.
--   * Inlining fragments. Some fragments can be completely eliminated and
--   replaced by the selection set they represent. Invalid (recursive and
--   non-existing) fragments are skipped. The most fragments are inlined, so the
--   executor doesn't have to perform additional lookups later.
--   * Evaluating directives (@\@include@ and @\@skip@).
--
-- This module is also responsible for smaller rewrites that touch only parts of
-- the original AST.
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

-- | Associates a fragment name with a list of 'Field's.
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

-- | Represents fragments and inline fragments.
data Fragment m
    = Fragment (Type.CompositeType m) (Seq (Selection m))

-- | Single selection element.
data Selection m
    = SelectionFragment (Fragment m)
    | SelectionField (Field m)

-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
--
-- Currently only queries and mutations are supported.
data Operation m
    = Query (Maybe Text) (Seq (Selection m))
    | Mutation (Maybe Text) (Seq (Selection m))
    | Subscription (Maybe Text) (Seq (Selection m))

-- | Single GraphQL field.
data Field m = Field
    (Maybe Full.Name) Full.Name (HashMap Full.Name Input) (Seq (Selection m))

-- | Contains the operation to be executed along with its root type.
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

-- | Query error types.
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')

-- | Rewrites the original syntax tree into an intermediate representation used
-- for query execution.
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

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

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

-- * Fragment replacement

-- | Extract fragment definitions into a single 'HashMap'.
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