{-# 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 operationName :: Name
operationName) = [Name] -> Name
Text.unwords
    ["Operation", Name
operationName, "couldn't be found in the document."]
queryError OperationNameRequired = "Missing operation name."
queryError CoercionError = "Coercion error."
queryError TransformationError = "Schema transformation error."
queryError EmptyDocument =
    "The document doesn't contain any executable operations."
queryError UnsupportedRootOperation =
    "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 Nothing (operation' :: OperationDefinition
operation' :| []) = OperationDefinition -> Either QueryError OperationDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure OperationDefinition
operation'
getOperation Nothing _ = QueryError -> Either QueryError OperationDefinition
forall a b. a -> Either a b
Left QueryError
OperationNameRequired
getOperation (Just operationName :: Name
operationName) operations :: NonEmpty OperationDefinition
operations
    | Just operation' :: 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 _ name :: Maybe Name
name _ _ _) =
        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 types :: HashMap Name (Type m)
types operationDefinition :: OperationDefinition
operationDefinition variableValues :: HashMap Name a
variableValues =
    let OperationDefinition _ _ variableDefinitions :: [VariableDefinition]
variableDefinitions _ _ = 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
variableDefinition coercedValues :: Maybe Subs
coercedValues = do
        let Full.VariableDefinition variableName :: Name
variableName variableTypeName :: Type
variableTypeName defaultValue :: Maybe (Node ConstValue)
defaultValue _ =
                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' variableType :: Type
variableType value' :: 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 i :: Int32
i) = Int32 -> Value
Type.Int Int32
i
constValue (Full.ConstFloat f :: Double
f) = Double -> Value
Type.Float Double
f
constValue (Full.ConstString x :: Name
x) = Name -> Value
Type.String Name
x
constValue (Full.ConstBoolean b :: Bool
b) = Bool -> Value
Type.Boolean Bool
b
constValue Full.ConstNull = Value
Type.Null
constValue (Full.ConstEnum e :: Name
e) = Name -> Value
Type.Enum Name
e
constValue (Full.ConstList l :: [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 o :: [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
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 :: Schema m
schema operationName :: Maybe Name
operationName subs :: HashMap Name a
subs ast :: 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

    (operations :: NonEmpty OperationDefinition
operations, fragmentTable :: 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 Full.Query _ _ _ _ ->
            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 Full.Mutation _ _ _ _
            | Just mutationType :: 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 Full.Subscription _ _ _ _
            | Just subscriptionType :: 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
        _ -> 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 ast :: Document
ast =
    let (operations :: [OperationDefinition]
operations, fragmentTable :: 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
definition (operations :: [OperationDefinition]
operations, fragments' :: FragmentDefinitions
fragments')
        | (Full.ExecutableDefinition executable :: ExecutableDefinition
executable) <- Definition
definition
        , (Full.DefinitionOperation operation' :: OperationDefinition
operation') <- ExecutableDefinition
executable =
            (OperationDefinition -> OperationDefinition
transform OperationDefinition
operation' OperationDefinition
-> [OperationDefinition] -> [OperationDefinition]
forall a. a -> [a] -> [a]
: [OperationDefinition]
operations, FragmentDefinitions
fragments')
        | (Full.ExecutableDefinition executable :: ExecutableDefinition
executable) <- Definition
definition
        , (Full.DefinitionFragment fragment :: FragmentDefinition
fragment) <- ExecutableDefinition
executable
        , (Full.FragmentDefinition name :: Name
name _ _ _ _) <- 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' _ acc :: ([OperationDefinition], FragmentDefinitions)
acc = ([OperationDefinition], FragmentDefinitions)
acc
    transform :: OperationDefinition -> OperationDefinition
transform = \case
        Full.OperationDefinition type' :: OperationType
type' name :: Maybe Name
name variables :: [VariableDefinition]
variables directives' :: [Directive]
directives' selections :: SelectionSet
selections _ ->
            OperationType
-> Maybe Name
-> [VariableDefinition]
-> [Directive]
-> SelectionSet
-> OperationDefinition
OperationDefinition OperationType
type' Maybe Name
name [VariableDefinition]
variables [Directive]
directives' SelectionSet
selections
        Full.SelectionSet selectionSet :: SelectionSet
selectionSet _ ->
            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
operationDefinition replacement :: 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 Full.Query name :: Maybe Name
name _ _ sels :: 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 Full.Mutation name :: Maybe Name
name _ _ sels :: 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 Full.Subscription name :: Maybe Name
name _ _ sels :: 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 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 fragmentSelection :: 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 fragmentSelection :: 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 alias :: Maybe Name
alias name :: Name
name arguments' :: [Argument]
arguments' directives' :: [Directive]
directives' selections :: SelectionSetOpt
selections _) = 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 arguments :: HashMap Name Input
arguments (Full.Argument name' :: Name
name' (Full.Node value' :: Value
value' _) _) =
        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
name directives' :: [Directive]
directives' _) = 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 definition :: 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
        Nothing
            | Just definition :: 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 :: 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
                    _ -> 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 type' :: Maybe Name
type' directives' :: [Directive]
directives' selections :: SelectionSet
selections _) = 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
        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
        _ -> 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
                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 typeName :: 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 typeCondition :: 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
                        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 typeName :: 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 acc :: Seq (Selection m)
acc sel :: 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 acc :: Seq a
acc (Left list :: Seq a
list) = Seq a
list Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
acc
    append acc :: Seq a
acc (Right one :: 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 directiveName :: Name
directiveName directiveArguments :: [Argument]
directiveArguments _)
        = 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 arguments :: Subs
arguments (Full.Argument name :: Name
name (Full.Node value' :: Value
value' _) _) = 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' :: Name
type' _ selections :: SelectionSet
selections _) = 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 :: 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
        _ -> 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{..} =
        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 newValue :: Fragment m
newValue replacement :: Replacement m
replacement@Replacement{..} =
        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
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 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 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 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 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 Full.Null = Value -> State (Replacement m) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Type.Null
value (Full.Enum 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 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 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
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
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 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 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 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 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 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 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 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 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 resultMap :: HashMap Name Input
resultMap Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node Value
value', ..} =
        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 resultMap :: HashMap Name Input
resultMap name :: Name
name value' :: 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 fieldValue :: 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
        Nothing -> HashMap Name Input -> State (Replacement m) (HashMap Name Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Name Input
resultMap