{-# 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 TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-# language ViewPatterns          #-}
{-# 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           GHC.TypeLits
import qualified Language.GraphQL.Draft.Syntax  as GQL

import           Data.Coerce                    (coerce)
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)
  -> ServerT chn p m hs
  -> Proxy qr -> Proxy mut -> Proxy sub
  -> Maybe T.Text -> VariableMapC -> GQL.ExecutableDocument
  -> IO Aeson.Value
runPipeline :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> IO Value
runPipeline f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr _ _ _ opName :: Maybe Text
opName vmap :: VariableMapC
vmap doc :: ExecutableDocument
doc
  = case Maybe Text
-> VariableMapC
-> ExecutableDocument
-> 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 -> ExecutableDocument -> f (Document p qr mut sub)
parseDoc @qr @mut @sub Maybe Text
opName VariableMapC
vmap ExecutableDocument
doc of
      Left e :: 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
        (data_ :: Value
data_, errors :: [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)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p qr mut sub
-> WriterT [GraphQLError] IO Value
runDocument forall a. m a -> ServerErrorIO a
f ServerT chn 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 [ ("data", Value
data_) ]
          _  -> 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 [ ("data", Value
data_), ("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)
  -> ServerT chn p m hs
  -> Proxy qr -> Proxy mut -> Proxy sub
  -> Maybe T.Text -> VariableMapC -> GQL.ExecutableDocument
  -> ConduitT Aeson.Value Void IO ()
  -> IO ()
runSubscriptionPipeline :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionPipeline f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr _ _ _ opName :: Maybe Text
opName vmap :: VariableMapC
vmap doc :: ExecutableDocument
doc sink :: ConduitT Value Void IO ()
sink
  = case Maybe Text
-> VariableMapC
-> ExecutableDocument
-> 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 -> ExecutableDocument -> f (Document p qr mut sub)
parseDoc @qr @mut @sub Maybe Text
opName VariableMapC
vmap ExecutableDocument
doc of
      Left e :: 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)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription forall a. m a -> ServerErrorIO a
f ServerT chn p m hs
svr Document p qr mut sub
d ConduitT Value Void IO ()
sink

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

errValue :: GraphQLError -> Aeson.Value
errValue :: GraphQLError -> Value
errValue (GraphQLError (ServerError _ msg :: String
msg) path :: [Text]
path)
  = [Pair] -> Value
Aeson.object [
      ("message", Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
msg)
    , ("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 e :: Text
e sink :: 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 e :: ServerError
e path :: [Text]
path sink :: ConduitM Value Void m ()
sink = do
  let val :: Value
val = [Pair] -> Value
Aeson.object [ ("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 ([Item [Value]
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)
    -> ServerT chn p m hs
    -> Document p qr mut sub
    -> WriterT [GraphQLError] IO Aeson.Value
  runDocumentSubscription ::
       (forall a. m a -> ServerErrorIO a)
    -> ServerT chn 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)
-> ServerT chn p m hs
-> Document p ('Just qr) ('Just mut) ('Just sub)
-> WriterT [GraphQLError] IO Value
runDocument f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: 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 q :: ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qanns qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service qr qanns qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           MutationDoc q :: ServiceQuery ('Package pname ss) (LookupService ss mut)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service mut manns mms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service mut manns mms)
ServiceQuery ('Package pname ss) (LookupService ss mut)
q
           SubscriptionDoc _
             -> 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 "cannot execute subscriptions in this wire"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p ('Just qr) ('Just mut) ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr (SubscriptionDoc d :: OneMethodQuery ('Package pname ss) (LookupService ss sub)
d)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> [Text]
-> ()
-> OneMethodQuery p ('Service sub manns mms)
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> [Text]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscription forall a. m a -> ServerErrorIO a
f ServerT chn p m hs
svr [] () OneMethodQuery p ('Service sub manns mms)
OneMethodQuery ('Package pname ss) (LookupService ss sub)
d
  runDocumentSubscription f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: Document p ('Just qr) ('Just mut) ('Just sub)
d = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument forall a. m a -> ServerErrorIO a
f ServerT chn 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)
-> ServerT chn p m hs
-> Document p ('Just qr) ('Just mut) 'Nothing
-> WriterT [GraphQLError] IO Value
runDocument f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: 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 q :: ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qanns qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service qr qanns qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           MutationDoc q :: ServiceQuery ('Package pname ss) (LookupService ss mut)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service mut manns mms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service mut manns mms)
ServiceQuery ('Package pname ss) (LookupService ss mut)
q
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p ('Just qr) ('Just mut) 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p ('Just qr) 'Nothing ('Just sub)
-> WriterT [GraphQLError] IO Value
runDocument f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: 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 q :: ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qanns qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service qr qanns qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
           SubscriptionDoc _
             -> 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 "cannot execute subscriptions in this wire"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p ('Just qr) 'Nothing ('Just sub)
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr (SubscriptionDoc d :: OneMethodQuery ('Package pname ss) (LookupService ss sub)
d)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> [Text]
-> ()
-> OneMethodQuery p ('Service sub manns mms)
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> [Text]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscription forall a. m a -> ServerErrorIO a
f ServerT chn p m hs
svr [] () OneMethodQuery p ('Service sub manns mms)
OneMethodQuery ('Package pname ss) (LookupService ss sub)
d
  runDocumentSubscription f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: Document p ('Just qr) 'Nothing ('Just sub)
d = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument forall a. m a -> ServerErrorIO a
f ServerT chn 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)
-> ServerT chn p m hs
-> Document p ('Just qr) 'Nothing 'Nothing
-> WriterT [GraphQLError] IO Value
runDocument f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr d :: 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 q :: ServiceQuery ('Package pname ss) (LookupService ss qr)
q
             -> (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ()
-> ServiceQuery p ('Service qr qanns qms)
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery forall a. m a -> ServerErrorIO a
f Schema
i ServerT chn p m hs
svr [] () ServiceQuery p ('Service qr qanns qms)
ServiceQuery ('Package pname ss) (LookupService ss qr)
q
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p ('Just qr) 'Nothing 'Nothing
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
-> ServerT chn 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)
-> ServerT chn p m hs
-> Document p 'Nothing mut sub
-> WriterT [GraphQLError] IO Value
runDocument _ = String
-> ServerT chn p m hs
-> Document p 'Nothing mut sub
-> WriterT [GraphQLError] IO Value
forall a. HasCallStack => String -> a
error "this should never be called"
  runDocumentSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p 'Nothing mut sub
-> ConduitT Value Void IO ()
-> IO ()
runDocumentSubscription _ = String
-> ServerT chn p m hs
-> Document p 'Nothing mut sub
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error "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)
  -> ServerT chn p m hs
  -> Document p qr mut sub
  -> ConduitT Aeson.Value Void IO ()
  -> IO ()
yieldDocument :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m hs
-> Document p qr mut sub
-> ConduitT Value Void IO ()
-> IO ()
yieldDocument f :: forall a. m a -> ServerErrorIO a
f svr :: ServerT chn p m hs
svr doc :: Document p qr mut sub
doc sink :: ConduitT Value Void IO ()
sink = do
  (data_ :: Value
data_, errors :: [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)
-> ServerT chn 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)
-> ServerT chn 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 ServerT chn p m hs
svr Document p qr mut sub
doc)
  let (Value
val :: Aeson.Value)
        = case [GraphQLError]
errors of
            [] -> [Pair] -> Value
Aeson.object [ ("data", Value
data_) ]
            _  -> [Pair] -> Value
Aeson.object [ ("data", Value
data_), ("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 ([Item [Value]
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 sname sanns ms chn inh.
     ( RunQueryFindHandler m p hs chn ss s hs
     , p ~ 'Package pname ss
     , s ~ 'Service sname sanns ms
     , inh ~ MappingRight chn sname )
  => (forall a. m a -> ServerErrorIO a)
  -> Intro.Schema -> ServerT chn p m hs
  -> [T.Text]
  -> inh
  -> ServiceQuery p s
  -> WriterT [GraphQLError] IO Aeson.Value
runQuery :: (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQuery f :: forall a. m a -> ServerErrorIO a
f sch :: Schema
sch whole :: ServerT chn p m hs
whole@(Services ss :: ServicesT chn s1 m hs
ss) path :: [Text]
path = (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m hs
-> [Text]
-> ServicesT chn s1 m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm) (whole :: [[*]]) (chn :: Mappings snm *)
       (ss :: [Service snm mnm anm]) (s :: Service snm mnm anm)
       (hs :: [[*]]) (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm]) (sname :: snm) (sanns :: [*])
       (ms :: [Method snm mnm anm]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess, s ~ 'Service sname sanns ms,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn ss m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f Schema
sch ServerT chn p m hs
whole [Text]
path ServicesT chn s1 m hs
ss

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

class RunQueryFindHandler m p whole chn ss s hs where
  runQueryFindHandler
    :: ( p ~  'Package pname wholess
       , s ~ 'Service sname sanns ms
       , inh ~ MappingRight chn sname )
    => (forall a. m a -> ServerErrorIO a)
    -> Intro.Schema -> ServerT chn p m whole
    -> [T.Text]
    -> ServicesT chn ss m hs
    -> inh
    -> ServiceQuery p s
    -> WriterT [GraphQLError] IO Aeson.Value
  runSubscriptionFindHandler
    :: ( p ~  'Package pname wholess
       , s ~ 'Service sname sanns ms
       , inh ~ MappingRight chn sname )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn p m whole
    -> [T.Text]
    -> ServicesT chn ss 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)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn '[] m '[]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler _ = String
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn '[] m '[]
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall a. HasCallStack => String -> a
error "this should never be called"
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn '[] m '[]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler _ = String
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn '[] m '[]
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error "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)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn (other : ss) m (h : hs)
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler f :: forall a. m a -> ServerErrorIO a
f sch :: Schema
sch whole :: ServerT chn p m whole
whole path :: [Text]
path (_ :<&>: that :: ServicesT chn rest m hss
that)
    = (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn rest m hss
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm) (whole :: [[*]]) (chn :: Mappings snm *)
       (ss :: [Service snm mnm anm]) (s :: Service snm mnm anm)
       (hs :: [[*]]) (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm]) (sname :: snm) (sanns :: [*])
       (ms :: [Method snm mnm anm]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess, s ~ 'Service sname sanns ms,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn ss m hs
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler forall a. m a -> ServerErrorIO a
f Schema
sch ServerT chn p m whole
whole [Text]
path ServicesT chn rest m hss
that
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn (other : ss) m (h : hs)
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path (_ :<&>: that :: ServicesT chn rest m hss
that)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn rest m hss
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
forall {snm} {mnm} {anm} {mnm} {anm} (m :: * -> *)
       (p :: Package snm mnm anm) (whole :: [[*]]) (chn :: Mappings snm *)
       (ss :: [Service snm mnm anm]) (s :: Service snm mnm anm)
       (hs :: [[*]]) (pname :: Maybe snm)
       (wholess :: [Service snm mnm anm]) (sname :: snm) (sanns :: [*])
       (ms :: [Method snm mnm anm]) inh.
(RunQueryFindHandler m p whole chn ss s hs,
 p ~ 'Package pname wholess, s ~ 'Service sname sanns ms,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn ss m hs
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole [Text]
path ServicesT chn rest m hss
that
instance {-# OVERLAPS #-} (s ~ 'Service sname sanns ms, KnownName sname, RunMethod m p whole chn sname ms h)
         => RunQueryFindHandler m p whole chn (s ': ss) s (h ': hs) where
  runQueryFindHandler :: (forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn (s : ss) m (h : hs)
-> inh
-> ServiceQuery p s
-> WriterT [GraphQLError] IO Value
runQueryFindHandler f :: forall a. m a -> ServerErrorIO a
f sch :: Schema
sch whole :: ServerT chn p m whole
whole path :: [Text]
path (this :: HandlersT chn (MappingRight chn sname) methods m hs1
this :<&>: _) inh :: inh
inh queries :: ServiceQuery p s
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 s -> WriterT [GraphQLError] IO (Maybe Pair))
-> ServiceQuery p s -> 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 s -> WriterT [GraphQLError] IO (Maybe Pair)
runOneQuery ServiceQuery p s
queries
    where
      -- if we include the signature we have to write
      -- an explicit type signature for 'runQueryFindHandler'
      runOneQuery :: OneMethodQuery p s -> WriterT [GraphQLError] IO (Maybe Pair)
runOneQuery (OneMethodQuery nm :: Maybe Text
nm args :: NS (ChosenMethodQuery p) ms
args)
        = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh methods m hs1
-> NS (ChosenMethodQuery p) methods
-> WriterT [GraphQLError] IO (Maybe Pair)
forall {k} {mnm} {anm} (m :: * -> *) (p :: Package k mnm anm)
       (whole :: [[*]]) (chn :: Mappings k *) (sname :: k)
       (ms :: [Method k mnm anm]) (hs :: [*]) (pname :: Maybe k)
       (wholess :: [Service k mnm anm]) inh.
(RunMethod m p whole chn sname ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole (Proxy sname
forall {k} (t :: k). Proxy t
Proxy @sname) [Text]
path Maybe Text
nm inh
inh HandlersT chn inh methods m hs1
HandlersT chn (MappingRight chn sname) methods m hs1
this NS (ChosenMethodQuery p) methods
NS (ChosenMethodQuery p) ms
args
      -- handle __typename
      runOneQuery (TypeNameQuery nm :: Maybe Text
nm)
        = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "__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 nm :: Maybe Text
nm ss :: SelectionSet
ss)
        = do let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "__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 -> SelectionSet -> WriterT [GraphQLError] IO Value
runIntroSchema [Text]
path Schema
sch SelectionSet
ss
      -- handle __type
      runOneQuery (TypeQuery nm :: Maybe Text
nm ty :: Text
ty ss :: SelectionSet
ss)
        = do let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "__schema" Maybe Text
nm
             Maybe Value
res <- [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path Schema
sch (Text -> Type
Intro.TypeRef Text
ty) SelectionSet
ss
             case Maybe Value
res of
               Just val :: 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)
               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
$ "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
<> "'")
                                    [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
  runSubscriptionFindHandler :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ServicesT chn (s : ss) m (h : hs)
-> inh
-> OneMethodQuery p s
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionFindHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path (this :: HandlersT chn (MappingRight chn sname) methods m hs1
this :<&>: _) inh :: inh
inh (OneMethodQuery nm :: Maybe Text
nm args :: NS (ChosenMethodQuery p) ms
args) sink :: ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh methods m hs1
-> NS (ChosenMethodQuery p) methods
-> ConduitT Value Void IO ()
-> IO ()
forall {k} {mnm} {anm} (m :: * -> *) (p :: Package k mnm anm)
       (whole :: [[*]]) (chn :: Mappings k *) (sname :: k)
       (ms :: [Method k mnm anm]) (hs :: [*]) (pname :: Maybe k)
       (wholess :: [Service k mnm anm]) inh.
(RunMethod m p whole chn sname ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole (Proxy sname
forall {k} (t :: k). Proxy t
Proxy @sname) [Text]
path Maybe Text
nm inh
inh HandlersT chn inh methods m hs1
HandlersT chn (MappingRight chn sname) methods m hs1
this NS (ChosenMethodQuery p) methods
NS (ChosenMethodQuery p) ms
args ConduitT Value Void IO ()
sink
  runSubscriptionFindHandler _ _ _ _ _ (TypeNameQuery nm :: Maybe Text
nm) sink :: ConduitT Value Void IO ()
sink
    = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "__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 ([Item [Value]
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
  runSubscriptionFindHandler _ _ _ _ _ _ sink :: 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 "__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

class RunMethod m p whole chn sname ms hs where
  runMethod
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn sname )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn p m whole
    -> Proxy sname -> [T.Text] -> Maybe T.Text -> inh
    -> HandlersT chn inh ms m hs
    -> NS (ChosenMethodQuery p) ms
    -> WriterT [GraphQLError] IO (Maybe (T.Text, Aeson.Value))
  runMethodSubscription
    :: ( p ~ 'Package pname wholess
       , inh ~ MappingRight chn sname )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn p m whole
    -> Proxy sname -> [T.Text] -> Maybe T.Text -> inh
    -> HandlersT chn 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)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod _ = String
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> WriterT [GraphQLError] IO (Maybe Pair)
forall a. HasCallStack => String -> a
error "this should never be called"
  runMethodSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription _ = String
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh '[] m '[]
-> NS (ChosenMethodQuery p) '[]
-> ConduitT Value Void IO ()
-> IO ()
forall a. HasCallStack => String -> a
error "this should never be called"
instance (RunMethod m p whole chn s ms hs, KnownName mname, RunHandler m p whole chn args r h)
         => RunMethod m p whole chn s ('Method mname anns args r ': ms) (h ': hs) where
  -- handle normal methods
  runMethod :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ('Method mname anns args r : ms) m (h : hs)
-> NS (ChosenMethodQuery p) ('Method mname anns args r : ms)
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole _ path :: [Text]
path nm :: Maybe Text
nm inh :: inh
inh (h :: inh -> h
h :<||>: _) (Z (ChosenMethodQuery args :: NP (ArgumentValue p) args
args ret :: 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)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn p m whole
whole ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Item [Text]
Text
realName]) (inh -> h
h 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
  runMethod f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole p :: Proxy s
p path :: [Text]
path nm :: Maybe Text
nm inh :: inh
inh (_ :<||>: r :: HandlersT chn inh ms m hs1
r) (S cont :: NS (ChosenMethodQuery p) xs
cont)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs1
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
forall {k} {mnm} {anm} (m :: * -> *) (p :: Package k mnm anm)
       (whole :: [[*]]) (chn :: Mappings k *) (sname :: k)
       (ms :: [Method k mnm anm]) (hs :: [*]) (pname :: Maybe k)
       (wholess :: [Service k mnm anm]) inh.
(RunMethod m p whole chn sname ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> WriterT [GraphQLError] IO (Maybe Pair)
runMethod forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh HandlersT chn inh ms m hs1
r NS (ChosenMethodQuery p) ms
NS (ChosenMethodQuery p) xs
cont
  -- handle subscriptions
  runMethodSubscription :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ('Method mname anns args r : ms) m (h : hs)
-> NS (ChosenMethodQuery p) ('Method mname anns args r : ms)
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole _ path :: [Text]
path nm :: Maybe Text
nm inh :: inh
inh (h :: inh -> h
h :<||>: _) (Z (ChosenMethodQuery args :: NP (ArgumentValue p) args
args ret :: ReturnQuery p r
ret)) sink :: ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn p m whole
whole ([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Item [Text]
Text
realName]) (inh -> h
h 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
  runMethodSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole p :: Proxy s
p path :: [Text]
path nm :: Maybe Text
nm inh :: inh
inh (_ :<||>: r :: HandlersT chn inh ms m hs1
r) (S cont :: NS (ChosenMethodQuery p) xs
cont) sink :: ConduitT Value Void IO ()
sink
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy s
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs1
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
forall {k} {mnm} {anm} (m :: * -> *) (p :: Package k mnm anm)
       (whole :: [[*]]) (chn :: Mappings k *) (sname :: k)
       (ms :: [Method k mnm anm]) (hs :: [*]) (pname :: Maybe k)
       (wholess :: [Service k mnm anm]) inh.
(RunMethod m p whole chn sname ms hs, p ~ 'Package pname wholess,
 inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> Proxy sname
-> [Text]
-> Maybe Text
-> inh
-> HandlersT chn inh ms m hs
-> NS (ChosenMethodQuery p) ms
-> ConduitT Value Void IO ()
-> IO ()
runMethodSubscription forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole Proxy s
p [Text]
path Maybe Text
nm inh
inh HandlersT chn inh ms m hs1
r NS (ChosenMethodQuery p) ms
NS (ChosenMethodQuery p) xs
cont ConduitT Value Void IO ()
sink

class Handles chn args r m h
      => RunHandler m p whole chn args r h where
  runHandler
    :: (forall a. m a -> ServerErrorIO a)
    -> ServerT chn 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)
    -> ServerT chn 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 aanns ref ': rest) r (t -> h) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> (t -> h)
-> NP (ArgumentValue p) ('ArgSingle aname aanns ref : rest)
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: t -> h
h (ArgumentValue one :: ArgumentValue' p r
one :* rest :: NP (ArgumentValue p) xs
rest)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn 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).
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)
-> ServerT chn p m whole
-> [Text]
-> (t -> h)
-> NP (ArgumentValue p) ('ArgSingle aname aanns ref : rest)
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: t -> h
h (ArgumentValue one :: ArgumentValue' p r
one :* rest :: NP (ArgumentValue p) xs
rest)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn 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).
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 aanns ref ': rest) r (ConduitT () t m () -> h) where
  runHandler :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> (ConduitT () t m () -> h)
-> NP (ArgumentValue p) ('ArgStream aname aanns ref : rest)
-> ReturnQuery p r
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: ConduitT () t m () -> h
h (ArgumentStream lst :: ArgumentValue' p ('ListRef r)
lst :* rest :: 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).
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)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn 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)
-> ServerT chn p m whole
-> [Text]
-> (ConduitT () t m () -> h)
-> NP (ArgumentValue p) ('ArgStream aname aanns ref : rest)
-> ReturnQuery p r
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: ConduitT () t m () -> h
h (ArgumentStream lst :: ArgumentValue' p ('ListRef r)
lst :* rest :: NP (ArgumentValue p) xs
rest) sink :: 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).
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)
-> ServerT chn 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)
       (whole :: [[*]]) (chn :: ServiceChain snm)
       (args :: [Argument snm anm]) (r :: Return snm) h.
RunHandler m p whole chn args r h =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn 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 ServerT chn 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)
-> ServerT chn p m whole
-> [Text]
-> m ()
-> NP (ArgumentValue p) '[]
-> ReturnQuery p 'RetNothing
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler f :: forall a. m a -> ServerErrorIO a
f _ path :: [Text]
path h :: m ()
h Nil _ = 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 e :: 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)
-> ServerT chn p m whole
-> [Text]
-> m ()
-> NP (ArgumentValue p) '[]
-> ReturnQuery p 'RetNothing
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription f :: forall a. m a -> ServerErrorIO a
f _ path :: [Text]
path h :: m ()
h Nil _ sink :: 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 e :: 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)
-> ServerT chn p m whole
-> [Text]
-> m l
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetSingle r)
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: m l
h Nil (RSingle q :: 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 v :: l
v -> (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole [Text]
path ReturnQuery' p r
q l
v
      Left e :: 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)
-> ServerT chn p m whole
-> [Text]
-> m l
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetSingle r)
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: m l
h Nil (RSingle q :: ReturnQuery' p r
q) sink :: 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 v :: l
v -> do
        (data_ :: Maybe Value
data_, errors :: [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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn 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 [ ("data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_) ]
          _  -> 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 [ ("data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_)
                                    , ("errors", (GraphQLError -> Value) -> [GraphQLError] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue GraphQLError -> Value
errValue [GraphQLError]
errors) ]
      Left e :: 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 [ ("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 ([Item [Value]
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)
-> ServerT chn p m whole
-> [Text]
-> (ConduitT l Void m () -> m ())
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetStream r)
-> WriterT [GraphQLError] IO (Maybe Value)
runHandler f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: ConduitT l Void m () -> m ()
h Nil (RStream q :: 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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn p m whole
whole [Text]
path ReturnQuery' p r
q) [l]
info
      Left e :: 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)
-> ServerT chn p m whole
-> [Text]
-> (ConduitT l Void m () -> m ())
-> NP (ArgumentValue p) '[]
-> ReturnQuery p ('RetStream r)
-> ConduitT Value Void IO ()
-> IO ()
runHandlerSubscription f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path h :: ConduitT l Void m () -> m ()
h Nil (RStream q :: ReturnQuery' p r
q) sink :: 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 "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 e :: 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 v :: l
v = do
        (data_ :: Maybe Value
data_, errors :: [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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn 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 [ ("data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_) ]
          _  -> 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 [ ("data", Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null Maybe Value
data_)
                                    , ("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 _ (ArgPrimitive x :: 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 _ (ArgSchema x :: 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 p :: Proxy chn
p (ArgList x :: [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).
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 p :: Proxy chn
p (ArgOptional x :: 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).
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)
                -> ServerT chn 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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p ('PrimitiveRef t)
-> t
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult _ _ _ 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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p ('SchemaRef sch l)
-> r
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult _ _ _ (RetSchema r :: SchemaQuery sch (sch :/: sty)
r) t :: 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 sname ~ t
         , LookupService ss ref ~ 'Service sname sanns ms
         , RunQueryFindHandler m ('Package pname ss) whole chn ss ('Service sname sanns ms) whole)
         => ResultConversion m ('Package pname ss) whole chn ('ObjectRef ref) t where
  convertResult :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn ('Package pname ss) m whole
-> [Text]
-> ReturnQuery' ('Package pname ss) ('ObjectRef ref)
-> t
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn ('Package pname ss) m whole
whole path :: [Text]
path (RetObject q :: ServiceQuery ('Package pname ss) (LookupService ss s)
q) h :: 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)
-> Schema
-> ServerT chn ('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)
       (s :: Service snm mnm anm) (pname :: Maybe snm)
       (ss :: [Service snm mnm anm]) (hs :: [[*]]) (sname :: snm)
       (sanns :: [*]) (ms :: [Method snm mnm anm]) (chn :: Mappings snm *)
       inh.
(RunQueryFindHandler m p hs chn ss s hs, p ~ 'Package pname ss,
 s ~ 'Service sname sanns ms, inh ~ MappingRight chn sname) =>
(forall a. m a -> ServerErrorIO a)
-> Schema
-> ServerT chn 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
                        (String -> Schema
forall a. HasCallStack => String -> a
error "cannot inspect schema inside a field")
                        ServerT chn ('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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p ('OptionalRef r)
-> Maybe s
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult _ _ _ _ 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 f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path (RetOptional q :: ReturnQuery' p r
q) (Just x :: s
x)
    = (forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> s
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn 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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p ('ListRef r)
-> [s]
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult f :: forall a. m a -> ServerErrorIO a
f whole :: ServerT chn p m whole
whole path :: [Text]
path (RetList q :: ReturnQuery' p r
q) xs :: [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)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> s
-> WriterT [GraphQLError] IO (Maybe Value)
forall {snm} {mnm} {anm} (m :: * -> *) (p :: Package snm mnm anm)
       (whole :: [[*]]) (chn :: ServiceChain snm) (r :: TypeRef snm) l.
ResultConversion m p whole chn r l =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn p m whole
-> [Text]
-> ReturnQuery' p r
-> l
-> WriterT [GraphQLError] IO (Maybe Value)
convertResult forall a. m a -> ServerErrorIO a
f ServerT chn 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 t :: Term sch ('DEnum name choices)
t _ = 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 args :: NP (Field sch) args
args) (QueryRecord rs :: [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 nm :: Maybe Text
nm choice :: NS (ChosenFieldQuery sch) args
choice)
        = let (val :: Maybe Value
val, fname :: 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 nm :: Maybe Text
nm)
        = let realName :: Text
realName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "__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]
++ "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 "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 x :: FieldValue sch t
x :* _) (Z (ChosenFieldQuery c :: 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 (_ :* xs :: NP (Field sch) xs
xs) (S rest :: 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 x :: t1
x) _
    = 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 xs :: [FieldValue sch t1]
xs) (RetSchList r :: 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 xs :: Maybe (FieldValue sch t1)
xs) (RetSchOptional r :: 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 t :: Term sch (sch :/: t1)
t) (RetSchSchema r :: 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.SelectionSet
  -> WriterT [GraphQLError] IO Aeson.Value
runIntroSchema :: [Text] -> Schema -> SelectionSet -> WriterT [GraphQLError] IO Value
runIntroSchema path :: [Text]
path s :: Schema
s@(Intro.Schema qr :: Maybe Text
qr mut :: Maybe Text
mut sub :: Maybe Text
sub ts :: TypeMap
ts) ss :: SelectionSet
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))
-> SelectionSet -> 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 SelectionSet
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.SelectionField (GQL.Field (Maybe Alias -> Maybe Text
forall a b. Coercible a b => a -> b
coerce -> Maybe Text
alias) (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
nm) _ _ innerss :: SelectionSet
innerss))
      = 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]
++ [Item [Text]
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
             "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
             "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 []
             "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
                    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 ty :: Type
ty -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty SelectionSet
innerss
             "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
                    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 ty :: Type
ty -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty SelectionSet
innerss
             "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
                    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 ty :: Type
ty -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
ty SelectionSet
innerss
             "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 (\t :: Type
t -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
t SelectionSet
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
             _ -> 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
$ "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
<> "' 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 _ = 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.SelectionSet
  -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
runIntroType :: [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType path :: [Text]
path s :: Schema
s@(Intro.Schema _ _ _ ts :: TypeMap
ts) (Intro.TypeRef t :: Text
t) ss :: SelectionSet
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
      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 ty :: Type
ty -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path Schema
s Type
ty SelectionSet
ss
runIntroType path :: [Text]
path s :: Schema
s (Intro.Type k :: TypeKind
k tnm :: Maybe Text
tnm fs :: [Field]
fs vals :: [EnumValue]
vals ofT :: Maybe Type
ofT) ss :: SelectionSet
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))
-> SelectionSet -> 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 SelectionSet
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.SelectionField (GQL.Field (Maybe Alias -> Maybe Text
forall a b. Coercible a b => a -> b
coerce -> Maybe Text
alias) (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
nm) _ _ innerss :: SelectionSet
innerss))
      = 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]
++ [Item [Text]
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, SelectionSet
innerss) of
             ("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)
             ("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
             ("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

             ("fields", _)
               -> case TypeKind
k of
                    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 (\f :: Field
f -> [Text]
-> Field -> SelectionSet -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields [Text]
path' Field
f SelectionSet
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
                    _ -> 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
             ("inputFields", _)
               -> case TypeKind
k of
                    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 (\f :: Field
f -> [Text]
-> Field -> SelectionSet -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields [Text]
path' Field
f SelectionSet
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
                    _ -> 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
             ("enumValues", _)
               -> 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 (\e :: EnumValue
e -> [Text]
-> EnumValue
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroEnums [Text]
path' EnumValue
e SelectionSet
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

             ("ofType", _)
               -> case Maybe Type
ofT of
                    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 o :: Type
o  -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
path' Schema
s Type
o SelectionSet
innerss

             -- unions and interfaces are not supported
             ("interfaces", _)
               -> 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 []
             ("possibleTypes", _)
               -> 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 []

             _ -> 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
$ "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
<> "' 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 _ = 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.SelectionSet
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroFields :: [Text]
-> Field -> SelectionSet -> WriterT [GraphQLError] IO (Maybe Value)
runIntroFields fpath :: [Text]
fpath fld :: Field
fld fss :: SelectionSet
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))
-> SelectionSet -> 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) SelectionSet
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 fpath :: [Text]
fpath (Intro.Field fnm :: Text
fnm fargs :: [Input]
fargs fty :: Type
fty)
                  (GQL.SelectionField (GQL.Field (Maybe Alias -> Maybe Text
forall a b. Coercible a b => a -> b
coerce -> Maybe Text
alias) (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
nm) _ _ innerss :: SelectionSet
innerss))
      = 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]
++ [Item [Text]
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, SelectionSet
innerss) of
          ("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
          ("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
          ("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
          ("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
          ("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

          ("type", _)
            -> [Text]
-> Schema
-> Type
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroType [Text]
fpath' Schema
s Type
fty SelectionSet
innerss
          ("args", _)
               -> 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 (\i :: Input
i -> [Text]
-> Input -> SelectionSet -> WriterT [GraphQLError] IO (Maybe Value)
runIntroInputs [Text]
fpath' Input
i SelectionSet
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

          _ -> 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
$ "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
<> "' 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 _ _ _ = 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.SelectionSet
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroEnums :: [Text]
-> EnumValue
-> SelectionSet
-> WriterT [GraphQLError] IO (Maybe Value)
runIntroEnums epath :: [Text]
epath enm :: EnumValue
enm ess :: SelectionSet
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))
-> SelectionSet -> 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) SelectionSet
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 epath :: [Text]
epath (Intro.EnumValue enm :: Text
enm)
                 (GQL.SelectionField (GQL.Field (Maybe Alias -> Maybe Text
forall a b. Coercible a b => a -> b
coerce -> Maybe Text
alias) (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
nm) _ _ innerss :: SelectionSet
innerss))
      = 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, SelectionSet
innerss) of
          ("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
          ("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
          ("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
          ("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

          _ -> 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
$ "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
<> "' 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 _ _ _ = 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.SelectionSet
      -> WriterT [GraphQLError] IO (Maybe Aeson.Value)
    runIntroInputs :: [Text]
-> Input -> SelectionSet -> WriterT [GraphQLError] IO (Maybe Value)
runIntroInputs ipath :: [Text]
ipath inm :: Input
inm iss :: SelectionSet
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))
-> SelectionSet -> 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) SelectionSet
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 ipath :: [Text]
ipath (Intro.Input inm :: Text
inm def :: Maybe Text
def ty :: Type
ty)
                 (GQL.SelectionField (GQL.Field (Maybe Alias -> Maybe Text
forall a b. Coercible a b => a -> b
coerce -> Maybe Text
alias) (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
nm) _ _ innerss :: SelectionSet
innerss))
      = 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]
++ [Item [Text]
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, SelectionSet
innerss) of
          ("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
          ("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
          ("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

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

          _ -> 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
$ "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
<> "' 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 _ _ _ = Maybe Pair -> WriterT [GraphQLError] IO (Maybe Pair)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pair
forall a. Maybe a
Nothing