{- 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
    { Replacement m -> Subs
variableValues :: Type.Subs
    , Replacement m -> HashMap Name FragmentDefinition
fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
    , Replacement m -> HashSet Name
visitedFragments :: HashSet Full.Name
    , Replacement m -> HashMap Name (Type m)
types :: HashMap Full.Name (Type m)
    }

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

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

instance Applicative m => Applicative (TransformT m) where
    pure :: a -> TransformT m a
pure = ReaderT (Replacement m) m a -> TransformT m a
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT (ReaderT (Replacement m) m a -> TransformT m a)
-> (a -> ReaderT (Replacement m) m a) -> a -> TransformT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT (Replacement m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TransformT ReaderT (Replacement m) m (a -> b)
f <*> :: TransformT m (a -> b) -> TransformT m a -> TransformT m b
<*> TransformT ReaderT (Replacement m) m a
x = ReaderT (Replacement m) m b -> TransformT m b
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT (ReaderT (Replacement m) m b -> TransformT m b)
-> ReaderT (Replacement m) m b -> TransformT m b
forall a b. (a -> b) -> a -> b
$ ReaderT (Replacement m) m (a -> b)
f ReaderT (Replacement m) m (a -> b)
-> ReaderT (Replacement m) m a -> ReaderT (Replacement m) m b
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 >>= :: TransformT m a -> (a -> TransformT m b) -> TransformT m b
>>= a -> TransformT m b
f = ReaderT (Replacement m) m b -> TransformT m b
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT (ReaderT (Replacement m) m b -> TransformT m b)
-> ReaderT (Replacement m) m b -> TransformT m b
forall a b. (a -> b) -> a -> b
$ ReaderT (Replacement m) m a
x ReaderT (Replacement m) m a
-> (a -> ReaderT (Replacement m) m b)
-> ReaderT (Replacement m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransformT m b -> ReaderT (Replacement m) m b
forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT (TransformT m b -> ReaderT (Replacement m) m b)
-> (a -> TransformT m b) -> a -> ReaderT (Replacement m) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TransformT m b
f

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

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

instance MonadCatch m => MonadCatch (TransformT m) where
  catch :: TransformT m a -> (e -> TransformT m a) -> TransformT m a
catch (TransformT ReaderT (Replacement m) m a
stack) e -> TransformT m a
handler =
      ReaderT (Replacement m) m a -> TransformT m a
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT (ReaderT (Replacement m) m a -> TransformT m a)
-> ReaderT (Replacement m) m a -> TransformT m a
forall a b. (a -> b) -> a -> b
$ ReaderT (Replacement m) m a
-> (e -> ReaderT (Replacement m) m a)
-> ReaderT (Replacement m) m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ReaderT (Replacement m) m a
stack ((e -> ReaderT (Replacement m) m a) -> ReaderT (Replacement m) m a)
-> (e -> ReaderT (Replacement m) m a)
-> ReaderT (Replacement m) m a
forall a b. (a -> b) -> a -> b
$ TransformT m a -> ReaderT (Replacement m) m a
forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT (TransformT m a -> ReaderT (Replacement m) m a)
-> (e -> TransformT m a) -> e -> ReaderT (Replacement m) m a
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 a. (Replacement m -> a) -> TransformT m a
asks = ReaderT (Replacement m) m a -> TransformT m a
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT (ReaderT (Replacement m) m a -> TransformT m a)
-> ((Replacement m -> a) -> ReaderT (Replacement m) m a)
-> (Replacement m -> a)
-> TransformT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Replacement m -> a) -> ReaderT (Replacement m) m a
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
(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

instance Show Input where
    showList :: [Input] -> ShowS
showList = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> ([Input] -> String) -> [Input] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Input] -> String
forall a. Show a => [a] -> String
showList'
      where
        showList' :: [a] -> String
showList' [a]
list = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (a -> String
forall a. Show a => a -> String
show (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    show :: Input -> String
show (Int Int32
integer) = Int32 -> String
forall a. Show a => a -> String
show Int32
integer
    show (Float Double
float') = Double -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat Double
float' String
forall a. Monoid a => a
mempty
    show (String Name
text) = String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> ShowS) -> String -> Name -> String
forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr (String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> (Char -> String) -> Char -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
Full.escape) String
"\"" Name
text
    show (Boolean Bool
boolean') = Bool -> String
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) = [Input] -> String
forall a. Show a => a -> String
show [Input]
list
    show (Object HashMap Name Input
fields) = [String] -> String
unwords
        [ String
"{"
        , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Name -> Input -> [String] -> [String])
-> [String] -> HashMap Name Input -> [String]
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Name -> Input -> [String] -> [String]
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 =
            [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name -> String
Text.unpack Name
key, String
": ", a -> String
forall a. Show a => a -> String
show a
value] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
accumulator
    show Input
variableValue = Input -> String
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 = (Definition
 -> ([OperationDefinition], HashMap Name FragmentDefinition)
 -> ([OperationDefinition], HashMap Name FragmentDefinition))
-> ([OperationDefinition], HashMap Name FragmentDefinition)
-> Document
-> ([OperationDefinition], HashMap Name FragmentDefinition)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition
-> ([OperationDefinition], HashMap Name FragmentDefinition)
-> ([OperationDefinition], HashMap Name FragmentDefinition)
forall (p :: * -> * -> *).
(Bifunctor p, Functor (p [OperationDefinition])) =>
Definition
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
filterOperation ([], HashMap Name FragmentDefinition
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 =
            ([OperationDefinition] -> [OperationDefinition])
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (OperationDefinition
operationDefinition' OperationDefinition
-> [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 =
            Name
-> FragmentDefinition
-> HashMap Name FragmentDefinition
-> HashMap Name FragmentDefinition
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fragmentName FragmentDefinition
fragmentDefinition (HashMap Name FragmentDefinition
 -> HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name FragmentDefinition)
-> p [OperationDefinition] (HashMap Name 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 :: OperationDefinition -> TransformT m (Operation m)
transform (Full.OperationDefinition OperationType
operationType Maybe Name
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
selectionSet' Location
operationLocation) = do
    Seq (Selection m)
transformedSelections <- SelectionSet -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
    Operation m -> TransformT m (Operation m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operation m -> TransformT m (Operation m))
-> Operation m -> TransformT m (Operation m)
forall a b. (a -> b) -> a -> b
$ OperationType -> Seq (Selection m) -> Location -> Operation m
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 <- SelectionSet -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selectionSet'
    Operation m -> TransformT m (Operation m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operation m -> TransformT m (Operation m))
-> Operation m -> TransformT m (Operation m)
forall a b. (a -> b) -> a -> b
$ OperationType -> Seq (Selection m) -> Location -> Operation m
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 :: SelectionSet -> TransformT m (Seq (Selection m))
selectionSet = SelectionSetOpt -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt (SelectionSetOpt -> TransformT m (Seq (Selection m)))
-> (SelectionSet -> SelectionSetOpt)
-> SelectionSet
-> TransformT m (Seq (Selection m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
NonEmpty.toList

selectionSetOpt :: Monad m => Full.SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt :: SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt = (Seq (Selection m)
 -> Selection -> TransformT m (Seq (Selection m)))
-> Seq (Selection m)
-> SelectionSetOpt
-> TransformT 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 -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
Seq (Selection m) -> Selection -> TransformT m (Seq (Selection m))
go Seq (Selection m)
forall a. Seq a
Seq.empty
  where
    go :: Seq (Selection m) -> Selection -> TransformT m (Seq (Selection m))
go Seq (Selection m)
accumulatedSelections Selection
currentSelection =
        Selection -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
Selection -> TransformT m (Seq (Selection m))
selection Selection
currentSelection TransformT m (Seq (Selection m))
-> (Seq (Selection m) -> Seq (Selection m))
-> TransformT m (Seq (Selection m))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Seq (Selection m)
accumulatedSelections Seq (Selection m) -> Seq (Selection m) -> Seq (Selection m)
forall a. Seq a -> Seq a -> Seq a
><)

selection :: Monad m => Full.Selection -> TransformT m (Seq (Selection m))
selection :: Selection -> TransformT m (Seq (Selection m))
selection (Full.FieldSelection Field
field') =
    (Field m -> Selection m)
-> TransformT m (Maybe (Field m))
-> TransformT m (Seq (Selection m))
forall (m :: * -> *) a.
Monad m =>
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet Field m -> Selection m
forall (m :: * -> *). Field m -> Selection m
FieldSelection (TransformT m (Maybe (Field m))
 -> TransformT m (Seq (Selection m)))
-> TransformT m (Maybe (Field m))
-> TransformT m (Seq (Selection m))
forall a b. (a -> b) -> a -> b
$ Field -> TransformT m (Maybe (Field m))
forall (m :: * -> *).
Monad m =>
Field -> TransformT m (Maybe (Field m))
field Field
field'
selection (Full.FragmentSpreadSelection FragmentSpread
fragmentSpread') =
    (Fragment m -> Selection m)
-> TransformT m (Maybe (Fragment m))
-> TransformT m (Seq (Selection m))
forall (m :: * -> *) a.
Monad m =>
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet Fragment m -> Selection m
forall (m :: * -> *). Fragment m -> Selection m
FragmentSelection (TransformT m (Maybe (Fragment m))
 -> TransformT m (Seq (Selection m)))
-> TransformT m (Maybe (Fragment m))
-> TransformT m (Seq (Selection m))
forall a b. (a -> b) -> a -> b
$ FragmentSpread -> TransformT m (Maybe (Fragment m))
forall (m :: * -> *).
Monad m =>
FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread FragmentSpread
fragmentSpread'
selection (Full.InlineFragmentSelection InlineFragment
inlineFragment') =
    (Seq (Selection m) -> Seq (Selection m))
-> (Fragment m -> Seq (Selection m))
-> Either (Seq (Selection m)) (Fragment m)
-> Seq (Selection m)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Seq (Selection m) -> Seq (Selection m)
forall a. a -> a
id (Selection m -> Seq (Selection m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection m -> Seq (Selection m))
-> (Fragment m -> Selection m) -> Fragment m -> Seq (Selection m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment m -> Selection m
forall (m :: * -> *). Fragment m -> Selection m
FragmentSelection) (Either (Seq (Selection m)) (Fragment m) -> Seq (Selection m))
-> TransformT m (Either (Seq (Selection m)) (Fragment m))
-> TransformT m (Seq (Selection m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InlineFragment
-> TransformT m (Either (Seq (Selection m)) (Fragment m))
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 a.
(a -> Selection m)
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
maybeToSelectionSet a -> Selection m
selectionType = (Maybe a -> Seq (Selection m))
-> TransformT m (Maybe a) -> TransformT m (Seq (Selection m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (Selection m)
-> (a -> Seq (Selection m)) -> Maybe a -> Seq (Selection m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq (Selection m)
forall a. Seq a
Seq.empty ((a -> Seq (Selection m)) -> Maybe a -> Seq (Selection m))
-> (a -> Seq (Selection m)) -> Maybe a -> Seq (Selection m)
forall a b. (a -> b) -> a -> b
$ Selection m -> Seq (Selection m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection m -> Seq (Selection m))
-> (a -> Selection m) -> a -> Seq (Selection m)
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 :: [Directive] -> TransformT m (Maybe [Directive])
directives = ([Directive] -> Maybe [Directive])
-> TransformT m [Directive] -> TransformT m (Maybe [Directive])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Directive] -> Maybe [Directive]
Type.selection (TransformT m [Directive] -> TransformT m (Maybe [Directive]))
-> ([Directive] -> TransformT m [Directive])
-> [Directive]
-> TransformT m (Maybe [Directive])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Directive -> TransformT m Directive)
-> [Directive] -> TransformT m [Directive]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Directive -> TransformT m Directive
forall (m :: * -> *).
Monad m =>
Directive -> TransformT m Directive
directive

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

fragmentSpread :: Monad m => Full.FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread :: FragmentSpread -> TransformT m (Maybe (Fragment m))
fragmentSpread (Full.FragmentSpread Name
spreadName [Directive]
directives' Location
location) = do
    Maybe [Directive]
transformedDirectives <- [Directive] -> TransformT m (Maybe [Directive])
forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
    Bool
visitedFragment <- (Replacement m -> Bool) -> TransformT m Bool
forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks ((Replacement m -> Bool) -> TransformT m Bool)
-> (Replacement m -> Bool) -> TransformT m Bool
forall a b. (a -> b) -> a -> b
$ Name -> HashSet Name -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Name
spreadName (HashSet Name -> Bool)
-> (Replacement m -> HashSet Name) -> Replacement m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement m -> HashSet Name
forall (m :: * -> *). Replacement m -> HashSet Name
visitedFragments
    Maybe FragmentDefinition
possibleFragmentDefinition <- (Replacement m -> Maybe FragmentDefinition)
-> TransformT m (Maybe FragmentDefinition)
forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
        ((Replacement m -> Maybe FragmentDefinition)
 -> TransformT m (Maybe FragmentDefinition))
-> (Replacement m -> Maybe FragmentDefinition)
-> TransformT m (Maybe FragmentDefinition)
forall a b. (a -> b) -> a -> b
$ Name -> HashMap Name FragmentDefinition -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
spreadName
        (HashMap Name FragmentDefinition -> Maybe FragmentDefinition)
-> (Replacement m -> HashMap Name FragmentDefinition)
-> Replacement m
-> Maybe FragmentDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement m -> HashMap Name FragmentDefinition
forall (m :: * -> *).
Replacement m -> HashMap Name FragmentDefinition
fragmentDefinitions
    case Maybe [Directive]
transformedDirectives Maybe [Directive]
-> Maybe FragmentDefinition -> Maybe FragmentDefinition
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 -> Maybe (Fragment m) -> TransformT m (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fragment m)
forall a. Maybe a
Nothing
            | Bool
otherwise -> do
                Maybe (CompositeType m)
fragmentType <- (Replacement m -> Maybe (CompositeType m))
-> TransformT m (Maybe (CompositeType m))
forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks
                    ((Replacement m -> Maybe (CompositeType m))
 -> TransformT m (Maybe (CompositeType m)))
-> (Replacement m -> Maybe (CompositeType m))
-> TransformT m (Maybe (CompositeType m))
forall a b. (a -> b) -> a -> b
$ Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Name
typeCondition
                    (HashMap Name (Type m) -> Maybe (CompositeType m))
-> (Replacement m -> HashMap Name (Type m))
-> Replacement m
-> Maybe (CompositeType m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement m -> HashMap Name (Type m)
forall (m :: * -> *). Replacement m -> HashMap Name (Type m)
types
                (CompositeType m -> TransformT m (Fragment m))
-> Maybe (CompositeType m) -> TransformT m (Maybe (Fragment m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SelectionSet -> CompositeType m -> TransformT m (Fragment m)
forall (m :: * -> *).
Monad m =>
SelectionSet -> CompositeType m -> TransformT m (Fragment m)
traverseSelections SelectionSet
selections) Maybe (CompositeType m)
fragmentType
        Maybe FragmentDefinition
Nothing -> Maybe (Fragment m) -> TransformT m (Maybe (Fragment m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fragment m)
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 <- ReaderT (Replacement m) m (Seq (Selection m))
-> TransformT m (Seq (Selection m))
forall (m :: * -> *) a.
ReaderT (Replacement m) m a -> TransformT m a
TransformT
            (ReaderT (Replacement m) m (Seq (Selection m))
 -> TransformT m (Seq (Selection m)))
-> ReaderT (Replacement m) m (Seq (Selection m))
-> TransformT m (Seq (Selection m))
forall a b. (a -> b) -> a -> b
$ (Replacement m -> Replacement m)
-> ReaderT (Replacement m) m (Seq (Selection m))
-> ReaderT (Replacement m) m (Seq (Selection m))
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local Replacement m -> Replacement m
forall (m :: * -> *). Replacement m -> Replacement m
fragmentInserter
            (ReaderT (Replacement m) m (Seq (Selection m))
 -> ReaderT (Replacement m) m (Seq (Selection m)))
-> ReaderT (Replacement m) m (Seq (Selection m))
-> ReaderT (Replacement m) m (Seq (Selection m))
forall a b. (a -> b) -> a -> b
$ TransformT m (Seq (Selection m))
-> ReaderT (Replacement m) m (Seq (Selection m))
forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
runTransformT
            (TransformT m (Seq (Selection m))
 -> ReaderT (Replacement m) m (Seq (Selection m)))
-> TransformT m (Seq (Selection m))
-> ReaderT (Replacement m) m (Seq (Selection m))
forall a b. (a -> b) -> a -> b
$ SelectionSet -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
SelectionSet -> TransformT m (Seq (Selection m))
selectionSet SelectionSet
selections
        Fragment m -> TransformT m (Fragment m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fragment m -> TransformT m (Fragment m))
-> Fragment m -> TransformT m (Fragment m)
forall a b. (a -> b) -> a -> b
$ CompositeType m -> Seq (Selection m) -> Location -> Fragment m
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 = Name -> HashSet Name -> HashSet Name
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 :: 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 <- SelectionSetOpt -> TransformT m (Seq (Selection m))
forall (m :: * -> *).
Monad m =>
SelectionSetOpt -> TransformT m (Seq (Selection m))
selectionSetOpt SelectionSetOpt
selectionSet'
    Maybe [Directive]
transformedDirectives <- [Directive] -> TransformT m (Maybe [Directive])
forall (m :: * -> *).
Monad m =>
[Directive] -> TransformT m (Maybe [Directive])
directives [Directive]
directives'
    HashMap Name (Node Input)
transformedArguments <- [Argument] -> TransformT m (HashMap Name (Node Input))
forall (m :: * -> *).
Monad m =>
[Argument] -> TransformT m (HashMap Name (Node Input))
arguments [Argument]
arguments'
    let transformedField :: Field m
transformedField = Maybe Name
-> Name
-> HashMap Name (Node Input)
-> Seq (Selection m)
-> Location
-> Field m
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'
    Maybe (Field m) -> TransformT m (Maybe (Field m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Field m) -> TransformT m (Maybe (Field m)))
-> Maybe (Field m) -> TransformT m (Maybe (Field m))
forall a b. (a -> b) -> a -> b
$ Maybe [Directive]
transformedDirectives Maybe [Directive] -> Maybe (Field m) -> Maybe (Field m)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Field m -> Maybe (Field m)
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 :: [Argument] -> TransformT m (HashMap Name (Node Input))
arguments = (HashMap Name (Node Input)
 -> Argument -> TransformT m (HashMap Name (Node Input)))
-> HashMap Name (Node Input)
-> [Argument]
-> TransformT m (HashMap Name (Node Input))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap Name (Node Input)
-> Argument -> TransformT m (HashMap Name (Node Input))
forall (m :: * -> *).
Monad m =>
HashMap Name (Node Input)
-> Argument -> TransformT m (HashMap Name (Node Input))
go HashMap Name (Node Input)
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 a -> Node a
replaceLocation = (a -> Location -> Node a) -> Location -> a -> Node a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Location -> Node a
forall a. a -> Location -> Node a
Full.Node Location
argumentLocation (a -> Node a) -> (Node a -> a) -> Node a -> Node a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node a -> a
forall a. Node a -> a
Full.node
        Maybe (Node Input)
argumentValue <- (Node Input -> Node Input)
-> Maybe (Node Input) -> Maybe (Node Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node Input -> Node Input
forall a. Node a -> Node a
replaceLocation (Maybe (Node Input) -> Maybe (Node Input))
-> TransformT m (Maybe (Node Input))
-> TransformT m (Maybe (Node Input))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Value -> TransformT m (Maybe (Node Input))
forall (m :: * -> *).
Monad m =>
Node Value -> TransformT m (Maybe (Node Input))
node Node Value
valueNode
        HashMap Name (Node Input)
-> TransformT m (HashMap Name (Node Input))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Name (Node Input)
 -> TransformT m (HashMap Name (Node Input)))
-> HashMap Name (Node Input)
-> TransformT m (HashMap Name (Node Input))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe (Node Input)
-> HashMap Name (Node Input)
-> HashMap Name (Node Input)
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 :: Directive -> TransformT m Directive
directive (Full.Directive Name
name' [Argument]
arguments' Location
_)
    = Name -> Arguments -> Directive
Definition.Directive Name
name'
    (Arguments -> Directive)
-> (Subs -> Arguments) -> Subs -> Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subs -> Arguments
Type.Arguments
    (Subs -> Directive) -> TransformT m Subs -> TransformT m Directive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Subs -> Argument -> TransformT m Subs)
-> Subs -> [Argument] -> TransformT m Subs
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Subs -> Argument -> TransformT m Subs
forall (m :: * -> *).
Monad m =>
Subs -> Argument -> TransformT m Subs
go Subs
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 <- Value -> TransformT m Value
forall (m :: * -> *). Monad m => Value -> TransformT m Value
directiveValue Value
node'
        Subs -> TransformT m Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Subs -> TransformT m Subs) -> Subs -> TransformT m 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
argumentName Value
transformedValue Subs
accumulator

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

input :: Monad m => Full.Value -> TransformT m (Maybe Input)
input :: Value -> TransformT m (Maybe Input)
input (Full.Variable Name
name') =
    (Replacement m -> Maybe Value) -> TransformT m (Maybe Value)
forall (m :: * -> *) a.
Monad m =>
(Replacement m -> a) -> TransformT m a
asks (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) TransformT m (Maybe Value)
-> (Maybe Value -> Maybe Input) -> TransformT m (Maybe Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Value -> Input) -> Maybe Value -> Maybe Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Input
Variable
input (Full.Int Int32
integer) = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Int32 -> Input
Int Int32
integer
input (Full.Float Double
double) = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Double -> Input
Float Double
double
input (Full.String Name
string) = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Name -> Input
String Name
string
input (Full.Boolean Bool
boolean) = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Bool -> Input
Boolean Bool
boolean
input Value
Full.Null = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just Input
Null
input (Full.Enum Name
enum) = Maybe Input -> TransformT m (Maybe Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Input -> TransformT m (Maybe Input))
-> Maybe Input -> TransformT m (Maybe Input)
forall a b. (a -> b) -> a -> b
$ Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input) -> Input -> Maybe Input
forall a b. (a -> b) -> a -> b
$ Name -> Input
Enum Name
enum
input (Full.List [Node Value]
list) = Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input)
-> ([Input] -> Input) -> [Input] -> Maybe Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Input] -> Input
List
    ([Input] -> Maybe Input)
-> TransformT m [Input] -> TransformT m (Maybe Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node Value -> TransformT m Input)
-> [Node Value] -> TransformT m [Input]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Maybe Input -> Input)
-> TransformT m (Maybe Input) -> TransformT m Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Input -> Maybe Input -> Input
forall a. a -> Maybe a -> a
fromMaybe Input
Null) (TransformT m (Maybe Input) -> TransformT m Input)
-> (Node Value -> TransformT m (Maybe Input))
-> Node Value
-> TransformT m Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> TransformT m (Maybe Input)
forall (m :: * -> *).
Monad m =>
Value -> TransformT m (Maybe Input)
input (Value -> TransformT m (Maybe Input))
-> (Node Value -> Value)
-> Node Value
-> TransformT m (Maybe Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Value -> Value
forall a. Node a -> a
Full.node) [Node Value]
list
input (Full.Object [ObjectField Value]
objectFields) = Input -> Maybe Input
forall a. a -> Maybe a
Just (Input -> Maybe Input)
-> (HashMap Name Input -> Input)
-> HashMap Name Input
-> Maybe Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name Input -> Input
Object
    (HashMap Name Input -> Maybe Input)
-> TransformT m (HashMap Name Input) -> TransformT m (Maybe Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap Name Input
 -> ObjectField Value -> TransformT m (HashMap Name Input))
-> HashMap Name Input
-> [ObjectField Value]
-> TransformT m (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 -> TransformT m (HashMap Name Input)
forall (m :: * -> *).
Monad m =>
HashMap Name Input
-> ObjectField Value -> TransformT m (HashMap Name Input)
objectField HashMap Name Input
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 <- (Node Input -> Input) -> Maybe (Node Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node Input -> Input
forall a. Node a -> a
Full.node (Maybe (Node Input) -> Maybe Input)
-> TransformT m (Maybe (Node Input)) -> TransformT m (Maybe Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Value -> TransformT m (Maybe (Node Input))
forall (m :: * -> *).
Monad m =>
Node Value -> TransformT m (Maybe (Node Input))
node Node Value
value
        HashMap Name Input -> TransformT m (HashMap Name Input)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Name Input -> TransformT m (HashMap Name Input))
-> HashMap Name Input -> TransformT m (HashMap Name Input)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Input -> HashMap Name Input -> HashMap Name Input
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 :: Name -> Maybe a -> HashMap Name a -> HashMap Name a
insertIfGiven Name
name (Just a
v) = Name -> a -> HashMap Name a -> HashMap Name a
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
_ = HashMap Name a -> HashMap Name a
forall a. a -> a
id

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