{-# language ConstraintKinds       #-}
{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedLists       #-}
{-# language OverloadedStrings     #-}
{-# language PolyKinds             #-}
{-# language RankNTypes            #-}
{-# language ScopedTypeVariables   #-}
{-# language TupleSections         #-}
{-# language TypeApplications      #-}
{-# language TypeFamilies          #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-# OPTIONS_GHC -fprint-explicit-foralls #-}
module Mu.GraphQL.Query.Run (
  GraphQLApp
, runPipeline
, runSubscriptionPipeline
, runDocument
, runQuery
, runSubscription
-- * Typeclass to be able to run query handlers
, RunQueryFindHandler
) where

import           Control.Concurrent.STM.TMQueue
import           Control.Monad.Except           (MonadError, runExceptT)
import           Control.Monad.Writer
import qualified Data.Aeson                     as Aeson
import qualified Data.Aeson.Types               as Aeson
import           Data.Conduit
import           Data.Conduit.Combinators       (sinkList, yieldMany)
import           Data.Conduit.TQueue
import qualified Data.HashMap.Strict            as HM
import           Data.Maybe
import qualified Data.Text                      as T
import           Data.Typeable
import           GHC.TypeLits
import qualified Language.GraphQL.AST           as GQL
import           Network.HTTP.Types.Header
import           Unsafe.Coerce                  (unsafeCoerce)

import           Mu.GraphQL.Query.Definition
import qualified Mu.GraphQL.Query.Introspection as Intro
import           Mu.GraphQL.Query.Parse
import           Mu.Rpc
import           Mu.Schema
import           Mu.Server

data GraphQLError
  = GraphQLError ServerError [T.Text]

type GraphQLApp p qr mut sub m chn hs
  = (ParseTypedDoc p qr mut sub, RunDocument p qr mut sub m chn hs)

runPipeline
  :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs
  => (forall a. m a -> ServerErrorIO a)
  -> RequestHeaders
  -> ServerT chn GQL.Field p m hs
  -> Proxy qr -> Proxy mut -> Proxy sub
  -> Maybe T.Text -> VariableMapC -> [GQL.Definition]
  -> IO Aeson.Value
runPipeline :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> [Definition]
-> IO Value
runPipeline forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Proxy qr
_ Proxy mut
_ Proxy sub
_ Maybe Text
opName VariableMapC
vmap [Definition]
doc
  = case Maybe Text
-> VariableMapC
-> [Definition]
-> Either Text (Document p qr mut sub)
forall (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (p :: Package') (f :: * -> *).
(MonadError Text f, ParseTypedDoc p qr mut sub) =>
Maybe Text
-> VariableMapC -> [Definition] -> f (Document p qr mut sub)
parseDoc @qr @mut @sub Maybe Text
opName VariableMapC
vmap [Definition]
doc of
      Left Text
e -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
singleErrValue Text
e
      Right (Document p qr mut sub
d :: Document p qr mut sub) -> do
        (Value
data_, [GraphQLError]
errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> WriterT [GraphQLError] IO Value
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p qr mut sub
d)
        case [GraphQLError]
errors of
          [] -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value
data_) ]
          [GraphQLError]
_  -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value
data_), (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [GraphQLError]
errors) ]

runSubscriptionPipeline
  :: forall qr mut sub p m chn hs. GraphQLApp p qr mut sub m chn hs
  => (forall a. m a -> ServerErrorIO a)
  -> RequestHeaders
  -> ServerT chn GQL.Field p m hs
  -> Proxy qr -> Proxy mut -> Proxy sub
  -> Maybe T.Text -> VariableMapC -> [GQL.Definition]
  -> ConduitT Aeson.Value Void IO ()
  -> IO ()
runSubscriptionPipeline :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> [Definition]
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionPipeline forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Proxy qr
_ Proxy mut
_ Proxy sub
_ Maybe Text
opName VariableMapC
vmap [Definition]
doc ConduitT Value Void IO ()
sink
  = case Maybe Text
-> VariableMapC
-> [Definition]
-> Either Text (Document p qr mut sub)
forall (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (p :: Package') (f :: * -> *).
(MonadError Text f, ParseTypedDoc p qr mut sub) =>
Maybe Text
-> VariableMapC -> [Definition] -> f (Document p qr mut sub)
parseDoc @qr @mut @sub Maybe Text
opName VariableMapC
vmap [Definition]
doc of
      Left Text
e
        -> Text -> ConduitT Value Void IO () -> IO ()
forall (m :: * -> *).
Monad m =>
Text -> ConduitM Value Void m () -> m ()
yieldSingleError Text
e ConduitT Value Void IO ()
sink
      Right (Document p qr mut sub
d :: Document p qr mut sub)
        -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p qr mut sub
d ConduitT Value Void IO ()
sink

singleErrValue :: T.Text -> Aeson.Value
singleErrValue :: Text -> Value
singleErrValue Text
e
  = [Pair] -> Value
Aeson.object [ (Text
"errors", Array -> Value
Aeson.Array [
                       [Pair] -> Value
Aeson.object [ (Text
"message", Text -> Value
Aeson.String Text
e) ] ])]

errValue :: GraphQLError -> Aeson.Value
errValue :: GraphQLError -> Value
errValue (GraphQLError (ServerError ServerErrorCode
_ String
msg) [Text]
path)
  = [Pair] -> Value
Aeson.object [
      (Text
"message", Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
msg)
    , (Text
"path", [Text] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Text]
path)
    ]

yieldSingleError :: Monad m
                 => T.Text -> ConduitM Aeson.Value Void m () -> m ()
yieldSingleError :: Text -> ConduitM Value Void m () -> m ()
yieldSingleError Text
e ConduitM Value Void m ()
sink =
  ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([Text -> Value
singleErrValue Text
e] :: [Aeson.Value]) ConduitT () Value m ()
-> ConduitM Value Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Value Void m ()
sink

yieldError :: Monad m
           => ServerError -> [T.Text]
           -> ConduitM Aeson.Value Void m () -> m ()
yieldError :: ServerError -> [Text] -> ConduitM Value Void m () -> m ()
yieldError ServerError
e [Text]
path ConduitM Value Void m ()
sink = do
  let val :: Value
val = [Pair] -> Value
Aeson.object [ (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e [Text]
path]) ]
  ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([Value
Item [Value]
val] :: [Aeson.Value]) ConduitT () Value m ()
-> ConduitM Value Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Value Void m ()
sink

class RunDocument (p :: Package')
                  (qr :: Maybe Symbol)
                  (mut :: Maybe Symbol)
                  (sub :: Maybe Symbol)
                  m chn hs where
  runDocument ::
       (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m hs
    -> Document p qr mut sub
    -> WriterT [GraphQLError] IO Aeson.Value
  runDocumentSubscription ::
       (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m hs
    -> Document p qr mut sub
    -> ConduitT Aeson.Value Void IO ()
    -> IO ()

instance
  ( p ~ 'Package pname ss
  , KnownSymbol qr
  , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs
  , MappingRight chn qr ~ ()
  , KnownSymbol mut
  , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs
  , MappingRight chn mut ~ ()
  , KnownSymbol sub
  , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs
  , MappingRight chn sub ~ ()
  , Intro.Introspect p ('Just qr) ('Just mut) ('Just sub)
  ) => RunDocument p ('Just qr) ('Just mut) ('Just sub) m chn hs where
  runDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) ('Just sub)
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) ('Just mut) ('Just sub)
d
    = let i :: Schema
i = Proxy p
-> Proxy ('Just qr)
-> Proxy ('Just mut)
-> Proxy ('Just sub)
-> Schema
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol).
Introspect p qr mut sub =>
Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema
Intro.introspect (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (Proxy ('Just qr)
forall {k} (t :: k). Proxy t
Proxy @('Just qr)) (Proxy ('Just mut)
forall {k} (t :: k). Proxy t
Proxy @('Just mut)) (Proxy ('Just sub)
forall {k} (t :: k). Proxy t
Proxy @('Just sub))
      in case Document p ('Just qr) ('Just mut) ('Just sub)
d of
           QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service qr qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service mut mms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service mut mms)
ServiceQuery ('Package pname ss) (LookupService ss mut)
q
           SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
_
             -> Value -> WriterT [GraphQLError] IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> WriterT [GraphQLError] IO Value)
-> Value -> WriterT [GraphQLError] IO Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
singleErrValue Text
"cannot execute subscriptions in this wire"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
d)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> OneMethodQuery p ('Service sub mms)
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr [] () OneMethodQuery p ('Service sub mms)
OneMethodQuery ('Package pname ss) (LookupService ss sub)
d
  runDocumentSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) ('Just mut) ('Just sub)
d = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) ('Just mut) ('Just sub)
d

instance
  ( p ~ 'Package pname ss
  , KnownSymbol qr
  , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs
  , MappingRight chn qr ~ ()
  , KnownSymbol mut
  , RunQueryFindHandler m p hs chn ss (LookupService ss mut) hs
  , MappingRight chn mut ~ ()
  , Intro.Introspect p ('Just qr) ('Just mut) 'Nothing
  ) => RunDocument p ('Just qr) ('Just mut) 'Nothing m chn hs where
  runDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) 'Nothing
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) ('Just mut) 'Nothing
d
    = let i :: Schema
i = Proxy p
-> Proxy ('Just qr)
-> Proxy ('Just mut)
-> Proxy 'Nothing
-> Schema
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol).
Introspect p qr mut sub =>
Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema
Intro.introspect (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (Proxy ('Just qr)
forall {k} (t :: k). Proxy t
Proxy @('Just qr)) (Proxy ('Just mut)
forall {k} (t :: k). Proxy t
Proxy @('Just mut)) (Proxy 'Nothing
forall {k} (t :: k). Proxy t
Proxy @'Nothing)
      in case Document p ('Just qr) ('Just mut) 'Nothing
d of
           QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service qr qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           MutationDoc ServiceQuery ('Package pname ss) (LookupService ss mut)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service mut mms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service mut mms)
ServiceQuery ('Package pname ss) (LookupService ss mut)
q
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) ('Just mut) 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument

instance
  ( p ~ 'Package pname ss
  , KnownSymbol qr
  , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs
  , MappingRight chn qr ~ ()
  , KnownSymbol sub
  , RunQueryFindHandler m p hs chn ss (LookupService ss sub) hs
  , MappingRight chn sub ~ ()
  , Intro.Introspect p ('Just qr) 'Nothing ('Just sub)
  ) => RunDocument p ('Just qr) 'Nothing ('Just sub) m chn hs where
  runDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing ('Just sub)
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) 'Nothing ('Just sub)
d
    = let i :: Schema
i = Proxy p
-> Proxy ('Just qr)
-> Proxy 'Nothing
-> Proxy ('Just sub)
-> Schema
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol).
Introspect p qr mut sub =>
Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema
Intro.introspect (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (Proxy ('Just qr)
forall {k} (t :: k). Proxy t
Proxy @('Just qr)) (Proxy 'Nothing
forall {k} (t :: k). Proxy t
Proxy @'Nothing) (Proxy ('Just sub)
forall {k} (t :: k). Proxy t
Proxy @('Just sub))
      in case Document p ('Just qr) 'Nothing ('Just sub)
d of
           QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service qr qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
_
             -> Value -> WriterT [GraphQLError] IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> WriterT [GraphQLError] IO Value)
-> Value -> WriterT [GraphQLError] IO Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
singleErrValue Text
"cannot execute subscriptions in this wire"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr (SubscriptionDoc OneMethodQuery ('Package pname ss) (LookupService ss sub)
d)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> OneMethodQuery p ('Service sub mms)
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr [] () OneMethodQuery p ('Service sub mms)
OneMethodQuery ('Package pname ss) (LookupService ss sub)
d
  runDocumentSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) 'Nothing ('Just sub)
d = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) 'Nothing ('Just sub)
d

instance
  ( p ~ 'Package pname ss
  , KnownSymbol qr
  , RunQueryFindHandler m p hs chn ss (LookupService ss qr) hs
  , MappingRight chn qr ~ ()
  , Intro.Introspect p ('Just qr) 'Nothing 'Nothing
  ) => RunDocument p ('Just qr) 'Nothing 'Nothing m chn hs where
  runDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing 'Nothing
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p ('Just qr) 'Nothing 'Nothing
d
    = let i :: Schema
i = Proxy p
-> Proxy ('Just qr) -> Proxy 'Nothing -> Proxy 'Nothing -> Schema
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol).
Introspect p qr mut sub =>
Proxy p -> Proxy qr -> Proxy mut -> Proxy sub -> Schema
Intro.introspect (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (Proxy ('Just qr)
forall {k} (t :: k). Proxy t
Proxy @('Just qr)) (Proxy 'Nothing
forall {k} (t :: k). Proxy t
Proxy @'Nothing) (Proxy 'Nothing
forall {k} (t :: k). Proxy t
Proxy @'Nothing)
      in case Document p ('Just qr) 'Nothing 'Nothing
d of
           QueryDoc ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
i ServerT chn Field p m hs
svr [] () ServiceQuery p ('Service qr qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p ('Just qr) 'Nothing 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument

instance
  ( TypeError ('Text "you need to have a query in your schema")
  ) => RunDocument p 'Nothing mut sub m chn hs where
  runDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p 'Nothing mut sub
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p 'Nothing mut sub
-> WriterT [GraphQLError] IO Value
forall a. HasCallStack => String -> a
error String
"this should never be called"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p 'Nothing mut sub
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p 'Nothing mut sub
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error String
"this should never be called"

yieldDocument ::
     forall p qr mut sub m chn hs.
     RunDocument p qr mut sub m chn hs
  => (forall a. m a -> ServerErrorIO a)
  -> RequestHeaders
  -> ServerT chn GQL.Field p m hs
  -> Document p qr mut sub
  -> ConduitT Aeson.Value Void IO ()
  -> IO ()
yieldDocument :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p qr mut sub
doc ConduitT Value Void IO ()
sink = do
  (Value
data_, [GraphQLError]
errors) <- WriterT [GraphQLError] IO Value -> IO (Value, [GraphQLError])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> WriterT [GraphQLError] IO Value
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
RunDocument p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> Document p qr mut sub
-> WriterT [GraphQLError] IO Value
runDocument @p @qr @mut @sub @m @chn @hs forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
svr Document p qr mut sub
doc)
  let (Value
val :: Aeson.Value)
        = case [GraphQLError]
errors of
            [] -> [Pair] -> Value
Aeson.object [ (Text
"data", Value
data_) ]
            [GraphQLError]
_  -> [Pair] -> Value
Aeson.object [ (Text
"data", Value
data_), (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [GraphQLError]
errors) ]
  ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([Value
Item [Value]
val] :: [Aeson.Value]) ConduitT () Value IO ()
-> ConduitT Value Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Value Void IO ()
sink

runQuery
  :: forall m p s pname ss hs chn inh.
     ( RunQueryFindHandler m p hs chn ss s hs
     , p ~ 'Package pname ss
     , inh ~ MappingRight chn (ServiceName s) )
  => (forall a. m a -> ServerErrorIO a)
  -> RequestHeaders
  -> Intro.Schema -> ServerT chn GQL.Field p m hs
  -> [T.Text]
  -> inh
  -> ServiceQuery p s
  -> WriterT [GraphQLError] IO Aeson.Value
runQuery :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch whole :: ServerT chn Field p m hs
whole@(Services ServicesT chn Field s1 m hs
ss) [Text]
path = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> ServicesT chn Field s1 m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (ss :: [Service snm mnm anm (TypeRef snm)])
       (s :: Service snm mnm anm (TypeRef snm)) (hs :: [[*]])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field ss m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m hs
whole [Text]
path ServicesT chn Field s1 m hs
ss

runSubscription
  :: forall m p s pname ss hs chn inh.
     ( RunQueryFindHandler m p hs chn ss s hs
     , p ~ 'Package pname ss
     , inh ~ MappingRight chn (ServiceName s) )
  => (forall a. m a -> ServerErrorIO a)
  -> RequestHeaders
  -> ServerT chn GQL.Field p m hs
  -> [T.Text]
  -> inh
  -> OneMethodQuery p s
  -> ConduitT Aeson.Value Void IO ()
  -> IO ()
runSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req whole :: ServerT chn Field p m hs
whole@(Services ServicesT chn Field s1 m hs
ss) [Text]
path
  = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m hs
-> [Text]
-> ServicesT chn Field s1 m hs
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (ss :: [Service snm mnm anm (TypeRef snm)])
       (s :: Service snm mnm anm (TypeRef snm)) (hs :: [[*]])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field ss m hs
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m hs
whole [Text]
path ServicesT chn Field s1 m hs
ss

class RunQueryFindHandler m p whole chn ss s hs where
  runQueryFindHandler
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> Intro.Schema -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> ServicesT chn GQL.Field ss m hs
    -> inh
    -> ServiceQuery p s
    -> WriterT [GraphQLError] IO Aeson.Value
  runSubscriptionFindHandler
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> ServicesT chn GQL.Field ss m hs
    -> inh
    -> OneMethodQuery p s
    -> ConduitT Aeson.Value Void IO ()
    -> IO ()

class RunQueryOnFoundHandler m p whole chn (s :: Service snm mnm anm (TypeRef snm)) hs where
  type ServiceName s :: snm
  runQueryOnFoundHandler
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> Intro.Schema -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> ServiceT chn GQL.Field s m hs
    -> inh
    -> ServiceQuery p s
    -> WriterT [GraphQLError] IO Aeson.Value
  runSubscriptionOnFoundHandler
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> ServiceT chn GQL.Field s m hs
    -> inh
    -> OneMethodQuery p s
    -> ConduitT Aeson.Value Void IO ()
    -> IO ()

instance TypeError ('Text "Could not find handler for " ':<>: 'ShowType s)
         => RunQueryFindHandler m p whole chn '[] s '[] where
  runQueryFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field '[] m '[]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field '[] m '[]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall a. HasCallStack => String -> a
error String
"this should never be called"
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field '[] m '[]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field '[] m '[]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error String
"this should never be called"
instance {-# OVERLAPPABLE #-}
         RunQueryFindHandler m p whole chn ss s hs
         => RunQueryFindHandler m p whole chn (other ': ss) s (h ': hs) where
  runQueryFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field (other : ss) m (h : hs)
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path (ServiceT chn Field svc m hs1
_ :<&>: ServicesT chn Field rest m hss
that)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field rest m hss
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (ss :: [Service snm mnm anm (TypeRef snm)])
       (s :: Service snm mnm anm (TypeRef snm)) (hs :: [[*]])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field ss m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path ServicesT chn Field rest m hss
that
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field (other : ss) m (h : hs)
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (ServiceT chn Field svc m hs1
_ :<&>: ServicesT chn Field rest m hss
that)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field rest m hss
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (ss :: [Service snm mnm anm (TypeRef snm)])
       (s :: Service snm mnm anm (TypeRef snm)) (hs :: [[*]])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field ss m hs
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ServicesT chn Field rest m hss
that
instance {-# OVERLAPS #-}
         (RunQueryOnFoundHandler m p whole chn s h)
         => RunQueryFindHandler m p whole chn (s ': ss) s (h ': hs) where
  runQueryFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field (s : ss) m (h : hs)
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path (ServiceT chn Field svc m hs1
s :<&>: ServicesT chn Field rest m hss
_)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field svc m hs1
-> inh
-> ServiceQuery p svc
-> WriterT [GraphQLError] IO Value
forall snm mnm anm (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (hs :: [*]) (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryOnFoundHandler m p whole chn s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field s m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryOnFoundHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path ServiceT chn Field svc m hs1
s
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServicesT chn Field (s : ss) m (h : hs)
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (ServiceT chn Field svc m hs1
s :<&>: ServicesT chn Field rest m hss
_)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field svc m hs1
-> inh
-> OneMethodQuery p svc
-> ConduitT Value Void IO ()
-> IO ()
forall snm mnm anm (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (hs :: [*]) (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunQueryOnFoundHandler m p whole chn s hs,
 p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field s m hs
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ServiceT chn Field svc m hs1
s

instance ( KnownName sname, RunMethod m p whole chn ('Service sname ms) ms h )
         => RunQueryOnFoundHandler m p whole chn ('Service sname ms) h where
  type ServiceName ('Service sname ms) = sname
  runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field ('Service sname ms) m h
-> inh
-> ServiceQuery p ('Service sname ms)
-> WriterT [GraphQLError] IO Value
runQueryOnFoundHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h
this) inh
inh (ServiceQuery [OneMethodQuery p ('Service nm ms)]
queries)
    = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> Value)
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OneMethodQuery p ('Service nm ms)
 -> WriterT [GraphQLError] IO (Maybe Pair))
-> [OneMethodQuery p ('Service nm ms)]
-> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OneMethodQuery p ('Service nm ms)
-> WriterT [GraphQLError] IO (Maybe Pair)
runOneQuery [OneMethodQuery p ('Service nm ms)]
queries
    where
      -- if we include the signature we have to write
      -- an explicit type signature for 'runQueryFindHandler'
      runOneQuery :: OneMethodQuery p ('Service nm ms)
-> WriterT [GraphQLError] IO (Maybe Pair)
runOneQuery (OneMethodQuery Maybe Text
nm NS (ChosenMethodQuery p) ms
args)
        = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy ('Service sname ms)
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh methods m h
-> NS (ChosenMethodQuery p) methods
-> WriterT [GraphQLError] IO (Maybe Pair)
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [*])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunMethod m p whole chn s ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole (Proxy ('Service sname ms)
forall {k} (t :: k). Proxy t
Proxy @('Service sname ms)) [Text]
path Maybe Text
nm inh
inh HandlersT chn Field inh methods m h
HandlersT chn Field (MappingRight chn sname) methods m h
this NS (ChosenMethodQuery p) methods
NS (ChosenMethodQuery p) ms
args
      -- handle __typename
      runOneQuery (TypeNameQuery Maybe Text
nm)
        = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"__typename" Maybe Text
nm
          in Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair))
-> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall a b. (a -> b) -> a -> b
$ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
realName, Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy sname
forall {k} (t :: k). Proxy t
Proxy @sname))
      -- handle __schema
      runOneQuery (SchemaQuery Maybe Text
nm [Selection]
ss)
        = do let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"__schema" Maybe Text
nm
             Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> (Value -> Pair) -> Value -> Maybe Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
realName, ) (Value -> Maybe Pair)
-> WriterT [GraphQLError] IO Value
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Schema -> [Selection] -> WriterT [GraphQLError] IO Value
runIntroSchema [Text]
path Schema
sch [Selection]
ss
      -- handle __type
      runOneQuery (TypeQuery Maybe Text
nm Text
ty [Selection]
ss)
        = do let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"__schema" Maybe Text
nm
             Maybe Value
res <- [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path Schema
sch (Text -> Type
Intro.TypeRef Text
ty) [Selection]
ss
             case Maybe Value
res of
               Just Value
val -> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair))
-> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall a b. (a -> b) -> a -> b
$ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
realName, Value
val)
               Maybe Value
Nothing  -> do [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                                     (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                                       (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"cannot find type '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
ty String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'")
                                    [Text]
path]
                              Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair))
-> Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall a b. (a -> b) -> a -> b
$ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
realName, Value
Aeson.Null)
  -- subscriptions should only have one element
  runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field ('Service sname ms) m h
-> inh
-> OneMethodQuery p ('Service sname ms)
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (ProperSvc HandlersT chn Field (MappingRight chn sname) methods m h
this) inh
inh (OneMethodQuery Maybe Text
nm NS (ChosenMethodQuery p) ms
args) ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy ('Service sname ms)
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh methods m h
-> NS (ChosenMethodQuery p) methods
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [*])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunMethod m p whole chn s ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole (Proxy ('Service sname ms)
forall {k} (t :: k). Proxy t
Proxy @('Service sname ms)) [Text]
path Maybe Text
nm inh
inh HandlersT chn Field inh methods m h
HandlersT chn Field (MappingRight chn sname) methods m h
this NS (ChosenMethodQuery p) methods
NS (ChosenMethodQuery p) ms
args ConduitT Value Void IO ()
sink
  runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ ServiceT chn Field ('Service sname ms) m h
_ inh
_ (TypeNameQuery Maybe Text
nm) ConduitT Value Void IO ()
sink
    = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"__typename" Maybe Text
nm
          o :: Value
o = [Pair] -> Value
Aeson.object [(Text
realName, Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy sname
forall {k} (t :: k). Proxy t
Proxy @sname))]
      in ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([Value
Item [Value]
o] :: [Aeson.Value]) ConduitT () Value IO ()
-> ConduitT Value Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Value Void IO ()
sink
  runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ ServiceT chn Field ('Service sname ms) m h
_ inh
_ OneMethodQuery p ('Service sname ms)
_ ConduitT Value Void IO ()
sink
    = ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany
                   ([Text -> Value
singleErrValue Text
"__schema and __type are not supported in subscriptions"]
                      :: [Aeson.Value])
                   ConduitT () Value IO ()
-> ConduitT Value Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Value Void IO ()
sink

instance ( KnownName sname, RunUnion m p whole chn elts )
         => RunQueryOnFoundHandler m p whole chn ('OneOf sname elts) h where
  type ServiceName ('OneOf sname elts) = sname
  runQueryOnFoundHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field ('OneOf sname elts) m h
-> inh
-> ServiceQuery p ('OneOf sname elts)
-> WriterT [GraphQLError] IO Value
runQueryOnFoundHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path (OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts)
this) inh
inh (OneOfQuery NP (ChosenOneOfQuery p) elts
queries)
    = do Either ServerError (UnionChoice chn elts)
res <- IO (Either ServerError (UnionChoice chn elts))
-> WriterT
     [GraphQLError] IO (Either ServerError (UnionChoice chn elts))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError (UnionChoice chn elts))
 -> WriterT
      [GraphQLError] IO (Either ServerError (UnionChoice chn elts)))
-> IO (Either ServerError (UnionChoice chn elts))
-> WriterT
     [GraphQLError] IO (Either ServerError (UnionChoice chn elts))
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO (UnionChoice chn elts)
-> IO (Either ServerError (UnionChoice chn elts))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ServerError IO (UnionChoice chn elts)
 -> IO (Either ServerError (UnionChoice chn elts)))
-> ExceptT ServerError IO (UnionChoice chn elts)
-> IO (Either ServerError (UnionChoice chn elts))
forall a b. (a -> b) -> a -> b
$ m (UnionChoice chn elts)
-> ExceptT ServerError IO (UnionChoice chn elts)
forall a. m a -> ServerErrorIO a
f (m (UnionChoice chn elts)
 -> ExceptT ServerError IO (UnionChoice chn elts))
-> m (UnionChoice chn elts)
-> ExceptT ServerError IO (UnionChoice chn elts)
forall a b. (a -> b) -> a -> b
$ MappingRight chn sname -> m (UnionChoice chn elts)
this inh
MappingRight chn sname
inh
         case Either ServerError (UnionChoice chn elts)
res of
          Left ServerError
e  -> [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e [Text]
path] WriterT [GraphQLError] IO ()
-> WriterT [GraphQLError] IO Value
-> WriterT [GraphQLError] IO Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> WriterT [GraphQLError] IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Aeson.Null
          Right UnionChoice chn elts
x -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) elts
-> UnionChoice chn elts
-> WriterT [GraphQLError] IO Value
forall {a} {methodName} {argName} (m :: * -> *)
       (p :: Package a methodName argName (TypeRef a)) (whole :: [[*]])
       (chn :: ServiceChain a) (elts :: [a]).
RunUnion m p whole chn elts =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) elts
-> UnionChoice chn elts
-> WriterT [GraphQLError] IO Value
runUnion forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path NP (ChosenOneOfQuery p) elts
queries UnionChoice chn elts
UnionChoice chn elts
x
  runSubscriptionOnFoundHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ServiceT chn Field ('OneOf sname elts) m h
-> inh
-> OneMethodQuery p ('OneOf sname elts)
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionOnFoundHandler forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ (OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts)
_) inh
_ OneMethodQuery p ('OneOf sname elts)
_ ConduitT Value Void IO ()
_
    = String -> IO ()
forall a. HasCallStack => String -> a
error String
"this should never happen"

class RunUnion m p whole chn elts where
  runUnion
    :: (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> Intro.Schema -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> NP (ChosenOneOfQuery p) elts
    -> UnionChoice chn elts
    -> WriterT [GraphQLError] IO Aeson.Value

instance RunUnion m p whole chn '[] where
  runUnion :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) '[]
-> UnionChoice chn '[]
-> WriterT [GraphQLError] IO Value
runUnion forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) '[]
-> UnionChoice chn '[]
-> WriterT [GraphQLError] IO Value
forall a. HasCallStack => String -> a
error String
"this should never happen"
instance forall m p pname s sname whole ss chn elts.
         ( RunQueryFindHandler m p whole chn ss s whole
         , p ~ 'Package pname ss
         , s ~ LookupService ss sname
         , ServiceName s ~ sname
         , RunUnion m p whole chn elts )
         => RunUnion m p whole chn (sname ': elts) where
  runUnion :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) (sname : elts)
-> UnionChoice chn (sname : elts)
-> WriterT [GraphQLError] IO Value
runUnion forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path
           (ChosenOneOfQuery (Proxy :: Proxy sname) ServiceQuery ('Package pname ss) (LookupService ss x)
q :* NP (ChosenOneOfQuery p) xs
rest)
           choice :: UnionChoice chn (sname : elts)
choice@(UnionChoice (Proxy elt
Proxy :: Proxy other) MappingRight chn elt
v)
    = case (Typeable sname, Typeable elt) => Maybe (sname :~: elt)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @sname @other of
        Maybe (sname :~: elt)
Nothing   -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) xs
-> UnionChoice chn xs
-> WriterT [GraphQLError] IO Value
forall {a} {methodName} {argName} (m :: * -> *)
       (p :: Package a methodName argName (TypeRef a)) (whole :: [[*]])
       (chn :: ServiceChain a) (elts :: [a]).
RunUnion m p whole chn elts =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m whole
-> [Text]
-> NP (ChosenOneOfQuery p) elts
-> UnionChoice chn elts
-> WriterT [GraphQLError] IO Value
runUnion forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
whole [Text]
path NP (ChosenOneOfQuery p) xs
rest (UnionChoice chn (sname : elts) -> UnionChoice chn xs
forall a b. a -> b
unsafeCoerce UnionChoice chn (sname : elts)
choice)
        Just sname :~: elt
Refl -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field ('Package pname ss) m whole
-> [Text]
-> MappingRight chn sname
-> ServiceQuery ('Package pname ss) (LookupService ss sname)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery @m @('Package pname ss) @(LookupService ss sname) @pname @ss @whole forall a. m a -> ServerErrorIO a
f RequestHeaders
req Schema
sch ServerT chn Field p m whole
ServerT chn Field ('Package pname ss) m whole
whole [Text]
path MappingRight chn sname
MappingRight chn elt
v ServiceQuery ('Package pname ss) (LookupService ss sname)
ServiceQuery ('Package pname ss) (LookupService ss x)
q

class RunMethod m p whole chn s ms hs where
  runMethod
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> Proxy s -> [T.Text] -> Maybe T.Text -> inh
    -> HandlersT chn GQL.Field inh ms m hs
    -> NS (ChosenMethodQuery p) ms
    -> WriterT [GraphQLError] IO (Maybe (T.Text, Aeson.Value))
  runMethodSubscription
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn (ServiceName s) )
    => (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> Proxy s -> [T.Text] -> Maybe T.Text -> inh
    -> HandlersT chn GQL.Field inh ms m hs
    -> NS (ChosenMethodQuery p) ms
    -> ConduitT Aeson.Value Void IO ()
    -> IO ()

instance RunMethod m p whole chn s '[] '[] where
  runMethod :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> WriterT [GraphQLError] IO (Maybe Pair)
forall a. HasCallStack => String -> a
error String
"this should never be called"
  runMethodSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
_ = String
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error String
"this should never be called"
instance ( RunMethod m p whole chn s ms hs
         , KnownName mname
         , RunHandler m p whole chn args r h
         , ReflectRpcInfo p s ('Method mname args r) )
         => RunMethod m p whole chn s ('Method mname args r ': ms) (h ': hs) where
  -- handle normal methods
  runMethod :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ('Method mname args r : ms) m (h : hs)
-> NS (ChosenMethodQuery p) ('Method mname args r : ms)
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
_ [Text]
path Maybe Text
nm inh
inh (RpcInfo Field -> inh -> h
h :<||>: HandlersT chn Field inh ms m hs
_) (Z (ChosenMethodQuery Field
fld NP (ArgumentValue p) args
args ReturnQuery p r
ret))
    = ((Text
realName ,) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Value -> Maybe Pair)
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]) (RpcInfo Field -> inh -> h
h RpcInfo Field
rpcInfo inh
inh) NP (ArgumentValue p) args
args ReturnQuery p r
ret
    where realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy mname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy mname
forall {k} (t :: k). Proxy t
Proxy @mname)) Maybe Text
nm
          rpcInfo :: RpcInfo Field
rpcInfo = Proxy p
-> Proxy s
-> Proxy ('Method mname args r)
-> RequestHeaders
-> Field
-> RpcInfo Field
forall (p :: Package')
       (s :: Service Symbol Symbol Symbol (TypeRef Symbol))
       (m :: Method Symbol Symbol Symbol (TypeRef Symbol)) i.
ReflectRpcInfo p s m =>
Proxy p -> Proxy s -> Proxy m -> RequestHeaders -> i -> RpcInfo i
reflectRpcInfo (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (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)) RequestHeaders
req Field
fld
  runMethod forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh (RpcInfo Field -> inh -> h
_ :<||>: HandlersT chn Field inh ms m hs
r) (S NS (ChosenMethodQuery p) xs
cont)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [*])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunMethod m p whole chn s ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh HandlersT chn Field inh ms m hs
r NS (ChosenMethodQuery p) ms
NS (ChosenMethodQuery p) xs
cont
  runMethod forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ Proxy s
_ [Text]
_ Maybe Text
_ inh
_ HandlersT chn Field inh ('Method mname args r : ms) m (h : hs)
_ NS (ChosenMethodQuery p) ('Method mname args r : ms)
_ = String -> WriterT [GraphQLError] IO (Maybe Pair)
forall a. HasCallStack => String -> a
error String
"this should never happen"
  -- handle subscriptions
  runMethodSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ('Method mname args r : ms) m (h : hs)
-> NS (ChosenMethodQuery p) ('Method mname args r : ms)
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
_ [Text]
path Maybe Text
nm inh
inh (RpcInfo Field -> inh -> h
h :<||>: HandlersT chn Field inh ms m hs
_) (Z (ChosenMethodQuery Field
fld NP (ArgumentValue p) args
args ReturnQuery p r
ret)) ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]) (RpcInfo Field -> inh -> h
h RpcInfo Field
rpcInfo inh
inh) NP (ArgumentValue p) args
args ReturnQuery p r
ret ConduitT Value Void IO ()
sink
    where realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy mname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy mname
forall {k} (t :: k). Proxy t
Proxy @mname)) Maybe Text
nm
          rpcInfo :: RpcInfo Field
rpcInfo = Proxy p
-> Proxy s
-> Proxy ('Method mname args r)
-> RequestHeaders
-> Field
-> RpcInfo Field
forall (p :: Package')
       (s :: Service Symbol Symbol Symbol (TypeRef Symbol))
       (m :: Method Symbol Symbol Symbol (TypeRef Symbol)) i.
ReflectRpcInfo p s m =>
Proxy p -> Proxy s -> Proxy m -> RequestHeaders -> i -> RpcInfo i
reflectRpcInfo (Proxy p
forall {k} (t :: k). Proxy t
Proxy @p) (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)) RequestHeaders
req Field
fld
  runMethodSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh (RpcInfo Field -> inh -> h
_ :<||>: HandlersT chn Field inh ms m hs
r) (S NS (ChosenMethodQuery p) xs
cont) ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: Mappings snm *) (s :: Service snm mnm anm (TypeRef snm))
       (ms :: [Method snm mnm anm (TypeRef snm)]) (hs :: [*])
       (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm (TypeRef snm)]) inh.
(RunMethod m p whole chn s ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn Field inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh HandlersT chn Field inh ms m hs
r NS (ChosenMethodQuery p) ms
NS (ChosenMethodQuery p) xs
cont ConduitT Value Void IO ()
sink
  runMethodSubscription forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ Proxy s
_ [Text]
_ Maybe Text
_ inh
_ HandlersT chn Field inh ('Method mname args r : ms) m (h : hs)
_ NS (ChosenMethodQuery p) ('Method mname args r : ms)
_ ConduitT Value Void IO ()
_ = String -> IO ()
forall a. HasCallStack => String -> a
error String
"this should never happen"

class Handles chn args r m h
      => RunHandler m p whole chn args r h where
  runHandler
    :: (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> h
    -> NP (ArgumentValue p) args
    -> ReturnQuery p r
    -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
  runHandlerSubscription
    :: (forall a. m a -> ServerErrorIO a)
    -> RequestHeaders
    -> ServerT chn GQL.Field p m whole
    -> [T.Text]
    -> h
    -> NP (ArgumentValue p) args
    -> ReturnQuery p r
    -> ConduitT Aeson.Value Void IO ()
    -> IO ()

instance (ArgumentConversion chn ref t, RunHandler m p whole chn rest r h)
         => RunHandler m p whole chn ('ArgSingle aname ref ': rest) r (t -> h) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (t -> h)
-> NP (ArgumentValue p) ('ArgSingle aname ref : rest)
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path t -> h
h (ArgumentValue ArgumentValue' p r
one :* NP (ArgumentValue p) xs
rest)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) xs
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (t -> h
h (Proxy chn -> ArgumentValue' p r -> t
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg (Proxy chn
forall {k} (t :: k). Proxy t
Proxy @chn) ArgumentValue' p r
one)) NP (ArgumentValue p) xs
rest
  runHandlerSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (t -> h)
-> NP (ArgumentValue p) ('ArgSingle aname ref : rest)
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path t -> h
h (ArgumentValue ArgumentValue' p r
one :* NP (ArgumentValue p) xs
rest)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) xs
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (t -> h
h (Proxy chn -> ArgumentValue' p r -> t
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg (Proxy chn
forall {k} (t :: k). Proxy t
Proxy @chn) ArgumentValue' p r
one)) NP (ArgumentValue p) xs
rest
instance ( MonadError ServerError m
         , FromRef chn ref t
         , ArgumentConversion chn ('ListRef ref) [t]
         , RunHandler m p whole chn rest r h )
         => RunHandler m p whole chn ('ArgStream aname ref ': rest) r (ConduitT () t m () -> h) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (ConduitT () t m () -> h)
-> NP (ArgumentValue p) ('ArgStream aname ref : rest)
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ConduitT () t m () -> h
h (ArgumentStream ArgumentValue' p ('ListRef r)
lst :* NP (ArgumentValue p) xs
rest)
    = let [t]
converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t]
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg (Proxy chn
forall {k} (t :: k). Proxy t
Proxy @chn) ArgumentValue' p ('ListRef r)
lst
      in (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) xs
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (ConduitT () t m () -> h
h ([t] -> ConduitT () (Element [t]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [t]
converted)) NP (ArgumentValue p) xs
rest
  runHandlerSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (ConduitT () t m () -> h)
-> NP (ArgumentValue p) ('ArgStream aname ref : rest)
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ConduitT () t m () -> h
h (ArgumentStream ArgumentValue' p ('ListRef r)
lst :* NP (ArgumentValue p) xs
rest) ReturnQuery p r
sink
    = let [t]
converted :: [t] = Proxy chn -> ArgumentValue' p ('ListRef r) -> [t]
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg (Proxy chn
forall {k} (t :: k). Proxy t
Proxy @chn) ArgumentValue' p ('ListRef r)
lst
      in (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) xs
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (r :: Return snm (TypeRef snm)) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> h
-> NP (ArgumentValue p) args
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (ConduitT () t m () -> h
h ([t] -> ConduitT () (Element [t]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [t]
converted)) NP (ArgumentValue p) xs
rest ReturnQuery p r
sink
instance (MonadError ServerError m)
         => RunHandler m p whole chn '[] 'RetNothing (m ()) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> m ()
-> NP (ArgumentValue p) '[]
-> ReturnQuery p 'RetNothing
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
_req ServerT chn Field p m whole
_ [Text]
path m ()
h NP (ArgumentValue p) '[]
Nil ReturnQuery p 'RetNothing
_ = do
    Either ServerError ()
res <- IO (Either ServerError ())
-> WriterT [GraphQLError] IO (Either ServerError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError ())
 -> WriterT [GraphQLError] IO (Either ServerError ()))
-> IO (Either ServerError ())
-> WriterT [GraphQLError] IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO () -> IO (Either ServerError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (m () -> ExceptT ServerError IO ()
forall a. m a -> ServerErrorIO a
f m ()
h)
    case Either ServerError ()
res of
      Right ()
_ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
      Left ServerError
e  -> [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e [Text]
path] WriterT [GraphQLError] IO ()
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Value)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
  runHandlerSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> m ()
-> NP (ArgumentValue p) '[]
-> ReturnQuery p 'RetNothing
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
_req ServerT chn Field p m whole
_ [Text]
path m ()
h NP (ArgumentValue p) '[]
Nil ReturnQuery p 'RetNothing
_ ConduitT Value Void IO ()
sink = do
    Either ServerError ()
res <- IO (Either ServerError ()) -> IO (Either ServerError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError ()) -> IO (Either ServerError ()))
-> IO (Either ServerError ()) -> IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO () -> IO (Either ServerError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (m () -> ExceptT ServerError IO ()
forall a. m a -> ServerErrorIO a
f m ()
h)
    case Either ServerError ()
res of
      Right ()
_ -> ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([] :: [Aeson.Value]) ConduitT () Value IO ()
-> ConduitT Value Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Value Void IO ()
sink
      Left ServerError
e  -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO ()
forall (m :: * -> *).
Monad m =>
ServerError -> [Text] -> ConduitM Value Void m () -> m ()
yieldError ServerError
e [Text]
path ConduitT Value Void IO ()
sink
instance (MonadError ServerError m, ResultConversion m p whole chn r l)
         => RunHandler m p whole chn '[] ('RetSingle r) (m l) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> m l
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetSingle r)
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path m l
h NP (ArgumentValue p) '[]
Nil (RSingle ReturnQuery' p r
q) = do
    Either ServerError l
res <- IO (Either ServerError l)
-> WriterT [GraphQLError] IO (Either ServerError l)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError l)
 -> WriterT [GraphQLError] IO (Either ServerError l))
-> IO (Either ServerError l)
-> WriterT [GraphQLError] IO (Either ServerError l)
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO l -> IO (Either ServerError l)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (m l -> ExceptT ServerError IO l
forall a. m a -> ServerErrorIO a
f m l
h)
    case Either ServerError l
res of
      Right l
v -> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q l
v
      Left ServerError
e  -> [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e [Text]
path] WriterT [GraphQLError] IO ()
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Value)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
  runHandlerSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> m l
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetSingle r)
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path m l
h NP (ArgumentValue p) '[]
Nil (RSingle ReturnQuery' p r
q) ConduitT Value Void IO ()
sink = do
    Either ServerError l
res <- IO (Either ServerError l) -> IO (Either ServerError l)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError l) -> IO (Either ServerError l))
-> IO (Either ServerError l) -> IO (Either ServerError l)
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO l -> IO (Either ServerError l)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (m l -> ExceptT ServerError IO l
forall a. m a -> ServerErrorIO a
f m l
h)
    Value
val <- case Either ServerError l
res of
      Right l
v -> do
        (Maybe Value
data_, [GraphQLError]
errors) <- WriterT [GraphQLError] IO (Maybe Value)
-> IO (Maybe Value, [GraphQLError])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q l
v)
        case [GraphQLError]
errors of
          [] -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_) ]
          [GraphQLError]
_  -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_)
                                    , (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [GraphQLError]
errors) ]
      Left ServerError
e -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e [Text]
path]) ]
    ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Value] -> ConduitT () (Element [Value]) IO ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany ([Value
Item [Value]
val] :: [Aeson.Value]) ConduitT () Value IO ()
-> ConduitT Value Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Value Void IO ()
sink
instance (MonadIO m, MonadError ServerError m, ResultConversion m p whole chn r l)
         => RunHandler m p whole chn '[] ('RetStream r) (ConduitT l Void m () -> m ()) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (ConduitT l Void m () -> m ())
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetStream r)
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ConduitT l Void m () -> m ()
h NP (ArgumentValue p) '[]
Nil (RStream ReturnQuery' p r
q) = do
    TMQueue l
queue <- IO (TMQueue l) -> WriterT [GraphQLError] IO (TMQueue l)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMQueue l)
forall a. IO (TMQueue a)
newTMQueueIO
    Either ServerError ()
res <- IO (Either ServerError ())
-> WriterT [GraphQLError] IO (Either ServerError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError ())
 -> WriterT [GraphQLError] IO (Either ServerError ()))
-> IO (Either ServerError ())
-> WriterT [GraphQLError] IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO () -> IO (Either ServerError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ServerError IO () -> IO (Either ServerError ()))
-> ExceptT ServerError IO () -> IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ m () -> ExceptT ServerError IO ()
forall a. m a -> ServerErrorIO a
f (m () -> ExceptT ServerError IO ())
-> m () -> ExceptT ServerError IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT l Void m () -> m ()
h (TMQueue l -> ConduitT l Void m ()
forall (m :: * -> *) a z.
MonadIO m =>
TMQueue a -> ConduitT a z m ()
sinkTMQueue TMQueue l
queue)
    case Either ServerError ()
res of
      Right ()
_ -> do
        [l]
info <- ConduitT () Void (WriterT [GraphQLError] IO) [l]
-> WriterT [GraphQLError] IO [l]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (WriterT [GraphQLError] IO) [l]
 -> WriterT [GraphQLError] IO [l])
-> ConduitT () Void (WriterT [GraphQLError] IO) [l]
-> WriterT [GraphQLError] IO [l]
forall a b. (a -> b) -> a -> b
$ TMQueue l -> ConduitT () l (WriterT [GraphQLError] IO) ()
forall (m :: * -> *) a z.
MonadIO m =>
TMQueue a -> ConduitT z a m ()
sourceTMQueue TMQueue l
queue ConduitT () l (WriterT [GraphQLError] IO) ()
-> ConduitM l Void (WriterT [GraphQLError] IO) [l]
-> ConduitT () Void (WriterT [GraphQLError] IO) [l]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM l Void (WriterT [GraphQLError] IO) [l]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
        Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> ([Maybe Value] -> Value) -> [Maybe Value] -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value)
-> ([Maybe Value] -> [Value]) -> [Maybe Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Value] -> [Value]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Value] -> Maybe Value)
-> WriterT [GraphQLError] IO [Maybe Value]
-> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (l -> WriterT [GraphQLError] IO (Maybe Value))
-> [l] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q) [l]
info
      Left ServerError
e  -> [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError ServerError
e []] WriterT [GraphQLError] IO ()
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Value)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
  runHandlerSubscription :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> (ConduitT l Void m () -> m ())
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetStream r)
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ConduitT l Void m () -> m ()
h NP (ArgumentValue p) '[]
Nil (RStream ReturnQuery' p r
q) ConduitT Value Void IO ()
sink = do
    Either ServerError ()
res <- IO (Either ServerError ()) -> IO (Either ServerError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError ()) -> IO (Either ServerError ()))
-> IO (Either ServerError ()) -> IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ ExceptT ServerError IO () -> IO (Either ServerError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ServerError IO () -> IO (Either ServerError ()))
-> ExceptT ServerError IO () -> IO (Either ServerError ())
forall a b. (a -> b) -> a -> b
$ m () -> ExceptT ServerError IO ()
forall a. m a -> ServerErrorIO a
f (m () -> ExceptT ServerError IO ())
-> m () -> ExceptT ServerError IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT l Void m () -> m ()
h
      ((forall a. IO a -> m a)
-> ConduitT l Void IO () -> ConduitT l Void m ()
forall (m :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
transPipe forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((l -> IO Value)
-> (Value -> IO (Maybe l))
-> ConduitT Value Void IO ()
-> ConduitT l Void IO ()
forall (m :: * -> *) i1 i2 o r.
Monad m =>
(i1 -> m i2)
-> (i2 -> m (Maybe i1)) -> ConduitT i2 o m r -> ConduitT i1 o m r
mapInputM l -> IO Value
convert (String -> Value -> IO (Maybe l)
forall a. HasCallStack => String -> a
error String
"this should not be called") ConduitT Value Void IO ()
sink))
    case Either ServerError ()
res of
      Right ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Left ServerError
e  -> ServerError -> [Text] -> ConduitT Value Void IO () -> IO ()
forall (m :: * -> *).
Monad m =>
ServerError -> [Text] -> ConduitM Value Void m () -> m ()
yieldError ServerError
e [Text]
path ConduitT Value Void IO ()
sink
    where
      convert :: l -> IO Aeson.Value
      convert :: l -> IO Value
convert l
v = do
        (Maybe Value
data_, [GraphQLError]
errors) <- WriterT [GraphQLError] IO (Maybe Value)
-> IO (Maybe Value, [GraphQLError])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q l
v)
        case [GraphQLError]
errors of
          [] -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_) ]
          [GraphQLError]
_  -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [ (Text
"data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_)
                                    , (Text
"errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [GraphQLError]
errors) ]

class FromRef chn ref t
      => ArgumentConversion chn ref t where
  convertArg :: Proxy chn -> ArgumentValue' p ref -> t
instance ArgumentConversion chn ('PrimitiveRef s) s where
  convertArg :: Proxy chn -> ArgumentValue' p ('PrimitiveRef s) -> s
convertArg Proxy chn
_ (ArgPrimitive t
x) = s
t
x
instance FromSchema sch sty t
         => ArgumentConversion chn ('SchemaRef sch sty) t where
  convertArg :: Proxy chn -> ArgumentValue' p ('SchemaRef sch sty) -> t
convertArg Proxy chn
_ (ArgSchema Term sch (sch :/: sty)
x) = Term sch (sch :/: sty) -> t
forall typeName fieldName (sch :: Schema typeName fieldName)
       (sty :: typeName) t.
FromSchema sch sty t =>
Term sch (sch :/: sty) -> t
fromSchema Term sch (sch :/: sty)
Term sch (sch :/: sty)
x
instance ArgumentConversion chn ref t
         => ArgumentConversion chn ('ListRef ref) [t] where
  convertArg :: Proxy chn -> ArgumentValue' p ('ListRef ref) -> [t]
convertArg Proxy chn
p (ArgList [ArgumentValue' p r]
x) = Proxy chn -> ArgumentValue' p r -> t
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg Proxy chn
p (ArgumentValue' p r -> t) -> [ArgumentValue' p r] -> [t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ArgumentValue' p r]
x
instance ArgumentConversion chn ref t
         => ArgumentConversion chn ('OptionalRef ref) (Maybe t) where
  convertArg :: Proxy chn -> ArgumentValue' p ('OptionalRef ref) -> Maybe t
convertArg Proxy chn
p (ArgOptional Maybe (ArgumentValue' p r)
x) = Proxy chn -> ArgumentValue' p r -> t
forall {snm} (chn :: ServiceChain snm) (ref :: TypeRef snm) t {mnm}
       {anm} (p :: Package snm mnm anm (TypeRef snm)).
ArgumentConversion chn ref t =>
Proxy chn -> ArgumentValue' p ref -> t
convertArg Proxy chn
p (ArgumentValue' p r -> t) -> Maybe (ArgumentValue' p r) -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ArgumentValue' p r)
x

class ToRef chn r l => ResultConversion m p whole chn r l where
  convertResult :: (forall a. m a -> ServerErrorIO a)
                -> RequestHeaders
                -> ServerT chn GQL.Field p m whole
                -> [T.Text]
                -> ReturnQuery' p r
                -> l -> WriterT [GraphQLError] IO (Maybe Aeson.Value)

instance Aeson.ToJSON t => ResultConversion m p whole chn ('PrimitiveRef t) t where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p ('PrimitiveRef t)
-> t
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ ReturnQuery' p ('PrimitiveRef t)
RetPrimitive = Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> (t -> Maybe Value)
-> t
-> WriterT [GraphQLError] IO (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (t -> Value) -> t -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON
instance ( ToSchema sch l r
         , RunSchemaQuery sch (sch :/: l) )
         => ResultConversion m p whole chn ('SchemaRef sch l) r where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p ('SchemaRef sch l)
-> r
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ (RetSchema SchemaQuery sch (sch :/: sty)
r) r
t
    = Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Term sch (sch :/: l) -> SchemaQuery sch (sch :/: l) -> Value
forall {tn} {fn} (sch :: Schema tn fn) (r :: TypeDef tn fn).
RunSchemaQuery sch r =>
Term sch r -> SchemaQuery sch r -> Value
runSchemaQuery (r -> Term sch (sch :/: l)
forall fn tn (sch :: Schema tn fn) t (sty :: tn).
ToSchema sch sty t =>
t -> Term sch (sch :/: sty)
toSchema' @_ @_ @sch @r r
t) SchemaQuery sch (sch :/: l)
SchemaQuery sch (sch :/: sty)
r
instance ( MappingRight chn ref ~ t
         , MappingRight chn (ServiceName svc) ~ t
         , LookupService ss ref ~ svc
         , RunQueryFindHandler m ('Package pname ss) whole chn ss svc whole)
         => ResultConversion m ('Package pname ss) whole chn ('ObjectRef ref) t where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field ('Package pname ss) m whole
-> [Text]
-> ReturnQuery' ('Package pname ss) ('ObjectRef ref)
-> t
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field ('Package pname ss) m whole
whole [Text]
path (RetObject ServiceQuery ('Package pname ss) (LookupService ss s)
q) t
h
    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> WriterT [GraphQLError] IO Value
-> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field ('Package pname ss) m whole
-> [Text]
-> t
-> ServiceQuery ('Package pname ss) (LookupService ss ref)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm))
       (s :: Service snm mnm anm (TypeRef snm)) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm (TypeRef snm)]) (hs :: [[*]])
       (chn :: Mappings snm *) inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 inh ~ MappingRight chn (ServiceName s)) =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> Schema
-> ServerT chn Field p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery @m @('Package pname ss) @(LookupService ss ref) forall a. m a -> ServerErrorIO a
f RequestHeaders
req
                        (String -> Schema
forall a. HasCallStack => String -> a
error String
"cannot inspect schema inside a field")
                        ServerT chn Field ('Package pname ss) m whole
whole [Text]
path t
h ServiceQuery ('Package pname ss) (LookupService ss ref)
ServiceQuery ('Package pname ss) (LookupService ss s)
q
instance ResultConversion m p whole chn r s
        => ResultConversion m p whole chn ('OptionalRef r) (Maybe s) where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p ('OptionalRef r)
-> Maybe s
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
_ RequestHeaders
_ ServerT chn Field p m whole
_ [Text]
_ ReturnQuery' p ('OptionalRef r)
_ Maybe s
Nothing
    = Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
  convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (RetOptional ReturnQuery' p r
q) (Just s
x)
    = (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> s
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q s
x
instance ResultConversion m p whole chn r s
        => ResultConversion m p whole chn ('ListRef r) [s] where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p ('ListRef r)
-> [s]
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path (RetList ReturnQuery' p r
q) [s]
xs
    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> ([Maybe Value] -> Value) -> [Maybe Value] -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value)
-> ([Maybe Value] -> [Value]) -> [Maybe Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Value] -> [Value]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Value] -> Maybe Value)
-> WriterT [GraphQLError] IO [Maybe Value]
-> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> WriterT [GraphQLError] IO (Maybe Value))
-> [s] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> s
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm (TypeRef snm)) (whole :: [[*]])
       (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> RequestHeaders
-> ServerT chn Field p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f RequestHeaders
req ServerT chn Field p m whole
whole [Text]
path ReturnQuery' p r
q) [s]
xs

class RunSchemaQuery sch r where
  runSchemaQuery
    :: Term sch r
    -> SchemaQuery sch r
    -> Aeson.Value
instance ( Aeson.ToJSON (Term sch ('DEnum name choices)) )
         => RunSchemaQuery sch ('DEnum name choices) where
  runSchemaQuery :: Term sch ('DEnum name choices)
-> SchemaQuery sch ('DEnum name choices) -> Value
runSchemaQuery Term sch ('DEnum name choices)
t SchemaQuery sch ('DEnum name choices)
_ = Term sch ('DEnum name choices) -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Term sch ('DEnum name choices)
t
instance ( KnownName rname, RunSchemaField sch fields )
         => RunSchemaQuery sch ('DRecord rname fields) where
  runSchemaQuery :: Term sch ('DRecord rname fields)
-> SchemaQuery sch ('DRecord rname fields) -> Value
runSchemaQuery (TRecord NP (Field sch) args
args) (QueryRecord [OneFieldQuery sch fs]
rs)
    = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (OneFieldQuery sch args -> Maybe Pair)
-> [OneFieldQuery sch args] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OneFieldQuery sch args -> Maybe Pair
runOneQuery [OneFieldQuery sch args]
[OneFieldQuery sch fs]
rs
    where
      runOneQuery :: OneFieldQuery sch args -> Maybe Pair
runOneQuery (OneFieldQuery Maybe Text
nm NS (ChosenFieldQuery sch) args
choice)
        = let (Maybe Value
val, Text
fname) = NP (Field sch) args
-> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text)
forall {tn} {fn} (sch :: Schema tn fn) (args :: [FieldDef tn fn]).
RunSchemaField sch args =>
NP (Field sch) args
-> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text)
runSchemaField NP (Field sch) args
args NS (ChosenFieldQuery sch) args
choice
              realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fname Maybe Text
nm
          in (Text
realName,) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
val
      runOneQuery (TypeNameFieldQuery Maybe Text
nm)
        = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"__typename" Maybe Text
nm
          -- add the 'R' because it's on return position
          in Pair -> Maybe Pair
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
realName, Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy rname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy rname
forall {k} (t :: k). Proxy t
Proxy @rname) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"R")


class RunSchemaField sch args where
  runSchemaField
    :: NP (Field sch) args
    -> NS (ChosenFieldQuery sch) args
    -> (Maybe Aeson.Value, T.Text)

instance RunSchemaField sch '[] where
  runSchemaField :: NP (Field sch) '[]
-> NS (ChosenFieldQuery sch) '[] -> (Maybe Value, Text)
runSchemaField = String
-> NP (Field sch) '[]
-> NS (ChosenFieldQuery sch) '[]
-> (Maybe Value, Text)
forall a. HasCallStack => String -> a
error String
"this should never be called"
instance (KnownName fname, RunSchemaType sch t, RunSchemaField sch fs)
         => RunSchemaField sch ('FieldDef fname t ': fs) where
  runSchemaField :: NP (Field sch) ('FieldDef fname t : fs)
-> NS (ChosenFieldQuery sch) ('FieldDef fname t : fs)
-> (Maybe Value, Text)
runSchemaField (Field FieldValue sch t
x :* NP (Field sch) xs
_) (Z (ChosenFieldQuery ReturnSchemaQuery sch r
c))
    = (FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value
forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn).
RunSchemaType sch t =>
FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value
runSchemaType FieldValue sch t
x ReturnSchemaQuery sch t
ReturnSchemaQuery sch r
c, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy fname -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy fname
forall {k} (t :: k). Proxy t
Proxy @fname))
  runSchemaField (Field sch x
_ :* NP (Field sch) xs
xs) (S NS (ChosenFieldQuery sch) xs
rest)
    = NP (Field sch) xs
-> NS (ChosenFieldQuery sch) xs -> (Maybe Value, Text)
forall {tn} {fn} (sch :: Schema tn fn) (args :: [FieldDef tn fn]).
RunSchemaField sch args =>
NP (Field sch) args
-> NS (ChosenFieldQuery sch) args -> (Maybe Value, Text)
runSchemaField NP (Field sch) xs
xs NS (ChosenFieldQuery sch) xs
NS (ChosenFieldQuery sch) xs
rest

class RunSchemaType sch t where
  runSchemaType
    :: FieldValue sch t
    -> ReturnSchemaQuery sch t
    -> Maybe Aeson.Value
instance ( Aeson.ToJSON t )
         => RunSchemaType sch ('TPrimitive t) where
  runSchemaType :: FieldValue sch ('TPrimitive t)
-> ReturnSchemaQuery sch ('TPrimitive t) -> Maybe Value
runSchemaType (FPrimitive t1
x) ReturnSchemaQuery sch ('TPrimitive t)
_
    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ t1 -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON t1
x
instance RunSchemaType sch r
         => RunSchemaType sch ('TList r) where
  runSchemaType :: FieldValue sch ('TList r)
-> ReturnSchemaQuery sch ('TList r) -> Maybe Value
runSchemaType (FList [FieldValue sch t1]
xs) (RetSchList ReturnSchemaQuery sch r
r)
    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> ([Value] -> Value) -> [Value] -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Maybe Value) -> [Value] -> Maybe Value
forall a b. (a -> b) -> a -> b
$ (FieldValue sch r -> Maybe Value) -> [FieldValue sch r] -> [Value]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FieldValue sch r -> ReturnSchemaQuery sch r -> Maybe Value
forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn).
RunSchemaType sch t =>
FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value
`runSchemaType` ReturnSchemaQuery sch r
r) [FieldValue sch t1]
[FieldValue sch r]
xs
instance RunSchemaType sch r
         => RunSchemaType sch ('TOption r) where
  runSchemaType :: FieldValue sch ('TOption r)
-> ReturnSchemaQuery sch ('TOption r) -> Maybe Value
runSchemaType (FOption Maybe (FieldValue sch t1)
xs) (RetSchOptional ReturnSchemaQuery sch r
r)
    = Maybe (FieldValue sch t1)
xs Maybe (FieldValue sch t1)
-> (FieldValue sch t1 -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FieldValue sch r -> ReturnSchemaQuery sch r -> Maybe Value)
-> ReturnSchemaQuery sch r -> FieldValue sch r -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip FieldValue sch r -> ReturnSchemaQuery sch r -> Maybe Value
forall {tn} {fn} (sch :: Schema tn fn) (t :: FieldType tn).
RunSchemaType sch t =>
FieldValue sch t -> ReturnSchemaQuery sch t -> Maybe Value
runSchemaType ReturnSchemaQuery sch r
r
instance RunSchemaQuery sch (sch :/: l)
         => RunSchemaType sch ('TSchematic l) where
  runSchemaType :: FieldValue sch ('TSchematic l)
-> ReturnSchemaQuery sch ('TSchematic l) -> Maybe Value
runSchemaType (FSchematic Term sch (sch :/: t1)
t) (RetSchSchema SchemaQuery sch (sch :/: sty)
r)
    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Term sch (sch :/: l) -> SchemaQuery sch (sch :/: l) -> Value
forall {tn} {fn} (sch :: Schema tn fn) (r :: TypeDef tn fn).
RunSchemaQuery sch r =>
Term sch r -> SchemaQuery sch r -> Value
runSchemaQuery Term sch (sch :/: l)
Term sch (sch :/: t1)
t SchemaQuery sch (sch :/: l)
SchemaQuery sch (sch :/: sty)
r


runIntroSchema
  :: [T.Text] -> Intro.Schema -> [GQL.Selection]
  -> WriterT [GraphQLError] IO Aeson.Value
runIntroSchema :: [Text] -> Schema -> [Selection] -> WriterT [GraphQLError] IO Value
runIntroSchema [Text]
path s :: Schema
s@(Intro.Schema Maybe Text
qr Maybe Text
mut Maybe Text
sub TypeMap
ts) [Selection]
ss
  = do [Pair]
things <- [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair])
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection -> WriterT [GraphQLError] IO (Maybe Pair))
-> [Selection] -> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runOne [Selection]
ss
       Value -> WriterT [GraphQLError] IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> WriterT [GraphQLError] IO Value)
-> Value -> WriterT [GraphQLError] IO Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Pair]
things
  where
    runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runOne (GQL.FieldSelection (GQL.Field Maybe Text
alias Text
nm [Argument]
_ [Directive]
_ [Selection]
innerss Location
_))
      = let Text
realName :: T.Text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
nm Maybe Text
alias
            path' :: [Text]
path' = [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]
        in (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
realName,) (Maybe Value -> Maybe Pair)
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text
nm of
             Text
"description"
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
             Text
"directives"
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Array -> Value
Aeson.Array []
             Text
"queryType"
               -> case Maybe Text
qr Maybe Text -> (Text -> Maybe Type) -> Maybe Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> TypeMap -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup TypeMap
ts of
                    Maybe Type
Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
                    Just Type
ty -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty [Selection]
innerss
             Text
"mutationType"
               -> case Maybe Text
mut Maybe Text -> (Text -> Maybe Type) -> Maybe Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> TypeMap -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup TypeMap
ts of
                    Maybe Type
Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
                    Just Type
ty -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty [Selection]
innerss
             Text
"subscriptionType"
               -> case Maybe Text
sub Maybe Text -> (Text -> Maybe Type) -> Maybe Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> TypeMap -> Maybe Type) -> TypeMap -> Text -> Maybe Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> TypeMap -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup TypeMap
ts of
                    Maybe Type
Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
                    Just Type
ty -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty [Selection]
innerss
             Text
"types"
               -> do [Value]
tys <- [Maybe Value] -> [Value]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Value] -> [Value])
-> WriterT [GraphQLError] IO [Maybe Value]
-> WriterT [GraphQLError] IO [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> WriterT [GraphQLError] IO (Maybe Value))
-> [Type] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Type
t -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
t [Selection]
innerss) (TypeMap -> [Type]
forall k v. HashMap k v -> [v]
HM.elems TypeMap
ts)
                     Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Value]
tys
             Text
_ -> do [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                             (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                               (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' was not found on type '__Schema'")
                             [Text]
path]
                     Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
    -- we do not support spreads here
    runOne Selection
_ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing

runIntroType
  :: [T.Text] -> Intro.Schema -> Intro.Type -> [GQL.Selection]
  -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
runIntroType :: [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path s :: Schema
s@(Intro.Schema Maybe Text
_ Maybe Text
_ Maybe Text
_ TypeMap
ts) (Intro.TypeRef Text
t) [Selection]
ss
  = case Text -> TypeMap -> Maybe Type
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
t TypeMap
ts of
      Maybe Type
Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
      Just Type
ty -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path Schema
s Type
ty [Selection]
ss
runIntroType [Text]
path Schema
s (Intro.Type TypeKind
k Maybe Text
tnm [Field]
fs [EnumValue]
vals [Type]
posTys Maybe Type
ofT) [Selection]
ss
  = do [Pair]
things <- [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair])
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection -> WriterT [GraphQLError] IO (Maybe Pair))
-> [Selection] -> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runOne [Selection]
ss
       Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Pair]
things
  where
    runOne :: Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runOne (GQL.FieldSelection (GQL.Field Maybe Text
alias Text
nm [Argument]
_ [Directive]
_ [Selection]
innerss Location
_))
      = let Text
realName :: T.Text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
nm Maybe Text
alias
            path' :: [Text]
path' = [Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]
        in (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
realName,) (Maybe Value -> Maybe Pair)
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Text
nm, [Selection]
innerss) of
             (Text
"kind", [])
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (TypeKind -> String
forall a. Show a => a -> String
show TypeKind
k)
             (Text
"name", [])
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null Text -> Value
Aeson.String Maybe Text
tnm
             (Text
"description", [])
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null

             (Text
"fields", [Selection]
_)
               -> case TypeKind
k of
                    TypeKind
Intro.OBJECT
                      -> do [Maybe Value]
things <- (Field -> WriterT [GraphQLError] IO (Maybe Value))
-> [Field] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Field
f -> [Text]
-> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields [Text]
path' Field
f [Selection]
innerss) [Field]
fs
                            Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Maybe Value]
things
                    TypeKind
_ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
             (Text
"inputFields", [Selection]
_)
               -> case TypeKind
k of
                    TypeKind
Intro.INPUT_OBJECT
                      -> do [Maybe Value]
things <- (Field -> WriterT [GraphQLError] IO (Maybe Value))
-> [Field] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Field
f -> [Text]
-> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields [Text]
path' Field
f [Selection]
innerss) [Field]
fs
                            Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Maybe Value]
things
                    TypeKind
_ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
             (Text
"enumValues", [Selection]
_)
               -> do [Maybe Value]
things <- (EnumValue -> WriterT [GraphQLError] IO (Maybe Value))
-> [EnumValue] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\EnumValue
e -> [Text]
-> EnumValue
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroEnums [Text]
path' EnumValue
e [Selection]
innerss) [EnumValue]
vals
                     Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Maybe Value]
things

             (Text
"ofType", [Selection]
_)
               -> case Maybe Type
ofT of
                    Maybe Type
Nothing -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
                    Just Type
o  -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
o [Selection]
innerss

             -- unions and interfaces are not supported
             (Text
"interfaces", [Selection]
_)
               -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Array -> Value
Aeson.Array []
             (Text
"possibleTypes", [Selection]
_)
               -> case TypeKind
k of
                    TypeKind
Intro.UNION
                      -> do [Value]
res <- [Maybe Value] -> [Value]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Value] -> [Value])
-> WriterT [GraphQLError] IO [Maybe Value]
-> WriterT [GraphQLError] IO [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                     (Type -> WriterT [GraphQLError] IO (Maybe Value))
-> [Type] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Type
o -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
o [Selection]
innerss) [Type]
posTys
                            Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Value]
res
                    TypeKind
_ -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null

             (Text, [Selection])
_ -> do [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                             (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                               (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' was not found on type '__Type'")
                             [Text]
path]
                     Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
    -- we do not support spreads here
    runOne Selection
_ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing

    runIntroFields
      :: [T.Text] -> Intro.Field -> [GQL.Selection]
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroFields :: [Text]
-> Field -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields [Text]
fpath Field
fld [Selection]
fss
      = do [Pair]
things <- [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair])
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection -> WriterT [GraphQLError] IO (Maybe Pair))
-> [Selection] -> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text]
-> Field -> Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runIntroField [Text]
fpath Field
fld) [Selection]
fss
           Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Pair]
things

    runIntroField :: [Text]
-> Field -> Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runIntroField [Text]
fpath (Intro.Field Text
fnm [Input]
fargs Type
fty)
                  (GQL.FieldSelection (GQL.Field Maybe Text
alias Text
nm [Argument]
_ [Directive]
_ [Selection]
innerss Location
_))
      = let Text
realName :: T.Text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
nm Maybe Text
alias
            fpath' :: [Text]
fpath' = [Text]
fpath [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]
        in (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
realName,) (Maybe Value -> Maybe Pair)
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Text
nm, [Selection]
innerss) of
          (Text
"name", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String Text
fnm
          (Text
"description", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
          (Text
"isDeprecated", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Aeson.Bool Bool
False
          (Text
"deprecationReason", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null

          -- this is used by __InputValue,
          -- which is required when the field
          -- is inside an INPUT_OBJECT
          (Text
"defaultValue", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null

          (Text
"type", [Selection]
_)
            -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
fpath' Schema
s Type
fty [Selection]
innerss
          (Text
"args", [Selection]
_)
               -> do [Maybe Value]
things <- (Input -> WriterT [GraphQLError] IO (Maybe Value))
-> [Input] -> WriterT [GraphQLError] IO [Maybe Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Input
i -> [Text]
-> Input -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value)
runIntroInputs [Text]
fpath' Input
i [Selection]
innerss) [Input]
fargs
                     Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Maybe Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Maybe Value]
things

          (Text, [Selection])
_ -> do [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                             (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                               (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' was not found on type '__Field'")
                             [Text]
fpath]
                  Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
    -- we do not support spreads here
    runIntroField [Text]
_ Field
_ Selection
_ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing

    runIntroEnums
      :: [T.Text] -> Intro.EnumValue -> [GQL.Selection]
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroEnums :: [Text]
-> EnumValue
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroEnums [Text]
epath EnumValue
enm [Selection]
ess
      = do [Pair]
things <- [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair])
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection -> WriterT [GraphQLError] IO (Maybe Pair))
-> [Selection] -> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text]
-> EnumValue -> Selection -> WriterT [GraphQLError] IO (Maybe Pair)
forall {f :: * -> *} {w}.
(MonadWriter w f, IsList w, Item w ~ GraphQLError) =>
[Text] -> EnumValue -> Selection -> f (Maybe Pair)
runIntroEnum [Text]
epath EnumValue
enm) [Selection]
ess
           Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Pair]
things

    runIntroEnum :: [Text] -> EnumValue -> Selection -> f (Maybe Pair)
runIntroEnum [Text]
epath (Intro.EnumValue Text
enm)
                 (GQL.FieldSelection (GQL.Field Maybe Text
alias Text
nm [Argument]
_ [Directive]
_ [Selection]
innerss Location
_))
      = let Text
realName :: T.Text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
nm Maybe Text
alias
        in (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
realName,) (Maybe Value -> Maybe Pair) -> f (Maybe Value) -> f (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Text
nm, [Selection]
innerss) of
          (Text
"name", [])
            -> Maybe Value -> f (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> f (Maybe Value)) -> Maybe Value -> f (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String Text
enm
          (Text
"description", [])
            -> Maybe Value -> f (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> f (Maybe Value)) -> Maybe Value -> f (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
          (Text
"isDeprecated", [])
            -> Maybe Value -> f (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> f (Maybe Value)) -> Maybe Value -> f (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Aeson.Bool Bool
False
          (Text
"deprecationReason", [])
            -> Maybe Value -> f (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> f (Maybe Value)) -> Maybe Value -> f (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null

          (Text, [Selection])
_ -> do w -> f ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                             (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                               (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' was not found on type '__EnumValue'")
                             [Text]
epath]
                  Maybe Value -> f (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
    -- we do not support spreads here
    runIntroEnum [Text]
_ EnumValue
_ Selection
_ = Maybe Pair -> f (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing

    runIntroInputs
      :: [T.Text] -> Intro.Input -> [GQL.Selection]
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroInputs :: [Text]
-> Input -> [Selection] -> WriterT [GraphQLError] IO (Maybe Value)
runIntroInputs [Text]
ipath Input
inm [Selection]
iss
      = do [Pair]
things <- [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair])
-> WriterT [GraphQLError] IO [Maybe Pair]
-> WriterT [GraphQLError] IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection -> WriterT [GraphQLError] IO (Maybe Pair))
-> [Selection] -> WriterT [GraphQLError] IO [Maybe Pair]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text]
-> Input -> Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runIntroInput [Text]
ipath Input
inm) [Selection]
iss
           Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Pair]
things

    runIntroInput :: [Text]
-> Input -> Selection -> WriterT [GraphQLError] IO (Maybe Pair)
runIntroInput [Text]
ipath (Intro.Input Text
inm Maybe Text
def Type
ty)
                 (GQL.FieldSelection (GQL.Field Maybe Text
alias Text
nm [Argument]
_ [Directive]
_ [Selection]
innerss Location
_))
      = let Text
realName :: T.Text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
nm Maybe Text
alias
            ipath' :: [Text]
ipath' = [Text]
ipath [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
realName]
        in (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
realName,) (Maybe Value -> Maybe Pair)
-> WriterT [GraphQLError] IO (Maybe Value)
-> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Text
nm, [Selection]
innerss) of
          (Text
"name", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String Text
inm
          (Text
"description", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Aeson.Null
          (Text
"defaultValue", [])
            -> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> WriterT [GraphQLError] IO (Maybe Value))
-> Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null Text -> Value
Aeson.String Maybe Text
def

          (Text
"type", [Selection]
_)
            -> [Text]
-> Schema
-> Type
-> [Selection]
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
ipath' Schema
s Type
ty [Selection]
innerss

          (Text, [Selection])
_ -> do [GraphQLError] -> WriterT [GraphQLError] IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ServerError -> [Text] -> GraphQLError
GraphQLError
                             (ServerErrorCode -> String -> ServerError
ServerError ServerErrorCode
Invalid
                               (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ String
"field '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' was not found on type '__Field'")
                             [Text]
ipath]
                  Maybe Value -> WriterT [GraphQLError] IO (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing
    -- we do not support spreads here
    runIntroInput [Text]
_ Input
_ Selection
_ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing