{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings     #-}
{-# language PolyKinds             #-}
{-# language ScopedTypeVariables   #-}
{-# language TupleSections         #-}
{-# 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 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.SOP.NS
import           Data.Scientific             (Scientific, floatingOrInteger, fromFloatDigits)
import qualified Data.Text                   as T
import           GHC.TypeLits
import qualified Language.GraphQL.AST        as GQL

import           Mu.GraphQL.Annotations
import           Mu.GraphQL.Query.Definition
import           Mu.Rpc
import           Mu.Schema

type VariableMapC = HM.HashMap T.Text GQL.ConstValue
type VariableMap  = HM.HashMap T.Text GQL.Value
type FragmentMap  = HM.HashMap T.Text GQL.FragmentDefinition

instance A.FromJSON GQL.ConstValue where
  parseJSON :: Value -> Parser ConstValue
parseJSON A.Null       = ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstValue
GQL.ConstNull
  parseJSON (A.Bool b :: Bool
b)   = ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstValue -> Parser ConstValue)
-> ConstValue -> Parser ConstValue
forall a b. (a -> b) -> a -> b
$ Bool -> ConstValue
GQL.ConstBoolean Bool
b
  parseJSON (A.String s :: Text
s) = ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstValue -> Parser ConstValue)
-> ConstValue -> Parser ConstValue
forall a b. (a -> b) -> a -> b
$ Text -> ConstValue
GQL.ConstString Text
s
  parseJSON (A.Number n :: Scientific
n) = case Scientific -> Either Double Int32
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Int32 of
                             Right i :: Int32
i -> ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstValue -> Parser ConstValue)
-> ConstValue -> Parser ConstValue
forall a b. (a -> b) -> a -> b
$ Int32 -> ConstValue
GQL.ConstInt Int32
i
                             Left  m :: Double
m -> ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstValue -> Parser ConstValue)
-> ConstValue -> Parser ConstValue
forall a b. (a -> b) -> a -> b
$ Double -> ConstValue
GQL.ConstFloat Double
m
  parseJSON (A.Array xs :: Array
xs) = [ConstValue] -> ConstValue
GQL.ConstList ([ConstValue] -> ConstValue)
-> (Vector ConstValue -> [ConstValue])
-> Vector ConstValue
-> ConstValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ConstValue -> [ConstValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Vector ConstValue -> ConstValue)
-> Parser (Vector ConstValue) -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ConstValue) -> Array -> Parser (Vector ConstValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser ConstValue
forall a. FromJSON a => Value -> Parser a
A.parseJSON Array
xs
  parseJSON (A.Object o :: Object
o) = [ObjectField ConstValue] -> ConstValue
GQL.ConstObject ([ObjectField ConstValue] -> ConstValue)
-> (HashMap Text ConstValue -> [ObjectField ConstValue])
-> HashMap Text ConstValue
-> ConstValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ConstValue) -> ObjectField ConstValue)
-> [(Text, ConstValue)] -> [ObjectField ConstValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ConstValue) -> ObjectField ConstValue
toObjFld ([(Text, ConstValue)] -> [ObjectField ConstValue])
-> (HashMap Text ConstValue -> [(Text, ConstValue)])
-> HashMap Text ConstValue
-> [ObjectField ConstValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text ConstValue -> [(Text, ConstValue)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text ConstValue -> ConstValue)
-> Parser (HashMap Text ConstValue) -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ConstValue)
-> Object -> Parser (HashMap Text ConstValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser ConstValue
forall a. FromJSON a => Value -> Parser a
A.parseJSON Object
o
    where
      toObjFld :: (T.Text, GQL.ConstValue) -> GQL.ObjectField GQL.ConstValue
      toObjFld :: (Text, ConstValue) -> ObjectField ConstValue
toObjFld (k :: Text
k, v :: ConstValue
v) = Text -> Node ConstValue -> Location -> ObjectField ConstValue
forall a. Text -> Node a -> Location -> ObjectField a
GQL.ObjectField Text
k (ConstValue -> Location -> Node ConstValue
forall a. a -> Location -> Node a
GQL.Node ConstValue
v Location
zl) Location
zl
      zl :: Location
zl = Word -> Word -> Location
GQL.Location 0 0

parseDoc ::
  forall qr mut sub p f.
  ( MonadError T.Text f, ParseTypedDoc p qr mut sub ) =>
  Maybe T.Text -> VariableMapC ->
  [GQL.Definition] ->
  f (Document p qr mut sub)
-- If there's no operation name, there must be only one query
parseDoc :: Maybe Text
-> HashMap Text ConstValue
-> [Definition]
-> f (Document p qr mut sub)
parseDoc Nothing vmap :: HashMap Text ConstValue
vmap defns :: [Definition]
defns
  = case [Definition]
-> ([[Selection]], [OperationDefinition], [FragmentDefinition])
partitionExDefs [Definition]
defns of
      ([unnamed :: [Selection]
unnamed], [], frs :: [FragmentDefinition]
frs)
        -> VariableMap
-> FragmentMap -> [Selection] -> 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 -> [Selection] -> f (Document p qr mut sub)
parseTypedDocQuery VariableMap
forall k v. HashMap k v
HM.empty ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs) [Selection]
unnamed
      ([], [named :: OperationDefinition
named], frs :: [FragmentDefinition]
frs)
        -> HashMap Text ConstValue
-> FragmentMap -> OperationDefinition -> 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 ConstValue
-> FragmentMap -> OperationDefinition -> f (Document p qr mut sub)
parseTypedDoc HashMap Text ConstValue
vmap ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs) OperationDefinition
named
      ([], [], _) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no operation to execute"
      (_,  [], _) -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "more than one unnamed query"
      ([], _, _)  -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "more than one named operation but no 'operationName' given"
      (_,  _, _)  -> Text -> f (Document p qr mut sub)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "both named and unnamed queries, but no 'operationName' given"
-- If there's an operation name, look in the named queries
parseDoc (Just operationName :: Text
operationName) vmap :: HashMap Text ConstValue
vmap defns :: [Definition]
defns
  = case [Definition]
-> ([[Selection]], [OperationDefinition], [FragmentDefinition])
partitionExDefs [Definition]
defns of
      (_, named :: [OperationDefinition]
named, frs :: [FragmentDefinition]
frs) -> f (Document p qr mut sub)
-> (OperationDefinition -> f (Document p qr mut sub))
-> Maybe OperationDefinition
-> 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 ConstValue
-> FragmentMap -> OperationDefinition -> 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 ConstValue
-> FragmentMap -> OperationDefinition -> f (Document p qr mut sub)
parseTypedDoc HashMap Text ConstValue
vmap ([FragmentDefinition] -> FragmentMap
fragmentsToMap [FragmentDefinition]
frs))
                               ((OperationDefinition -> Bool)
-> [OperationDefinition] -> Maybe OperationDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find OperationDefinition -> Bool
isThis [OperationDefinition]
named)
    where isThis :: OperationDefinition -> Bool
isThis (GQL.OperationDefinition _ (Just nm :: Text
nm) _ _ _ _)
            = Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
operationName
          isThis _ = 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
$ "operation '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"

partitionExDefs
 :: [GQL.Definition]
 -> ([[GQL.Selection]], [GQL.OperationDefinition], [GQL.FragmentDefinition])
partitionExDefs :: [Definition]
-> ([[Selection]], [OperationDefinition], [FragmentDefinition])
partitionExDefs defs :: [Definition]
defs
  = ( [ NonEmpty Selection -> [Selection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty Selection
ss
      | GQL.ExecutableDefinition (GQL.DefinitionOperation (GQL.SelectionSet ss :: NonEmpty Selection
ss _)) <- [Definition]
defs ]
    , [ OperationDefinition
od
      | GQL.ExecutableDefinition (GQL.DefinitionOperation od :: OperationDefinition
od@GQL.OperationDefinition {}) <- [Definition]
defs ]
    , [ FragmentDefinition
fr
      | GQL.ExecutableDefinition (GQL.DefinitionFragment fr :: FragmentDefinition
fr) <- [Definition]
defs ])

parseTypedDoc ::
  (MonadError T.Text f, ParseTypedDoc p qr mut sub) =>
  VariableMapC -> FragmentMap ->
  GQL.OperationDefinition ->
  f (Document p qr mut sub)
parseTypedDoc :: HashMap Text ConstValue
-> FragmentMap -> OperationDefinition -> f (Document p qr mut sub)
parseTypedDoc _ _ GQL.SelectionSet {}
  = [Char] -> f (Document p qr mut sub)
forall a. HasCallStack => [Char] -> a
error "this should have been handled in parseDoc"
parseTypedDoc vmap :: HashMap Text ConstValue
vmap frmap :: FragmentMap
frmap (GQL.OperationDefinition typ :: OperationType
typ _ vdefs :: [VariableDefinition]
vdefs _ (NonEmpty Selection -> [Selection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList -> [Selection]
ss) _)
  = let defVmap :: HashMap Text ConstValue
defVmap = [VariableDefinition] -> HashMap Text ConstValue
parseVariableMap [VariableDefinition]
vdefs
        finalVmap :: VariableMap
finalVmap = ConstValue -> Value
constToValue (ConstValue -> Value) -> HashMap Text ConstValue -> VariableMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text ConstValue
-> HashMap Text ConstValue -> HashMap Text ConstValue
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap Text ConstValue
vmap HashMap Text ConstValue
defVmap  -- first one takes precedence
    in case OperationType
typ of
        GQL.Query        -> VariableMap
-> FragmentMap -> [Selection] -> 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 -> [Selection] -> f (Document p qr mut sub)
parseTypedDocQuery VariableMap
finalVmap FragmentMap
frmap [Selection]
ss
        GQL.Mutation     -> VariableMap
-> FragmentMap -> [Selection] -> 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 -> [Selection] -> f (Document p qr mut sub)
parseTypedDocMutation VariableMap
finalVmap FragmentMap
frmap [Selection]
ss
        GQL.Subscription -> VariableMap
-> FragmentMap -> [Selection] -> 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 -> [Selection] -> f (Document p qr mut sub)
parseTypedDocSubscription VariableMap
finalVmap FragmentMap
frmap [Selection]
ss

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 f :: FragmentDefinition
f = (FragmentDefinition -> Text
fdName FragmentDefinition
f, FragmentDefinition
f)

class ParseTypedDoc (p :: Package')
                    (qr :: Maybe Symbol) (mut :: Maybe Symbol) (sub :: Maybe Symbol) where
  parseTypedDocQuery ::
    MonadError T.Text f =>
    VariableMap -> FragmentMap ->
    [GQL.Selection] ->
    f (Document p qr mut sub)
  parseTypedDocMutation ::
    MonadError T.Text f =>
    VariableMap -> FragmentMap ->
    [GQL.Selection] ->
    f (Document p qr mut sub)
  parseTypedDocSubscription ::
    MonadError T.Text f =>
    VariableMap -> FragmentMap ->
    [GQL.Selection] ->
    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
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocQuery vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss qr)
 -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
-> f (ServiceQuery ('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 p
-> Proxy qr
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss qr))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy qr
forall k (t :: k). Proxy t
Proxy @qr) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocMutation vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss mut)
 -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub))
-> f (ServiceQuery ('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 p
-> Proxy mut
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss mut))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy mut
forall k (t :: k). Proxy t
Proxy @mut) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) ('Just sub))
parseTypedDocSubscription vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = do ServiceQuery ('Package pname ss) ('Service sub smethods)
q <- Proxy p
-> Proxy sub
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss sub))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) VariableMap
vmap FragmentMap
frmap [Selection]
sset
         case ServiceQuery ('Package pname ss) ('Service sub smethods)
q of
           ServiceQuery [one :: OneMethodQuery ('Package pname ss) ('Service nm ms)
one]
             -> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
-> f (Document p ('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 p ('Just qr) ('Just mut) ('Just sub)))
-> Document ('Package pname ss) ('Just qr) ('Just mut) ('Just sub)
-> f (Document p ('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)
OneMethodQuery ('Package pname ss) ('Service nm ms)
one
           _ -> Text -> f (Document p ('Just qr) ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocQuery vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss qr)
 -> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
-> f (ServiceQuery ('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 p
-> Proxy qr
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss qr))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy qr
forall k (t :: k). Proxy t
Proxy @qr) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocMutation vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss mut)
 -> Document ('Package pname ss) ('Just qr) ('Just mut) 'Nothing)
-> f (ServiceQuery ('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 p
-> Proxy mut
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss mut))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy mut
forall k (t :: k). Proxy t
Proxy @mut) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) ('Just mut) 'Nothing)
parseTypedDocSubscription _ _ _
    = Text -> f (Document p ('Just qr) ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocQuery vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss qr)
 -> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub))
-> f (ServiceQuery ('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 p
-> Proxy qr
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss qr))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy qr
forall k (t :: k). Proxy t
Proxy @qr) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocMutation _ _ _
    = Text -> f (Document p ('Just qr) 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no mutations are defined in the schema"
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) 'Nothing ('Just sub))
parseTypedDocSubscription vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = do ServiceQuery ('Package pname ss) ('Service sub smethods)
q <- Proxy p
-> Proxy sub
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss sub))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) VariableMap
vmap FragmentMap
frmap [Selection]
sset
         case ServiceQuery ('Package pname ss) ('Service sub smethods)
q of
           ServiceQuery [one :: OneMethodQuery ('Package pname ss) ('Service nm ms)
one]
             -> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
-> f (Document p ('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 p ('Just qr) 'Nothing ('Just sub)))
-> Document ('Package pname ss) ('Just qr) 'Nothing ('Just sub)
-> f (Document p ('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)
OneMethodQuery ('Package pname ss) ('Service nm ms)
one
           _ -> Text -> f (Document p ('Just qr) 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocQuery vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss qr)
 -> Document ('Package pname ss) ('Just qr) 'Nothing 'Nothing)
-> f (ServiceQuery ('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 p
-> Proxy qr
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss qr))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy qr
forall k (t :: k). Proxy t
Proxy @qr) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocMutation _ _ _
    = Text -> f (Document p ('Just qr) 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no mutations are defined in the schema"
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p ('Just qr) 'Nothing 'Nothing)
parseTypedDocSubscription _ _ _
    = Text -> f (Document p ('Just qr) 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocQuery _ _ _
    = Text -> f (Document p 'Nothing ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no queries are defined in the schema"
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocMutation vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss mut)
 -> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub))
-> f (ServiceQuery ('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 p
-> Proxy mut
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss mut))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy mut
forall k (t :: k). Proxy t
Proxy @mut) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing ('Just mut) ('Just sub))
parseTypedDocSubscription vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = do ServiceQuery ('Package pname ss) ('Service sub smethods)
q <- Proxy p
-> Proxy sub
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss sub))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) VariableMap
vmap FragmentMap
frmap [Selection]
sset
         case ServiceQuery ('Package pname ss) ('Service sub smethods)
q of
           ServiceQuery [one :: OneMethodQuery ('Package pname ss) ('Service nm ms)
one]
             -> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
-> f (Document p '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 p 'Nothing ('Just mut) ('Just sub)))
-> Document ('Package pname ss) 'Nothing ('Just mut) ('Just sub)
-> f (Document p '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)
OneMethodQuery ('Package pname ss) ('Service nm ms)
one
           _ -> Text -> f (Document p 'Nothing ('Just mut) ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocQuery _ _ _
    = Text -> f (Document p 'Nothing ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no queries are defined in the schema"
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocMutation vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss mut)
 -> Document ('Package pname ss) 'Nothing ('Just mut) 'Nothing)
-> f (ServiceQuery ('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 p
-> Proxy mut
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss mut))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy mut
forall k (t :: k). Proxy t
Proxy @mut) VariableMap
vmap FragmentMap
frmap [Selection]
sset
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing ('Just mut) 'Nothing)
parseTypedDocSubscription _ _ _
    = Text -> f (Document p 'Nothing ('Just mut) 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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
-> [Selection]
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocQuery _ _ _
    = Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no queries are defined in the schema"
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocMutation _ _ _
    = Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no mutations are defined in the schema"
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing 'Nothing ('Just sub))
parseTypedDocSubscription vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sset :: [Selection]
sset
    = do ServiceQuery ('Package pname ss) ('Service sub smethods)
q <- Proxy p
-> Proxy sub
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss sub))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) VariableMap
vmap FragmentMap
frmap [Selection]
sset
         case ServiceQuery ('Package pname ss) ('Service sub smethods)
q of
           ServiceQuery [one :: OneMethodQuery ('Package pname ss) ('Service nm ms)
one]
             -> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
-> f (Document p 'Nothing 'Nothing ('Just sub))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
 -> f (Document p 'Nothing 'Nothing ('Just sub)))
-> Document ('Package pname ss) 'Nothing 'Nothing ('Just sub)
-> f (Document p '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)
OneMethodQuery ('Package pname ss) ('Service nm ms)
one
           _ -> Text -> f (Document p 'Nothing 'Nothing ('Just sub))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "subscriptions may only have one field"

instance
  ParseTypedDoc p 'Nothing 'Nothing 'Nothing where
  parseTypedDocQuery :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocQuery _ _ _
    = Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no queries are defined in the schema"
  parseTypedDocMutation :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocMutation _ _ _
    = Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no mutations are defined in the schema"
  parseTypedDocSubscription :: VariableMap
-> FragmentMap
-> [Selection]
-> f (Document p 'Nothing 'Nothing 'Nothing)
parseTypedDocSubscription _ _ _
    = Text -> f (Document p 'Nothing 'Nothing 'Nothing)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "no subscriptions are defined in the schema"

parseVariableMap :: [GQL.VariableDefinition] -> VariableMapC
parseVariableMap :: [VariableDefinition] -> HashMap Text ConstValue
parseVariableMap vmap :: [VariableDefinition]
vmap
  = [(Text, ConstValue)] -> HashMap Text ConstValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text
v, ConstValue
def)
                | GQL.VariableDefinition v :: Text
v _ (Just (GQL.Node def :: ConstValue
def _)) _ <- [VariableDefinition]
vmap]

constToValue :: GQL.ConstValue -> GQL.Value
constToValue :: ConstValue -> Value
constToValue (GQL.ConstInt n :: Int32
n)     = Int32 -> Value
GQL.Int Int32
n
constToValue (GQL.ConstFloat n :: Double
n)   = Double -> Value
GQL.Float Double
n
constToValue (GQL.ConstString n :: Text
n)  = Text -> Value
GQL.String Text
n
constToValue (GQL.ConstBoolean n :: Bool
n) = Bool -> Value
GQL.Boolean Bool
n
constToValue GQL.ConstNull        = Value
GQL.Null
constToValue (GQL.ConstEnum n :: Text
n)    = Text -> Value
GQL.Enum Text
n
constToValue (GQL.ConstList n :: [ConstValue]
n)
  = [Value] -> Value
GQL.List ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ConstValue -> Value
constToValue (ConstValue -> Value) -> [ConstValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConstValue]
n
constToValue (GQL.ConstObject n :: [ObjectField ConstValue]
n)
  = [ObjectField Value] -> Value
GQL.Object
      [ Text -> Node Value -> Location -> ObjectField Value
forall a. Text -> Node a -> Location -> ObjectField a
GQL.ObjectField Text
a (Value -> Location -> Node Value
forall a. a -> Location -> Node a
GQL.Node (ConstValue -> Value
constToValue ConstValue
v) Location
m) Location
l
      | GQL.ObjectField a :: Text
a (GQL.Node v :: ConstValue
v m :: Location
m) l :: Location
l <- [ObjectField ConstValue]
n ]

class ParseQuery (p :: Package') (s :: Symbol) where
  parseQuery
    :: ( MonadError T.Text f, p ~ 'Package pname ss )
    => Proxy p -> Proxy s
    -> VariableMap -> FragmentMap -> [GQL.Selection]
    -> f (ServiceQuery p (LookupService ss s))

instance ( p ~ 'Package pname ss
         , KnownName s
         , ParseQuery' p s (LookupService ss s) )
         => ParseQuery p s where
  parseQuery :: Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery pp :: Proxy p
pp ps :: Proxy s
ps = Proxy p
-> Proxy s
-> Proxy (LookupService ss s)
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol)
       (svc :: Service Symbol Symbol Symbol (TypeRef Symbol))
       (f :: * -> *) (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery' p s svc, MonadError Text f, p ~ 'Package pname ss,
 LookupService ss s ~ svc, KnownName s) =>
Proxy p
-> Proxy s
-> Proxy svc
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p svc)
parseQuery' Proxy p
pp Proxy s
ps (Proxy (LookupService ss s)
forall k (t :: k). Proxy t
Proxy @(LookupService ss s))

class ParseQuery' (p :: Package') (s :: Symbol) (svc :: Service') where
  parseQuery'
    :: ( MonadError T.Text f, p ~ 'Package pname ss
       , LookupService ss s ~ svc, KnownName s )
    => Proxy p -> Proxy s -> Proxy svc
    -> VariableMap -> FragmentMap -> [GQL.Selection]
    -> f (ServiceQuery p svc)

instance (ParseQueryOneOf p elts)
         => ParseQuery' p s ('OneOf s elts) where
  parseQuery' :: Proxy p
-> Proxy s
-> Proxy ('OneOf s elts)
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p ('OneOf s elts))
parseQuery' pp :: Proxy p
pp _ps :: Proxy s
_ps _ vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fs :: [Selection]
fs
    = NP (ChosenOneOfQuery p) elts -> ServiceQuery p ('OneOf s elts)
forall serviceName mnm anm
       (p :: Package serviceName mnm anm (TypeRef serviceName))
       (elts :: [serviceName]) (nm :: serviceName).
NP (ChosenOneOfQuery p) elts -> ServiceQuery p ('OneOf nm elts)
OneOfQuery (NP (ChosenOneOfQuery p) elts -> ServiceQuery p ('OneOf s elts))
-> f (NP (ChosenOneOfQuery p) elts)
-> f (ServiceQuery p ('OneOf s elts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy p
-> Proxy elts
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) elts)
forall (p :: Package') (s :: [Symbol]) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQueryOneOf p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) s)
parseQueryOneOf Proxy p
pp (Proxy elts
forall k (t :: k). Proxy t
Proxy @elts) VariableMap
vmap FragmentMap
frmap [Selection]
fs

class ParseQueryOneOf (p :: Package') (s :: [Symbol]) where
  parseQueryOneOf
    :: ( MonadError T.Text f, p ~ 'Package pname ss )
    => Proxy p -> Proxy s
    -> VariableMap -> FragmentMap -> [GQL.Selection]
    -> f (NP (ChosenOneOfQuery p) s)

instance ParseQueryOneOf p '[] where
  parseQueryOneOf :: Proxy p
-> Proxy '[]
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) '[])
parseQueryOneOf _ _ _ _ _ = NP (ChosenOneOfQuery p) '[] -> f (NP (ChosenOneOfQuery p) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (ChosenOneOfQuery p) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance ( ParseQuery p s, KnownSymbol s
         , ParseQueryOneOf p ss)
         => ParseQueryOneOf p (s ': ss) where
  parseQueryOneOf :: Proxy p
-> Proxy (s : ss)
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) (s : ss))
parseQueryOneOf pp :: Proxy p
pp _ps :: Proxy (s : ss)
_ps vmap :: VariableMap
vmap frmap :: FragmentMap
frmap sel :: [Selection]
sel
    = ChosenOneOfQuery ('Package pname ss) s
-> NP (ChosenOneOfQuery ('Package pname ss)) ss
-> NP (ChosenOneOfQuery ('Package pname ss)) (s : ss)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (ChosenOneOfQuery ('Package pname ss) s
 -> NP (ChosenOneOfQuery ('Package pname ss)) ss
 -> NP (ChosenOneOfQuery ('Package pname ss)) (s : ss))
-> f (ChosenOneOfQuery ('Package pname ss) s)
-> f (NP (ChosenOneOfQuery ('Package pname ss)) ss
      -> NP (ChosenOneOfQuery ('Package pname ss)) (s : ss))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy s
-> ServiceQuery ('Package pname ss) (LookupService ss s)
-> ChosenOneOfQuery ('Package pname ss) s
forall k methodName argName (elt :: k) (pname :: Maybe k)
       (ss :: [Service k methodName argName (TypeRef k)]).
Typeable elt =>
Proxy elt
-> ServiceQuery ('Package pname ss) (LookupService ss elt)
-> ChosenOneOfQuery ('Package pname ss) elt
ChosenOneOfQuery (Proxy s
forall k (t :: k). Proxy t
Proxy @s) (ServiceQuery ('Package pname ss) (LookupService ss s)
 -> ChosenOneOfQuery ('Package pname ss) s)
-> f (ServiceQuery ('Package pname ss) (LookupService ss s))
-> f (ChosenOneOfQuery ('Package pname ss) s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
parseQuery Proxy p
pp (Proxy s
forall k (t :: k). Proxy t
Proxy @s) VariableMap
vmap FragmentMap
frmap [Selection]
sel)
           f (NP (ChosenOneOfQuery ('Package pname ss)) ss
   -> NP (ChosenOneOfQuery ('Package pname ss)) (s : ss))
-> f (NP (ChosenOneOfQuery ('Package pname ss)) ss)
-> f (NP (ChosenOneOfQuery ('Package pname ss)) (s : ss))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy p
-> Proxy ss
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) ss)
forall (p :: Package') (s :: [Symbol]) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQueryOneOf p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (NP (ChosenOneOfQuery p) s)
parseQueryOneOf Proxy p
pp (Proxy ss
forall k (t :: k). Proxy t
Proxy @ss) VariableMap
vmap FragmentMap
frmap [Selection]
sel

instance ( ParseMethod p ('Service s methods) methods )
         => ParseQuery' p s ('Service s methods) where
  parseQuery' :: Proxy p
-> Proxy s
-> Proxy ('Service s methods)
-> VariableMap
-> FragmentMap
-> [Selection]
-> f (ServiceQuery p ('Service s methods))
parseQuery' _pp :: Proxy p
_pp _ps :: Proxy s
_ps _psvc :: Proxy ('Service s methods)
_psvc vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fs :: [Selection]
fs = [OneMethodQuery p ('Service s methods)]
-> ServiceQuery p ('Service s methods)
forall serviceName methodName argName
       (p :: Package serviceName methodName argName (TypeRef serviceName))
       (nm :: serviceName)
       (ms :: [Method
                 serviceName methodName argName (TypeRef serviceName)]).
[OneMethodQuery p ('Service nm ms)]
-> ServiceQuery p ('Service nm ms)
ServiceQuery ([OneMethodQuery p ('Service s methods)]
 -> ServiceQuery p ('Service s methods))
-> f [OneMethodQuery p ('Service s methods)]
-> f (ServiceQuery p ('Service s methods))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Selection] -> f [OneMethodQuery p ('Service s methods)]
go [Selection]
fs
    where
      go :: [Selection] -> f [OneMethodQuery p ('Service s methods)]
go [] = [OneMethodQuery p ('Service s methods)]
-> f [OneMethodQuery p ('Service s methods)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      go (GQL.FieldSelection fld :: Field
fld : ss :: [Selection]
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)))
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
<*> [Selection] -> f [OneMethodQuery p ('Service s methods)]
go [Selection]
ss
      go (GQL.FragmentSpreadSelection (GQL.FragmentSpread nm :: Text
nm dirs :: [Directive]
dirs _) : ss :: [Selection]
ss)
        | Just fr :: FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
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]
fdDirectives FragmentDefinition
fr)
            then [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
<$> [Selection] -> f [OneMethodQuery p ('Service s methods)]
go (FragmentDefinition -> [Selection]
fdSelectionSet FragmentDefinition
fr) 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
<*> [Selection] -> f [OneMethodQuery p ('Service s methods)]
go [Selection]
ss
            else [Selection] -> f [OneMethodQuery p ('Service s methods)]
go [Selection]
ss
        | Bool
otherwise  -- the fragment definition was not found
        = Text -> f [OneMethodQuery p ('Service s methods)]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f [OneMethodQuery p ('Service s methods)])
-> Text -> f [OneMethodQuery p ('Service s methods)]
forall a b. (a -> b) -> a -> b
$ "fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
      go (_ : _)  -- Inline fragments are not yet supported
        = Text -> f [OneMethodQuery p ('Service s methods)]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "inline fragments are not (yet) supported"
      -- fieldToMethod :: GQL.Field -> f (Maybe (OneMethodQuery p ('Service sname methods)))
      fieldToMethod :: Field -> f (Maybe (OneMethodQuery p ('Service s methods)))
fieldToMethod f :: Field
f@(GQL.Field alias :: Maybe Text
alias name :: Text
name args :: [Argument]
args dirs :: [Directive]
dirs sels :: [Selection]
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 s methods))
-> f (Maybe (OneMethodQuery p ('Service s methods)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OneMethodQuery p ('Service s methods))
forall a. Maybe a
Nothing
        | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "__typename"
        = case ([Argument]
args, [Selection]
sels) of
            ([], []) -> Maybe (OneMethodQuery p ('Service s methods))
-> f (Maybe (OneMethodQuery p ('Service s methods)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (OneMethodQuery p ('Service s methods))
 -> f (Maybe (OneMethodQuery p ('Service s methods))))
-> Maybe (OneMethodQuery p ('Service s methods))
-> f (Maybe (OneMethodQuery p ('Service s methods)))
forall a b. (a -> b) -> a -> b
$ OneMethodQuery p ('Service s methods)
-> Maybe (OneMethodQuery p ('Service s methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service s methods)
 -> Maybe (OneMethodQuery p ('Service s methods)))
-> OneMethodQuery p ('Service s methods)
-> Maybe (OneMethodQuery p ('Service s methods))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> OneMethodQuery p ('Service s methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)).
Maybe Text -> OneMethodQuery p s
TypeNameQuery Maybe Text
alias
            _        -> Text -> f (Maybe (OneMethodQuery p ('Service s methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "__typename does not admit arguments nor selection of subfields"
        | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "__schema"
        = case [Argument]
args of
            [] -> OneMethodQuery p ('Service s methods)
-> Maybe (OneMethodQuery p ('Service s methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service s methods)
 -> Maybe (OneMethodQuery p ('Service s methods)))
-> ([Selection] -> OneMethodQuery p ('Service s methods))
-> [Selection]
-> Maybe (OneMethodQuery p ('Service s methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [Selection] -> OneMethodQuery p ('Service s methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)).
Maybe Text -> [Selection] -> OneMethodQuery p s
SchemaQuery Maybe Text
alias ([Selection] -> Maybe (OneMethodQuery p ('Service s methods)))
-> f [Selection]
-> f (Maybe (OneMethodQuery p ('Service s methods)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap ([Selection] -> [Selection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [Selection]
sels)
            _  -> Text -> f (Maybe (OneMethodQuery p ('Service s methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "__schema does not admit selection of subfields"
        | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "__type"
        = let getString :: Value -> Maybe Text
getString (GQL.String s :: Text
s)   = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
              getString (GQL.Variable v :: Text
v) = Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
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 _                = Maybe Text
forall a. Maybe a
Nothing
          in case [Argument]
args of
            [GQL.Argument _ (GQL.Node val :: Value
val _) _]
              -> case Value -> Maybe Text
getString Value
val of
                  Just s :: Text
s -> OneMethodQuery p ('Service s methods)
-> Maybe (OneMethodQuery p ('Service s methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service s methods)
 -> Maybe (OneMethodQuery p ('Service s methods)))
-> ([Selection] -> OneMethodQuery p ('Service s methods))
-> [Selection]
-> Maybe (OneMethodQuery p ('Service s methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> Text -> [Selection] -> OneMethodQuery p ('Service s methods)
forall snm mnm anm (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)).
Maybe Text -> Text -> [Selection] -> OneMethodQuery p s
TypeQuery Maybe Text
alias Text
s ([Selection] -> Maybe (OneMethodQuery p ('Service s methods)))
-> f [Selection]
-> f (Maybe (OneMethodQuery p ('Service s methods)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap [Selection]
sels
                  _      -> Text -> f (Maybe (OneMethodQuery p ('Service s methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "__type requires a string argument"
            _ -> Text -> f (Maybe (OneMethodQuery p ('Service s methods)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "__type requires one single argument"
        | Bool
otherwise
        = OneMethodQuery p ('Service s methods)
-> Maybe (OneMethodQuery p ('Service s methods))
forall a. a -> Maybe a
Just (OneMethodQuery p ('Service s methods)
 -> Maybe (OneMethodQuery p ('Service s methods)))
-> (NS (ChosenMethodQuery p) methods
    -> OneMethodQuery p ('Service s methods))
-> NS (ChosenMethodQuery p) methods
-> Maybe (OneMethodQuery p ('Service s methods))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text
-> NS (ChosenMethodQuery p) methods
-> OneMethodQuery p ('Service s 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 Maybe Text
alias
          (NS (ChosenMethodQuery p) methods
 -> Maybe (OneMethodQuery p ('Service s methods)))
-> f (NS (ChosenMethodQuery p) methods)
-> f (Maybe (OneMethodQuery p ('Service s 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))
                            ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s))
                            VariableMap
vmap FragmentMap
frmap Field
f

shouldSkip :: VariableMap -> GQL.Directive -> Bool
shouldSkip :: VariableMap -> Directive -> Bool
shouldSkip vmap :: VariableMap
vmap (GQL.Directive nm :: Text
nm [GQL.Argument ifn :: Text
ifn (GQL.Node v :: Value
v _) _] _)
  | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "skip", Text
ifn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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 "" Value
v of
      Right (FPrimitive b :: t1
b) -> t1
Bool
b
      _                    -> Bool
False
  | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "include", Text
ifn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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 "" Value
v of
      Right (FPrimitive b :: t1
b) -> Bool -> Bool
not t1
Bool
b
      _                    -> Bool
False
shouldSkip _ _ = Bool
False

unFragment :: MonadError T.Text f
           => FragmentMap -> [GQL.Selection] -> f [GQL.Selection]
unFragment :: FragmentMap -> [Selection] -> f [Selection]
unFragment _ [] = [Selection] -> f [Selection]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
unFragment frmap :: FragmentMap
frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread nm :: Text
nm _ _) : ss :: [Selection]
ss)
  | Just fr :: FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
nm FragmentMap
frmap
  = [Selection] -> [Selection] -> [Selection]
forall a. [a] -> [a] -> [a]
(++) ([Selection] -> [Selection] -> [Selection])
-> f [Selection] -> f ([Selection] -> [Selection])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap (FragmentDefinition -> [Selection]
fdSelectionSet FragmentDefinition
fr)
         f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap [Selection]
ss
  | Bool
otherwise  -- the fragment definition was not found
  = Text -> f [Selection]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f [Selection]) -> Text -> f [Selection]
forall a b. (a -> b) -> a -> b
$ "fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
unFragment frmap :: FragmentMap
frmap (GQL.FieldSelection (GQL.Field al :: Maybe Text
al nm :: Text
nm args :: [Argument]
args dir :: [Directive]
dir innerss :: [Selection]
innerss loc :: Location
loc) : ss :: [Selection]
ss)
  = (:) (Selection -> [Selection] -> [Selection])
-> f Selection -> f ([Selection] -> [Selection])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field -> Selection
GQL.FieldSelection (Field -> Selection)
-> ([Selection] -> Field) -> [Selection] -> Selection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Selection] -> Location -> Field)
-> Location -> [Selection] -> Field
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Text
-> Text
-> [Argument]
-> [Directive]
-> [Selection]
-> Location
-> Field
GQL.Field Maybe Text
al Text
nm [Argument]
args [Directive]
dir) Location
loc
                ([Selection] -> Selection) -> f [Selection] -> f Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap [Selection]
innerss)
        f ([Selection] -> [Selection]) -> f [Selection] -> f [Selection]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FragmentMap -> [Selection] -> f [Selection]
forall (f :: * -> *).
MonadError Text f =>
FragmentMap -> [Selection] -> f [Selection]
unFragment FragmentMap
frmap [Selection]
ss
unFragment _ _
  = Text -> f [Selection]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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 ->
    {- GQL.Name ->
    [GQL.Argument] ->
    GQL.SelectionSet -> -}
    f (NS (ChosenMethodQuery p) ms)

instance ParseMethod p s '[] where
  selectMethod :: Proxy s
-> Text
-> VariableMap
-> FragmentMap
-> Field
-> f (NS (ChosenMethodQuery p) '[])
selectMethod _ tyName :: Text
tyName _ _ (Field -> Text
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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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
<> "'"
instance
  ( KnownName 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 s :: Proxy s
s tyName :: Text
tyName vmap :: VariableMap
vmap frmap :: FragmentMap
frmap f :: Field
f@(GQL.Field _ wanted :: Text
wanted args :: [Argument]
args _ sels :: [Selection]
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 -> [Selection] -> f (ReturnQuery p r)
forall (p :: Package') (r :: Return Symbol (TypeRef Symbol))
       (f :: * -> *).
(ParseDifferentReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (ReturnQuery p r)
parseDiffReturn VariableMap
vmap FragmentMap
frmap Text
wanted [Selection]
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 = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy mname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
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 _ _ _ _ = 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
-- one single argument without name
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 _ _ vmap :: VariableMap
vmap [GQL.Argument _ (GQL.Node x :: Value
x _) _]
    = (\v :: 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 "arg" Value
x
  parseArgs _ _ _ _
    = Text -> f (NP (ArgumentValue p) '[ 'ArgSingle 'Nothing a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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 _ _ vmap :: VariableMap
vmap [GQL.Argument _ (GQL.Node x :: Value
x _) _]
    = (\v :: 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 "arg" Value
x
  parseArgs _ _ _ _
    = Text -> f (NP (ArgumentValue p) '[ 'ArgStream 'Nothing a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "this field receives one single argument"
-- more than one 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 ps :: Proxy s
ps pm :: Proxy m
pm vmap :: VariableMap
vmap args :: [Argument]
args
    = let aname :: Text
aname = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy aname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
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 (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy aname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Argument -> Text) -> Argument -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Text
argName) [Argument]
args of
        Just (GQL.Argument _ (GQL.Node x :: 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
        Nothing
          -> do let x :: Maybe ConstValue
x = Proxy ann -> Maybe ConstValue
forall (vs :: Maybe DefaultValue).
FindDefaultArgValue vs =>
Proxy vs -> Maybe ConstValue
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 (ConstValue -> Value
constToValue (ConstValue -> Value) -> Maybe ConstValue -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConstValue
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 ps :: Proxy s
ps pm :: Proxy m
pm vmap :: VariableMap
vmap args :: [Argument]
args
    = let aname :: Text
aname = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy aname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
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 (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy aname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy aname
forall k (t :: k). Proxy t
Proxy @aname)) ([Char] -> Bool) -> (Argument -> [Char]) -> Argument -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Argument -> Text) -> Argument -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Text
argName) [Argument]
args of
        Just (GQL.Argument _ (GQL.Node x :: 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
        Nothing
          -> do let x :: Maybe ConstValue
x = Proxy ann -> Maybe ConstValue
forall (vs :: Maybe DefaultValue).
FindDefaultArgValue vs =>
Proxy vs -> Maybe ConstValue
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 (ConstValue -> Value
constToValue (ConstValue -> Value) -> Maybe ConstValue -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConstValue
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.ConstValue
instance FindDefaultArgValue 'Nothing where
  findDefaultArgValue :: Proxy 'Nothing -> Maybe ConstValue
findDefaultArgValue _ = Maybe ConstValue
forall a. Maybe a
Nothing
instance ReflectValueConst v
         => FindDefaultArgValue ('Just ('DefaultValue v)) where
  findDefaultArgValue :: Proxy ('Just ('DefaultValue v)) -> Maybe ConstValue
findDefaultArgValue _ = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Proxy v -> ConstValue
forall nat symbol (v :: ValueConst nat symbol)
       (proxy :: ValueConst nat symbol -> *).
ReflectValueConst v =>
proxy v -> ConstValue
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 vmap :: VariableMap
vmap aname :: Text
aname (Just x :: 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 _ _ 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 vmap :: VariableMap
vmap aname :: Text
aname (Just x :: 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 _ _ 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 vmap :: VariableMap
vmap aname :: Text
aname (Just x :: 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 _ aname :: Text
aname 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   "' 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' vmap :: VariableMap
vmap aname :: Text
aname (GQL.Variable x :: 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
      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
$ "variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
      Just v :: 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' vmap :: VariableMap
vmap aname :: Text
aname v :: 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 vmap :: VariableMap
vmap aname :: Text
aname (GQL.List xs :: [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 _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef Bool) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Bool))
parseArg _ _ (GQL.Boolean b :: 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 _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef Int32) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Int32))
parseArg _ _ (GQL.Int b :: Int32
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
$ Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
b
  parseArg _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef Integer) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Integer))
parseArg _ _ (GQL.Int b :: Int32
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 (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
b)
  parseArg _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef Scientific) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Scientific))
parseArg _ _ (GQL.Float b :: Double
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 -> ArgumentValue' p ('PrimitiveRef Scientific))
-> Scientific -> ArgumentValue' p ('PrimitiveRef Scientific)
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
b
  parseArg _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef Double) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Double))
parseArg _ _ (GQL.Float b :: Double
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
b
  parseArg _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef T.Text) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef Text))
parseArg _ _ (GQL.String b :: 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 _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef String) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef [Char]))
parseArg _ _ (GQL.String b :: Text
b)
    = ArgumentValue' p ('PrimitiveRef [Char])
-> f (ArgumentValue' p ('PrimitiveRef [Char]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArgumentValue' p ('PrimitiveRef [Char])
 -> f (ArgumentValue' p ('PrimitiveRef [Char])))
-> ArgumentValue' p ('PrimitiveRef [Char])
-> f (ArgumentValue' p ('PrimitiveRef [Char]))
forall a b. (a -> b) -> a -> b
$ [Char] -> ArgumentValue' p ('PrimitiveRef [Char])
forall snm mnm anm t (p :: Package snm mnm anm (TypeRef snm)).
t -> ArgumentValue' p ('PrimitiveRef t)
ArgPrimitive ([Char] -> ArgumentValue' p ('PrimitiveRef [Char]))
-> [Char] -> ArgumentValue' p ('PrimitiveRef [Char])
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
b
  parseArg _ aname :: Text
aname _
    = Text -> f (ArgumentValue' p ('PrimitiveRef [Char]))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (ArgumentValue' p ('PrimitiveRef [Char])))
-> Text -> f (ArgumentValue' p ('PrimitiveRef [Char]))
forall a b. (a -> b) -> a -> b
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ParseArg p ('PrimitiveRef ()) where
  parseArg :: VariableMap
-> Text -> Value -> f (ArgumentValue' p ('PrimitiveRef ()))
parseArg _ _ GQL.Null = 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 _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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 vmap :: VariableMap
vmap aname :: Text
aname v :: 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' vmap :: VariableMap
vmap aname :: Text
aname (GQL.Variable x :: 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
      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
$ "variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
      Just v :: 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' vmap :: VariableMap
vmap aname :: Text
aname v :: 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 vmap :: VariableMap
vmap _ (GQL.Object vs :: [ObjectField 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 -> [ObjectField Value] -> f (NP (Field sch) args)
forall (sch :: Schema') (args :: [FieldDef Symbol Symbol])
       (f :: * -> *).
(ObjectParser sch args, MonadError Text f) =>
VariableMap
-> Text -> [ObjectField Value] -> f (NP (Field sch) args)
objectParser VariableMap
vmap ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) [ObjectField Value]
vs
  parseObjectOrEnum _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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 _ _ (GQL.Enum nm :: Text
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 -> Text -> f (NS Proxy choices)
forall (choices :: [ChoiceDef Symbol]) (f :: * -> *).
(EnumParser choices, MonadError Text f) =>
Text -> Text -> f (NS Proxy choices)
enumParser ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)) Text
nm
  parseObjectOrEnum _ aname :: Text
aname _
    = 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
$ "argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"

class ObjectParser (sch :: Schema') (args :: [FieldDef Symbol Symbol]) where
  objectParser :: MonadError T.Text f
               => VariableMap
               -> T.Text
               -> [GQL.ObjectField GQL.Value]
               -> f (NP (Field sch) args)

instance ObjectParser sch '[] where
  objectParser :: VariableMap
-> Text -> [ObjectField Value] -> f (NP (Field sch) '[])
objectParser _ _ _ = 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
-> [ObjectField Value]
-> f (NP (Field sch) ('FieldDef nm v : args))
objectParser vmap :: VariableMap
vmap tyName :: Text
tyName args :: [ObjectField Value]
args
    = let wanted :: Text
wanted = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy nm -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy nm
forall k (t :: k). Proxy t
Proxy @nm)
      in case (ObjectField Value -> Bool)
-> [ObjectField Value] -> Maybe (ObjectField 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)
-> (ObjectField Value -> Text) -> ObjectField Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectField Value -> Text
forall a. ObjectField a -> Text
GQL.name) [ObjectField Value]
args of
        Just (GQL.ObjectField _ (GQL.Node v :: 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 -> [ObjectField Value] -> f (NP (Field sch) args)
forall (sch :: Schema') (args :: [FieldDef Symbol Symbol])
       (f :: * -> *).
(ObjectParser sch args, MonadError Text f) =>
VariableMap
-> Text -> [ObjectField Value] -> f (NP (Field sch) args)
objectParser VariableMap
vmap Text
tyName [ObjectField Value]
args
        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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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
<> "'"

class EnumParser (choices :: [ChoiceDef Symbol]) where
  enumParser :: MonadError T.Text f
             => T.Text -> GQL.Name
             -> f (NS Proxy choices)

instance EnumParser '[] where
  enumParser :: Text -> Text -> f (NS Proxy '[])
enumParser tyName :: Text
tyName wanted :: 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
$ "value '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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
<> "'"
instance (KnownName name, EnumParser choices)
         => EnumParser ('ChoiceDef name ': choices) where
  enumParser :: Text -> Text -> f (NS Proxy ('ChoiceDef name : choices))
enumParser tyName :: Text
tyName wanted :: 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 -> Text -> f (NS Proxy choices)
forall (choices :: [ChoiceDef Symbol]) (f :: * -> *).
(EnumParser choices, MonadError Text f) =>
Text -> Text -> f (NS Proxy choices)
enumParser Text
tyName Text
wanted
    where
      mname :: Text
mname = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
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' vmap :: VariableMap
vmap aname :: Text
aname (GQL.Variable x :: 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
      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
$ "variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
      Just v :: 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' vmap :: VariableMap
vmap aname :: Text
aname v :: 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 _ _ GQL.Null = 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 _ fname :: Text
fname _    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive Bool) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Bool))
valueParser _ _ (GQL.Boolean b :: 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 _ fname :: Text
fname _           = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive Int32) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Int32))
valueParser _ _ (GQL.Int b :: Int32
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
$ Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
b
  valueParser _ fname :: Text
fname _       = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive Integer) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Integer))
valueParser _ _ (GQL.Int b :: Int32
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 -> FieldValue sch ('TPrimitive Integer))
-> Integer -> FieldValue sch ('TPrimitive Integer)
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
b
  valueParser _ fname :: Text
fname _       = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive Scientific) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Scientific))
valueParser _ _ (GQL.Float b :: Double
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 -> FieldValue sch ('TPrimitive Scientific))
-> Scientific -> FieldValue sch ('TPrimitive Scientific)
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
b
  valueParser _ fname :: Text
fname _         = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive Double) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Double))
valueParser _ _ (GQL.Float b :: Double
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
b
  valueParser _ fname :: Text
fname _         = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive T.Text) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Text))
valueParser _ _ (GQL.String b :: 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 _ fname :: Text
fname _          = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance ValueParser sch ('TPrimitive String) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive [Char]))
valueParser _ _ (GQL.String b :: Text
b) = FieldValue sch ('TPrimitive [Char])
-> f (FieldValue sch ('TPrimitive [Char]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue sch ('TPrimitive [Char])
 -> f (FieldValue sch ('TPrimitive [Char])))
-> FieldValue sch ('TPrimitive [Char])
-> f (FieldValue sch ('TPrimitive [Char]))
forall a b. (a -> b) -> a -> b
$ [Char] -> FieldValue sch ('TPrimitive [Char])
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive ([Char] -> FieldValue sch ('TPrimitive [Char]))
-> [Char] -> FieldValue sch ('TPrimitive [Char])
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
b
  valueParser _ fname :: Text
fname _          = Text -> f (FieldValue sch ('TPrimitive [Char]))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive [Char])))
-> Text -> f (FieldValue sch ('TPrimitive [Char]))
forall a b. (a -> b) -> a -> b
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance (ValueParser sch r) => ValueParser sch ('TList r) where
  valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TList r))
valueParser vmap :: VariableMap
vmap fname :: Text
fname (GQL.List xs :: [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 _ fname :: Text
fname _                = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"
instance (ValueParser sch r) => ValueParser sch ('TOption r) where
  valueParser :: VariableMap -> Text -> Value -> f (FieldValue sch ('TOption r))
valueParser _ _ GQL.Null = 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 vmap :: VariableMap
vmap fname :: Text
fname v :: 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 vmap :: VariableMap
vmap _ v :: 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 ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sty -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy sty
forall k (t :: k). Proxy t
Proxy @sty)) Value
v
instance ValueParser sch ('TPrimitive A.Value) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Value))
valueParser vmap :: VariableMap
vmap _ x :: Value
x = Value -> FieldValue sch ('TPrimitive Value)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive (Value -> FieldValue sch ('TPrimitive Value))
-> f Value -> f (FieldValue sch ('TPrimitive Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Value -> f Value
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> Value -> m Value
toAesonValue VariableMap
vmap Value
x
instance ValueParser sch ('TPrimitive A.Object) where
  valueParser :: VariableMap
-> Text -> Value -> f (FieldValue sch ('TPrimitive Object))
valueParser vm :: VariableMap
vm _ (GQL.Object xs :: [ObjectField Value]
xs) = Object -> FieldValue sch ('TPrimitive Object)
forall typeName fieldName t1 (sch :: Schema typeName fieldName).
t1 -> FieldValue sch ('TPrimitive t1)
FPrimitive (Object -> FieldValue sch ('TPrimitive Object))
-> ([(Text, Value)] -> Object)
-> [(Text, Value)]
-> FieldValue sch ('TPrimitive Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> FieldValue sch ('TPrimitive Object))
-> f [(Text, Value)] -> f (FieldValue sch ('TPrimitive Object))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectField Value -> f (Text, Value))
-> [ObjectField Value] -> f [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VariableMap -> ObjectField Value -> f (Text, Value)
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> ObjectField Value -> m (Text, Value)
toKeyValuePairs VariableMap
vm) [ObjectField Value]
xs
  valueParser _ fname :: Text
fname _            = Text -> f (FieldValue sch ('TPrimitive Object))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> f (FieldValue sch ('TPrimitive Object)))
-> Text -> f (FieldValue sch ('TPrimitive Object))
forall a b. (a -> b) -> a -> b
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not of right type"

toKeyValuePairs :: MonadError T.Text m => VariableMap -> GQL.ObjectField GQL.Value -> m (T.Text, A.Value)
toKeyValuePairs :: VariableMap -> ObjectField Value -> m (Text, Value)
toKeyValuePairs vmap :: VariableMap
vmap (GQL.ObjectField key :: Text
key (GQL.Node v :: Value
v _) _) = (Text
key,) (Value -> (Text, Value)) -> m Value -> m (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableMap -> Value -> m Value
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> Value -> m Value
toAesonValue VariableMap
vmap Value
v

toAesonValue :: MonadError T.Text m => VariableMap -> GQL.Value -> m A.Value
toAesonValue :: VariableMap -> Value -> m Value
toAesonValue vm :: VariableMap
vm (GQL.Variable v :: Text
v) =
  case Text -> VariableMap -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
v VariableMap
vm of
    Nothing -> Text -> m Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m Value) -> Text -> m Value
forall a b. (a -> b) -> a -> b
$ "variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
    Just xs :: Value
xs -> VariableMap -> Value -> m Value
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> Value -> m Value
toAesonValue VariableMap
vm Value
xs
toAesonValue _  (GQL.Int n :: Int32
n)      = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value)
-> (Scientific -> Value) -> Scientific -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
A.Number (Scientific -> m Value) -> Scientific -> m Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n
toAesonValue _  (GQL.Float d :: Double
d)    = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value)
-> (Scientific -> Value) -> Scientific -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
A.Number (Scientific -> m Value) -> Scientific -> m Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
d
toAesonValue _  (GQL.String s :: Text
s)   = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
A.String Text
s
toAesonValue _  (GQL.Boolean b :: Bool
b)  = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
A.Bool Bool
b
toAesonValue _   GQL.Null        = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
A.Null
toAesonValue _  (GQL.Enum e :: Text
e)     = Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
A.String Text
e
toAesonValue vm :: VariableMap
vm (GQL.List xs :: [Value]
xs)    = [Value] -> Value
forall a. ToJSON a => a -> Value
A.toJSON ([Value] -> Value) -> m [Value] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> m Value) -> [Value] -> m [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VariableMap -> Value -> m Value
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> Value -> m Value
toAesonValue VariableMap
vm) [Value]
xs
toAesonValue vm :: VariableMap
vm (GQL.Object xs :: [ObjectField Value]
xs)  = Object -> Value
A.Object (Object -> Value)
-> ([(Text, Value)] -> Object) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> Value) -> m [(Text, Value)] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectField Value -> m (Text, Value))
-> [ObjectField Value] -> m [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VariableMap -> ObjectField Value -> m (Text, Value)
forall (m :: * -> *).
MonadError Text m =>
VariableMap -> ObjectField Value -> m (Text, Value)
toKeyValuePairs VariableMap
vm) [ObjectField Value]
xs

class ParseDifferentReturn (p :: Package') (r :: Return Symbol (TypeRef Symbol)) where
  parseDiffReturn :: MonadError T.Text f
                  => VariableMap
                  -> FragmentMap
                  -> T.Text
                  -> [GQL.Selection]
                  -> f (ReturnQuery p r)
instance ParseDifferentReturn p 'RetNothing where
  parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery p 'RetNothing)
parseDiffReturn _ _ _ [] = 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 _ _ fname :: Text
fname _
    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' should not have a selection of subfields"
instance ParseReturn p r => ParseDifferentReturn p ('RetSingle r) where
  parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery p ('RetSingle r))
parseDiffReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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 -> [Selection] -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ParseReturn p r => ParseDifferentReturn p ('RetStream r) where
  parseDiffReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery p ('RetStream r))
parseDiffReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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 -> [Selection] -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s

class ParseReturn (p :: Package') (r :: TypeRef Symbol) where
  parseReturn :: MonadError T.Text f
              => VariableMap
              -> FragmentMap
              -> T.Text
              -> [GQL.Selection]
              -> f (ReturnQuery' p r)

instance ParseReturn p ('PrimitiveRef t) where
  parseReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery' p ('PrimitiveRef t))
parseReturn _ _ _ []
    = 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 _ _ fname :: Text
fname _
    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' should not have a selection of subfields"
instance (ParseSchema sch (sch :/: sty))
         => ParseReturn p ('SchemaRef sch sty) where
  parseReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery' p ('SchemaRef sch sty))
parseReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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
-> [Selection]
-> f (SchemaQuery sch (sch :/: sty))
forall (s :: Schema') (t :: TypeDefB * Symbol Symbol)
       (f :: * -> *).
(ParseSchema s t, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (SchemaQuery s t)
parseSchema VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ParseReturn p r
         => ParseReturn p ('ListRef r) where
  parseReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery' p ('ListRef r))
parseReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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 -> [Selection] -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ParseReturn p r
         => ParseReturn p ('OptionalRef r) where
  parseReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery' p ('OptionalRef r))
parseReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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 -> [Selection] -> f (ReturnQuery' p r)
forall (p :: Package') (r :: TypeRef Symbol) (f :: * -> *).
(ParseReturn p r, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (ReturnQuery' p r)
parseReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ( p ~ 'Package pname ss, ParseQuery p s )
         => ParseReturn p ('ObjectRef s) where
  parseReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnQuery' p ('ObjectRef s))
parseReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap _ s :: [Selection]
s
    = ServiceQuery ('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 (ServiceQuery ('Package pname ss) (LookupService ss s)
 -> ReturnQuery' ('Package pname ss) ('ObjectRef s))
-> f (ServiceQuery ('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
-> [Selection]
-> f (ServiceQuery p (LookupService ss s))
forall (p :: Package') (s :: Symbol) (f :: * -> *)
       (pname :: Maybe Symbol)
       (ss :: [Service Symbol Symbol Symbol (TypeRef Symbol)]).
(ParseQuery p s, MonadError Text f, p ~ 'Package pname ss) =>
Proxy p
-> Proxy s
-> VariableMap
-> FragmentMap
-> [Selection]
-> 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 [Selection]
s

class ParseSchema (s :: Schema') (t :: TypeDef Symbol Symbol) where
  parseSchema :: MonadError T.Text f
              => VariableMap
              -> FragmentMap
              -> T.Text
              -> [GQL.Selection]
              -> f (SchemaQuery s t)
instance ParseSchema sch ('DEnum name choices) where
  parseSchema :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (SchemaQuery sch ('DEnum name choices))
parseSchema _ _ _ []
    = 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 _ _ fname :: Text
fname _
    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' should not have a selection of subfields"
instance (KnownName name, ParseField sch fields)
         => ParseSchema sch ('DRecord name fields) where
  parseSchema :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (SchemaQuery sch ('DRecord name fields))
parseSchema vmap :: VariableMap
vmap frmap :: FragmentMap
frmap _ s :: [Selection]
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
-> [Selection]
-> 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, KnownName rname,
 ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> 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 [Selection]
s

parseSchemaQuery ::
  forall (sch :: Schema') t (rname :: Symbol) fields f.
  ( MonadError T.Text f
  , t ~  'DRecord rname fields
  , KnownName rname
  , ParseField sch fields ) =>
  Proxy sch ->
  Proxy t ->
  VariableMap -> FragmentMap -> [GQL.Selection] ->
  f [OneFieldQuery sch fields]
parseSchemaQuery :: Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> f [OneFieldQuery sch fields]
parseSchemaQuery _ _ _ _ [] = [OneFieldQuery sch fields] -> f [OneFieldQuery sch fields]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseSchemaQuery pp :: Proxy sch
pp ps :: Proxy t
ps vmap :: VariableMap
vmap frmap :: FragmentMap
frmap (GQL.FieldSelection fld :: Field
fld : ss :: [Selection]
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
-> [Selection]
-> 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, KnownName rname,
 ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap [Selection]
ss
  where
    fieldToMethod :: GQL.Field -> f (Maybe (OneFieldQuery sch fields))
    fieldToMethod :: Field -> f (Maybe (OneFieldQuery sch fields))
fieldToMethod (GQL.Field alias :: Maybe Text
alias name :: Text
name args :: [Argument]
args dirs :: [Directive]
dirs sels :: [Selection]
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
      | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "__typename"
      = case ([Argument]
args, [Selection]
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
alias
          _        -> Text -> f (Maybe (OneFieldQuery sch fields))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "__typename does not admit arguments nor selection of subfields"
      | _:_ <- [Argument]
args
      = Text -> f (Maybe (OneFieldQuery sch fields))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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 Maybe Text
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
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) fields)
forall (sch :: Schema') (fs :: [FieldDef Symbol Symbol])
       (f :: * -> *).
(ParseField sch fs, MonadError Text f) =>
Text
-> VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) fs)
selectField ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy rname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
nameVal (Proxy rname
forall k (t :: k). Proxy t
Proxy @rname)) VariableMap
vmap FragmentMap
frmap Text
name [Selection]
sels
parseSchemaQuery pp :: Proxy sch
pp ps :: Proxy t
ps vmap :: VariableMap
vmap frmap :: FragmentMap
frmap (GQL.FragmentSpreadSelection (GQL.FragmentSpread nm :: Text
nm dirs :: [Directive]
dirs _) : ss :: [Selection]
ss)
  | Just fr :: FragmentDefinition
fr <- Text -> FragmentMap -> Maybe FragmentDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
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]
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
-> [Selection]
-> 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, KnownName rname,
 ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap (FragmentDefinition -> [Selection]
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
-> [Selection]
-> 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, KnownName rname,
 ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap [Selection]
ss
       else Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> 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, KnownName rname,
 ParseField sch fields) =>
Proxy sch
-> Proxy t
-> VariableMap
-> FragmentMap
-> [Selection]
-> f [OneFieldQuery sch fields]
parseSchemaQuery Proxy sch
pp Proxy t
ps VariableMap
vmap FragmentMap
frmap [Selection]
ss
  | Bool
otherwise  -- the fragment definition was not found
  = 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
$ "fragment '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' was not found"
parseSchemaQuery _ _ _ _ (_ : _)  -- Inline fragments are not yet supported
  = Text -> f [OneFieldQuery sch fields]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "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.Selection] ->
    f (NS (ChosenFieldQuery sch) fs)

instance ParseField sch '[] where
  selectField :: Text
-> VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) '[])
selectField tyName :: Text
tyName _ _ wanted :: Text
wanted _
    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wanted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' 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
<> "'"
instance
  (KnownName fname, ParseField sch fs, ParseSchemaReturn sch r) =>
  ParseField sch ('FieldDef fname r ': fs)
  where
  selectField :: Text
-> VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) ('FieldDef fname r : fs))
selectField tyName :: Text
tyName vmap :: VariableMap
vmap frmap :: FragmentMap
frmap wanted :: Text
wanted sels :: [Selection]
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
-> [Selection]
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
wanted [Selection]
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
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) fs)
forall (sch :: Schema') (fs :: [FieldDef Symbol Symbol])
       (f :: * -> *).
(ParseField sch fs, MonadError Text f) =>
Text
-> VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (NS (ChosenFieldQuery sch) fs)
selectField Text
tyName VariableMap
vmap FragmentMap
frmap Text
wanted [Selection]
sels
    where
      mname :: Text
mname = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy fname -> [Char]
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> [Char]
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.Selection]
                    -> f (ReturnSchemaQuery sch r)

instance ParseSchemaReturn sch ('TPrimitive t) where
  parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch ('TPrimitive t))
parseSchemaReturn _ _ _ []
    = 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 _ _ fname :: Text
fname _
    = 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
$ "field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' should not have a selection of subfields"
instance ( ParseSchema sch (sch :/: sty) )
         => ParseSchemaReturn sch ('TSchematic sty) where
  parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch ('TSchematic sty))
parseSchemaReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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
-> [Selection]
-> f (SchemaQuery sch (sch :/: sty))
forall (s :: Schema') (t :: TypeDefB * Symbol Symbol)
       (f :: * -> *).
(ParseSchema s t, MonadError Text f) =>
VariableMap
-> FragmentMap -> Text -> [Selection] -> f (SchemaQuery s t)
parseSchema VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ParseSchemaReturn sch r
         => ParseSchemaReturn sch ('TList r) where
  parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch ('TList r))
parseSchemaReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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
-> [Selection]
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s
instance ParseSchemaReturn sch r
         => ParseSchemaReturn sch ('TOption r) where
  parseSchemaReturn :: VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch ('TOption r))
parseSchemaReturn vmap :: VariableMap
vmap frmap :: FragmentMap
frmap fname :: Text
fname s :: [Selection]
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
-> [Selection]
-> f (ReturnSchemaQuery sch r)
forall (sch :: Schema') (r :: FieldType Symbol) (f :: * -> *).
(ParseSchemaReturn sch r, MonadError Text f) =>
VariableMap
-> FragmentMap
-> Text
-> [Selection]
-> f (ReturnSchemaQuery sch r)
parseSchemaReturn VariableMap
vmap FragmentMap
frmap Text
fname [Selection]
s

-- some useful field accessors

fdName :: GQL.FragmentDefinition -> GQL.Name
fdName :: FragmentDefinition -> Text
fdName (GQL.FragmentDefinition nm :: Text
nm _ _ _ _) = Text
nm

fdDirectives :: GQL.FragmentDefinition -> [GQL.Directive]
fdDirectives :: FragmentDefinition -> [Directive]
fdDirectives (GQL.FragmentDefinition _ _ ds :: [Directive]
ds _ _) = [Directive]
ds

fdSelectionSet :: GQL.FragmentDefinition -> [GQL.Selection]
fdSelectionSet :: FragmentDefinition -> [Selection]
fdSelectionSet (GQL.FragmentDefinition _ _ _ ss :: NonEmpty Selection
ss _)
  = NonEmpty Selection -> [Selection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty Selection
ss

argName :: GQL.Argument -> GQL.Name
argName :: Argument -> Text
argName (GQL.Argument nm :: Text
nm _ _) = Text
nm

fName :: GQL.Field -> GQL.Name
fName :: Field -> Text
fName (GQL.Field _ nm :: Text
nm _ _ _ _) = Text
nm