{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.Selection
( Selection (..),
SelectionContent (..),
SelectionSet,
UnionTag (..),
UnionSelection,
Fragment (..),
Fragments,
Operation (..),
Variable (..),
VariableDefinitions,
DefaultValue,
getOperationName,
getOperationDataType,
splitSystemSelection,
)
where
import Control.Monad.Except (MonadError (throwError))
import Data.Foldable (foldr')
import Data.Mergeable
( Merge (..),
MergeMap,
NameCollision (..),
OrdMap,
)
import Data.Mergeable.MergeMap (partition)
import Data.Morpheus.Error.Operation
( mutationIsNotDefined,
subscriptionIsNotDefined,
)
import Data.Morpheus.Internal.Utils
( HistoryT,
KeyOf (..),
addPath,
(<:>),
)
import Data.Morpheus.Rendering.RenderGQL
( RenderGQL (..),
Rendering,
newline,
renderObject,
space,
)
import Data.Morpheus.Types.Internal.AST.Base
( Position,
Ref (..),
)
import Data.Morpheus.Types.Internal.AST.Error
( GQLError,
at,
atPositions,
msg,
)
import Data.Morpheus.Types.Internal.AST.Fields
( Arguments,
Directives,
renderArgumentValues,
renderDirectives,
)
import Data.Morpheus.Types.Internal.AST.Name
( FieldName,
FragmentName,
TypeName,
intercalate,
isNotSystemFieldName,
)
import Data.Morpheus.Types.Internal.AST.OperationType (OperationType (..))
import Data.Morpheus.Types.Internal.AST.Stage
( ALLOW_DUPLICATES,
RAW,
Stage,
VALID,
)
import Data.Morpheus.Types.Internal.AST.TypeCategory
( OBJECT,
)
import Data.Morpheus.Types.Internal.AST.TypeSystem
( Schema (..),
TypeDefinition (..),
)
import Data.Morpheus.Types.Internal.AST.Value
( ResolvedValue,
Variable (..),
VariableDefinitions,
)
import Language.Haskell.TH.Syntax (Lift (..))
import Relude hiding (intercalate, show)
import Prelude (show)
data Fragment (stage :: Stage) = Fragment
{ forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName :: FragmentName,
forall (stage :: Stage). Fragment stage -> TypeName
fragmentType :: TypeName,
forall (stage :: Stage). Fragment stage -> Position
fragmentPosition :: Position,
forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentSelection :: SelectionSet stage,
forall (stage :: Stage). Fragment stage -> Directives stage
fragmentDirectives :: Directives stage
}
deriving (Int -> Fragment stage -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (stage :: Stage). Int -> Fragment stage -> ShowS
forall (stage :: Stage). [Fragment stage] -> ShowS
forall (stage :: Stage). Fragment stage -> String
showList :: [Fragment stage] -> ShowS
$cshowList :: forall (stage :: Stage). [Fragment stage] -> ShowS
show :: Fragment stage -> String
$cshow :: forall (stage :: Stage). Fragment stage -> String
showsPrec :: Int -> Fragment stage -> ShowS
$cshowsPrec :: forall (stage :: Stage). Int -> Fragment stage -> ShowS
Show, Fragment stage -> Fragment stage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (stage :: Stage). Fragment stage -> Fragment stage -> Bool
/= :: Fragment stage -> Fragment stage -> Bool
$c/= :: forall (stage :: Stage). Fragment stage -> Fragment stage -> Bool
== :: Fragment stage -> Fragment stage -> Bool
$c== :: forall (stage :: Stage). Fragment stage -> Fragment stage -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (stage :: Stage) (m :: * -> *).
Quote m =>
Fragment stage -> m Exp
forall (stage :: Stage) (m :: * -> *).
Quote m =>
Fragment stage -> Code m (Fragment stage)
forall (m :: * -> *). Quote m => Fragment stage -> m Exp
forall (m :: * -> *).
Quote m =>
Fragment stage -> Code m (Fragment stage)
liftTyped :: forall (m :: * -> *).
Quote m =>
Fragment stage -> Code m (Fragment stage)
$cliftTyped :: forall (stage :: Stage) (m :: * -> *).
Quote m =>
Fragment stage -> Code m (Fragment stage)
lift :: forall (m :: * -> *). Quote m => Fragment stage -> m Exp
$clift :: forall (stage :: Stage) (m :: * -> *).
Quote m =>
Fragment stage -> m Exp
Lift, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (stage :: Stage) x. Rep (Fragment stage) x -> Fragment stage
forall (stage :: Stage) x. Fragment stage -> Rep (Fragment stage) x
$cto :: forall (stage :: Stage) x. Rep (Fragment stage) x -> Fragment stage
$cfrom :: forall (stage :: Stage) x. Fragment stage -> Rep (Fragment stage) x
Generic, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (stage :: Stage). Eq (Fragment stage)
forall (stage :: Stage). Int -> Fragment stage -> Int
forall (stage :: Stage). Fragment stage -> Int
hash :: Fragment stage -> Int
$chash :: forall (stage :: Stage). Fragment stage -> Int
hashWithSalt :: Int -> Fragment stage -> Int
$chashWithSalt :: forall (stage :: Stage). Int -> Fragment stage -> Int
Hashable)
instance NameCollision GQLError (Fragment s) where
nameCollision :: Fragment s -> GQLError
nameCollision Fragment {FragmentName
fragmentName :: FragmentName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName, Position
fragmentPosition :: Position
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentPosition} =
(GQLError
"There can be only one fragment named " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
fragmentName forall a. Semigroup a => a -> a -> a
<> GQLError
".")
GQLError -> Position -> GQLError
`at` Position
fragmentPosition
instance KeyOf FragmentName (Fragment s) where
keyOf :: Fragment s -> FragmentName
keyOf = forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName
type Fragments (s :: Stage) = OrdMap FragmentName (Fragment s)
data SelectionContent (s :: Stage) where
SelectionField :: SelectionContent s
SelectionSet :: SelectionSet s -> SelectionContent s
UnionSelection ::
{ SelectionContent 'VALID -> Maybe (SelectionSet 'VALID)
defaultSelection :: Maybe (SelectionSet VALID),
SelectionContent 'VALID -> UnionSelection 'VALID
conditionalSelections :: UnionSelection VALID
} ->
SelectionContent VALID
instance Hashable (SelectionContent s) where
hashWithSalt :: Int -> SelectionContent s -> Int
hashWithSalt Int
s SelectionContent s
SelectionField = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
1 :: Int)
hashWithSalt Int
s (SelectionSet MergeMap (ALLOW_DUPLICATES s) FieldName (Selection s)
x) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2 :: Int, MergeMap (ALLOW_DUPLICATES s) FieldName (Selection s)
x)
hashWithSalt Int
s (UnionSelection Maybe (SelectionSet 'VALID)
x UnionSelection 'VALID
xs) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
3 :: Int, Maybe (SelectionSet 'VALID)
x, UnionSelection 'VALID
xs)
renderSelectionSet :: SelectionSet VALID -> Rendering
renderSelectionSet :: SelectionSet 'VALID -> Rendering
renderSelectionSet = forall a. RenderGQL a => [a] -> Rendering
renderObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance RenderGQL (SelectionContent VALID) where
renderGQL :: SelectionContent 'VALID -> Rendering
renderGQL SelectionContent 'VALID
SelectionField = Rendering
""
renderGQL (SelectionSet SelectionSet 'VALID
selSet) = SelectionSet 'VALID -> Rendering
renderSelectionSet SelectionSet 'VALID
selSet
renderGQL (UnionSelection Maybe (SelectionSet 'VALID)
interfaceFields UnionSelection 'VALID
unionSets) =
forall a. RenderGQL a => [a] -> Rendering
renderObject [Either (Selection 'VALID) UnionTag]
unionSelectionElements
where
unionSelectionElements :: [Either (Selection VALID) UnionTag]
unionSelectionElements :: [Either (Selection 'VALID) UnionTag]
unionSelectionElements =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe (SelectionSet 'VALID)
interfaceFields)
forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn UnionTag -> TypeName
unionTagName forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionSelection 'VALID
unionSets)
instance
( Monad m,
MonadError GQLError m,
Merge (HistoryT m) (SelectionSet s)
) =>
Merge (HistoryT m) (SelectionContent s)
where
merge :: Monad (HistoryT m) =>
SelectionContent s
-> SelectionContent s -> HistoryT m (SelectionContent s)
merge (SelectionSet SelectionSet s
s1) (SelectionSet SelectionSet s
s2) = forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge SelectionSet s
s1 SelectionSet s
s2
merge (UnionSelection Maybe (SelectionSet 'VALID)
m1 UnionSelection 'VALID
u1) (UnionSelection Maybe (SelectionSet 'VALID)
m2 UnionSelection 'VALID
u2) = Maybe (SelectionSet 'VALID)
-> UnionSelection 'VALID -> SelectionContent 'VALID
UnionSelection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
(Merge f a, Monad f) =>
Maybe a -> Maybe a -> f (Maybe a)
withMaybe Maybe (SelectionSet 'VALID)
m1 Maybe (SelectionSet 'VALID)
m2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge UnionSelection 'VALID
u1 UnionSelection 'VALID
u2
merge SelectionContent s
oldC SelectionContent s
currentC
| SelectionContent s
oldC forall a. Eq a => a -> a -> Bool
== SelectionContent s
currentC = forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionContent s
oldC
| Bool
otherwise = do
[Ref FieldName]
path <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
( forall a. Msg a => a -> GQLError
msg (forall (t1 :: NAME) (t2 :: NAME) (t3 :: NAME).
Name t1 -> [Name t2] -> Name t3
intercalate Name Any
"." forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall name. Ref name -> name
refName [Ref FieldName]
path)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall name. Ref name -> Position
refPosition [Ref FieldName]
path
)
withMaybe :: (Merge f a, Monad f) => Maybe a -> Maybe a -> f (Maybe a)
withMaybe :: forall (f :: * -> *) a.
(Merge f a, Monad f) =>
Maybe a -> Maybe a -> f (Maybe a)
withMaybe (Just a
x) (Just a
y) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge a
x a
y
withMaybe (Just a
x) Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x
withMaybe Maybe a
Nothing (Just a
y) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
y
withMaybe Maybe a
Nothing Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
deriving instance Show (SelectionContent a)
deriving instance Eq (SelectionContent a)
deriving instance Lift (SelectionContent a)
data UnionTag = UnionTag
{ UnionTag -> TypeName
unionTagName :: TypeName,
UnionTag -> SelectionSet 'VALID
unionTagSelection :: SelectionSet VALID
}
deriving (Int -> UnionTag -> ShowS
[UnionTag] -> ShowS
UnionTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnionTag] -> ShowS
$cshowList :: [UnionTag] -> ShowS
show :: UnionTag -> String
$cshow :: UnionTag -> String
showsPrec :: Int -> UnionTag -> ShowS
$cshowsPrec :: Int -> UnionTag -> ShowS
Show, UnionTag -> UnionTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionTag -> UnionTag -> Bool
$c/= :: UnionTag -> UnionTag -> Bool
== :: UnionTag -> UnionTag -> Bool
$c== :: UnionTag -> UnionTag -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => UnionTag -> m Exp
forall (m :: * -> *). Quote m => UnionTag -> Code m UnionTag
liftTyped :: forall (m :: * -> *). Quote m => UnionTag -> Code m UnionTag
$cliftTyped :: forall (m :: * -> *). Quote m => UnionTag -> Code m UnionTag
lift :: forall (m :: * -> *). Quote m => UnionTag -> m Exp
$clift :: forall (m :: * -> *). Quote m => UnionTag -> m Exp
Lift, forall x. Rep UnionTag x -> UnionTag
forall x. UnionTag -> Rep UnionTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnionTag x -> UnionTag
$cfrom :: forall x. UnionTag -> Rep UnionTag x
Generic, Eq UnionTag
Int -> UnionTag -> Int
UnionTag -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UnionTag -> Int
$chash :: UnionTag -> Int
hashWithSalt :: Int -> UnionTag -> Int
$chashWithSalt :: Int -> UnionTag -> Int
Hashable)
instance KeyOf TypeName UnionTag where
keyOf :: UnionTag -> TypeName
keyOf = UnionTag -> TypeName
unionTagName
instance RenderGQL UnionTag where
renderGQL :: UnionTag -> Rendering
renderGQL UnionTag {TypeName
unionTagName :: TypeName
unionTagName :: UnionTag -> TypeName
unionTagName, SelectionSet 'VALID
unionTagSelection :: SelectionSet 'VALID
unionTagSelection :: UnionTag -> SelectionSet 'VALID
unionTagSelection} =
Rendering
"... on "
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
unionTagName
forall a. Semigroup a => a -> a -> a
<> SelectionSet 'VALID -> Rendering
renderSelectionSet SelectionSet 'VALID
unionTagSelection
mergeConflict :: (Monad m, MonadError GQLError m) => GQLError -> HistoryT m a
mergeConflict :: forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
GQLError -> HistoryT m a
mergeConflict GQLError
err = do
[Ref FieldName]
path <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
[Ref FieldName] -> HistoryT m a
__mergeConflict [Ref FieldName]
path
where
__mergeConflict :: (Monad m, MonadError GQLError m) => [Ref FieldName] -> HistoryT m a
__mergeConflict :: forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
[Ref FieldName] -> HistoryT m a
__mergeConflict [] = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err
__mergeConflict refs :: [Ref FieldName]
refs@(Ref FieldName
rootField : [Ref FieldName]
xs) =
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(GQLError
renderSubfields forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall name. Ref name -> Position
refPosition [Ref FieldName]
refs forall a. Semigroup a => a -> a -> a
<> GQLError
err)
where
fieldConflicts :: Ref a -> GQLError
fieldConflicts Ref a
ref = forall a. Msg a => a -> GQLError
msg (forall name. Ref name -> name
refName Ref a
ref) forall a. Semigroup a => a -> a -> a
<> GQLError
" conflict because "
renderSubfield :: Ref a -> GQLError -> GQLError
renderSubfield Ref a
ref GQLError
txt = GQLError
txt forall a. Semigroup a => a -> a -> a
<> GQLError
"subfields " forall a. Semigroup a => a -> a -> a
<> forall {a}. Msg a => Ref a -> GQLError
fieldConflicts Ref a
ref
renderStart :: GQLError
renderStart = GQLError
"Fields " forall a. Semigroup a => a -> a -> a
<> forall {a}. Msg a => Ref a -> GQLError
fieldConflicts Ref FieldName
rootField
renderSubfields :: GQLError
renderSubfields =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr'
forall {a}. Msg a => Ref a -> GQLError -> GQLError
renderSubfield
GQLError
renderStart
[Ref FieldName]
xs
instance
( Monad m,
MonadError GQLError m
) =>
Merge (HistoryT m) UnionTag
where
merge :: Monad (HistoryT m) => UnionTag -> UnionTag -> HistoryT m UnionTag
merge (UnionTag TypeName
oldTag SelectionSet 'VALID
oldSel) (UnionTag TypeName
_ SelectionSet 'VALID
currentSel) =
TypeName -> SelectionSet 'VALID -> UnionTag
UnionTag TypeName
oldTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge SelectionSet 'VALID
oldSel SelectionSet 'VALID
currentSel
type UnionSelection (s :: Stage) = MergeMap (ALLOW_DUPLICATES s) TypeName UnionTag
type SelectionSet (s :: Stage) = MergeMap (ALLOW_DUPLICATES s) FieldName (Selection s)
splitSystemSelection :: SelectionSet s -> (Maybe (SelectionSet s), Maybe (SelectionSet s))
splitSystemSelection :: forall (s :: Stage).
SelectionSet s -> (Maybe (SelectionSet s), Maybe (SelectionSet s))
splitSystemSelection = forall a (dups :: Bool) k.
(a -> Bool)
-> MergeMap dups k a
-> (Maybe (MergeMap dups k a), Maybe (MergeMap dups k a))
partition (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Bool
isNotSystemFieldName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Selection s -> FieldName
selectionName)
data Selection (s :: Stage) where
Selection ::
{ forall (s :: Stage). Selection s -> Position
selectionPosition :: Position,
forall (s :: Stage). Selection s -> Maybe FieldName
selectionAlias :: Maybe FieldName,
forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName,
forall (s :: Stage). Selection s -> Arguments s
selectionArguments :: Arguments s,
forall (s :: Stage). Selection s -> Directives s
selectionDirectives :: Directives s,
forall (s :: Stage). Selection s -> SelectionContent s
selectionContent :: SelectionContent s,
forall (s :: Stage). Selection s -> Maybe FragmentName
selectionOrigin :: Maybe FragmentName
} ->
Selection s
InlineFragment :: Fragment RAW -> Selection RAW
Spread :: Directives RAW -> Ref FragmentName -> Selection RAW
instance Hashable (Selection s) where
hashWithSalt :: Int -> Selection s -> Int
hashWithSalt Int
s (InlineFragment Fragment 'RAW
x) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
1 :: Int, Fragment 'RAW
x)
hashWithSalt Int
s (Spread Directives 'RAW
x Ref FragmentName
y) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2 :: Int, Directives 'RAW
x, forall name. Ref name -> name
refName Ref FragmentName
y)
hashWithSalt Int
s Selection {Maybe FieldName
Maybe FragmentName
Directives s
Arguments s
Position
FieldName
SelectionContent s
selectionOrigin :: Maybe FragmentName
selectionContent :: SelectionContent s
selectionDirectives :: Directives s
selectionArguments :: Arguments s
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionPosition :: Position
selectionOrigin :: forall (s :: Stage). Selection s -> Maybe FragmentName
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionDirectives :: forall (s :: Stage). Selection s -> Directives s
selectionArguments :: forall (s :: Stage). Selection s -> Arguments s
selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionName :: forall (s :: Stage). Selection s -> FieldName
..} =
forall a. Hashable a => Int -> a -> Int
hashWithSalt
Int
s
( Int
3 :: Int,
Maybe FieldName
selectionAlias,
FieldName
selectionName,
Arguments s
selectionArguments,
Directives s
selectionDirectives,
SelectionContent s
selectionContent
)
instance RenderGQL (Selection VALID) where
renderGQL :: Selection 'VALID -> Rendering
renderGQL
Selection
{ Maybe FieldName
Maybe FragmentName
Directives 'VALID
Arguments 'VALID
Position
FieldName
SelectionContent 'VALID
selectionOrigin :: Maybe FragmentName
selectionContent :: SelectionContent 'VALID
selectionDirectives :: Directives 'VALID
selectionArguments :: Arguments 'VALID
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionPosition :: Position
selectionOrigin :: forall (s :: Stage). Selection s -> Maybe FragmentName
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionDirectives :: forall (s :: Stage). Selection s -> Directives s
selectionArguments :: forall (s :: Stage). Selection s -> Arguments s
selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionName :: forall (s :: Stage). Selection s -> FieldName
..
} =
forall a. RenderGQL a => a -> Rendering
renderGQL (forall a. a -> Maybe a -> a
fromMaybe FieldName
selectionName Maybe FieldName
selectionAlias)
forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Arguments s -> Rendering
renderArgumentValues Arguments 'VALID
selectionArguments
forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
renderDirectives Directives 'VALID
selectionDirectives
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL SelectionContent 'VALID
selectionContent
instance KeyOf FieldName (Selection s) where
keyOf :: Selection s -> FieldName
keyOf
Selection
{ FieldName
selectionName :: FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName,
Maybe FieldName
selectionAlias :: Maybe FieldName
selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName
selectionAlias
} = forall a. a -> Maybe a -> a
fromMaybe FieldName
selectionName Maybe FieldName
selectionAlias
keyOf Selection s
_ = FieldName
""
useDifferentAliases :: GQLError
useDifferentAliases :: GQLError
useDifferentAliases =
GQLError
"Use different aliases on the "
forall a. Semigroup a => a -> a -> a
<> GQLError
"fields to fetch both if this was intentional."
instance
( Monad m,
MonadError GQLError m,
Merge (HistoryT m) (SelectionSet s)
) =>
Merge (HistoryT m) (Selection s)
where
merge :: Monad (HistoryT m) =>
Selection s -> Selection s -> HistoryT m (Selection s)
merge = forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m,
Merge (HistoryT m) (SelectionSet s)) =>
Selection s -> Selection s -> HistoryT m (Selection s)
mergeSelection
mergeSelection ::
( Monad m,
MonadError GQLError m,
Merge (HistoryT m) (SelectionSet s)
) =>
Selection s ->
Selection s ->
HistoryT m (Selection s)
mergeSelection :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m,
Merge (HistoryT m) (SelectionSet s)) =>
Selection s -> Selection s -> HistoryT m (Selection s)
mergeSelection
old :: Selection s
old@Selection {selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition = Position
pos1}
current :: Selection s
current@Selection {selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition = Position
pos2} =
do
FieldName
selectionName <- forall (m :: * -> *) (t :: * -> *) (s1 :: Stage) (s2 :: Stage).
(Monad m, MonadError GQLError m, Foldable t) =>
t Position -> Selection s1 -> Selection s2 -> HistoryT m FieldName
mergeName [Position
pos1, Position
pos2] Selection s
old Selection s
current
forall a1 (m :: * -> *) a2.
MonadReader [a1] m =>
a1 -> m a2 -> m a2
addPath (forall name. name -> Position -> Ref name
Ref FieldName
selectionName Position
pos1) forall a b. (a -> b) -> a -> b
$ do
Arguments s
selectionArguments <- ReaderT [Ref FieldName] m (Arguments s)
mergeArguments
SelectionContent s
selectionContent <- forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection s
old) (forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection s
current)
Directives s
dirs <- forall (s :: Stage). Selection s -> Directives s
selectionDirectives Selection s
old forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> forall (s :: Stage). Selection s -> Directives s
selectionDirectives Selection s
current
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Selection
{ selectionAlias :: Maybe FieldName
selectionAlias = Maybe FieldName
mergeAlias,
selectionPosition :: Position
selectionPosition = Position
pos1,
selectionDirectives :: Directives s
selectionDirectives = Directives s
dirs,
selectionOrigin :: Maybe FragmentName
selectionOrigin = forall a. Maybe a
Nothing,
Arguments s
FieldName
SelectionContent s
selectionContent :: SelectionContent s
selectionArguments :: Arguments s
selectionName :: FieldName
selectionContent :: SelectionContent s
selectionArguments :: Arguments s
selectionName :: FieldName
..
}
where
mergeAlias :: Maybe FieldName
mergeAlias
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Selection s -> Maybe FieldName
selectionAlias) [Selection s
old, Selection s
current] = forall (s :: Stage). Selection s -> Maybe FieldName
selectionAlias Selection s
old
| Bool
otherwise = forall a. Maybe a
Nothing
mergeArguments :: ReaderT [Ref FieldName] m (Arguments s)
mergeArguments
| forall (s :: Stage). Selection s -> Arguments s
selectionArguments Selection s
old forall a. Eq a => a -> a -> Bool
== forall (s :: Stage). Selection s -> Arguments s
selectionArguments Selection s
current = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: Stage). Selection s -> Arguments s
selectionArguments Selection s
current
| Bool
otherwise =
forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
GQLError -> HistoryT m a
mergeConflict forall a b. (a -> b) -> a -> b
$
(GQLError
"they have differing arguments. " forall a. Semigroup a => a -> a -> a
<> GQLError
useDifferentAliases)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` [Position
pos1, Position
pos2]
mergeSelection Selection s
x Selection s
y = forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
GQLError -> HistoryT m a
mergeConflict (GQLError
"INTERNAL: can't merge. " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> GQLError
msgValue Selection s
x forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> GQLError
msgValue Selection s
y forall a. Semigroup a => a -> a -> a
<> GQLError
useDifferentAliases)
msgValue :: Show a => a -> GQLError
msgValue :: forall a. Show a => a -> GQLError
msgValue = forall a. Msg a => a -> GQLError
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
mergeName ::
(Monad m, MonadError GQLError m, Foldable t) =>
t Position ->
Selection s1 ->
Selection s2 ->
HistoryT m FieldName
mergeName :: forall (m :: * -> *) (t :: * -> *) (s1 :: Stage) (s2 :: Stage).
(Monad m, MonadError GQLError m, Foldable t) =>
t Position -> Selection s1 -> Selection s2 -> HistoryT m FieldName
mergeName t Position
pos Selection s1
old Selection s2
current
| forall (s :: Stage). Selection s -> FieldName
selectionName Selection s1
old forall a. Eq a => a -> a -> Bool
== forall (s :: Stage). Selection s -> FieldName
selectionName Selection s2
current = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: Stage). Selection s -> FieldName
selectionName Selection s2
current
| Bool
otherwise =
forall (m :: * -> *) a.
(Monad m, MonadError GQLError m) =>
GQLError -> HistoryT m a
mergeConflict forall a b. (a -> b) -> a -> b
$
( forall a. Msg a => a -> GQLError
msg (forall (s :: Stage). Selection s -> FieldName
selectionName Selection s1
old)
forall a. Semigroup a => a -> a -> a
<> GQLError
" and "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall (s :: Stage). Selection s -> FieldName
selectionName Selection s2
current)
forall a. Semigroup a => a -> a -> a
<> GQLError
" are different fields. "
forall a. Semigroup a => a -> a -> a
<> GQLError
useDifferentAliases
)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` t Position
pos
deriving instance Show (Selection a)
deriving instance Lift (Selection a)
deriving instance Eq (Selection a)
type DefaultValue = Maybe ResolvedValue
data Operation (s :: Stage) = Operation
{ forall (s :: Stage). Operation s -> Position
operationPosition :: Position,
forall (s :: Stage). Operation s -> OperationType
operationType :: OperationType,
forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName,
forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments :: VariableDefinitions s,
forall (s :: Stage). Operation s -> Directives s
operationDirectives :: Directives s,
forall (s :: Stage). Operation s -> SelectionSet s
operationSelection :: SelectionSet s
}
deriving (Int -> Operation s -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> Operation s -> ShowS
forall (s :: Stage). [Operation s] -> ShowS
forall (s :: Stage). Operation s -> String
showList :: [Operation s] -> ShowS
$cshowList :: forall (s :: Stage). [Operation s] -> ShowS
show :: Operation s -> String
$cshow :: forall (s :: Stage). Operation s -> String
showsPrec :: Int -> Operation s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> Operation s -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *). Quote m => Operation s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
Operation s -> Code m (Operation s)
forall (m :: * -> *). Quote m => Operation s -> m Exp
forall (m :: * -> *).
Quote m =>
Operation s -> Code m (Operation s)
liftTyped :: forall (m :: * -> *).
Quote m =>
Operation s -> Code m (Operation s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
Operation s -> Code m (Operation s)
lift :: forall (m :: * -> *). Quote m => Operation s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *). Quote m => Operation s -> m Exp
Lift)
instance RenderGQL (Operation VALID) where
renderGQL :: Operation 'VALID -> Rendering
renderGQL
Operation
{ Maybe FieldName
operationName :: Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName,
OperationType
operationType :: OperationType
operationType :: forall (s :: Stage). Operation s -> OperationType
operationType,
Directives 'VALID
operationDirectives :: Directives 'VALID
operationDirectives :: forall (s :: Stage). Operation s -> Directives s
operationDirectives,
SelectionSet 'VALID
operationSelection :: SelectionSet 'VALID
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection
} =
forall a. RenderGQL a => a -> Rendering
renderGQL OperationType
operationType
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rendering
"" ((Rendering
space forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenderGQL a => a -> Rendering
renderGQL) Maybe FieldName
operationName
forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
renderDirectives Directives 'VALID
operationDirectives
forall a. Semigroup a => a -> a -> a
<> SelectionSet 'VALID -> Rendering
renderSelectionSet SelectionSet 'VALID
operationSelection
forall a. Semigroup a => a -> a -> a
<> Rendering
newline
getOperationName :: Maybe FieldName -> TypeName
getOperationName :: Maybe FieldName -> TypeName
getOperationName = forall b a. b -> (a -> b) -> Maybe a -> b
maybe TypeName
"AnonymousOperation" coerce :: forall a b. Coercible a b => a -> b
coerce
getOperationDataType :: MonadError GQLError m => Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID)
getOperationDataType :: forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
Operation s -> Schema 'VALID -> m (TypeDefinition OBJECT 'VALID)
getOperationDataType Operation {operationType :: forall (s :: Stage). Operation s -> OperationType
operationType = OperationType
OPERATION_QUERY} Schema 'VALID
lib = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema 'VALID
lib)
getOperationDataType Operation {operationType :: forall (s :: Stage). Operation s -> OperationType
operationType = OperationType
OPERATION_MUTATION, Position
operationPosition :: Position
operationPosition :: forall (s :: Stage). Operation s -> Position
operationPosition} Schema 'VALID
lib =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Position -> GQLError
mutationIsNotDefined Position
operationPosition) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema 'VALID
lib)
getOperationDataType Operation {operationType :: forall (s :: Stage). Operation s -> OperationType
operationType = OperationType
OPERATION_SUBSCRIPTION, Position
operationPosition :: Position
operationPosition :: forall (s :: Stage). Operation s -> Position
operationPosition} Schema 'VALID
lib =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Position -> GQLError
subscriptionIsNotDefined Position
operationPosition) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema 'VALID
lib)