{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

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

-- | 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
    ( Field(..)
    , Fragment(..)
    , Input(..)
    , Operation(..)
    , Replacement(..)
    , Selection(..)
    , TransformT(..)
    , document
    , transform
    ) where

import Control.Monad (foldM)
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), local)
import qualified Control.Monad.Trans.Reader as Reader
import Data.Bifunctor (first)
import Data.Functor ((<&>))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Int (Int32)
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq, (><))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.Type.Schema (Type)
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Internal as Type
import Numeric (showFloat)

-- | Associates a fragment name with a list of 'Field's.
data Replacement m = Replacement
    { forall (m :: * -> *). Replacement m -> Subs
variableValues :: Type.Subs
    , forall (m :: * -> *).
Replacement m -> HashMap Name FragmentDefinition
fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
    , forall (m :: * -> *). Replacement m -> HashSet Name
visitedFragments :: HashSet Full.Name
    , forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types :: HashMap Full.Name (Type m)
    }

newtype TransformT m a = TransformT
    { forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT :: ReaderT (Replacement m) m a
    }

instance Functor m => Functor (TransformT m) where
    fmap :: forall a b. (a -> b) -> TransformT m a -> TransformT m b
fmap a -> b
f = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT

instance Applicative m => Applicative (TransformT m) where
    pure :: forall a. a -> TransformT m a
pure = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TransformT ReaderT (Replacement m) m (a -> b)
f <*> :: forall a b.
TransformT m (a -> b) -> TransformT m a -> TransformT m b
<*> TransformT ReaderT (Replacement m) m a
x = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall a b. (a -> b) -> a -> b
$ ReaderT (Replacement m) m (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (Replacement m) m a
x

instance Monad m => Monad (TransformT m) where
    TransformT ReaderT (Replacement m) m a
x >>= :: forall a b.
TransformT m a -> (a -> TransformT m b) -> TransformT m b
>>= a -> TransformT m b
f = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall a b. (a -> b) -> a -> b
$ ReaderT (Replacement m) m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TransformT m b
f

instance MonadTrans TransformT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> TransformT m a
lift = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadThrow m => MonadThrow (TransformT m) where
    throwM :: forall e a. Exception e => e -> TransformT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (TransformT m) where
  catch :: forall e a.
Exception e =>
TransformT m a -> (e -> TransformT m a) -> TransformT m a
catch (TransformT ReaderT (Replacement m) m a
stack) e -> TransformT m a
handler =
      forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ReaderT (Replacement m) m a
stack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TransformT m a
handler

asks :: Monad m => forall a. (Replacement m -> a) -> TransformT m a
asks :: forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks = forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
Reader.asks

-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
data Operation m
    = Operation Full.OperationType (Seq (Selection m)) Full.Location

-- | Field or inlined fragment.
data Selection m
    = FieldSelection (Field m)
    | FragmentSelection (Fragment m)

data Field m = Field
    (Maybe Full.Name)
    Full.Name
    (HashMap Full.Name (Full.Node Input))
    (Seq (Selection m))
    Full.Location

data Fragment m = Fragment
    (Type.CompositeType m) (Seq (Selection m)) Full.Location

data Input
    = Variable Type.Value
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Full.Name
    | List [Input]
    | Object (HashMap Full.Name Input)
    deriving Input -> Input -> Bool
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

instance Show Input where
    showList :: [Input] -> ShowS
showList = forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => [a] -> String
showList'
      where
        showList' :: [a] -> String
showList' [a]
list = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list) forall a. [a] -> [a] -> [a]
++ String
"]"
    show :: Input -> String
show (Int Int32
integer) = forall a. Show a => a -> String
show Int32
integer
    show (Float Double
float') = forall a. RealFloat a => a -> ShowS
showFloat Double
float' forall a. Monoid a => a
mempty
    show (String Name
text) = String
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
Full.escape) String
"\"" Name
text
    show (Boolean Bool
boolean') = forall a. Show a => a -> String
show Bool
boolean'
    show Input
Null = String
"null"
    show (Enum Name
name) = Name -> String
Text.unpack Name
name
    show (List [Input]
list) = forall a. Show a => a -> String
show [Input]
list
    show (Object HashMap Name Input
fields) = [String] -> String
unwords
        [ String
"{"
        , forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall {a}. Show a => Name -> a -> [String] -> [String]
showObject [] HashMap Name Input
fields)
        , String
"}"
        ]
      where
        showObject :: Name -> a -> [String] -> [String]
showObject Name
key a
value [String]
accumulator =
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name -> String
Text.unpack Name
key, String
": ", forall a. Show a => a -> String
show a
value] forall a. a -> [a] -> [a]
: [String]
accumulator
    show Input
variableValue = forall a. Show a => a -> String
show Input
variableValue

-- | Extracts operations and fragment definitions of the document.
document :: Full.Document
    -> ([Full.OperationDefinition], HashMap Full.Name Full.FragmentDefinition)
document :: Document
-> ([OperationDefinition], HashMap Name FragmentDefinition)
document = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {p :: * -> * -> *}.
(Bifunctor p, Functor (p [OperationDefinition])) =>
Definition
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
filterOperation ([], forall k v. HashMap k v
HashMap.empty)
  where
    filterOperation :: Definition
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
filterOperation (Full.ExecutableDefinition ExecutableDefinition
executableDefinition) p [OperationDefinition] (HashMap Name FragmentDefinition)
accumulator
        | Full.DefinitionOperation OperationDefinition
operationDefinition' <- ExecutableDefinition
executableDefinition =
            forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (OperationDefinition
operationDefinition' forall a. a -> [a] -> [a]
:) p [OperationDefinition] (HashMap Name FragmentDefinition)
accumulator
        | Full.DefinitionFragment FragmentDefinition
fragmentDefinition <- ExecutableDefinition
executableDefinition
        , Full.FragmentDefinition Name
fragmentName Name
_ [Directive]
_ SelectionSet
_ Location
_ <- FragmentDefinition
fragmentDefinition =
            forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fragmentName FragmentDefinition
fragmentDefinition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p [OperationDefinition] (HashMap Name FragmentDefinition)
accumulator
    filterOperation Definition
_ p [OperationDefinition] (HashMap Name FragmentDefinition)
accumulator = p [OperationDefinition] (HashMap Name FragmentDefinition)
accumulator -- Type system definitions.

-- | Rewrites the original syntax tree into an intermediate representation used
-- for the query execution.
transform :: Monad m => Full.OperationDefinition -> TransformT m (Operation m)
transform :: forall (m :: * -> *).
Monad m =>
OperationDefinition -> TransformT m (Operation m)
transform (Full.OperationDefinition OperationType
operationType Maybe Name
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
selectionSet' Location
operationLocation) = do
    Seq (Selection m)
transformedSelections <- forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
OperationType -> Seq (Selection m) -> Location -> Operation m
Operation OperationType
operationType Seq (Selection m)
transformedSelections Location
operationLocation
transform (Full.SelectionSet SelectionSet
selectionSet' Location
operationLocation) = do
    Seq (Selection m)
transformedSelections <- forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
OperationType -> Seq (Selection m) -> Location -> Operation m
Operation OperationType
Full.Query Seq (Selection m)
transformedSelections Location
operationLocation

selectionSet :: Monad m => Full.SelectionSet -> TransformT m (Seq (Selection m))
selectionSet :: forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet = forall (m :: * -> *).
Monad m =>
SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList

selectionSetOpt :: Monad m => Full.SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt :: forall (m :: * -> *).
Monad m =>
SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
Seq (Selection m) -> Selection -> TransformT m (Seq (Selection m))
go forall a. Seq a
Seq.empty
  where
    go :: Seq (Selection m) -> Selection -> TransformT m (Seq (Selection m))
go Seq (Selection m)
accumulatedSelections Selection
currentSelection =
        forall (m :: * -> *).
Monad m =>
Selection -> TransformT m (Seq (Selection m))
selection Selection
currentSelection forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Seq (Selection m)
accumulatedSelections forall a. Seq a -> Seq a -> Seq a
><)

selection :: Monad m => Full.Selection -> TransformT m (Seq (Selection m))
selection :: forall (m :: * -> *).
Monad m =>
Selection -> TransformT m (Seq (Selection m))
selection (Full.FieldSelection Field
field') =
    forall (m :: * -> *) a.
Monad m =>
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet forall (m :: * -> *). Field m -> Selection m
FieldSelection forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Field -> TransformT m (Maybe (Field m))
field Field
field'
selection (Full.FragmentSpreadSelection FragmentSpread
fragmentSpread') =
    forall (m :: * -> *) a.
Monad m =>
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet forall (m :: * -> *). Fragment m -> Selection m
FragmentSelection forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread FragmentSpread
fragmentSpread'
selection (Full.InlineFragmentSelection InlineFragment
inlineFragment') =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Fragment m -> Selection m
FragmentSelection) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
InlineFragment
-> TransformT m (Either (Seq (Selection m)) (Fragment m))
inlineFragment InlineFragment
inlineFragment'

maybeToSelectionSet :: Monad m
    => forall a
    . (a -> Selection m)
    -> TransformT m (Maybe a)
    -> TransformT m (Seq (Selection m))
maybeToSelectionSet :: forall (m :: * -> *) a.
Monad m =>
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet a -> Selection m
selectionType = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Selection m
selectionType)

directives :: Monad m => [Full.Directive] -> TransformT m (Maybe [Definition.Directive])
directives :: forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Directive] -> Maybe [Directive]
Type.selection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
Monad m =>
Directive -> TransformT m Directive
directive

inlineFragment :: Monad m
    => Full.InlineFragment
    -> TransformT m (Either (Seq (Selection m)) (Fragment m))
inlineFragment :: forall (m :: * -> *).
Monad m =>
InlineFragment
-> TransformT m (Either (Seq (Selection m)) (Fragment m))
inlineFragment (Full.InlineFragment Maybe Name
maybeCondition [Directive]
directives' SelectionSet
selectionSet' Location
location)
    | Just Name
typeCondition <- Maybe Name
maybeCondition = do
        Seq (Selection m)
transformedSelections <- forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
        Maybe [Directive]
transformedDirectives <- forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
        Maybe (CompositeType m)
maybeFragmentType <- forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Name
typeCondition
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe [Directive]
transformedDirectives forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (CompositeType m)
maybeFragmentType of
            Just CompositeType m
fragmentType -> forall a b. b -> Either a b
Right
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
CompositeType m -> Seq (Selection m) -> Location -> Fragment m
Fragment CompositeType m
fragmentType Seq (Selection m)
transformedSelections Location
location
            Maybe (CompositeType m)
Nothing -> forall a b. a -> Either a b
Left forall a. Seq a
Seq.empty
    | Bool
otherwise = do
        Seq (Selection m)
transformedSelections <- forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
        Maybe [Directive]
transformedDirectives <- forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe [Directive]
transformedDirectives
            then forall a b. a -> Either a b
Left Seq (Selection m)
transformedSelections
            else forall a b. a -> Either a b
Left forall a. Seq a
Seq.empty

fragmentSpread :: Monad m => Full.FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread :: forall (m :: * -> *).
Monad m =>
FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread (Full.FragmentSpread Name
spreadName [Directive]
directives' Location
location) = do
    Maybe [Directive]
transformedDirectives <- forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
    Bool
visitedFragment <- forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Name
spreadName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Replacement m -> HashSet Name
visitedFragments
    Maybe FragmentDefinition
possibleFragmentDefinition <- forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
        forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
spreadName
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Replacement m -> HashMap Name FragmentDefinition
fragmentDefinitions
    case Maybe [Directive]
transformedDirectives forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FragmentDefinition
possibleFragmentDefinition of
        Just (Full.FragmentDefinition Name
_ Name
typeCondition [Directive]
_ SelectionSet
selections Location
_)
            | Bool
visitedFragment -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            | Bool
otherwise -> do
                Maybe (CompositeType m)
fragmentType <- forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
                    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Name
typeCondition
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types
                forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {m :: * -> *}.
Monad m =>
SelectionSet -> CompositeType m -> TransformT m (Fragment m)
traverseSelections SelectionSet
selections) Maybe (CompositeType m)
fragmentType
        Maybe FragmentDefinition
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  where
    traverseSelections :: SelectionSet -> CompositeType m -> TransformT m (Fragment m)
traverseSelections SelectionSet
selections CompositeType m
typeCondition = do
        Seq (Selection m)
transformedSelections <- forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT
            forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local forall {m :: * -> *}. Replacement m -> Replacement m
fragmentInserter
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selections
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
CompositeType m -> Seq (Selection m) -> Location -> Fragment m
Fragment CompositeType m
typeCondition Seq (Selection m)
transformedSelections Location
location
    fragmentInserter :: Replacement m -> Replacement m
fragmentInserter replacement :: Replacement m
replacement@Replacement{ HashSet Name
visitedFragments :: HashSet Name
visitedFragments :: forall (m :: * -> *). Replacement m -> HashSet Name
visitedFragments } = Replacement m
replacement
        { visitedFragments :: HashSet Name
visitedFragments = forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Name
spreadName HashSet Name
visitedFragments }

field :: Monad m => Full.Field -> TransformT m (Maybe (Field m))
field :: forall (m :: * -> *).
Monad m =>
Field -> TransformT m (Maybe (Field m))
field (Full.Field Maybe Name
alias' Name
name' [Argument]
arguments' [Directive]
directives' SelectionSetOpt
selectionSet' Location
location') = do
    Seq (Selection m)
transformedSelections <- forall (m :: * -> *).
Monad m =>
SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt SelectionSetOpt
selectionSet'
    Maybe [Directive]
transformedDirectives <- forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
    HashMap Name (Node Input)
transformedArguments <- forall (m :: * -> *).
Monad m =>
[Argument] -> TransformT m (HashMap Name (Node Input))
arguments [Argument]
arguments'
    let transformedField :: Field m
transformedField = forall (m :: * -> *).
Maybe Name
-> Name
-> HashMap Name (Node Input)
-> Seq (Selection m)
-> Location
-> Field m
Field
            Maybe Name
alias'
            Name
name'
            HashMap Name (Node Input)
transformedArguments
            Seq (Selection m)
transformedSelections
            Location
location'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe [Directive]
transformedDirectives forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Field m
transformedField

arguments :: Monad m => [Full.Argument] -> TransformT m (HashMap Full.Name (Full.Node Input))
arguments :: forall (m :: * -> *).
Monad m =>
[Argument] -> TransformT m (HashMap Name (Node Input))
arguments = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
HashMap Name (Node Input)
-> Argument -> TransformT m (HashMap Name (Node Input))
go forall k v. HashMap k v
HashMap.empty
  where
    go :: HashMap Name (Node Input)
-> Argument -> TransformT m (HashMap Name (Node Input))
go HashMap Name (Node Input)
accumulator (Full.Argument Name
name' Node Value
valueNode Location
argumentLocation) = do
        let replaceLocation :: Node b -> Node b
replaceLocation = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Location -> Node a
Full.Node Location
argumentLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node a -> a
Full.node
        Maybe (Node Input)
argumentValue <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Node b -> Node b
replaceLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Node Value -> TransformT m (Maybe (Node Input))
node Node Value
valueNode
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Name -> Maybe a -> HashMap Name a -> HashMap Name a
insertIfGiven Name
name' Maybe (Node Input)
argumentValue HashMap Name (Node Input)
accumulator

directive :: Monad m => Full.Directive -> TransformT m Definition.Directive
directive :: forall (m :: * -> *).
Monad m =>
Directive -> TransformT m Directive
directive (Full.Directive Name
name' [Argument]
arguments' Location
_)
    = Name -> Arguments -> Directive
Definition.Directive Name
name'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subs -> Arguments
Type.Arguments
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
Subs -> Argument -> TransformT m Subs
go forall k v. HashMap k v
HashMap.empty [Argument]
arguments'
  where
    go :: Subs -> Argument -> TransformT m Subs
go Subs
accumulator (Full.Argument Name
argumentName Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Value
node' } Location
_) = do
        Value
transformedValue <- forall (m :: * -> *). Monad m => Value -> TransformT m Value
directiveValue Value
node'
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
argumentName Value
transformedValue Subs
accumulator

directiveValue :: Monad m => Full.Value -> TransformT m Type.Value
directiveValue :: forall (m :: * -> *). Monad m => Value -> TransformT m Value
directiveValue = \case
    (Full.Variable Name
name') -> forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
        forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault Value
Type.Null Name
name'
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Replacement m -> Subs
variableValues
    (Full.Int Int32
integer) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
integer
    (Full.Float Double
double) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
double
    (Full.String Name
string) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
    (Full.Boolean Bool
boolean) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
boolean
    Value
Full.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Type.Null
    (Full.Enum Name
enum) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
    (Full.List [Node Value]
list) -> [Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. Monad m => Node Value -> TransformT m Value
directiveNode [Node Value]
list
    (Full.Object [ObjectField Value]
objectFields) ->
        Subs -> Value
Type.Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
Subs -> ObjectField Value -> TransformT m Subs
objectField forall k v. HashMap k v
HashMap.empty [ObjectField Value]
objectFields
  where
    directiveNode :: Node Value -> TransformT m Value
directiveNode Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Value
node'} = forall (m :: * -> *). Monad m => Value -> TransformT m Value
directiveValue Value
node'
    objectField :: Subs -> ObjectField Value -> TransformT m Subs
objectField Subs
accumulator Full.ObjectField{ Name
$sel:name:ObjectField :: forall a. ObjectField a -> Name
name :: Name
name, Node Value
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value :: Node Value
value } = do
        Value
transformedValue <- forall {m :: * -> *}. Monad m => Node Value -> TransformT m Value
directiveNode Node Value
value
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name Value
transformedValue Subs
accumulator

input :: Monad m => Full.Value -> TransformT m (Maybe Input)
input :: forall (m :: * -> *).
Monad m =>
Value -> TransformT m (Maybe Input)
input (Full.Variable Name
name') =
    forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Replacement m -> Subs
variableValues) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Input
Variable
input (Full.Int Int32
integer) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int32 -> Input
Int Int32
integer
input (Full.Float Double
double) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Input
Float Double
double
input (Full.String Name
string) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Input
String Name
string
input (Full.Boolean Bool
boolean) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Input
Boolean Bool
boolean
input Value
Full.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Input
Null
input (Full.Enum Name
enum) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Input
Enum Name
enum
input (Full.List [Node Value]
list) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Input] -> Input
List
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Input
Null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Monad m =>
Value -> TransformT m (Maybe Input)
input forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node a -> a
Full.node) [Node Value]
list
input (Full.Object [ObjectField Value]
objectFields) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name Input -> Input
Object
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
HashMap Name Input
-> ObjectField Value -> TransformT m (HashMap Name Input)
objectField forall k v. HashMap k v
HashMap.empty [ObjectField Value]
objectFields
  where
    objectField :: HashMap Name Input
-> ObjectField Value -> TransformT m (HashMap Name Input)
objectField HashMap Name Input
accumulator Full.ObjectField{Name
Node Value
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
location :: Location
value :: Node Value
name :: Name
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:name:ObjectField :: forall a. ObjectField a -> Name
..} = do
        Maybe Input
objectFieldValue <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Node a -> a
Full.node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Node Value -> TransformT m (Maybe (Node Input))
node Node Value
value
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Name -> Maybe a -> HashMap Name a -> HashMap Name a
insertIfGiven Name
name Maybe Input
objectFieldValue HashMap Name Input
accumulator

insertIfGiven :: forall a
    . Full.Name
    -> Maybe a
    -> HashMap Full.Name a
    -> HashMap Full.Name a
insertIfGiven :: forall a. Name -> Maybe a -> HashMap Name a -> HashMap Name a
insertIfGiven Name
name (Just a
v) = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
name a
v
insertIfGiven Name
_ Maybe a
_ = forall a. a -> a
id

node :: Monad m => Full.Node Full.Value -> TransformT m (Maybe (Full.Node Input))
node :: forall (m :: * -> *).
Monad m =>
Node Value -> TransformT m (Maybe (Node Input))
node Full.Node{$sel:node:Node :: forall a. Node a -> a
node = Value
node', Location
$sel:location:Node :: forall a. Node a -> Location
location :: Location
..} =
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. a -> Location -> Node a
Full.Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Value -> TransformT m (Maybe Input)
input Value
node' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Location
location