{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App
  ( Config (..),
    VALIDATION_MODE (..),
    defaultConfig,
    debugConfig,
    App (..),
    AppData (..),
    runApp,
    withDebugger,
    disableIntrospection,
    mkApp,
    runAppStream,
    MapAPI (..),
    eitherSchema,
    withConstraint,
    APIConstraint,
  )
where

import Control.Monad.Except (throwError)
import qualified Data.Aeson as A
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.App.Internal.Resolving
  ( ResolverContext (..),
    ResponseStream,
    ResultT (..),
    RootResolverValue,
    resultOr,
    runRootResolverValue,
  )
import Data.Morpheus.App.Internal.Stitching (Stitching (..))
import Data.Morpheus.App.MapAPI (MapAPI (..))
import Data.Morpheus.Core
  ( Config (..),
    RenderGQL (..),
    VALIDATION_MODE (..),
    ValidateSchema (..),
    debugConfig,
    defaultConfig,
    internalSchema,
    parseRequestWith,
    render,
  )
import Data.Morpheus.Internal.Ext (GQLResult, (<:>))
import Data.Morpheus.Internal.Utils
  ( empty,
    prop,
    throwErrors,
  )
import Data.Morpheus.Types.IO
  ( GQLRequest (..),
    GQLResponse,
    renderResponse,
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    GQLErrors,
    Operation (..),
    OperationType (..),
    Schema (..),
    Selection (..),
    SelectionContent (..),
    VALID,
    Value,
    toAny,
  )
import qualified Data.Morpheus.Types.Internal.AST as AST
import Relude hiding (ByteString, empty)

mkApp :: (ValidateSchema s) => Schema s -> RootResolverValue e m -> App e m
mkApp :: forall (s :: Stage) e (m :: * -> *).
ValidateSchema s =>
Schema s -> RootResolverValue e m -> App e m
mkApp Schema s
appSchema RootResolverValue e m
appResolvers =
  (NonEmpty GQLError -> App e m)
-> (Schema VALID -> App e m)
-> Result GQLError (Schema VALID)
-> App e m
forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr
    NonEmpty GQLError -> App e m
forall event (m :: * -> *). NonEmpty GQLError -> App event m
FailApp
    (AppData e m VALID -> App e m
forall event (m :: * -> *). AppData event m VALID -> App event m
App (AppData e m VALID -> App e m)
-> (Schema VALID -> AppData e m VALID) -> Schema VALID -> App e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> [APIConstraint]
-> RootResolverValue e m
-> Schema VALID
-> AppData e m VALID
forall event (m :: * -> *) (s :: Stage).
Config
-> [APIConstraint]
-> RootResolverValue event m
-> Schema s
-> AppData event m s
AppData Config
defaultConfig [] RootResolverValue e m
appResolvers)
    (Bool -> Config -> Schema s -> Result GQLError (Schema VALID)
forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> Result GQLError (Schema VALID)
validateSchema Bool
True Config
defaultConfig Schema s
appSchema)

data App event (m :: Type -> Type)
  = App {forall event (m :: * -> *). App event m -> AppData event m VALID
app :: AppData event m VALID}
  | FailApp {forall event (m :: * -> *). App event m -> NonEmpty GQLError
appErrors :: GQLErrors}

instance RenderGQL (App e m) where
  renderGQL :: App e m -> Rendering
renderGQL App {AppData e m VALID
app :: forall event (m :: * -> *). App event m -> AppData event m VALID
app :: AppData e m VALID
app} = AppData e m VALID -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL AppData e m VALID
app
  renderGQL FailApp {NonEmpty GQLError
appErrors :: forall event (m :: * -> *). App event m -> NonEmpty GQLError
appErrors :: NonEmpty GQLError
appErrors} = ByteString -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (ByteString -> Rendering) -> ByteString -> Rendering
forall a b. (a -> b) -> a -> b
$ [GQLError] -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode ([GQLError] -> ByteString) -> [GQLError] -> ByteString
forall a b. (a -> b) -> a -> b
$ NonEmpty GQLError -> [GQLError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GQLError
appErrors

instance (Monad m) => Semigroup (App e m) where
  (FailApp NonEmpty GQLError
err1) <> :: App e m -> App e m -> App e m
<> (FailApp NonEmpty GQLError
err2) = NonEmpty GQLError -> App e m
forall event (m :: * -> *). NonEmpty GQLError -> App event m
FailApp (NonEmpty GQLError
err1 NonEmpty GQLError -> NonEmpty GQLError -> NonEmpty GQLError
forall a. Semigroup a => a -> a -> a
<> NonEmpty GQLError
err2)
  FailApp {NonEmpty GQLError
appErrors :: forall event (m :: * -> *). App event m -> NonEmpty GQLError
appErrors :: NonEmpty GQLError
appErrors} <> App {} = NonEmpty GQLError -> App e m
forall event (m :: * -> *). NonEmpty GQLError -> App event m
FailApp NonEmpty GQLError
appErrors
  App {} <> FailApp {NonEmpty GQLError
appErrors :: forall event (m :: * -> *). App event m -> NonEmpty GQLError
appErrors :: NonEmpty GQLError
appErrors} = NonEmpty GQLError -> App e m
forall event (m :: * -> *). NonEmpty GQLError -> App event m
FailApp NonEmpty GQLError
appErrors
  (App AppData e m VALID
x) <> (App AppData e m VALID
y) = (NonEmpty GQLError -> App e m)
-> (AppData e m VALID -> App e m)
-> Result GQLError (AppData e m VALID)
-> App e m
forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr NonEmpty GQLError -> App e m
forall event (m :: * -> *). NonEmpty GQLError -> App event m
FailApp AppData e m VALID -> App e m
forall event (m :: * -> *). AppData event m VALID -> App event m
App (AppData e m VALID
-> AppData e m VALID -> Result GQLError (AppData e m VALID)
forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
AppData e m VALID -> AppData e m VALID -> m (AppData e m VALID)
stitch AppData e m VALID
x AppData e m VALID
y)

type APIConstraint = Schema VALID -> Operation VALID -> Either String ()

data AppData event (m :: Type -> Type) s = AppData
  { forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Config
appConfig :: Config,
    forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
constraints :: [APIConstraint],
    forall event (m :: * -> *) (s :: Stage).
AppData event m s -> RootResolverValue event m
appResolvers :: RootResolverValue event m,
    forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appSchema :: Schema s
  }

instance RenderGQL (AppData e m s) where
  renderGQL :: AppData e m s -> Rendering
renderGQL = Schema s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (Schema s -> Rendering)
-> (AppData e m s -> Schema s) -> AppData e m s -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppData e m s -> Schema s
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appSchema

instance (Monad m) => Stitching (AppData e m s) where
  stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
AppData e m s -> AppData e m s -> m (AppData e m s)
stitch AppData e m s
x AppData e m s
y =
    Config
-> [APIConstraint]
-> RootResolverValue e m
-> Schema s
-> AppData e m s
forall event (m :: * -> *) (s :: Stage).
Config
-> [APIConstraint]
-> RootResolverValue event m
-> Schema s
-> AppData event m s
AppData
      (AppData e m s -> Config
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Config
appConfig AppData e m s
y)
      (AppData e m s -> [APIConstraint]
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
constraints AppData e m s
x [APIConstraint] -> [APIConstraint] -> [APIConstraint]
forall a. Semigroup a => a -> a -> a
<> AppData e m s -> [APIConstraint]
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
constraints AppData e m s
y)
      (RootResolverValue e m -> Schema s -> AppData e m s)
-> m (RootResolverValue e m) -> m (Schema s -> AppData e m s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RootResolverValue e m
 -> RootResolverValue e m -> m (RootResolverValue e m))
-> (AppData e m s -> RootResolverValue e m)
-> AppData e m s
-> AppData e m s
-> m (RootResolverValue e m)
forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop RootResolverValue e m
-> RootResolverValue e m -> m (RootResolverValue e m)
forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
RootResolverValue e m
-> RootResolverValue e m -> m (RootResolverValue e m)
stitch AppData e m s -> RootResolverValue e m
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> RootResolverValue event m
appResolvers AppData e m s
x AppData e m s
y
      m (Schema s -> AppData e m s) -> m (Schema s) -> m (AppData e m s)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Schema s -> Schema s -> m (Schema s))
-> (AppData e m s -> Schema s)
-> AppData e m s
-> AppData e m s
-> m (Schema s)
forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop Schema s -> Schema s -> m (Schema s)
forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Schema s -> Schema s -> m (Schema s)
stitch AppData e m s -> Schema s
forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appSchema AppData e m s
x AppData e m s
y

checkConstraints :: Schema VALID -> Operation VALID -> [APIConstraint] -> GQLResult ()
checkConstraints :: Schema VALID -> Operation VALID -> [APIConstraint] -> GQLResult ()
checkConstraints Schema VALID
appSchema Operation VALID
validRequest [APIConstraint]
constraints =
  (String -> GQLResult ())
-> ([()] -> GQLResult ()) -> Either String [()] -> GQLResult ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (GQLError -> GQLResult ()
forall a. GQLError -> Result GQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLResult ())
-> (String -> GQLError) -> String -> GQLResult ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GQLError
forall a. IsString a => String -> a
fromString (String -> GQLError) -> (String -> String) -> String -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"API Constraint: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>))
    (GQLResult () -> [()] -> GQLResult ()
forall a b. a -> b -> a
const (GQLResult () -> [()] -> GQLResult ())
-> GQLResult () -> [()] -> GQLResult ()
forall a b. (a -> b) -> a -> b
$ () -> GQLResult ()
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    ((APIConstraint -> Either String ())
-> [APIConstraint] -> Either String [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\APIConstraint
f -> APIConstraint
f Schema VALID
appSchema Operation VALID
validRequest) [APIConstraint]
constraints)

runAppData ::
  (Monad m, ValidateSchema s) =>
  AppData event m s ->
  GQLRequest ->
  ResponseStream event m (Value VALID)
runAppData :: forall (m :: * -> *) (s :: Stage) event.
(Monad m, ValidateSchema s) =>
AppData event m s
-> GQLRequest -> ResponseStream event m (Value VALID)
runAppData AppData {Config
appConfig :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Config
appConfig :: Config
appConfig, Schema s
appSchema :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appSchema :: Schema s
appSchema, RootResolverValue event m
appResolvers :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> RootResolverValue event m
appResolvers :: RootResolverValue event m
appResolvers, [APIConstraint]
constraints :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
constraints :: [APIConstraint]
constraints} GQLRequest
request = do
  ResolverContext
validRequest <- [APIConstraint]
-> Schema s
-> Config
-> GQLRequest
-> ResponseStream event m ResolverContext
forall (m :: * -> *) (s :: Stage) event.
(Monad m, ValidateSchema s) =>
[APIConstraint]
-> Schema s
-> Config
-> GQLRequest
-> ResponseStream event m ResolverContext
validateReq [APIConstraint]
constraints Schema s
appSchema Config
appConfig GQLRequest
request
  RootResolverValue event m
-> ResolverContext -> ResponseStream event m (Value VALID)
forall (m :: * -> *) e.
Monad m =>
RootResolverValue e m
-> ResolverContext -> ResponseStream e m (Value VALID)
runRootResolverValue RootResolverValue event m
appResolvers ResolverContext
validRequest

validateReq ::
  ( Monad m,
    ValidateSchema s
  ) =>
  [APIConstraint] ->
  Schema s ->
  Config ->
  GQLRequest ->
  ResponseStream event m ResolverContext
validateReq :: forall (m :: * -> *) (s :: Stage) event.
(Monad m, ValidateSchema s) =>
[APIConstraint]
-> Schema s
-> Config
-> GQLRequest
-> ResponseStream event m ResolverContext
validateReq [APIConstraint]
constraints Schema s
inputSchema Config
config GQLRequest
request = m (Result GQLError ([ResponseEvent event m], ResolverContext))
-> ResultT (ResponseEvent event m) m ResolverContext
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([ResponseEvent event m], ResolverContext))
 -> ResultT (ResponseEvent event m) m ResolverContext)
-> m (Result GQLError ([ResponseEvent event m], ResolverContext))
-> ResultT (ResponseEvent event m) m ResolverContext
forall a b. (a -> b) -> a -> b
$
  Result GQLError ([ResponseEvent event m], ResolverContext)
-> m (Result GQLError ([ResponseEvent event m], ResolverContext))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([ResponseEvent event m], ResolverContext)
 -> m (Result GQLError ([ResponseEvent event m], ResolverContext)))
-> Result GQLError ([ResponseEvent event m], ResolverContext)
-> m (Result GQLError ([ResponseEvent event m], ResolverContext))
forall a b. (a -> b) -> a -> b
$
    do
      Schema VALID
validSchema <- Bool -> Config -> Schema s -> Result GQLError (Schema VALID)
forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> Result GQLError (Schema VALID)
validateSchema Bool
True Config
config Schema s
inputSchema
      Schema VALID
schema <- Schema VALID
forall (s :: Stage). Schema s
internalSchema Schema VALID -> Schema VALID -> Result GQLError (Schema VALID)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> Schema VALID
validSchema
      Operation VALID
operation <- Config -> Schema VALID -> GQLRequest -> GQLResult (Operation VALID)
parseRequestWith Config
config Schema VALID
validSchema GQLRequest
request
      Schema VALID -> Operation VALID -> [APIConstraint] -> GQLResult ()
checkConstraints Schema VALID
schema Operation VALID
operation [APIConstraint]
constraints
      ([ResponseEvent event m], ResolverContext)
-> Result GQLError ([ResponseEvent event m], ResolverContext)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( [],
          ResolverContext
            { Schema VALID
schema :: Schema VALID
schema :: Schema VALID
schema,
              Config
config :: Config
config :: Config
config,
              Operation VALID
operation :: Operation VALID
operation :: Operation VALID
operation,
              currentType :: TypeDefinition ANY VALID
currentType =
                TypeDefinition OBJECT VALID -> TypeDefinition ANY VALID
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny (TypeDefinition OBJECT VALID -> TypeDefinition ANY VALID)
-> TypeDefinition OBJECT VALID -> TypeDefinition ANY VALID
forall a b. (a -> b) -> a -> b
$
                  TypeDefinition OBJECT VALID
-> Maybe (TypeDefinition OBJECT VALID)
-> TypeDefinition OBJECT VALID
forall a. a -> Maybe a -> a
fromMaybe
                    (Schema VALID -> TypeDefinition OBJECT VALID
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
AST.query Schema VALID
schema)
                    (OperationType
-> Schema VALID -> Maybe (TypeDefinition OBJECT VALID)
forall (s :: Stage).
OperationType -> Schema s -> Maybe (TypeDefinition OBJECT s)
rootType (Operation VALID -> OperationType
forall (s :: Stage). Operation s -> OperationType
operationType Operation VALID
operation) Schema VALID
schema),
              currentSelection :: Selection VALID
currentSelection =
                Selection
                  { selectionName :: FieldName
selectionName = FieldName
"Root",
                    selectionArguments :: Arguments VALID
selectionArguments = Arguments VALID
forall coll. Empty coll => coll
empty,
                    selectionPosition :: Position
selectionPosition = Operation VALID -> Position
forall (s :: Stage). Operation s -> Position
operationPosition Operation VALID
operation,
                    selectionAlias :: Maybe FieldName
selectionAlias = Maybe FieldName
forall a. Maybe a
Nothing,
                    selectionContent :: SelectionContent VALID
selectionContent = SelectionSet VALID -> SelectionContent VALID
forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet (Operation VALID -> SelectionSet VALID
forall (s :: Stage). Operation s -> SelectionSet s
operationSelection Operation VALID
operation),
                    selectionDirectives :: Directives VALID
selectionDirectives = Directives VALID
forall coll. Empty coll => coll
empty,
                    selectionOrigin :: Maybe FragmentName
selectionOrigin = Maybe FragmentName
forall a. Maybe a
Nothing
                  }
            }
        )

rootType :: OperationType -> Schema s -> Maybe (AST.TypeDefinition AST.OBJECT s)
rootType :: forall (s :: Stage).
OperationType -> Schema s -> Maybe (TypeDefinition OBJECT s)
rootType OperationType
OPERATION_QUERY = TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> (Schema s -> TypeDefinition OBJECT s)
-> Schema s
-> Maybe (TypeDefinition OBJECT s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
AST.query
rootType OperationType
OPERATION_MUTATION = Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation
rootType OperationType
OPERATION_SUBSCRIPTION = Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription

stateless ::
  (Functor m) =>
  ResponseStream event m (Value VALID) ->
  m GQLResponse
stateless :: forall (m :: * -> *) event.
Functor m =>
ResponseStream event m (Value VALID) -> m GQLResponse
stateless = (Result GQLError ([ResponseEvent event m], Value VALID)
 -> GQLResponse)
-> m (Result GQLError ([ResponseEvent event m], Value VALID))
-> m GQLResponse
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result GQLError (Value VALID) -> GQLResponse
renderResponse (Result GQLError (Value VALID) -> GQLResponse)
-> (Result GQLError ([ResponseEvent event m], Value VALID)
    -> Result GQLError (Value VALID))
-> Result GQLError ([ResponseEvent event m], Value VALID)
-> GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([ResponseEvent event m], Value VALID) -> Value VALID)
-> Result GQLError ([ResponseEvent event m], Value VALID)
-> Result GQLError (Value VALID)
forall a b. (a -> b) -> Result GQLError a -> Result GQLError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ResponseEvent event m], Value VALID) -> Value VALID
forall a b. (a, b) -> b
snd) (m (Result GQLError ([ResponseEvent event m], Value VALID))
 -> m GQLResponse)
-> (ResponseStream event m (Value VALID)
    -> m (Result GQLError ([ResponseEvent event m], Value VALID)))
-> ResponseStream event m (Value VALID)
-> m GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseStream event m (Value VALID)
-> m (Result GQLError ([ResponseEvent event m], Value VALID))
forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT

runAppStream :: (Monad m) => App event m -> GQLRequest -> ResponseStream event m (Value VALID)
runAppStream :: forall (m :: * -> *) event.
Monad m =>
App event m -> GQLRequest -> ResponseStream event m (Value VALID)
runAppStream App {AppData event m VALID
app :: forall event (m :: * -> *). App event m -> AppData event m VALID
app :: AppData event m VALID
app} = AppData event m VALID
-> GQLRequest -> ResponseStream event m (Value VALID)
forall (m :: * -> *) (s :: Stage) event.
(Monad m, ValidateSchema s) =>
AppData event m s
-> GQLRequest -> ResponseStream event m (Value VALID)
runAppData AppData event m VALID
app
runAppStream FailApp {NonEmpty GQLError
appErrors :: forall event (m :: * -> *). App event m -> NonEmpty GQLError
appErrors :: NonEmpty GQLError
appErrors} = ResponseStream event m (Value VALID)
-> GQLRequest -> ResponseStream event m (Value VALID)
forall a b. a -> b -> a
const (ResponseStream event m (Value VALID)
 -> GQLRequest -> ResponseStream event m (Value VALID))
-> ResponseStream event m (Value VALID)
-> GQLRequest
-> ResponseStream event m (Value VALID)
forall a b. (a -> b) -> a -> b
$ NonEmpty GQLError -> ResponseStream event m (Value VALID)
forall e (m :: * -> *) b. MonadError e m => NonEmpty e -> m b
throwErrors NonEmpty GQLError
appErrors

runApp :: (MapAPI a b, Monad m) => App e m -> a -> m b
runApp :: forall a b (m :: * -> *) e.
(MapAPI a b, Monad m) =>
App e m -> a -> m b
runApp App e m
app = (GQLRequest -> m GQLResponse) -> a -> m b
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
forall (m :: * -> *).
Applicative m =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI (ResponseStream e m (Value VALID) -> m GQLResponse
forall (m :: * -> *) event.
Functor m =>
ResponseStream event m (Value VALID) -> m GQLResponse
stateless (ResponseStream e m (Value VALID) -> m GQLResponse)
-> (GQLRequest -> ResponseStream e m (Value VALID))
-> GQLRequest
-> m GQLResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App e m -> GQLRequest -> ResponseStream e m (Value VALID)
forall (m :: * -> *) event.
Monad m =>
App event m -> GQLRequest -> ResponseStream event m (Value VALID)
runAppStream App e m
app)

mapApp :: (AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
mapApp :: forall e (m :: * -> *).
(AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
mapApp AppData e m VALID -> AppData e m VALID
f App {AppData e m VALID
app :: forall event (m :: * -> *). App event m -> AppData event m VALID
app :: AppData e m VALID
app} =
  App {app :: AppData e m VALID
app = AppData e m VALID -> AppData e m VALID
f AppData e m VALID
app}
mapApp AppData e m VALID -> AppData e m VALID
_ App e m
x = App e m
x

mapConfig :: (Config -> Config) -> App e m -> App e m
mapConfig :: forall e (m :: * -> *). (Config -> Config) -> App e m -> App e m
mapConfig Config -> Config
g = (AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
forall e (m :: * -> *).
(AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
mapApp AppData e m VALID -> AppData e m VALID
forall {event} {m :: * -> *} {s :: Stage}.
AppData event m s -> AppData event m s
f
  where
    f :: AppData event m s -> AppData event m s
f AppData {Config
appConfig :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Config
appConfig :: Config
appConfig, [APIConstraint]
Schema s
RootResolverValue event m
constraints :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
appResolvers :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> RootResolverValue event m
appSchema :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
constraints :: [APIConstraint]
appResolvers :: RootResolverValue event m
appSchema :: Schema s
..} = AppData {appConfig :: Config
appConfig = Config -> Config
g Config
appConfig, [APIConstraint]
Schema s
RootResolverValue event m
constraints :: [APIConstraint]
appResolvers :: RootResolverValue event m
appSchema :: Schema s
constraints :: [APIConstraint]
appResolvers :: RootResolverValue event m
appSchema :: Schema s
..}

withDebugger :: App e m -> App e m
withDebugger :: forall e (m :: * -> *). App e m -> App e m
withDebugger = (Config -> Config) -> App e m -> App e m
forall e (m :: * -> *). (Config -> Config) -> App e m -> App e m
mapConfig (\Config
c -> Config
c {debug = True})

disableIntrospection :: App e m -> App e m
disableIntrospection :: forall e (m :: * -> *). App e m -> App e m
disableIntrospection = (Config -> Config) -> App e m -> App e m
forall e (m :: * -> *). (Config -> Config) -> App e m -> App e m
mapConfig (\Config
c -> Config
c {introspection = False})

withConstraint :: APIConstraint -> App e m -> App e m
withConstraint :: forall e (m :: * -> *). APIConstraint -> App e m -> App e m
withConstraint APIConstraint
constraint = (AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
forall e (m :: * -> *).
(AppData e m VALID -> AppData e m VALID) -> App e m -> App e m
mapApp AppData e m VALID -> AppData e m VALID
forall {event} {m :: * -> *} {s :: Stage}.
AppData event m s -> AppData event m s
f
  where
    f :: AppData event m s -> AppData event m s
f AppData {[APIConstraint]
Schema s
Config
RootResolverValue event m
appConfig :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Config
constraints :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> [APIConstraint]
appResolvers :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> RootResolverValue event m
appSchema :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appConfig :: Config
constraints :: [APIConstraint]
appResolvers :: RootResolverValue event m
appSchema :: Schema s
..} = AppData {constraints :: [APIConstraint]
constraints = APIConstraint
constraint APIConstraint -> [APIConstraint] -> [APIConstraint]
forall a. a -> [a] -> [a]
: [APIConstraint]
constraints, Schema s
Config
RootResolverValue event m
appConfig :: Config
appResolvers :: RootResolverValue event m
appSchema :: Schema s
appConfig :: Config
appResolvers :: RootResolverValue event m
appSchema :: Schema s
..}

eitherSchema :: App event m -> Either [GQLError] ByteString
eitherSchema :: forall event (m :: * -> *).
App event m -> Either [GQLError] ByteString
eitherSchema (App AppData {Schema VALID
appSchema :: forall event (m :: * -> *) (s :: Stage).
AppData event m s -> Schema s
appSchema :: Schema VALID
appSchema}) = ByteString -> Either [GQLError] ByteString
forall a b. b -> Either a b
Right (Schema VALID -> ByteString
forall a. RenderGQL a => a -> ByteString
render Schema VALID
appSchema)
eitherSchema (FailApp NonEmpty GQLError
errors) = [GQLError] -> Either [GQLError] ByteString
forall a b. a -> Either a b
Left (NonEmpty GQLError -> [GQLError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GQLError
errors)