{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
{-# language ViewPatterns #-}
{-# OPTIONS_GHC -Wincomplete-patterns -fno-warn-orphans #-}
module Mu.GraphQL.Query.Parse where
import Control.Monad.Except
import qualified Data.Aeson as A
import Data.Coerce (coerce)
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import Data.Int (Int32)
import Data.List (find)
import Data.Maybe
import Data.Proxy
import Data.Scientific (Scientific, floatingOrInteger, toRealFloat)
import Data.SOP.NS
import qualified Data.Text as T
import GHC.TypeLits
import qualified Language.GraphQL.Draft.Syntax as GQL
import Mu.GraphQL.Annotations
import Mu.GraphQL.Query.Definition
import Mu.Rpc
import Mu.Schema
type VariableMapC = HM.HashMap T.Text GQL.ValueConst
type VariableMap = HM.HashMap T.Text GQL.Value
type FragmentMap = HM.HashMap T.Text GQL.FragmentDefinition
instance A.FromJSON GQL.ValueConst where
parseJSON :: Value -> Parser ValueConst
parseJSON Value
A.Null = ValueConst -> Parser ValueConst
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueConst
GQL.VCNull
parseJSON (A.Bool Bool
b) = ValueConst -> Parser ValueConst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst -> Parser ValueConst)
-> ValueConst -> Parser ValueConst
forall a b. (a -> b) -> a -> b
$ Bool -> ValueConst
GQL.VCBoolean Bool
b
parseJSON (A.String Text
s) = ValueConst -> Parser ValueConst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst -> Parser ValueConst)
-> ValueConst -> Parser ValueConst
forall a b. (a -> b) -> a -> b
$ StringValue -> ValueConst
GQL.VCString (StringValue -> ValueConst) -> StringValue -> ValueConst
forall a b. (a -> b) -> a -> b
$ Text -> StringValue
coerce Text
s
parseJSON (A.Number Scientific
n)
| (Right Integer
i :: Either Double Integer) <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n
= ValueConst -> Parser ValueConst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst -> Parser ValueConst)
-> ValueConst -> Parser ValueConst
forall a b. (a -> b) -> a -> b
$ Integer -> ValueConst
GQL.VCInt Integer
i
| Bool
otherwise = ValueConst -> Parser ValueConst
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst -> Parser ValueConst)
-> ValueConst -> Parser ValueConst
forall a b. (a -> b) -> a -> b
$ Scientific -> ValueConst
GQL.VCFloat Scientific
n
parseJSON (A.Array Array
xs) = ListValueC -> ValueConst
GQL.VCList (ListValueC -> ValueConst)
-> (Vector ValueConst -> ListValueC)
-> Vector ValueConst
-> ValueConst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ValueConst] -> ListValueC
forall a. [a] -> ListValueG a
GQL.ListValueG ([ValueConst] -> ListValueC)
-> (Vector ValueConst -> [ValueConst])
-> Vector ValueConst
-> ListValueC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ValueConst -> [ValueConst]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Vector ValueConst -> ValueConst)
-> Parser (Vector ValueConst) -> Parser ValueConst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ValueConst) -> Array -> Parser (Vector ValueConst)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser ValueConst
forall a. FromJSON a => Value -> Parser a
A.parseJSON Array
xs
parseJSON (A.Object Object
o) = ObjectValueC -> ValueConst
GQL.VCObject (ObjectValueC -> ValueConst)
-> (HashMap Text ValueConst -> ObjectValueC)
-> HashMap Text ValueConst
-> ValueConst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ObjectFieldG ValueConst] -> ObjectValueC
forall a. [ObjectFieldG a] -> ObjectValueG a
GQL.ObjectValueG ([ObjectFieldG ValueConst] -> ObjectValueC)
-> (HashMap Text ValueConst -> [ObjectFieldG ValueConst])
-> HashMap Text ValueConst
-> ObjectValueC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ValueConst) -> ObjectFieldG ValueConst)
-> [(Text, ValueConst)] -> [ObjectFieldG ValueConst]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ValueConst) -> ObjectFieldG ValueConst
toObjFld ([(Text, ValueConst)] -> [ObjectFieldG ValueConst])
-> (HashMap Text ValueConst -> [(Text, ValueConst)])
-> HashMap Text ValueConst
-> [ObjectFieldG ValueConst]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text ValueConst -> [(Text, ValueConst)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text ValueConst -> ValueConst)
-> Parser (HashMap Text ValueConst) -> Parser ValueConst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ValueConst)
-> Object -> Parser (HashMap Text ValueConst)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser ValueConst
forall a. FromJSON a => Value -> Parser a
A.parseJSON Object
o
where
toObjFld :: (T.Text, GQL.ValueConst) -> GQL.ObjectFieldG GQL.ValueConst
toObjFld :: (Text, ValueConst) -> ObjectFieldG ValueConst
toObjFld (Text
k, ValueConst
v) = Name -> ValueConst -> ObjectFieldG ValueConst
forall a. Name -> a -> ObjectFieldG a
GQL.ObjectFieldG (Text -> Name
coerce Text
k) ValueConst
v
parseDoc ::
forall qr mut sub p f.
( MonadError T.Text f, ParseTypedDoc p qr mut sub ) =>
Maybe T.Text -> VariableMapC ->
GQL.ExecutableDocument ->
f (Document p qr mut sub)
parseDoc :: Maybe Text
-> HashMap Text ValueConst
-> ExecutableDocument
-> f (Document p qr mut sub)
parseDoc Maybe Text
Nothing HashMap Text ValueConst
vmap (GQL.ExecutableDocument [ExecutableDefinition]
defns)
= case [ExecutableDefinition]
-> ([SelectionSet], [TypedOperationDefinition],
[FragmentDefinition])
GQL.partitionExDefs [ExecutableDefinition]
defns of
([SelectionSet
unnamed], [], [FragmentDefinition]
frs)
-> VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
(sub :: Maybe Symbol) (f :: * -> *).
(ParseTypedDoc p qr mut sub, MonadError Text f) =>
VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
parseTypedDocQuery VariableMap
forall k v. HashMap k v
HM.empty ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs) SelectionSet
unnamed
([], [TypedOperationDefinition
named], [FragmentDefinition]
frs)
-> HashMap Text ValueConst
-> FragmentMap
-> TypedOperationDefinition
-> f (Document p qr mut sub)
forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol)
(mut :: Maybe Symbol) (sub :: Maybe Symbol).
(MonadError Text f, ParseTypedDoc p qr mut sub) =>
HashMap Text ValueConst
-> FragmentMap
-> TypedOperationDefinition
-> f (Document p qr mut sub)
parseTypedDoc HashMap Text ValueConst
vmap ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs) TypedOperationDefinition
named
([], [], [FragmentDefinition]
_) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no operation to execute"
([SelectionSet]
_, [], [FragmentDefinition]
_) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"more than one unnamed query"
([], [TypedOperationDefinition]
_, [FragmentDefinition]
_) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"more than one named operation but no 'operationName' given"
([SelectionSet]
_, [TypedOperationDefinition]
_, [FragmentDefinition]
_) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"both named and unnamed queries, but no 'operationName' given"
parseDoc (Just Text
operationName) HashMap Text ValueConst
vmap (GQL.ExecutableDocument [ExecutableDefinition]
defns)
= case [ExecutableDefinition]
-> ([SelectionSet], [TypedOperationDefinition],
[FragmentDefinition])
GQL.partitionExDefs [ExecutableDefinition]
defns of
([SelectionSet]
_, [TypedOperationDefinition]
named, [FragmentDefinition]
frs) -> f (Document p qr mut sub)
-> (TypedOperationDefinition -> f (Document p qr mut sub))
-> Maybe TypedOperationDefinition
-> f (Document p qr mut sub)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f (Document p qr mut sub)
forall a. MonadError Text f => f a
notFound (HashMap Text ValueConst
-> FragmentMap
-> TypedOperationDefinition
-> f (Document p qr mut sub)
forall (f :: * -> *) (p :: Package') (qr :: Maybe Symbol)
(mut :: Maybe Symbol) (sub :: Maybe Symbol).
(MonadError Text f, ParseTypedDoc p qr mut sub) =>
HashMap Text ValueConst
-> FragmentMap
-> TypedOperationDefinition
-> f (Document p qr mut sub)
parseTypedDoc HashMap Text ValueConst
vmap ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs)) ((TypedOperationDefinition -> Bool)
-> [TypedOperationDefinition] -> Maybe TypedOperationDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TypedOperationDefinition -> Bool
isThis [TypedOperationDefinition]
named)
where isThis :: TypedOperationDefinition -> Bool
isThis (TypedOperationDefinition -> Maybe Name
GQL._todName -> Just Name
nm)
= Name -> Text
GQL.unName Name
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
operationName
isThis TypedOperationDefinition
_ = Bool
False
notFound :: MonadError T.Text f => f a
notFound :: f a
notFound = Text -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f a) -> Text -> f a
forall a b. (a -> b) -> a -> b
$ Text
"operation '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
fragmentsToMap :: [GQL.FragmentDefinition] -> FragmentMap
fragmentsToMap :: [FragmentDefinition] -> FragmentMap
fragmentsToMap = [(Text, FragmentDefinition)] -> FragmentMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, FragmentDefinition)] -> FragmentMap)
-> ([FragmentDefinition] -> [(Text, FragmentDefinition)])
-> [FragmentDefinition]
-> FragmentMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FragmentDefinition -> (Text, FragmentDefinition))
-> [FragmentDefinition] -> [(Text, FragmentDefinition)]
forall a b. (a -> b) -> [a] -> [b]
map FragmentDefinition -> (Text, FragmentDefinition)
fragmentToThingy
where fragmentToThingy :: GQL.FragmentDefinition -> (T.Text, GQL.FragmentDefinition)
fragmentToThingy :: FragmentDefinition -> (Text, FragmentDefinition)
fragmentToThingy FragmentDefinition
f = (Name -> Text
GQL.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> Name
GQL._fdName FragmentDefinition
f, FragmentDefinition
f)
parseTypedDoc ::
(MonadError T.Text f, ParseTypedDoc p qr mut sub) =>
VariableMapC -> FragmentMap ->
GQL.TypedOperationDefinition ->
f (Document p qr mut sub)
parseTypedDoc :: HashMap Text ValueConst
-> FragmentMap
-> TypedOperationDefinition
-> f (Document p qr mut sub)
parseTypedDoc HashMap Text ValueConst
vmap FragmentMap
frmap TypedOperationDefinition
tod
= let defVmap :: HashMap Text ValueConst
defVmap = [VariableDefinition] -> HashMap Text ValueConst
parseVariableMap (TypedOperationDefinition -> [VariableDefinition]
GQL._todVariableDefinitions TypedOperationDefinition
tod)
finalVmap :: VariableMap
finalVmap = ValueConst -> Value
constToValue (ValueConst -> Value) -> HashMap Text ValueConst -> VariableMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text ValueConst
-> HashMap Text ValueConst -> HashMap Text ValueConst
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap Text ValueConst
vmap HashMap Text ValueConst
defVmap
in case TypedOperationDefinition -> OperationType
GQL._todType TypedOperationDefinition
tod of
OperationType
GQL.OperationTypeQuery
-> VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
(sub :: Maybe Symbol) (f :: * -> *).
(ParseTypedDoc p qr mut sub, MonadError Text f) =>
VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
parseTypedDocQuery VariableMap
finalVmap FragmentMap
frmap (TypedOperationDefinition -> SelectionSet
GQL._todSelectionSet TypedOperationDefinition
tod)
OperationType
GQL.OperationTypeMutation
-> VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
(sub :: Maybe Symbol) (f :: * -> *).
(ParseTypedDoc p qr mut sub, MonadError Text f) =>
VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
parseTypedDocMutation VariableMap
finalVmap FragmentMap
frmap (TypedOperationDefinition -> SelectionSet
GQL._todSelectionSet TypedOperationDefinition
tod)
OperationType
GQL.OperationTypeSubscription
-> VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
(sub :: Maybe Symbol) (f :: * -> *).
(ParseTypedDoc p qr mut sub, MonadError Text f) =>
VariableMap
-> FragmentMap -> SelectionSet -> f (Document p qr mut sub)
parseTypedDocSubscription VariableMap
finalVmap FragmentMap
frmap (TypedOperationDefinition -> SelectionSet
GQL._todSelectionSet TypedOperationDefinition
tod)
class ParseTypedDoc (p :: Package')
(qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) where
parseTypedDocQuery ::
MonadError T.Text f =>
VariableMap -> FragmentMap ->
GQL.SelectionSet ->
f (Document p qr mut sub)
parseTypedDocMutation ::
MonadError T.Text f =>
VariableMap -> FragmentMap ->
GQL.SelectionSet ->
f (Document p qr mut sub)
parseTypedDocSubscription ::
MonadError T.Text f =>
VariableMap -> FragmentMap ->
GQL.SelectionSet ->
f (Document p qr mut sub)
instance
( p ~ 'Package pname ss,
LookupService ss qr ~ 'Service qr qmethods,
KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,
LookupService ss mut ~ 'Service mut mmethods,
KnownName mut, ParseMethod p ('Service mut mmethods) mmethods,
LookupService ss sub ~ 'Service sub smethods,
KnownName sub, ParseMethod p ('Service sub smethods) smethods
) => ParseTypedDoc p ('Just qr) ('Just mut) ('Just sub) where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocQuery VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a)
(qms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(mut :: Maybe a) (sub :: Maybe a).
(LookupService ss qr ~ 'Service qr qms) =>
ServiceQuery ('Package ss ss) (LookupService ss qr)
-> Document ('Package ss ss) ('Just qr) mut sub
QueryDoc ([OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> f (Document
('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy qr
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy qr
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocMutation VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(qr :: Maybe a) (sub :: Maybe a).
(LookupService ss mut ~ 'Service mut mms) =>
ServiceQuery ('Package ss ss) (LookupService ss mut)
-> Document ('Package ss ss) qr ('Just mut) sub
MutationDoc ([OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> f (Document
('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy mut
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy mut
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocSubscription VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= do [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q <- Proxy ('Package pname ss)
-> Proxy sub
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy sub
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
case [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q of
[OneMethodQuery ('Package pname ss) (LookupService ss sub)
one] -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) ('Just qr) ('Just mut) ('Just sub)))
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (sub :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (pname :: Maybe a)
(qr :: Maybe a) (mut :: Maybe a).
(LookupService ss sub ~ 'Service sub mms) =>
OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) qr mut ('Just sub)
SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
one
[OneMethodQuery ('Package pname ss) (LookupService ss sub)]
_ -> Text -> f (Document p ('Just qr) ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"subscriptions may only have one field"
instance
( p ~ 'Package pname ss,
LookupService ss qr ~ 'Service qr qmethods,
KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,
LookupService ss mut ~ 'Service mut mmethods,
KnownName mut, ParseMethod p ('Service mut mmethods) mmethods
) => ParseTypedDoc p ('Just qr) ('Just mut) 'Nothing where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocQuery VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a)
(qms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(mut :: Maybe a) (sub :: Maybe a).
(LookupService ss qr ~ 'Service qr qms) =>
ServiceQuery ('Package ss ss) (LookupService ss qr)
-> Document ('Package ss ss) ('Just qr) mut sub
QueryDoc ([OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> f (Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy qr
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy qr
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocMutation VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(qr :: Maybe a) (sub :: Maybe a).
(LookupService ss mut ~ 'Service mut mms) =>
ServiceQuery ('Package ss ss) (LookupService ss mut)
-> Document ('Package ss ss) qr ('Just mut) sub
MutationDoc ([OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> f (Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy mut
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy mut
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocSubscription VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p ('Just qr) ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no subscriptions are defined in the schema"
instance
( p ~ 'Package pname ss,
LookupService ss qr ~ 'Service qr qmethods,
KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,
LookupService ss sub ~ 'Service sub smethods,
KnownName sub, ParseMethod p ('Service sub smethods) smethods
) => ParseTypedDoc p ('Just qr) 'Nothing ('Just sub) where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocQuery VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a)
(qms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(mut :: Maybe a) (sub :: Maybe a).
(LookupService ss qr ~ 'Service qr qms) =>
ServiceQuery ('Package ss ss) (LookupService ss qr)
-> Document ('Package ss ss) ('Just qr) mut sub
QueryDoc ([OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub))
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> f (Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy qr
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy qr
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocMutation VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p ('Just qr) 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no mutations are defined in the schema"
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocSubscription VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= do [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q <- Proxy ('Package pname ss)
-> Proxy sub
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy sub
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
case [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q of
[OneMethodQuery ('Package pname ss) (LookupService ss sub)
one] -> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
-> f (Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
-> f (Document
('Package pname ss) ('Just qr) 'Nothing ('Just sub)))
-> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
-> f (Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (sub :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (pname :: Maybe a)
(qr :: Maybe a) (mut :: Maybe a).
(LookupService ss sub ~ 'Service sub mms) =>
OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) qr mut ('Just sub)
SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
one
[OneMethodQuery ('Package pname ss) (LookupService ss sub)]
_ -> Text -> f (Document p ('Just qr) 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"subscriptions may only have one field"
instance
( p ~ 'Package pname ss,
LookupService ss qr ~ 'Service qr qmethods,
KnownName qr, ParseMethod p ('Service qr qmethods) qmethods
) => ParseTypedDoc p ('Just qr) 'Nothing 'Nothing where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocQuery VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) 'Nothing 'Nothing
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (qr :: a)
(qms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(mut :: Maybe a) (sub :: Maybe a).
(LookupService ss qr ~ 'Service qr qms) =>
ServiceQuery ('Package ss ss) (LookupService ss qr)
-> Document ('Package ss ss) ('Just qr) mut sub
QueryDoc ([OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> Document ('Package pname ss) ('Just qr) 'Nothing 'Nothing)
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
-> f (Document ('Package pname ss) ('Just qr) 'Nothing 'Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy qr
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss qr)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy qr
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocMutation VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p ('Just qr) 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no mutations are defined in the schema"
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocSubscription VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p ('Just qr) 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no subscriptions are defined in the schema"
instance
( p ~ 'Package pname ss,
LookupService ss mut ~ 'Service mut mmethods,
KnownName mut, ParseMethod p ('Service mut mmethods) mmethods,
LookupService ss sub ~ 'Service sub smethods,
KnownName sub, ParseMethod p ('Service sub smethods) smethods
) => ParseTypedDoc p 'Nothing ('Just mut) ('Just sub) where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocQuery VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no queries are defined in the schema"
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocMutation VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(qr :: Maybe a) (sub :: Maybe a).
(LookupService ss mut ~ 'Service mut mms) =>
ServiceQuery ('Package ss ss) (LookupService ss mut)
-> Document ('Package ss ss) qr ('Just mut) sub
MutationDoc ([OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub))
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> f (Document
('Package pname ss) 'Nothing ('Just mut) ('Just sub))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy mut
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy mut
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocSubscription VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= do [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q <- Proxy ('Package pname ss)
-> Proxy sub
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy sub
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
case [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q of
[OneMethodQuery ('Package pname ss) (LookupService ss sub)
one] -> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) 'Nothing ('Just mut) ('Just sub))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) 'Nothing ('Just mut) ('Just sub)))
-> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
-> f (Document
('Package pname ss) 'Nothing ('Just mut) ('Just sub))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (sub :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (pname :: Maybe a)
(qr :: Maybe a) (mut :: Maybe a).
(LookupService ss sub ~ 'Service sub mms) =>
OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) qr mut ('Just sub)
SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
one
[OneMethodQuery ('Package pname ss) (LookupService ss sub)]
_ -> Text -> f (Document p 'Nothing ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"subscriptions may only have one field"
instance
( p ~ 'Package pname ss,
LookupService ss mut ~ 'Service mut mmethods,
KnownName mut, ParseMethod p ('Service mut mmethods) mmethods
) => ParseTypedDoc p 'Nothing ('Just mut) 'Nothing where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocQuery VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no queries are defined in the schema"
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocMutation VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) 'Nothing ('Just mut) 'Nothing
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (mut :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (ss :: Maybe a)
(qr :: Maybe a) (sub :: Maybe a).
(LookupService ss mut ~ 'Service mut mms) =>
ServiceQuery ('Package ss ss) (LookupService ss mut)
-> Document ('Package ss ss) qr ('Just mut) sub
MutationDoc ([OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> Document ('Package pname ss) 'Nothing ('Just mut) 'Nothing)
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
-> f (Document ('Package pname ss) 'Nothing ('Just mut) 'Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Package pname ss)
-> Proxy mut
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss mut)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy mut
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocSubscription VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no subscriptions are defined in the schema"
instance
( p ~ 'Package pname ss,
LookupService ss sub ~ 'Service sub smethods,
KnownName sub, ParseMethod p ('Service sub smethods) smethods
) => ParseTypedDoc p 'Nothing 'Nothing ('Just sub) where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocQuery VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no queries are defined in the schema"
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocMutation VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no mutations are defined in the schema"
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocSubscription VariableMap
vmap FragmentMap
frmap SelectionSet
sset
= do [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q <- Proxy ('Package pname ss)
-> Proxy sub
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy ('Package pname ss)
forall k (t :: k). Proxy t
Proxy Proxy sub
forall k (t :: k). Proxy t
Proxy VariableMap
vmap FragmentMap
frmap SelectionSet
sset
case [OneMethodQuery ('Package pname ss) (LookupService ss sub)]
q of
[OneMethodQuery ('Package pname ss) (LookupService ss sub)
one] -> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
-> f (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
-> f (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)))
-> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
-> f (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
forall a mnm anm (ss :: [Service a mnm anm (TypeRef a)]) (sub :: a)
(mms :: [Method a mnm anm (TypeRef a)]) (pname :: Maybe a)
(qr :: Maybe a) (mut :: Maybe a).
(LookupService ss sub ~ 'Service sub mms) =>
OneMethodQuery ('Package pname ss) (LookupService ss sub)
-> Document ('Package pname ss) qr mut ('Just sub)
SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
one
[OneMethodQuery ('Package pname ss) (LookupService ss sub)]
_ -> Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"subscriptions may only have one field"
instance
ParseTypedDoc p 'Nothing 'Nothing 'Nothing where
parseTypedDocQuery :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocQuery VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no queries are defined in the schema"
parseTypedDocMutation :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocMutation VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no mutations are defined in the schema"
parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> SelectionSet
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocSubscription VariableMap
_ FragmentMap
_ SelectionSet
_
= Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no subscriptions are defined in the schema"
parseVariableMap :: [GQL.VariableDefinition] -> VariableMapC
parseVariableMap :: [VariableDefinition] -> HashMap Text ValueConst
parseVariableMap [VariableDefinition]
vmap
= [(Text, ValueConst)] -> HashMap Text ValueConst
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Name -> Text
GQL.unName (Variable -> Name
GQL.unVariable Variable
v), ValueConst
def)
| GQL.VariableDefinition Variable
v GType
_ (Just ValueConst
def) <- [VariableDefinition]
vmap]
constToValue :: GQL.ValueConst -> GQL.Value
constToValue :: ValueConst -> Value
constToValue (GQL.VCInt Integer
n) = Integer -> Value
GQL.VInt Integer
n
constToValue (GQL.VCFloat Scientific
n) = Scientific -> Value
GQL.VFloat Scientific
n
constToValue (GQL.VCString StringValue
n) = StringValue -> Value
GQL.VString StringValue
n
constToValue (GQL.VCBoolean Bool
n) = Bool -> Value
GQL.VBoolean Bool
n
constToValue ValueConst
GQL.VCNull = Value
GQL.VNull
constToValue (GQL.VCEnum EnumValue
n) = EnumValue -> Value
GQL.VEnum EnumValue
n
constToValue (GQL.VCList (GQL.ListValueG [ValueConst]
n))
= ListValue -> Value
GQL.VList (ListValue -> Value) -> ListValue -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> ListValue
forall a. [a] -> ListValueG a
GQL.ListValueG ([Value] -> ListValue) -> [Value] -> ListValue
forall a b. (a -> b) -> a -> b
$ ValueConst -> Value
constToValue (ValueConst -> Value) -> [ValueConst] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ValueConst]
n
constToValue (GQL.VCObject (GQL.ObjectValueG [ObjectFieldG ValueConst]
n))
= ObjectValue -> Value
GQL.VObject (ObjectValue -> Value) -> ObjectValue -> Value
forall a b. (a -> b) -> a -> b
$ [ObjectFieldG Value] -> ObjectValue
forall a. [ObjectFieldG a] -> ObjectValueG a
GQL.ObjectValueG
[ Name -> Value -> ObjectFieldG Value
forall a. Name -> a -> ObjectFieldG a
GQL.ObjectFieldG Name
a (ValueConst -> Value
constToValue ValueConst
v) | GQL.ObjectFieldG Name
a ValueConst
v <- [ObjectFieldG ValueConst]
n ]
parseQuery ::
forall (p :: Package') (s :: Symbol) pname ss methods f.
( MonadError T.Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods,
KnownName s, ParseMethod p ('Service s methods) methods
) =>
Proxy p ->
Proxy s ->
VariableMap -> FragmentMap -> GQL.SelectionSet ->
f (ServiceQuery p (LookupService ss s))
parseQuery :: Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
_ Proxy s
_ VariableMap
_ FragmentMap
_ [] = [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap (GQL.SelectionField Field
fld : SelectionSet
ss)
= [OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)]
forall a. [a] -> [a] -> [a]
(++) ([OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)])
-> f [OneMethodQuery p ('Service s methods)]
-> f ([OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (OneMethodQuery p ('Service s methods))
-> [OneMethodQuery p ('Service s methods)]
forall a. Maybe a -> [a]
maybeToList (Maybe (OneMethodQuery p ('Service s methods))
-> [OneMethodQuery p ('Service s methods)])
-> f (Maybe (OneMethodQuery p ('Service s methods)))
-> f [OneMethodQuery p ('Service s methods)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> f (Maybe (OneMethodQuery p ('Service s methods)))
forall (sname :: Symbol).
Field -> f (Maybe (OneMethodQuery p ('Service sname methods)))
fieldToMethod Field
fld)
f ([OneMethodQuery p ('Service s methods)]
-> [OneMethodQuery p ('Service s methods)])
-> f [OneMethodQuery p ('Service s methods)]
-> f [OneMethodQuery p ('Service s methods)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
where
fieldToMethod :: GQL.Field -> f (Maybe (OneMethodQuery p ('Service sname methods)))
fieldToMethod :: Field -> f (Maybe (OneMethodQuery p ('Service sname methods)))
fieldToMethod f :: Field
f@(GQL.Field Maybe Alias
alias Name
name [Argument]
args [Directive]
dirs SelectionSet
sels)
| (Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) [Directive]
dirs
= Maybe (OneMethodQuery p ('Service sname methods))
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneMethodQuery p ('Service sname methods))
forall a. Maybe a
Nothing
| Name -> Text
GQL.unName Name
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"__typename"
= case ([Argument]
args, SelectionSet
sels) of
([], []) -> Maybe (OneMethodQuery p ('Service sname methods))
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OneMethodQuery p ('Service sname methods))
-> f (Maybe (OneMethodQuery p ('Service sname methods))))
-> Maybe (OneMethodQuery p ('Service sname methods))
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods)))
-> OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> OneMethodQuery p ('Service sname methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(nm :: snm) (ms :: [Method snm mnm anm (TypeRef snm)]).
Maybe Text -> OneMethodQuery p ('Service nm ms)
TypeNameQuery (Maybe Text -> OneMethodQuery p ('Service sname methods))
-> Maybe Text -> OneMethodQuery p ('Service sname methods)
forall a b. (a -> b) -> a -> b
$ Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias
([Argument], SelectionSet)
_ -> Text -> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"__typename does not admit arguments nor selection of subfields"
| Name -> Text
GQL.unName Name
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"__schema"
= case [Argument]
args of
[] -> OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods)))
-> (SelectionSet -> OneMethodQuery p ('Service sname methods))
-> SelectionSet
-> Maybe (OneMethodQuery p ('Service sname methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> SelectionSet -> OneMethodQuery p ('Service sname methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(nm :: snm) (ms :: [Method snm mnm anm (TypeRef snm)]).
Maybe Text -> SelectionSet -> OneMethodQuery p ('Service nm ms)
SchemaQuery (Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias) (SelectionSet -> Maybe (OneMethodQuery p ('Service sname methods)))
-> f SelectionSet
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap SelectionSet
sels
[Argument]
_ -> Text -> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"__schema does not admit selection of subfields"
| Name -> Text
GQL.unName Name
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"__type"
= let alias' :: Maybe Text
alias' = Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias
getString :: Value -> Maybe Text
getString (GQL.VString StringValue
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ StringValue -> Text
coerce StringValue
s
getString (GQL.VVariable Variable
v) = Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Variable -> Text
coerce Variable
v) VariableMap
vmap Maybe Value -> (Value -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Text
getString
getString Value
_ = Maybe Text
forall a. Maybe a
Nothing
in case [Argument]
args of
[GQL.Argument Name
_ Value
val]
-> case Value -> Maybe Text
getString Value
val of
Just Text
s -> OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods)))
-> (SelectionSet -> OneMethodQuery p ('Service sname methods))
-> SelectionSet
-> Maybe (OneMethodQuery p ('Service sname methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> Text
-> SelectionSet
-> OneMethodQuery p ('Service sname methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(nm :: snm) (ms :: [Method snm mnm anm (TypeRef snm)]).
Maybe Text
-> Text -> SelectionSet -> OneMethodQuery p ('Service nm ms)
TypeQuery Maybe Text
alias' Text
s (SelectionSet -> Maybe (OneMethodQuery p ('Service sname methods)))
-> f SelectionSet
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap SelectionSet
sels
Maybe Text
_ -> Text -> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"__type requires a string argument"
[Argument]
_ -> Text -> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"__type requires one single argument"
| Bool
otherwise
= OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service sname methods)
-> Maybe (OneMethodQuery p ('Service sname methods)))
-> (NS (ChosenMethodQuery p) methods
-> OneMethodQuery p ('Service sname methods))
-> NS (ChosenMethodQuery p) methods
-> Maybe (OneMethodQuery p ('Service sname methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> NS (ChosenMethodQuery p) methods
-> OneMethodQuery p ('Service sname methods)
forall serviceName methodName argName
(p :: Package serviceName methodName argName (TypeRef serviceName))
(ms :: [Method
serviceName methodName argName (TypeRef serviceName)])
(nm :: serviceName).
Maybe Text
-> NS (ChosenMethodQuery p) ms -> OneMethodQuery p ('Service nm ms)
OneMethodQuery (Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias)
(NS (ChosenMethodQuery p) methods
-> Maybe (OneMethodQuery p ('Service sname methods)))
-> f (NS (ChosenMethodQuery p) methods)
-> f (Maybe (OneMethodQuery p ('Service sname methods)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ('Service s methods)
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) methods)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(ms :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(ParseMethod p s ms, MonadError Text f) =>
Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) ms)
selectMethod (Proxy ('Service s methods)
forall k (t :: k). Proxy t
Proxy @('Service s methods))
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s))
VariableMap
vmap FragmentMap
frmap Field
f
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap (GQL.SelectionFragmentSpread (GQL.FragmentSpread Name
nm [Directive]
dirs) : SelectionSet
ss)
| Just FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Name -> Text
GQL.unName Name
nm) FragmentMap
frmap
= if Bool -> Bool
not ((Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) [Directive]
dirs) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) ([Directive] -> Bool) -> [Directive] -> Bool
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> [Directive]
GQL._fdDirectives FragmentDefinition
fr)
then [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall a. [a] -> [a] -> [a]
(++) ([OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)])
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> f ([OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap (FragmentDefinition -> SelectionSet
GQL._fdSelectionSet FragmentDefinition
fr)
f ([OneMethodQuery ('Package pname ss) ('Service s methods)]
-> [OneMethodQuery ('Package pname ss) ('Service s methods)])
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
else Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
pp Proxy s
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
| Bool
otherwise
= Text -> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)])
-> Text
-> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall a b. (a -> b) -> a -> b
$ Text
"fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
GQL.unName Name
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
parseQuery Proxy p
_ Proxy s
_ VariableMap
_ FragmentMap
_ (Selection
_ : SelectionSet
_)
= Text -> f [OneMethodQuery ('Package pname ss) ('Service s methods)]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"inline fragments are not (yet) supported"
shouldSkip :: VariableMap -> GQL.Directive -> Bool
shouldSkip :: VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap (GQL.Directive (Name -> Text
GQL.unName -> Text
nm) [GQL.Argument (Name -> Text
GQL.unName -> Text
ifn) Value
v])
| Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"skip", Text
ifn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"if"
= case VariableMap
-> Text -> Value -> Either Text (FieldValue '[] ('TPrimitive Bool))
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' @'[] @('TPrimitive Bool) VariableMap
vmap Text
"" Value
v of
Right (FPrimitive t1
b) -> t1
Bool
b
Either Text (FieldValue '[] ('TPrimitive Bool))
_ -> Bool
False
| Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"include", Text
ifn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"if"
= case VariableMap
-> Text -> Value -> Either Text (FieldValue '[] ('TPrimitive Bool))
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' @'[] @('TPrimitive Bool) VariableMap
vmap Text
"" Value
v of
Right (FPrimitive t1
b) -> Bool -> Bool
not t1
Bool
b
Either Text (FieldValue '[] ('TPrimitive Bool))
_ -> Bool
False
shouldSkip VariableMap
_ Directive
_ = Bool
False
unFragment :: MonadError T.Text f
=> FragmentMap -> GQL.SelectionSet -> f GQL.SelectionSet
unFragment :: FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
_ [] = SelectionSet -> f SelectionSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
unFragment FragmentMap
frmap (GQL.SelectionFragmentSpread (GQL.FragmentSpread Name
nm [Directive]
_) : SelectionSet
ss)
| Just FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Name -> Text
GQL.unName Name
nm) FragmentMap
frmap
= SelectionSet -> SelectionSet -> SelectionSet
forall a. [a] -> [a] -> [a]
(++) (SelectionSet -> SelectionSet -> SelectionSet)
-> f SelectionSet -> f (SelectionSet -> SelectionSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap (FragmentDefinition -> SelectionSet
GQL._fdSelectionSet FragmentDefinition
fr)
f (SelectionSet -> SelectionSet)
-> f SelectionSet -> f SelectionSet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap SelectionSet
ss
| Bool
otherwise
= Text -> f SelectionSet
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f SelectionSet) -> Text -> f SelectionSet
forall a b. (a -> b) -> a -> b
$ Text
"fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
GQL.unName Name
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
unFragment FragmentMap
frmap (GQL.SelectionField (GQL.Field Maybe Alias
al Name
nm [Argument]
args [Directive]
dir SelectionSet
innerss) : SelectionSet
ss)
= (:) (Selection -> SelectionSet -> SelectionSet)
-> f Selection -> f (SelectionSet -> SelectionSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field -> Selection
GQL.SelectionField (Field -> Selection)
-> (SelectionSet -> Field) -> SelectionSet -> Selection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Alias
-> Name -> [Argument] -> [Directive] -> SelectionSet -> Field
GQL.Field Maybe Alias
al Name
nm [Argument]
args [Directive]
dir (SelectionSet -> Selection) -> f SelectionSet -> f Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap SelectionSet
innerss)
f (SelectionSet -> SelectionSet)
-> f SelectionSet -> f SelectionSet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FragmentMap -> SelectionSet -> f SelectionSet
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> SelectionSet -> f SelectionSet
unFragment FragmentMap
frmap SelectionSet
ss
unFragment FragmentMap
_ SelectionSet
_
= Text -> f SelectionSet
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"inline fragments are not (yet) supported"
class ParseMethod (p :: Package') (s :: Service') (ms :: [Method']) where
selectMethod ::
MonadError T.Text f =>
Proxy s ->
T.Text ->
VariableMap ->
FragmentMap ->
GQL.Field ->
f (NS (ChosenMethodQuery p) ms)
instance ParseMethod p s '[] where
selectMethod :: Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) '[])
selectMethod Proxy s
_ Text
tyName VariableMap
_ FragmentMap
_ (Name -> Text
GQL.unName (Name -> Text) -> (Field -> Name) -> Field -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Name
GQL._fName -> Text
wanted)
= Text -> f (NS (ChosenMethodQuery p) '[])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (NS (ChosenMethodQuery p) '[]))
-> Text -> f (NS (ChosenMethodQuery p) '[])
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found on type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
instance
( KnownSymbol mname, ParseMethod p s ms
, ParseArgs p s ('Method mname args r) args
, ParseDifferentReturn p r) =>
ParseMethod p s ('Method mname args r ': ms)
where
selectMethod :: Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) ('Method mname args r : ms))
selectMethod Proxy s
s Text
tyName VariableMap
vmap FragmentMap
frmap f :: Field
f@(GQL.Field Maybe Alias
_ (Name -> Text
GQL.unName -> Text
wanted) [Argument]
args [Directive]
_ SelectionSet
sels)
| Text
wanted Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mname
= ChosenMethodQuery p ('Method mname args r)
-> NS (ChosenMethodQuery p) ('Method mname args r : ms)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (ChosenMethodQuery p ('Method mname args r)
-> NS (ChosenMethodQuery p) ('Method mname args r : ms))
-> f (ChosenMethodQuery p ('Method mname args r))
-> f (NS (ChosenMethodQuery p) ('Method mname args r : ms))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ChosenMethodQuery p ('Method mname args r)
forall serviceName mnm argName
(p :: Package serviceName mnm argName (TypeRef serviceName))
(args :: [Argument serviceName argName (TypeRef serviceName)])
(r :: Return serviceName (TypeRef serviceName)) (mname :: mnm).
Field
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ChosenMethodQuery p ('Method mname args r)
ChosenMethodQuery Field
f
(NP (ArgumentValue p) args
-> ReturnQuery p r -> ChosenMethodQuery p ('Method mname args r))
-> f (NP (ArgumentValue p) args)
-> f (ReturnQuery p r
-> ChosenMethodQuery p ('Method mname args r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy s
-> Proxy ('Method mname args r)
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(m :: Method Symbol Symbol Symbol (TypeRef Symbol))
(args :: [Argument Symbol Symbol (TypeRef Symbol)]) (f :: * -> *).
(ParseArgs p s m args, MonadError Text f) =>
Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
parseArgs (Proxy s
forall k (t :: k). Proxy t
Proxy @s) (Proxy ('Method mname args r)
forall k (t :: k). Proxy t
Proxy @('Method mname args r)) VariableMap
vmap [Argument]
args
f (ReturnQuery p r -> ChosenMethodQuery p ('Method mname args r))
-> f (ReturnQuery p r)
-> f (ChosenMethodQuery p ('Method mname args r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery p r)
forall (p :: Package') (r :: Return Symbol (TypeRef Symbol))
(f :: * -> *).
(ParseDifferentReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery p r)
parseDiffReturn VariableMap
vmap FragmentMap
frmap Text
wanted SelectionSet
sels)
| Bool
otherwise
= NS (ChosenMethodQuery p) ms
-> NS (ChosenMethodQuery p) ('Method mname args r : ms)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (ChosenMethodQuery p) ms
-> NS (ChosenMethodQuery p) ('Method mname args r : ms))
-> f (NS (ChosenMethodQuery p) ms)
-> f (NS (ChosenMethodQuery p) ('Method mname args r : ms))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) ms)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(ms :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(ParseMethod p s ms, MonadError Text f) =>
Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) ms)
selectMethod Proxy s
s Text
tyName VariableMap
vmap FragmentMap
frmap Field
f
where
mname :: Text
mname = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy mname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy mname
forall k (t :: k). Proxy t
Proxy @mname)
class ParseArgs (p :: Package') (s :: Service') (m :: Method') (args :: [Argument']) where
parseArgs :: MonadError T.Text f
=> Proxy s -> Proxy m
-> VariableMap
-> [GQL.Argument]
-> f (NP (ArgumentValue p) args)
instance ParseArgs p s m '[] where
parseArgs :: Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) '[])
parseArgs Proxy s
_ Proxy m
_ VariableMap
_ [Argument]
_ = NP (ArgumentValue p) '[] -> f (NP (ArgumentValue p) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (ArgumentValue p) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance ParseArg p a
=> ParseArgs p s m '[ 'ArgSingle 'Nothing a ] where
parseArgs :: Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a])
parseArgs Proxy s
_ Proxy m
_ VariableMap
vmap [GQL.Argument Name
_ Value
x]
= (\ArgumentValue' p a
v -> ArgumentValue' p a -> ArgumentValue p ('ArgSingle 'Nothing a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p r -> ArgumentValue p ('ArgSingle aname r)
ArgumentValue ArgumentValue' p a
v ArgumentValue p ('ArgSingle 'Nothing a)
-> NP (ArgumentValue p) '[]
-> NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (ArgumentValue p) '[]
forall k (a :: k -> *). NP a '[]
Nil) (ArgumentValue' p a
-> NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a])
-> f (ArgumentValue' p a)
-> f (NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
"arg" Value
x
parseArgs Proxy s
_ Proxy m
_ VariableMap
_ [Argument]
_
= Text -> f (NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"this field receives one single argument"
instance ParseArg p a
=> ParseArgs p s m '[ 'ArgStream 'Nothing a ] where
parseArgs :: Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) '[ 'ArgStream 'Nothing a])
parseArgs Proxy s
_ Proxy m
_ VariableMap
vmap [GQL.Argument Name
_ Value
x]
= (\ArgumentValue' p ('ListRef a)
v -> ArgumentValue' p ('ListRef a)
-> ArgumentValue p ('ArgStream 'Nothing a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p ('ListRef r)
-> ArgumentValue p ('ArgStream aname r)
ArgumentStream ArgumentValue' p ('ListRef a)
v ArgumentValue p ('ArgStream 'Nothing a)
-> NP (ArgumentValue p) '[]
-> NP (ArgumentValue p) '[ 'ArgStream 'Nothing a]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (ArgumentValue p) '[]
forall k (a :: k -> *). NP a '[]
Nil) (ArgumentValue' p ('ListRef a)
-> NP (ArgumentValue p) '[ 'ArgStream 'Nothing a])
-> f (ArgumentValue' p ('ListRef a))
-> f (NP (ArgumentValue p) '[ 'ArgStream 'Nothing a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef a))
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
"arg" Value
x
parseArgs Proxy s
_ Proxy m
_ VariableMap
_ [Argument]
_
= Text -> f (NP (ArgumentValue p) '[ 'ArgStream 'Nothing a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"this field receives one single argument"
instance ( KnownName aname, ParseMaybeArg p a, ParseArgs p s m as
, s ~ 'Service snm sms, m ~ 'Method mnm margs mr
, ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname
, FindDefaultArgValue ann )
=> ParseArgs p s m ('ArgSingle ('Just aname) a ': as) where
parseArgs :: Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
= let aname :: Text
aname = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy aname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)
in case (Argument -> Bool) -> [Argument] -> Maybe Argument
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy aname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)) (String -> Bool) -> (Argument -> String) -> Argument -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Argument -> Text) -> Argument -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
GQL.unName (Name -> Text) -> (Argument -> Name) -> Argument -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Name
GQL._aName) [Argument]
args of
Just (GQL.Argument Name
_ Value
x)
-> ArgumentValue p ('ArgSingle ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (ArgumentValue p ('ArgSingle ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
-> f (ArgumentValue p ('ArgSingle ('Just aname) a))
-> f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentValue' p a -> ArgumentValue p ('ArgSingle ('Just aname) a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p r -> ArgumentValue p ('ArgSingle aname r)
ArgumentValue (ArgumentValue' p a
-> ArgumentValue p ('ArgSingle ('Just aname) a))
-> f (ArgumentValue' p a)
-> f (ArgumentValue p ('ArgSingle ('Just aname) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseMaybeArg p a, MonadError Text f) =>
VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
parseMaybeArg VariableMap
vmap Text
aname (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x))
f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
-> f (NP (ArgumentValue p) as)
-> f (NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) as)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(m :: Method Symbol Symbol Symbol (TypeRef Symbol))
(args :: [Argument Symbol Symbol (TypeRef Symbol)]) (f :: * -> *).
(ParseArgs p s m args, MonadError Text f) =>
Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
Maybe Argument
Nothing
-> do let x :: Maybe ValueConst
x = Proxy ann -> Maybe ValueConst
forall (vs :: Maybe DefaultValue).
FindDefaultArgValue vs =>
Proxy vs -> Maybe ValueConst
findDefaultArgValue (Proxy ann
forall k (t :: k). Proxy t
Proxy @ann)
ArgumentValue p ('ArgSingle ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (ArgumentValue p ('ArgSingle ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
-> f (ArgumentValue p ('ArgSingle ('Just aname) a))
-> f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentValue' p a -> ArgumentValue p ('ArgSingle ('Just aname) a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p r -> ArgumentValue p ('ArgSingle aname r)
ArgumentValue (ArgumentValue' p a
-> ArgumentValue p ('ArgSingle ('Just aname) a))
-> f (ArgumentValue' p a)
-> f (ArgumentValue p ('ArgSingle ('Just aname) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseMaybeArg p a, MonadError Text f) =>
VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
parseMaybeArg VariableMap
vmap Text
aname
(ValueConst -> Value
constToValue (ValueConst -> Value) -> Maybe ValueConst -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ValueConst
x))
f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
-> f (NP (ArgumentValue p) as)
-> f (NP (ArgumentValue p) ('ArgSingle ('Just aname) a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) as)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(m :: Method Symbol Symbol Symbol (TypeRef Symbol))
(args :: [Argument Symbol Symbol (TypeRef Symbol)]) (f :: * -> *).
(ParseArgs p s m args, MonadError Text f) =>
Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
instance ( KnownName aname, ParseArg p a, ParseArgs p s m as
, s ~ 'Service snm sms, m ~ 'Method mnm margs mr
, ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname
, FindDefaultArgValue ann )
=> ParseArgs p s m ('ArgStream ('Just aname) a ': as) where
parseArgs :: Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
= let aname :: Text
aname = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy aname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)
in case (Argument -> Bool) -> [Argument] -> Maybe Argument
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy aname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)) (String -> Bool) -> (Argument -> String) -> Argument -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Argument -> Text) -> Argument -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
GQL.unName (Name -> Text) -> (Argument -> Name) -> Argument -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Name
GQL._aName) [Argument]
args of
Just (GQL.Argument Name
_ Value
x)
-> ArgumentValue p ('ArgStream ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (ArgumentValue p ('ArgStream ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
-> f (ArgumentValue p ('ArgStream ('Just aname) a))
-> f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentValue' p ('ListRef a)
-> ArgumentValue p ('ArgStream ('Just aname) a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p ('ListRef r)
-> ArgumentValue p ('ArgStream aname r)
ArgumentStream (ArgumentValue' p ('ListRef a)
-> ArgumentValue p ('ArgStream ('Just aname) a))
-> f (ArgumentValue' p ('ListRef a))
-> f (ArgumentValue p ('ArgStream ('Just aname) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> Text -> Maybe Value -> f (ArgumentValue' p ('ListRef a))
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseMaybeArg p a, MonadError Text f) =>
VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
parseMaybeArg VariableMap
vmap Text
aname (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x))
f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
-> f (NP (ArgumentValue p) as)
-> f (NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) as)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(m :: Method Symbol Symbol Symbol (TypeRef Symbol))
(args :: [Argument Symbol Symbol (TypeRef Symbol)]) (f :: * -> *).
(ParseArgs p s m args, MonadError Text f) =>
Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
Maybe Argument
Nothing
-> do let x :: Maybe ValueConst
x = Proxy ann -> Maybe ValueConst
forall (vs :: Maybe DefaultValue).
FindDefaultArgValue vs =>
Proxy vs -> Maybe ValueConst
findDefaultArgValue (Proxy ann
forall k (t :: k). Proxy t
Proxy @ann)
ArgumentValue p ('ArgStream ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (ArgumentValue p ('ArgStream ('Just aname) a)
-> NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
-> f (ArgumentValue p ('ArgStream ('Just aname) a))
-> f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentValue' p ('ListRef a)
-> ArgumentValue p ('ArgStream ('Just aname) a)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm) (aname :: Maybe anm).
ArgumentValue' p ('ListRef r)
-> ArgumentValue p ('ArgStream aname r)
ArgumentStream (ArgumentValue' p ('ListRef a)
-> ArgumentValue p ('ArgStream ('Just aname) a))
-> f (ArgumentValue' p ('ListRef a))
-> f (ArgumentValue p ('ArgStream ('Just aname) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> Text -> Maybe Value -> f (ArgumentValue' p ('ListRef a))
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseMaybeArg p a, MonadError Text f) =>
VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
parseMaybeArg VariableMap
vmap Text
aname
(ValueConst -> Value
constToValue (ValueConst -> Value) -> Maybe ValueConst -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ValueConst
x))
f (NP (ArgumentValue p) as
-> NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
-> f (NP (ArgumentValue p) as)
-> f (NP (ArgumentValue p) ('ArgStream ('Just aname) a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) as)
forall (p :: Package')
(s :: Service Symbol Symbol Symbol (TypeRef Symbol))
(m :: Method Symbol Symbol Symbol (TypeRef Symbol))
(args :: [Argument Symbol Symbol (TypeRef Symbol)]) (f :: * -> *).
(ParseArgs p s m args, MonadError Text f) =>
Proxy s
-> Proxy m
-> VariableMap
-> [Argument]
-> f (NP (ArgumentValue p) args)
parseArgs Proxy s
ps Proxy m
pm VariableMap
vmap [Argument]
args
class FindDefaultArgValue (vs :: Maybe DefaultValue) where
findDefaultArgValue :: Proxy vs
-> Maybe GQL.ValueConst
instance FindDefaultArgValue 'Nothing where
findDefaultArgValue :: Proxy 'Nothing -> Maybe ValueConst
findDefaultArgValue Proxy 'Nothing
_ = Maybe ValueConst
forall a. Maybe a
Nothing
instance ReflectValueConst v
=> FindDefaultArgValue ('Just ('DefaultValue v)) where
findDefaultArgValue :: Proxy ('Just ('DefaultValue v)) -> Maybe ValueConst
findDefaultArgValue Proxy ('Just ('DefaultValue v))
_ = ValueConst -> Maybe ValueConst
forall a. a -> Maybe a
Just (ValueConst -> Maybe ValueConst) -> ValueConst -> Maybe ValueConst
forall a b. (a -> b) -> a -> b
$ Proxy v -> ValueConst
forall nat symbol (v :: ValueConst nat symbol)
(proxy :: ValueConst nat symbol -> *).
ReflectValueConst v =>
proxy v -> ValueConst
reflectValueConst (Proxy v
forall k (t :: k). Proxy t
Proxy @v)
class ParseMaybeArg (p :: Package') (a :: TypeRef Symbol) where
parseMaybeArg :: MonadError T.Text f
=> VariableMap
-> T.Text
-> Maybe GQL.Value
-> f (ArgumentValue' p a)
instance {-# OVERLAPS #-} (ParseArg p a)
=> ParseMaybeArg p ('OptionalRef a) where
parseMaybeArg :: VariableMap
-> Text -> Maybe Value -> f (ArgumentValue' p ('OptionalRef a))
parseMaybeArg VariableMap
vmap Text
aname (Just Value
x)
= Maybe (ArgumentValue' p a) -> ArgumentValue' p ('OptionalRef a)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
Maybe (ArgumentValue' p r) -> ArgumentValue' p ('OptionalRef r)
ArgOptional (Maybe (ArgumentValue' p a) -> ArgumentValue' p ('OptionalRef a))
-> (ArgumentValue' p a -> Maybe (ArgumentValue' p a))
-> ArgumentValue' p a
-> ArgumentValue' p ('OptionalRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentValue' p a -> Maybe (ArgumentValue' p a)
forall a. a -> Maybe a
Just (ArgumentValue' p a -> ArgumentValue' p ('OptionalRef a))
-> f (ArgumentValue' p a) -> f (ArgumentValue' p ('OptionalRef a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
aname Value
x
parseMaybeArg VariableMap
_ Text
_ Maybe Value
Nothing
= ArgumentValue' p ('OptionalRef a)
-> f (ArgumentValue' p ('OptionalRef a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('OptionalRef a)
-> f (ArgumentValue' p ('OptionalRef a)))
-> ArgumentValue' p ('OptionalRef a)
-> f (ArgumentValue' p ('OptionalRef a))
forall a b. (a -> b) -> a -> b
$ Maybe (ArgumentValue' p a) -> ArgumentValue' p ('OptionalRef a)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
Maybe (ArgumentValue' p r) -> ArgumentValue' p ('OptionalRef r)
ArgOptional Maybe (ArgumentValue' p a)
forall a. Maybe a
Nothing
instance {-# OVERLAPS #-} (ParseArg p a)
=> ParseMaybeArg p ('ListRef a) where
parseMaybeArg :: VariableMap
-> Text -> Maybe Value -> f (ArgumentValue' p ('ListRef a))
parseMaybeArg VariableMap
vmap Text
aname (Just Value
x)
= VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef a))
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
aname Value
x
parseMaybeArg VariableMap
_ Text
_ Maybe Value
Nothing
= ArgumentValue' p ('ListRef a) -> f (ArgumentValue' p ('ListRef a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('ListRef a)
-> f (ArgumentValue' p ('ListRef a)))
-> ArgumentValue' p ('ListRef a)
-> f (ArgumentValue' p ('ListRef a))
forall a b. (a -> b) -> a -> b
$ [ArgumentValue' p a] -> ArgumentValue' p ('ListRef a)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
[ArgumentValue' p r] -> ArgumentValue' p ('ListRef r)
ArgList []
instance {-# OVERLAPPABLE #-} (ParseArg p a)
=> ParseMaybeArg p a where
parseMaybeArg :: VariableMap -> Text -> Maybe Value -> f (ArgumentValue' p a)
parseMaybeArg VariableMap
vmap Text
aname (Just Value
x)
= VariableMap -> Text -> Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
aname Value
x
parseMaybeArg VariableMap
_ Text
aname Maybe Value
Nothing
= Text -> f (ArgumentValue' p a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p a)) -> Text -> f (ArgumentValue' p a)
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"' was not given a value, and has no default one"
parseArg' :: (ParseArg p a, MonadError T.Text f)
=> VariableMap
-> T.Text
-> GQL.Value
-> f (ArgumentValue' p a)
parseArg' :: VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
aname (GQL.VVariable (Name -> Text
GQL.unName (Name -> Text) -> (Variable -> Name) -> Variable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Name
GQL.unVariable -> Text
x))
= case Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
x VariableMap
vmap of
Maybe Value
Nothing -> Text -> f (ArgumentValue' p a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p a)) -> Text -> f (ArgumentValue' p a)
forall a b. (a -> b) -> a -> b
$ Text
"variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
Just Value
v -> VariableMap -> Text -> Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg VariableMap
vmap Text
aname Value
v
parseArg' VariableMap
vmap Text
aname Value
v = VariableMap -> Text -> Value -> f (ArgumentValue' p a)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg VariableMap
vmap Text
aname Value
v
class ParseArg (p :: Package') (a :: TypeRef Symbol) where
parseArg :: MonadError T.Text f
=> VariableMap
-> T.Text
-> GQL.Value
-> f (ArgumentValue' p a)
instance (ParseArg p r) => ParseArg p ('ListRef r) where
parseArg :: VariableMap -> Text -> Value -> f (ArgumentValue' p ('ListRef r))
parseArg VariableMap
vmap Text
aname (GQL.VList (GQL.ListValueG [Value]
xs))
= [ArgumentValue' p r] -> ArgumentValue' p ('ListRef r)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
[ArgumentValue' p r] -> ArgumentValue' p ('ListRef r)
ArgList ([ArgumentValue' p r] -> ArgumentValue' p ('ListRef r))
-> f [ArgumentValue' p r] -> f (ArgumentValue' p ('ListRef r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> f (ArgumentValue' p r))
-> [Value] -> f [ArgumentValue' p r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VariableMap -> Text -> Value -> f (ArgumentValue' p r)
forall (p :: Package') (a :: TypeRef Symbol) (f :: * -> *).
(ParseArg p a, MonadError Text f) =>
VariableMap -> Text -> Value -> f (ArgumentValue' p a)
parseArg' VariableMap
vmap Text
aname) [Value]
xs
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('ListRef r))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('ListRef r)))
-> Text -> f (ArgumentValue' p ('ListRef r))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef Bool) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Bool))
parseArg VariableMap
_ Text
_ (GQL.VBoolean Bool
b)
= ArgumentValue' p ('PrimitiveRef Bool)
-> f (ArgumentValue' p ('PrimitiveRef Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Bool)
-> f (ArgumentValue' p ('PrimitiveRef Bool)))
-> ArgumentValue' p ('PrimitiveRef Bool)
-> f (ArgumentValue' p ('PrimitiveRef Bool))
forall a b. (a -> b) -> a -> b
$ Bool -> ArgumentValue' p ('PrimitiveRef Bool)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive Bool
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Bool))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Bool)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Bool))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef Int32) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Int32))
parseArg VariableMap
_ Text
_ (GQL.VInt Integer
b)
= ArgumentValue' p ('PrimitiveRef Int32)
-> f (ArgumentValue' p ('PrimitiveRef Int32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Int32)
-> f (ArgumentValue' p ('PrimitiveRef Int32)))
-> ArgumentValue' p ('PrimitiveRef Int32)
-> f (ArgumentValue' p ('PrimitiveRef Int32))
forall a b. (a -> b) -> a -> b
$ Int32 -> ArgumentValue' p ('PrimitiveRef Int32)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive (Int32 -> ArgumentValue' p ('PrimitiveRef Int32))
-> Int32 -> ArgumentValue' p ('PrimitiveRef Int32)
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Int32))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Int32)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Int32))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef Integer) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Integer))
parseArg VariableMap
_ Text
_ (GQL.VInt Integer
b)
= ArgumentValue' p ('PrimitiveRef Integer)
-> f (ArgumentValue' p ('PrimitiveRef Integer))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Integer)
-> f (ArgumentValue' p ('PrimitiveRef Integer)))
-> ArgumentValue' p ('PrimitiveRef Integer)
-> f (ArgumentValue' p ('PrimitiveRef Integer))
forall a b. (a -> b) -> a -> b
$ Integer -> ArgumentValue' p ('PrimitiveRef Integer)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive Integer
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Integer))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Integer)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Integer))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef Scientific) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Scientific))
parseArg VariableMap
_ Text
_ (GQL.VFloat Scientific
b)
= ArgumentValue' p ('PrimitiveRef Scientific)
-> f (ArgumentValue' p ('PrimitiveRef Scientific))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Scientific)
-> f (ArgumentValue' p ('PrimitiveRef Scientific)))
-> ArgumentValue' p ('PrimitiveRef Scientific)
-> f (ArgumentValue' p ('PrimitiveRef Scientific))
forall a b. (a -> b) -> a -> b
$ Scientific -> ArgumentValue' p ('PrimitiveRef Scientific)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive Scientific
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Scientific))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Scientific)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Scientific))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef Double) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Double))
parseArg VariableMap
_ Text
_ (GQL.VFloat Scientific
b)
= ArgumentValue' p ('PrimitiveRef Double)
-> f (ArgumentValue' p ('PrimitiveRef Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Double)
-> f (ArgumentValue' p ('PrimitiveRef Double)))
-> ArgumentValue' p ('PrimitiveRef Double)
-> f (ArgumentValue' p ('PrimitiveRef Double))
forall a b. (a -> b) -> a -> b
$ Double -> ArgumentValue' p ('PrimitiveRef Double)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive (Double -> ArgumentValue' p ('PrimitiveRef Double))
-> Double -> ArgumentValue' p ('PrimitiveRef Double)
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Double))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Double)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Double))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef T.Text) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Text))
parseArg VariableMap
_ Text
_ (GQL.VString (GQL.StringValue Text
b))
= ArgumentValue' p ('PrimitiveRef Text)
-> f (ArgumentValue' p ('PrimitiveRef Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef Text)
-> f (ArgumentValue' p ('PrimitiveRef Text)))
-> ArgumentValue' p ('PrimitiveRef Text)
-> f (ArgumentValue' p ('PrimitiveRef Text))
forall a b. (a -> b) -> a -> b
$ Text -> ArgumentValue' p ('PrimitiveRef Text)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive Text
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef Text))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef Text)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef Text))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef String) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef String))
parseArg VariableMap
_ Text
_ (GQL.VString (GQL.StringValue Text
b))
= ArgumentValue' p ('PrimitiveRef String)
-> f (ArgumentValue' p ('PrimitiveRef String))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef String)
-> f (ArgumentValue' p ('PrimitiveRef String)))
-> ArgumentValue' p ('PrimitiveRef String)
-> f (ArgumentValue' p ('PrimitiveRef String))
forall a b. (a -> b) -> a -> b
$ String -> ArgumentValue' p ('PrimitiveRef String)
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive (String -> ArgumentValue' p ('PrimitiveRef String))
-> String -> ArgumentValue' p ('PrimitiveRef String)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
b
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef String))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef String)))
-> Text -> f (ArgumentValue' p ('PrimitiveRef String))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ParseArg p ('PrimitiveRef ()) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef ()))
parseArg VariableMap
_ Text
_ Value
GQL.VNull = ArgumentValue' p ('PrimitiveRef ())
-> f (ArgumentValue' p ('PrimitiveRef ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef ())
-> f (ArgumentValue' p ('PrimitiveRef ())))
-> ArgumentValue' p ('PrimitiveRef ())
-> f (ArgumentValue' p ('PrimitiveRef ()))
forall a b. (a -> b) -> a -> b
$ () -> ArgumentValue' p ('PrimitiveRef ())
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive ()
parseArg VariableMap
_ Text
aname Value
_
= Text -> f (ArgumentValue' p ('PrimitiveRef ()))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef ())))
-> Text -> f (ArgumentValue' p ('PrimitiveRef ()))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance (ObjectOrEnumParser sch (sch :/: sty))
=> ParseArg p ('SchemaRef sch sty) where
parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('SchemaRef sch sty))
parseArg VariableMap
vmap Text
aname Value
v
= Term sch (sch :/: sty) -> ArgumentValue' p ('SchemaRef sch sty)
forall typeName fieldName snm mnm anm
(sch :: Schema typeName fieldName) (sty :: typeName)
(p :: Package snm mnm anm (TypeRef snm)).
Term sch (sch :/: sty) -> ArgumentValue' p ('SchemaRef sch sty)
ArgSchema (Term sch (sch :/: sty) -> ArgumentValue' p ('SchemaRef sch sty))
-> f (Term sch (sch :/: sty))
-> f (ArgumentValue' p ('SchemaRef sch sty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (Term sch (sch :/: sty))
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ObjectOrEnumParser sch t, MonadError Text f) =>
VariableMap -> Text -> Value -> f (Term sch t)
parseObjectOrEnum' VariableMap
vmap Text
aname Value
v
parseObjectOrEnum' :: (ObjectOrEnumParser sch t, MonadError T.Text f)
=> VariableMap
-> T.Text
-> GQL.Value
-> f (Term sch t)
parseObjectOrEnum' :: VariableMap -> Text -> Value -> f (Term sch t)
parseObjectOrEnum' VariableMap
vmap Text
aname (GQL.VVariable (Name -> Text
GQL.unName (Name -> Text) -> (Variable -> Name) -> Variable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Name
GQL.unVariable -> Text
x))
= case Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
x VariableMap
vmap of
Maybe Value
Nothing -> Text -> f (Term sch t)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (Term sch t)) -> Text -> f (Term sch t)
forall a b. (a -> b) -> a -> b
$ Text
"variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
Just Value
v -> VariableMap -> Text -> Value -> f (Term sch t)
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ObjectOrEnumParser sch t, MonadError Text f) =>
VariableMap -> Text -> Value -> f (Term sch t)
parseObjectOrEnum VariableMap
vmap Text
aname Value
v
parseObjectOrEnum' VariableMap
vmap Text
aname Value
v
= VariableMap -> Text -> Value -> f (Term sch t)
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ObjectOrEnumParser sch t, MonadError Text f) =>
VariableMap -> Text -> Value -> f (Term sch t)
parseObjectOrEnum VariableMap
vmap Text
aname Value
v
class ObjectOrEnumParser (sch :: Schema') (t :: TypeDef Symbol Symbol) where
parseObjectOrEnum :: MonadError T.Text f
=> VariableMap
-> T.Text
-> GQL.Value
-> f (Term sch t)
instance (ObjectParser sch args, KnownName name)
=> ObjectOrEnumParser sch ('DRecord name args) where
parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DRecord name args))
parseObjectOrEnum VariableMap
vmap Text
_ (GQL.VObject (GQL.ObjectValueG [ObjectFieldG Value]
vs))
= NP (Field sch) args -> Term sch ('DRecord name args)
forall typeName fieldName (sch :: Schema typeName fieldName)
(args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field sch) args -> Term sch ('DRecord name args)
TRecord (NP (Field sch) args -> Term sch ('DRecord name args))
-> f (NP (Field sch) args) -> f (Term sch ('DRecord name args))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> Text -> [ObjectFieldG Value] -> f (NP (Field sch) args)
forall (sch :: Schema') (args :: [FieldDef Symbol Symbol])
(f :: * -> *).
(ObjectParser sch args, MonadError Text f) =>
VariableMap
-> Text -> [ObjectFieldG Value] -> f (NP (Field sch) args)
objectParser VariableMap
vmap (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) [ObjectFieldG Value]
vs
parseObjectOrEnum VariableMap
_ Text
aname Value
_
= Text -> f (Term sch ('DRecord name args))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (Term sch ('DRecord name args)))
-> Text -> f (Term sch ('DRecord name args))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance (EnumParser choices, KnownName name)
=> ObjectOrEnumParser sch ('DEnum name choices) where
parseObjectOrEnum :: VariableMap -> Text -> Value -> f (Term sch ('DEnum name choices))
parseObjectOrEnum VariableMap
_ Text
_ (GQL.VEnum (GQL.EnumValue Name
nm))
= NS Proxy choices -> Term sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
(sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (NS Proxy choices -> Term sch ('DEnum name choices))
-> f (NS Proxy choices) -> f (Term sch ('DEnum name choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Name -> f (NS Proxy choices)
forall (choices :: [ChoiceDef Symbol]) (f :: * -> *).
(EnumParser choices, MonadError Text f) =>
Text -> Name -> f (NS Proxy choices)
enumParser (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) Name
nm
parseObjectOrEnum VariableMap
_ Text
aname Value
_
= Text -> f (Term sch ('DEnum name choices))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (Term sch ('DEnum name choices)))
-> Text -> f (Term sch ('DEnum name choices))
forall a b. (a -> b) -> a -> b
$ Text
"argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
class ObjectParser (sch :: Schema') (args :: [FieldDef Symbol Symbol]) where
objectParser :: MonadError T.Text f
=> VariableMap
-> T.Text
-> [GQL.ObjectFieldG GQL.Value]
-> f (NP (Field sch) args)
instance ObjectParser sch '[] where
objectParser :: VariableMap
-> Text -> [ObjectFieldG Value] -> f (NP (Field sch) '[])
objectParser VariableMap
_ Text
_ [ObjectFieldG Value]
_ = NP (Field sch) '[] -> f (NP (Field sch) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (Field sch) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance
(ObjectParser sch args, ValueParser sch v, KnownName nm) =>
ObjectParser sch ('FieldDef nm v ': args)
where
objectParser :: VariableMap
-> Text
-> [ObjectFieldG Value]
-> f (NP (Field sch) ('FieldDef nm v : args))
objectParser VariableMap
vmap Text
tyName [ObjectFieldG Value]
args
= let wanted :: Text
wanted = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy nm -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)
in case (ObjectFieldG Value -> Bool)
-> [ObjectFieldG Value] -> Maybe (ObjectFieldG Value)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
wanted) (Text -> Bool)
-> (ObjectFieldG Value -> Text) -> ObjectFieldG Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
GQL.unName (Name -> Text)
-> (ObjectFieldG Value -> Name) -> ObjectFieldG Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectFieldG Value -> Name
forall a. ObjectFieldG a -> Name
GQL._ofName) [ObjectFieldG Value]
args of
Just (GQL.ObjectFieldG Name
_ Value
v)
-> Field sch ('FieldDef nm v)
-> NP (Field sch) args -> NP (Field sch) ('FieldDef nm v : args)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (Field sch ('FieldDef nm v)
-> NP (Field sch) args -> NP (Field sch) ('FieldDef nm v : args))
-> f (Field sch ('FieldDef nm v))
-> f (NP (Field sch) args
-> NP (Field sch) ('FieldDef nm v : args))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue sch v -> Field sch ('FieldDef nm v)
forall typeName fieldName (sch :: Schema typeName fieldName)
(t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (FieldValue sch v -> Field sch ('FieldDef nm v))
-> f (FieldValue sch v) -> f (Field sch ('FieldDef nm v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (FieldValue sch v)
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' VariableMap
vmap Text
wanted Value
v) f (NP (Field sch) args -> NP (Field sch) ('FieldDef nm v : args))
-> f (NP (Field sch) args)
-> f (NP (Field sch) ('FieldDef nm v : args))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VariableMap
-> Text -> [ObjectFieldG Value] -> f (NP (Field sch) args)
forall (sch :: Schema') (args :: [FieldDef Symbol Symbol])
(f :: * -> *).
(ObjectParser sch args, MonadError Text f) =>
VariableMap
-> Text -> [ObjectFieldG Value] -> f (NP (Field sch) args)
objectParser VariableMap
vmap Text
tyName [ObjectFieldG Value]
args
Maybe (ObjectFieldG Value)
Nothing -> Text -> f (NP (Field sch) ('FieldDef nm v : args))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (NP (Field sch) ('FieldDef nm v : args)))
-> Text -> f (NP (Field sch) ('FieldDef nm v : args))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found on type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
class EnumParser (choices :: [ChoiceDef Symbol]) where
enumParser :: MonadError T.Text f
=> T.Text -> GQL.Name
-> f (NS Proxy choices)
instance EnumParser '[] where
enumParser :: Text -> Name -> f (NS Proxy '[])
enumParser Text
tyName (Name -> Text
GQL.unName -> Text
wanted)
= Text -> f (NS Proxy '[])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (NS Proxy '[])) -> Text -> f (NS Proxy '[])
forall a b. (a -> b) -> a -> b
$ Text
"value '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found on enum '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
instance (KnownName name, EnumParser choices)
=> EnumParser ('ChoiceDef name ': choices) where
enumParser :: Text -> Name -> f (NS Proxy ('ChoiceDef name : choices))
enumParser Text
tyName w :: Name
w@(Name -> Text
GQL.unName -> Text
wanted)
| Text
wanted Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mname = NS Proxy ('ChoiceDef name : choices)
-> f (NS Proxy ('ChoiceDef name : choices))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy ('ChoiceDef name) -> NS Proxy ('ChoiceDef name : choices)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy ('ChoiceDef name)
forall k (t :: k). Proxy t
Proxy)
| Bool
otherwise = NS Proxy choices -> NS Proxy ('ChoiceDef name : choices)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Proxy choices -> NS Proxy ('ChoiceDef name : choices))
-> f (NS Proxy choices) -> f (NS Proxy ('ChoiceDef name : choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Name -> f (NS Proxy choices)
forall (choices :: [ChoiceDef Symbol]) (f :: * -> *).
(EnumParser choices, MonadError Text f) =>
Text -> Name -> f (NS Proxy choices)
enumParser Text
tyName Name
w
where
mname :: Text
mname = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
valueParser' :: (ValueParser sch v, MonadError T.Text f)
=> VariableMap
-> T.Text
-> GQL.Value
-> f (FieldValue sch v)
valueParser' :: VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' VariableMap
vmap Text
aname (GQL.VVariable (Name -> Text
GQL.unName (Name -> Text) -> (Variable -> Name) -> Variable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Name
GQL.unVariable -> Text
x))
= case Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
x VariableMap
vmap of
Maybe Value
Nothing -> Text -> f (FieldValue sch v)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch v)) -> Text -> f (FieldValue sch v)
forall a b. (a -> b) -> a -> b
$ Text
"variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
Just Value
v -> VariableMap -> Text -> Value -> f (FieldValue sch v)
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser VariableMap
vmap Text
aname Value
v
valueParser' VariableMap
vmap Text
aname Value
v = VariableMap -> Text -> Value -> f (FieldValue sch v)
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser VariableMap
vmap Text
aname Value
v
class ValueParser (sch :: Schema') (v :: FieldType Symbol) where
valueParser :: MonadError T.Text f
=> VariableMap
-> T.Text
-> GQL.Value
-> f (FieldValue sch v)
instance ValueParser sch 'TNull where
valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch 'TNull)
valueParser VariableMap
_ Text
_ Value
GQL.VNull = FieldValue sch 'TNull -> f (FieldValue sch 'TNull)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldValue sch 'TNull
forall typeName fieldName (sch :: Schema typeName fieldName).
FieldValue sch 'TNull
FNull
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch 'TNull)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch 'TNull))
-> Text -> f (FieldValue sch 'TNull)
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive Bool) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Bool))
valueParser VariableMap
_ Text
_ (GQL.VBoolean Bool
b) = FieldValue sch ('TPrimitive Bool)
-> f (FieldValue sch ('TPrimitive Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Bool)
-> f (FieldValue sch ('TPrimitive Bool)))
-> FieldValue sch ('TPrimitive Bool)
-> f (FieldValue sch ('TPrimitive Bool))
forall a b. (a -> b) -> a -> b
$ Bool -> FieldValue sch ('TPrimitive Bool)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive Bool
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Bool))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Bool)))
-> Text -> f (FieldValue sch ('TPrimitive Bool))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive Int32) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Int32))
valueParser VariableMap
_ Text
_ (GQL.VInt Integer
b) = FieldValue sch ('TPrimitive Int32)
-> f (FieldValue sch ('TPrimitive Int32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Int32)
-> f (FieldValue sch ('TPrimitive Int32)))
-> FieldValue sch ('TPrimitive Int32)
-> f (FieldValue sch ('TPrimitive Int32))
forall a b. (a -> b) -> a -> b
$ Int32 -> FieldValue sch ('TPrimitive Int32)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive (Int32 -> FieldValue sch ('TPrimitive Int32))
-> Int32 -> FieldValue sch ('TPrimitive Int32)
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Int32))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Int32)))
-> Text -> f (FieldValue sch ('TPrimitive Int32))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive Integer) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Integer))
valueParser VariableMap
_ Text
_ (GQL.VInt Integer
b) = FieldValue sch ('TPrimitive Integer)
-> f (FieldValue sch ('TPrimitive Integer))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Integer)
-> f (FieldValue sch ('TPrimitive Integer)))
-> FieldValue sch ('TPrimitive Integer)
-> f (FieldValue sch ('TPrimitive Integer))
forall a b. (a -> b) -> a -> b
$ Integer -> FieldValue sch ('TPrimitive Integer)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive Integer
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Integer))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Integer)))
-> Text -> f (FieldValue sch ('TPrimitive Integer))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive Scientific) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Scientific))
valueParser VariableMap
_ Text
_ (GQL.VFloat Scientific
b) = FieldValue sch ('TPrimitive Scientific)
-> f (FieldValue sch ('TPrimitive Scientific))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Scientific)
-> f (FieldValue sch ('TPrimitive Scientific)))
-> FieldValue sch ('TPrimitive Scientific)
-> f (FieldValue sch ('TPrimitive Scientific))
forall a b. (a -> b) -> a -> b
$ Scientific -> FieldValue sch ('TPrimitive Scientific)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive Scientific
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Scientific))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Scientific)))
-> Text -> f (FieldValue sch ('TPrimitive Scientific))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive Double) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Double))
valueParser VariableMap
_ Text
_ (GQL.VFloat Scientific
b) = FieldValue sch ('TPrimitive Double)
-> f (FieldValue sch ('TPrimitive Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Double)
-> f (FieldValue sch ('TPrimitive Double)))
-> FieldValue sch ('TPrimitive Double)
-> f (FieldValue sch ('TPrimitive Double))
forall a b. (a -> b) -> a -> b
$ Double -> FieldValue sch ('TPrimitive Double)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive (Double -> FieldValue sch ('TPrimitive Double))
-> Double -> FieldValue sch ('TPrimitive Double)
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Double))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Double)))
-> Text -> f (FieldValue sch ('TPrimitive Double))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive T.Text) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Text))
valueParser VariableMap
_ Text
_ (GQL.VString (GQL.StringValue Text
b))
= FieldValue sch ('TPrimitive Text)
-> f (FieldValue sch ('TPrimitive Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive Text)
-> f (FieldValue sch ('TPrimitive Text)))
-> FieldValue sch ('TPrimitive Text)
-> f (FieldValue sch ('TPrimitive Text))
forall a b. (a -> b) -> a -> b
$ Text -> FieldValue sch ('TPrimitive Text)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive Text
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive Text))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Text)))
-> Text -> f (FieldValue sch ('TPrimitive Text))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance ValueParser sch ('TPrimitive String) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive String))
valueParser VariableMap
_ Text
_ (GQL.VString (GQL.StringValue Text
b))
= FieldValue sch ('TPrimitive String)
-> f (FieldValue sch ('TPrimitive String))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive String)
-> f (FieldValue sch ('TPrimitive String)))
-> FieldValue sch ('TPrimitive String)
-> f (FieldValue sch ('TPrimitive String))
forall a b. (a -> b) -> a -> b
$ String -> FieldValue sch ('TPrimitive String)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive (String -> FieldValue sch ('TPrimitive String))
-> String -> FieldValue sch ('TPrimitive String)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
b
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TPrimitive String))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive String)))
-> Text -> f (FieldValue sch ('TPrimitive String))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance (ValueParser sch r) => ValueParser sch ('TList r) where
valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TList r))
valueParser VariableMap
vmap Text
fname (GQL.VList (GQL.ListValueG [Value]
xs))
= [FieldValue sch r] -> FieldValue sch ('TList r)
forall typeName fieldName (sch :: Schema typeName fieldName)
(t1 :: FieldType typeName).
[FieldValue sch t1] -> FieldValue sch ('TList t1)
FList ([FieldValue sch r] -> FieldValue sch ('TList r))
-> f [FieldValue sch r] -> f (FieldValue sch ('TList r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> f (FieldValue sch r)) -> [Value] -> f [FieldValue sch r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VariableMap -> Text -> Value -> f (FieldValue sch r)
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' VariableMap
vmap Text
fname) [Value]
xs
valueParser VariableMap
_ Text
fname Value
_
= Text -> f (FieldValue sch ('TList r))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TList r)))
-> Text -> f (FieldValue sch ('TList r))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not of right type"
instance (ValueParser sch r) => ValueParser sch ('TOption r) where
valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TOption r))
valueParser VariableMap
_ Text
_ Value
GQL.VNull
= FieldValue sch ('TOption r) -> f (FieldValue sch ('TOption r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TOption r) -> f (FieldValue sch ('TOption r)))
-> FieldValue sch ('TOption r) -> f (FieldValue sch ('TOption r))
forall a b. (a -> b) -> a -> b
$ Maybe (FieldValue sch r) -> FieldValue sch ('TOption r)
forall typeName fieldName (sch :: Schema typeName fieldName)
(t1 :: FieldType typeName).
Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1)
FOption Maybe (FieldValue sch r)
forall a. Maybe a
Nothing
valueParser VariableMap
vmap Text
fname Value
v
= Maybe (FieldValue sch r) -> FieldValue sch ('TOption r)
forall typeName fieldName (sch :: Schema typeName fieldName)
(t1 :: FieldType typeName).
Maybe (FieldValue sch t1) -> FieldValue sch ('TOption t1)
FOption (Maybe (FieldValue sch r) -> FieldValue sch ('TOption r))
-> (FieldValue sch r -> Maybe (FieldValue sch r))
-> FieldValue sch r
-> FieldValue sch ('TOption r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldValue sch r -> Maybe (FieldValue sch r)
forall a. a -> Maybe a
Just (FieldValue sch r -> FieldValue sch ('TOption r))
-> f (FieldValue sch r) -> f (FieldValue sch ('TOption r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (FieldValue sch r)
forall (sch :: Schema') (v :: FieldType Symbol) (f :: * -> *).
(ValueParser sch v, MonadError Text f) =>
VariableMap -> Text -> Value -> f (FieldValue sch v)
valueParser' VariableMap
vmap Text
fname Value
v
instance (ObjectOrEnumParser sch (sch :/: sty), KnownName sty)
=> ValueParser sch ('TSchematic sty) where
valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TSchematic sty))
valueParser VariableMap
vmap Text
_ Value
v
= Term sch (sch :/: sty) -> FieldValue sch ('TSchematic sty)
forall typeName fieldName (sch :: Schema typeName fieldName)
(t1 :: typeName).
Term sch (sch :/: t1) -> FieldValue sch ('TSchematic t1)
FSchematic (Term sch (sch :/: sty) -> FieldValue sch ('TSchematic sty))
-> f (Term sch (sch :/: sty))
-> f (FieldValue sch ('TSchematic sty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Text -> Value -> f (Term sch (sch :/: sty))
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ObjectOrEnumParser sch t, MonadError Text f) =>
VariableMap -> Text -> Value -> f (Term sch t)
parseObjectOrEnum' VariableMap
vmap (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sty -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy sty
forall k (t :: k). Proxy t
Proxy @sty)) Value
v
class ParseDifferentReturn (p :: Package') (r :: Return Symbol (TypeRef Symbol)) where
parseDiffReturn :: MonadError T.Text f
=> VariableMap
-> FragmentMap
-> T.Text
-> GQL.SelectionSet
-> f (ReturnQuery p r)
instance ParseDifferentReturn p 'RetNothing where
parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery p 'RetNothing)
parseDiffReturn VariableMap
_ FragmentMap
_ Text
_ [] = ReturnQuery p 'RetNothing -> f (ReturnQuery p 'RetNothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReturnQuery p 'RetNothing
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)).
ReturnQuery p 'RetNothing
RNothing
parseDiffReturn VariableMap
_ FragmentMap
_ Text
fname SelectionSet
_
= Text -> f (ReturnQuery p 'RetNothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ReturnQuery p 'RetNothing))
-> Text -> f (ReturnQuery p 'RetNothing)
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' should not have a selection of subfields"
instance ParseReturn p r => ParseDifferentReturn p ('RetSingle r) where
parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery p ('RetSingle r))
parseDiffReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnQuery' p r -> ReturnQuery p ('RetSingle r)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm).
ReturnQuery' p r -> ReturnQuery p ('RetSingle r)
RSingle (ReturnQuery' p r -> ReturnQuery p ('RetSingle r))
-> f (ReturnQuery' p r) -> f (ReturnQuery p ('RetSingle r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ParseReturn p r => ParseDifferentReturn p ('RetStream r) where
parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery p ('RetStream r))
parseDiffReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnQuery' p r -> ReturnQuery p ('RetStream r)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
(r :: TypeRef snm).
ReturnQuery' p r -> ReturnQuery p ('RetStream r)
RStream (ReturnQuery' p r -> ReturnQuery p ('RetStream r))
-> f (ReturnQuery' p r) -> f (ReturnQuery p ('RetStream r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
class ParseReturn (p :: Package') (r :: TypeRef Symbol) where
parseReturn :: MonadError T.Text f
=> VariableMap
-> FragmentMap
-> T.Text
-> GQL.SelectionSet
-> f (ReturnQuery' p r)
instance ParseReturn p ('PrimitiveRef t) where
parseReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery' p ('PrimitiveRef t))
parseReturn VariableMap
_ FragmentMap
_ Text
_ []
= ReturnQuery' p ('PrimitiveRef t)
-> f (ReturnQuery' p ('PrimitiveRef t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReturnQuery' p ('PrimitiveRef t)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm)) t.
ReturnQuery' p ('PrimitiveRef t)
RetPrimitive
parseReturn VariableMap
_ FragmentMap
_ Text
fname SelectionSet
_
= Text -> f (ReturnQuery' p ('PrimitiveRef t))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ReturnQuery' p ('PrimitiveRef t)))
-> Text -> f (ReturnQuery' p ('PrimitiveRef t))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' should not have a selection of subfields"
instance (ParseSchema sch (sch :/: sty))
=> ParseReturn p ('SchemaRef sch sty) where
parseReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery' p ('SchemaRef sch sty))
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= SchemaQuery sch (sch :/: sty)
-> ReturnQuery' p ('SchemaRef sch sty)
forall typeName fieldName snm mnm anm
(sch :: Schema typeName fieldName) (r :: typeName)
(p :: Package snm mnm anm (TypeRef snm)).
SchemaQuery sch (sch :/: r) -> ReturnQuery' p ('SchemaRef sch r)
RetSchema (SchemaQuery sch (sch :/: sty)
-> ReturnQuery' p ('SchemaRef sch sty))
-> f (SchemaQuery sch (sch :/: sty))
-> f (ReturnQuery' p ('SchemaRef sch sty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (SchemaQuery sch (sch :/: sty))
forall (s :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ParseSchema s t, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (SchemaQuery s t)
parseSchema VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ParseReturn p r
=> ParseReturn p ('ListRef r) where
parseReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery' p ('ListRef r))
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnQuery' p r -> ReturnQuery' p ('ListRef r)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
ReturnQuery' p r -> ReturnQuery' p ('ListRef r)
RetList (ReturnQuery' p r -> ReturnQuery' p ('ListRef r))
-> f (ReturnQuery' p r) -> f (ReturnQuery' p ('ListRef r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ParseReturn p r
=> ParseReturn p ('OptionalRef r) where
parseReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery' p ('OptionalRef r))
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r)
forall serviceName mnm anm
(p :: Package serviceName mnm anm (TypeRef serviceName))
(r :: TypeRef serviceName).
ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r)
RetOptional (ReturnQuery' p r -> ReturnQuery' p ('OptionalRef r))
-> f (ReturnQuery' p r) -> f (ReturnQuery' p ('OptionalRef r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ( p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods,
KnownName s, ParseMethod p ('Service s methods) methods
) => ParseReturn p ('ObjectRef s) where
parseReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnQuery' p ('ObjectRef s))
parseReturn VariableMap
vmap FragmentMap
frmap Text
_ SelectionSet
s
= [OneMethodQuery ('Package pname ss) (LookupService ss s)]
-> ReturnQuery' ('Package pname ss) ('ObjectRef s)
forall serviceName mnm anm (pname :: Maybe serviceName)
(ss :: [Service serviceName mnm anm (TypeRef serviceName)])
(s :: serviceName).
ServiceQuery ('Package pname ss) (LookupService ss s)
-> ReturnQuery' ('Package pname ss) ('ObjectRef s)
RetObject ([OneMethodQuery ('Package pname ss) (LookupService ss s)]
-> ReturnQuery' ('Package pname ss) ('ObjectRef s))
-> f [OneMethodQuery ('Package pname ss) (LookupService ss s)]
-> f (ReturnQuery' ('Package pname ss) ('ObjectRef s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (pname :: Maybe Symbol)
(ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)])
(methods :: [Method Symbol Symbol Symbol (TypeRef Symbol)])
(f :: * -> *).
(MonadError Text f, p ~ 'Package pname ss,
LookupService ss s ~ 'Service s methods, KnownName s,
ParseMethod p ('Service s methods) methods) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) VariableMap
vmap FragmentMap
frmap SelectionSet
s
class ParseSchema (s :: Schema') (t :: TypeDef Symbol Symbol) where
parseSchema :: MonadError T.Text f
=> VariableMap
-> FragmentMap
-> T.Text
-> GQL.SelectionSet
-> f (SchemaQuery s t)
instance ParseSchema sch ('DEnum name choices) where
parseSchema :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (SchemaQuery sch ('DEnum name choices))
parseSchema VariableMap
_ FragmentMap
_ Text
_ []
= SchemaQuery sch ('DEnum name choices)
-> f (SchemaQuery sch ('DEnum name choices))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SchemaQuery sch ('DEnum name choices)
forall tn fn (sch :: Schema tn fn) (nm :: tn)
(choices :: [ChoiceDef fn]).
SchemaQuery sch ('DEnum nm choices)
QueryEnum
parseSchema VariableMap
_ FragmentMap
_ Text
fname SelectionSet
_
= Text -> f (SchemaQuery sch ('DEnum name choices))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (SchemaQuery sch ('DEnum name choices)))
-> Text -> f (SchemaQuery sch ('DEnum name choices))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' should not have a selection of subfields"
instance (KnownSymbol name, ParseField sch fields)
=> ParseSchema sch ('DRecord name fields) where
parseSchema :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (SchemaQuery sch ('DRecord name fields))
parseSchema VariableMap
vmap FragmentMap
frmap Text
_ SelectionSet
s
= [OneFieldQuery sch fields]
-> SchemaQuery sch ('DRecord name fields)
forall typeName fieldName (sch :: Schema typeName fieldName)
(fs :: [FieldDef typeName fieldName]) (ty :: typeName).
[OneFieldQuery sch fs] -> SchemaQuery sch ('DRecord ty fs)
QueryRecord ([OneFieldQuery sch fields]
-> SchemaQuery sch ('DRecord name fields))
-> f [OneFieldQuery sch fields]
-> f (SchemaQuery sch ('DRecord name fields))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy sch
-> Proxy ('DRecord name fields)
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(rname :: Symbol) (fields :: [FieldDef Symbol Symbol])
(f :: * -> *).
(MonadError Text f, t ~ 'DRecord rname fields, KnownSymbol rname,
ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery (Proxy sch
forall k (t :: k). Proxy t
Proxy @sch) (Proxy ('DRecord name fields)
forall k (t :: k). Proxy t
Proxy @('DRecord name fields)) VariableMap
vmap FragmentMap
frmap SelectionSet
s
parseSchemaQuery ::
forall (sch :: Schema') t (rname :: Symbol) fields f.
( MonadError T.Text f
, t ~ 'DRecord rname fields
, KnownSymbol rname
, ParseField sch fields ) =>
Proxy sch ->
Proxy t ->
VariableMap -> FragmentMap -> GQL.SelectionSet ->
f [OneFieldQuery sch fields]
parseSchemaQuery :: Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
_ Proxy t
_ VariableMap
_ FragmentMap
_ [] = [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap (GQL.SelectionField Field
fld : SelectionSet
ss)
= [OneFieldQuery sch fields]
-> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields]
forall a. [a] -> [a] -> [a]
(++) ([OneFieldQuery sch fields]
-> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
-> f [OneFieldQuery sch fields]
-> f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (OneFieldQuery sch fields) -> [OneFieldQuery sch fields]
forall a. Maybe a -> [a]
maybeToList (Maybe (OneFieldQuery sch fields) -> [OneFieldQuery sch fields])
-> f (Maybe (OneFieldQuery sch fields))
-> f [OneFieldQuery sch fields]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> f (Maybe (OneFieldQuery sch fields))
fieldToMethod Field
fld)
f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
-> f [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(rname :: Symbol) (fields :: [FieldDef Symbol Symbol])
(f :: * -> *).
(MonadError Text f, t ~ 'DRecord rname fields, KnownSymbol rname,
ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
where
fieldToMethod :: GQL.Field -> f (Maybe (OneFieldQuery sch fields))
fieldToMethod :: Field -> f (Maybe (OneFieldQuery sch fields))
fieldToMethod (GQL.Field Maybe Alias
alias Name
name [Argument]
args [Directive]
dirs SelectionSet
sels)
| (Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) [Directive]
dirs
= Maybe (OneFieldQuery sch fields)
-> f (Maybe (OneFieldQuery sch fields))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneFieldQuery sch fields)
forall a. Maybe a
Nothing
| Name -> Text
GQL.unName Name
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"__typename"
= case ([Argument]
args, SelectionSet
sels) of
([], []) -> Maybe (OneFieldQuery sch fields)
-> f (Maybe (OneFieldQuery sch fields))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OneFieldQuery sch fields)
-> f (Maybe (OneFieldQuery sch fields)))
-> Maybe (OneFieldQuery sch fields)
-> f (Maybe (OneFieldQuery sch fields))
forall a b. (a -> b) -> a -> b
$ OneFieldQuery sch fields -> Maybe (OneFieldQuery sch fields)
forall a. a -> Maybe a
Just (OneFieldQuery sch fields -> Maybe (OneFieldQuery sch fields))
-> OneFieldQuery sch fields -> Maybe (OneFieldQuery sch fields)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> OneFieldQuery sch fields
forall tn fn (sch :: Schema tn fn) (fs :: [FieldDef tn fn]).
Maybe Text -> OneFieldQuery sch fs
TypeNameFieldQuery (Maybe Text -> OneFieldQuery sch fields)
-> Maybe Text -> OneFieldQuery sch fields
forall a b. (a -> b) -> a -> b
$ Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias
([Argument], SelectionSet)
_ -> Text -> f (Maybe (OneFieldQuery sch fields))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"__typename does not admit arguments nor selection of subfields"
| Argument
_:[Argument]
_ <- [Argument]
args
= Text -> f (Maybe (OneFieldQuery sch fields))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"this field does not support arguments"
| Bool
otherwise
= OneFieldQuery sch fields -> Maybe (OneFieldQuery sch fields)
forall a. a -> Maybe a
Just (OneFieldQuery sch fields -> Maybe (OneFieldQuery sch fields))
-> (NS (ChosenFieldQuery sch) fields -> OneFieldQuery sch fields)
-> NS (ChosenFieldQuery sch) fields
-> Maybe (OneFieldQuery sch fields)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> NS (ChosenFieldQuery sch) fields -> OneFieldQuery sch fields
forall tn fn (sch :: Schema tn fn) (fs :: [FieldDef tn fn]).
Maybe Text -> NS (ChosenFieldQuery sch) fs -> OneFieldQuery sch fs
OneFieldQuery (Name -> Text
GQL.unName (Name -> Text) -> (Alias -> Name) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Name
GQL.unAlias (Alias -> Text) -> Maybe Alias -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alias
alias)
(NS (ChosenFieldQuery sch) fields
-> Maybe (OneFieldQuery sch fields))
-> f (NS (ChosenFieldQuery sch) fields)
-> f (Maybe (OneFieldQuery sch fields))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) fields)
forall (sch :: Schema') (fs :: [FieldDef Symbol Symbol])
(f :: * -> *).
(ParseField sch fs, MonadError Text f) =>
Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) fs)
selectField (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy rname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy rname
forall k (t :: k). Proxy t
Proxy @rname)) VariableMap
vmap FragmentMap
frmap Name
name SelectionSet
sels
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap (GQL.SelectionFragmentSpread (GQL.FragmentSpread Name
nm [Directive]
dirs) : SelectionSet
ss)
| Just FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Name -> Text
GQL.unName Name
nm) FragmentMap
frmap
= if Bool -> Bool
not ((Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) [Directive]
dirs) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (VariableMap -> Directive -> Bool
shouldSkip VariableMap
vmap) ([Directive] -> Bool) -> [Directive] -> Bool
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> [Directive]
GQL._fdDirectives FragmentDefinition
fr)
then [OneFieldQuery sch fields]
-> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields]
forall a. [a] -> [a] -> [a]
(++) ([OneFieldQuery sch fields]
-> [OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
-> f [OneFieldQuery sch fields]
-> f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(rname :: Symbol) (fields :: [FieldDef Symbol Symbol])
(f :: * -> *).
(MonadError Text f, t ~ 'DRecord rname fields, KnownSymbol rname,
ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap (FragmentDefinition -> SelectionSet
GQL._fdSelectionSet FragmentDefinition
fr)
f ([OneFieldQuery sch fields] -> [OneFieldQuery sch fields])
-> f [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(rname :: Symbol) (fields :: [FieldDef Symbol Symbol])
(f :: * -> *).
(MonadError Text f, t ~ 'DRecord rname fields, KnownSymbol rname,
ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
else Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
forall (sch :: Schema') (t :: TypeDefB * Symbol Symbol)
(rname :: Symbol) (fields :: [FieldDef Symbol Symbol])
(f :: * -> *).
(MonadError Text f, t ~ 'DRecord rname fields, KnownSymbol rname,
ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> SelectionSet
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap SelectionSet
ss
| Bool
otherwise
= Text -> f [OneFieldQuery sch fields]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f [OneFieldQuery sch fields])
-> Text -> f [OneFieldQuery sch fields]
forall a b. (a -> b) -> a -> b
$ Text
"fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
GQL.unName Name
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found"
parseSchemaQuery Proxy sch
_ Proxy t
_ VariableMap
_ FragmentMap
_ (Selection
_ : SelectionSet
_)
= Text -> f [OneFieldQuery sch fields]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"inline fragments are not (yet) supported"
class ParseField (sch :: Schema') (fs :: [FieldDef Symbol Symbol]) where
selectField ::
MonadError T.Text f =>
T.Text ->
VariableMap ->
FragmentMap ->
GQL.Name ->
GQL.SelectionSet ->
f (NS (ChosenFieldQuery sch) fs)
instance ParseField sch '[] where
selectField :: Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) '[])
selectField Text
tyName VariableMap
_ FragmentMap
_ (Name -> Text
GQL.unName -> Text
wanted) SelectionSet
_
= Text -> f (NS (ChosenFieldQuery sch) '[])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (NS (ChosenFieldQuery sch) '[]))
-> Text -> f (NS (ChosenFieldQuery sch) '[])
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not found on type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tyName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
instance
(KnownSymbol fname, ParseField sch fs, ParseSchemaReturn sch r) =>
ParseField sch ('FieldDef fname r ': fs)
where
selectField :: Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
selectField Text
tyName VariableMap
vmap FragmentMap
frmap w :: Name
w@(Name -> Text
GQL.unName -> Text
wanted) SelectionSet
sels
| Text
wanted Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mname
= ChosenFieldQuery sch ('FieldDef fname r)
-> NS (ChosenFieldQuery sch) ('FieldDef fname r : fs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (ChosenFieldQuery sch ('FieldDef fname r)
-> NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
-> f (ChosenFieldQuery sch ('FieldDef fname r))
-> f (NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReturnSchemaQuery sch r -> ChosenFieldQuery sch ('FieldDef fname r)
forall typeName fn (sch :: Schema typeName fn)
(r :: FieldType typeName) (name :: fn).
ReturnSchemaQuery sch r -> ChosenFieldQuery sch ('FieldDef name r)
ChosenFieldQuery (ReturnSchemaQuery sch r
-> ChosenFieldQuery sch ('FieldDef fname r))
-> f (ReturnSchemaQuery sch r)
-> f (ChosenFieldQuery sch ('FieldDef fname r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
wanted SelectionSet
sels)
| Bool
otherwise
= NS (ChosenFieldQuery sch) fs
-> NS (ChosenFieldQuery sch) ('FieldDef fname r : fs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (ChosenFieldQuery sch) fs
-> NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
-> f (NS (ChosenFieldQuery sch) fs)
-> f (NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) fs)
forall (sch :: Schema') (fs :: [FieldDef Symbol Symbol])
(f :: * -> *).
(ParseField sch fs, MonadError Text f) =>
Text
-> VariableMap
-> FragmentMap
-> Name
-> SelectionSet
-> f (NS (ChosenFieldQuery sch) fs)
selectField Text
tyName VariableMap
vmap FragmentMap
frmap Name
w SelectionSet
sels
where
mname :: Text
mname = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy fname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy fname
forall k (t :: k). Proxy t
Proxy @fname)
class ParseSchemaReturn (sch :: Schema') (r :: FieldType Symbol) where
parseSchemaReturn :: MonadError T.Text f
=> VariableMap
-> FragmentMap
-> T.Text
-> GQL.SelectionSet
-> f (ReturnSchemaQuery sch r)
instance ParseSchemaReturn sch ('TPrimitive t) where
parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch ('TPrimitive t))
parseSchemaReturn VariableMap
_ FragmentMap
_ Text
_ []
= ReturnSchemaQuery sch ('TPrimitive t)
-> f (ReturnSchemaQuery sch ('TPrimitive t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReturnSchemaQuery sch ('TPrimitive t)
forall tn fn (sch :: Schema tn fn) t.
ReturnSchemaQuery sch ('TPrimitive t)
RetSchPrimitive
parseSchemaReturn VariableMap
_ FragmentMap
_ Text
fname SelectionSet
_
= Text -> f (ReturnSchemaQuery sch ('TPrimitive t))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ReturnSchemaQuery sch ('TPrimitive t)))
-> Text -> f (ReturnSchemaQuery sch ('TPrimitive t))
forall a b. (a -> b) -> a -> b
$ Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' should not have a selection of subfields"
instance ( ParseSchema sch (sch :/: sty) )
=> ParseSchemaReturn sch ('TSchematic sty) where
parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch ('TSchematic sty))
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= SchemaQuery sch (sch :/: sty)
-> ReturnSchemaQuery sch ('TSchematic sty)
forall typeName fn (sch :: Schema typeName fn) (sty :: typeName).
SchemaQuery sch (sch :/: sty)
-> ReturnSchemaQuery sch ('TSchematic sty)
RetSchSchema (SchemaQuery sch (sch :/: sty)
-> ReturnSchemaQuery sch ('TSchematic sty))
-> f (SchemaQuery sch (sch :/: sty))
-> f (ReturnSchemaQuery sch ('TSchematic sty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (SchemaQuery sch (sch :/: sty))
forall (s :: Schema') (t :: TypeDefB * Symbol Symbol)
(f :: * -> *).
(ParseSchema s t, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> SelectionSet -> f (SchemaQuery s t)
parseSchema VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ParseSchemaReturn sch r
=> ParseSchemaReturn sch ('TList r) where
parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch ('TList r))
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TList r)
forall typeName fn (sch :: Schema typeName fn)
(r :: FieldType typeName).
ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TList r)
RetSchList (ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TList r))
-> f (ReturnSchemaQuery sch r)
-> f (ReturnSchemaQuery sch ('TList r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
instance ParseSchemaReturn sch r
=> ParseSchemaReturn sch ('TOption r) where
parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch ('TOption r))
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s
= ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TOption r)
forall typeName fn (sch :: Schema typeName fn)
(r :: FieldType typeName).
ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TOption r)
RetSchOptional (ReturnSchemaQuery sch r -> ReturnSchemaQuery sch ('TOption r))
-> f (ReturnSchemaQuery sch r)
-> f (ReturnSchemaQuery sch ('TOption r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> SelectionSet
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname SelectionSet
s