mu-graphql 0.3.0.0 → 0.4.0.0

raw patch · 9 files changed

+456/−315 lines, 9 filesdep +foldldep ~aesondep ~asyncdep ~attoparsecnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: foldl

Dependency ranges changed: aeson, async, attoparsec, bytestring, conduit, http-types, list-t, mtl, mu-rpc, mu-schema, parsers, regex-tdfa, scientific, sop-core, stm, stm-chans, stm-conduit, stm-containers, template-haskell, text, unordered-containers, uuid, wai, wai-extra, wai-websockets, warp, warp-tls, websockets

API changes (from Hackage documentation)

Files

• exe/Main.hs +3/−1
• mu-graphql.cabal +37/−37
• src/Mu/GraphQL/Annotations.hs +6/−2
• src/Mu/GraphQL/Quasi.hs +62/−35
• src/Mu/GraphQL/Query/Definition.hs +27/−19
• src/Mu/GraphQL/Query/Introspection.hs +5/−5
• src/Mu/GraphQL/Query/Parse.hs +144/−95
• src/Mu/GraphQL/Query/Run.hs +131/−107
• src/Mu/GraphQL/Server.hs +41/−14

@@ -8,6 +8,7 @@ {-# language TemplateHaskell       #-} {-# language TupleSections         #-} {-# language TypeApplications      #-}+{-# language TypeFamilies          #-} {-# language TypeOperators         #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures #-} @@ -62,7 +63,8 @@     , (3, "Michael Ende", [(4, "The Neverending Story"), (5, "Momo")])     ] -libraryServer :: forall m. (MonadServer m) => ServerT ServiceMapping ServiceDefinition m _+libraryServer :: forall m i. (MonadServer m)+              => ServerT ServiceMapping i ServiceDefinition m _ libraryServer   = resolver ( object @"Book"   ( field  @"id"      bookId                                 , field  @"title"   bookTitle

@@ -1,5 +1,5 @@ name:          mu-graphql-version:       0.3.0.0+version:       0.4.0.0 synopsis:      GraphQL support for Mu description:   GraphQL servers and clients for Mu-Haskell cabal-version: >=1.10@@ -28,36 +28,36 @@     Mu.GraphQL.Query.Run     Mu.GraphQL.Subscription.Protocol -  -- other-extensions:   build-depends:-      aeson-    , async-    , attoparsec-    , base                  >=4.12 && <5-    , bytestring-    , conduit+      aeson                 >=1.4   && <2+    , async                 >=2.2   && <3+    , attoparsec            >=0.13  && <0.14+    , base                  >=4.12  && <5+    , bytestring            >=0.10  && <0.11+    , conduit               >=1.3.2 && <2+    , foldl                 >=1.4   && <2     , graphql-parser-    , http-types-    , list-t-    , mtl-    , mu-rpc-    , mu-schema-    , parsers-    , scientific-    , sop-core-    , stm-    , stm-chans-    , stm-conduit-    , stm-containers-    , template-haskell-    , text-    , unordered-containers-    , uuid-    , wai-    , wai-websockets-    , warp-    , warp-tls-    , websockets+    , http-types            >=0.12  && <0.13+    , list-t                >=1.0   && <2+    , mtl                   >=2.2   && <2.3+    , mu-rpc                ==0.4.*+    , mu-schema             ==0.3.*+    , parsers               >=0.12  && <0.13+    , scientific            >=0.3   && <0.4+    , sop-core              >=0.5   && <0.6+    , stm                   >=2.5   && <3+    , stm-chans             >=3     && <4+    , stm-conduit           >=4     && <5+    , stm-containers        >=1.1   && <2+    , template-haskell      >=2.14  && <2.16+    , text                  >=1.2   && <1.3+    , unordered-containers  >=0.2   && <0.3+    , uuid                  >=1.3   && <2+    , wai                   >=3.2   && <4+    , wai-websockets        >=3     && <4+    , warp                  >=3.3   && <4+    , warp-tls              >=3.2   && <4+    , websockets            >=0.12  && <0.13    hs-source-dirs:   src   default-language: Haskell2010@@ -69,12 +69,12 @@   default-language: Haskell2010   ghc-options:      -Wall   build-depends:-      base        >=4.12    && <5-    , conduit+      base        >=4.12  && <5+    , conduit     >=1.3.2 && <1.4     , mu-graphql-    , mu-rpc-    , mu-schema-    , regex-tdfa  >=1.3.1.0-    , text-    , wai-extra-    , warp+    , mu-rpc      ==0.4.*+    , mu-schema   ==0.3.*+    , regex-tdfa  >=1.3   && <2+    , text        >=1.2   && <2+    , wai-extra   >=3     && <4+    , warp        >=3.3   && <4

@@ -17,9 +17,10 @@ -} module Mu.GraphQL.Annotations (   ValueConst(..)-, DefaultValue+, DefaultValue(..) , ReflectValueConst(..) , fromGQLValueConst+, module Mu.Rpc.Annotations ) where  import           Control.Applicative           (Alternative (..))@@ -29,9 +30,12 @@ import           GHC.TypeLits import qualified Language.GraphQL.Draft.Syntax as GQL +import           Mu.Rpc.Annotations+ -- | Specifies the default value of an argument. --   To be used as an annotation.-data DefaultValue (v :: ValueConst Nat Symbol)+newtype DefaultValue+  = DefaultValue (ValueConst Nat Symbol)  -- | Type-level GraphQL constant values. --   Due to limitations in type-level literal values

@@ -1,6 +1,7 @@ {-# language DataKinds         #-} {-# language OverloadedStrings #-} {-# language TemplateHaskell   #-}+{-# language TupleSections     #-} {-# language ViewPatterns      #-} {-| Description : Quasi-quoters for GraphQL schemas@@ -17,6 +18,7 @@ import           Data.Coerce                   (coerce) import qualified Data.HashMap.Strict           as HM import           Data.List                     (foldl')+import           Data.Maybe                    (catMaybes) import qualified Data.Text                     as T import qualified Data.Text.IO                  as TIO import           Data.UUID                     (UUID)@@ -50,8 +52,8 @@  data Result =     GQLScalar-  | GQLSchema Type-  | GQLService Type+  | GQLSchema  Type+  | GQLService Type [(T.Text, (T.Text, (T.Text, Type)))]  data GQLType =     Enum@@ -72,12 +74,18 @@ classify = HM.fromList . (typeToKeyValue <$>)   where     typeToKeyValue :: GQL.TypeDefinition -> (T.Text, GQLType)-    typeToKeyValue (GQL.TypeDefinitionScalar (GQL.ScalarTypeDefinition _ (coerce -> name) _))             = (name, Scalar)-    typeToKeyValue (GQL.TypeDefinitionObject (GQL.ObjectTypeDefinition _ (coerce -> name) _ _ _))         = (name, Object)-    typeToKeyValue (GQL.TypeDefinitionInterface (GQL.InterfaceTypeDefinition _ (coerce -> name) _ _))     = (name, Other)-    typeToKeyValue (GQL.TypeDefinitionUnion (GQL.UnionTypeDefinition _ (coerce -> name) _ _))             = (name, Other)-    typeToKeyValue (GQL.TypeDefinitionEnum (GQL.EnumTypeDefinition _ (coerce -> name) _ _))               = (name, Enum)-    typeToKeyValue (GQL.TypeDefinitionInputObject (GQL.InputObjectTypeDefinition _ (coerce -> name) _ _)) = (name, InputObject)+    typeToKeyValue (GQL.TypeDefinitionScalar (GQL.ScalarTypeDefinition _ name _))+      = (coerce name, Scalar)+    typeToKeyValue (GQL.TypeDefinitionObject (GQL.ObjectTypeDefinition _ name _ _ _))+      = (coerce name, Object)+    typeToKeyValue (GQL.TypeDefinitionInterface (GQL.InterfaceTypeDefinition _ name _ _))+      = (coerce name, Other)+    typeToKeyValue (GQL.TypeDefinitionUnion (GQL.UnionTypeDefinition _ name _ _))+      = (coerce name, Other)+    typeToKeyValue (GQL.TypeDefinitionEnum (GQL.EnumTypeDefinition _ name _ _))+      = (coerce name, Enum)+    typeToKeyValue (GQL.TypeDefinitionInputObject (GQL.InputObjectTypeDefinition _ name _ _))+      = (coerce name, InputObject)  -- | Constructs the GraphQL tree splitting between Schemas and Services. graphqlToDecls :: String -> String -> [GQL.TypeSystemDefinition] -> Q [Dec]@@ -90,48 +98,69 @@       schMap       = classifySchema schTypes   rs <- traverse (typeToDec schemaName' typeMap schMap) types   let schemaTypes  = [x | GQLSchema  x <- rs]-      serviceTypes = [x | GQLService x <- rs]+      serviceTypes = [x | GQLService x _ <- rs]+      defaultDefs  = concat [d | GQLService _ d <- rs]   schemaDec <- tySynD schemaName' [] (pure $ typesToList schemaTypes)-  serviceDec <- tySynD serviceName' []-    [t| 'Package ('Just $(textToStrLit $ T.pack serviceName))-                  $(pure $ typesToList serviceTypes) |]-  pure [schemaDec, serviceDec]+  pkgTy <- [t| 'Package ('Just $(textToStrLit $ T.pack serviceName))+                        $(pure $ typesToList serviceTypes) |]+  serviceDec <- tySynD serviceName' [] (pure pkgTy)+  defaultDec <- [d| type instance AnnotatedPackage DefaultValue $(pure pkgTy) =+                      $(typesToList <$> traverse defaultDeclToTy defaultDefs) |]+  pure $ schemaDec : serviceDec : defaultDec +defaultDeclToTy :: (T.Text, (T.Text, (T.Text, Type))) -> Q Type+defaultDeclToTy (sn, (mn, (an, dv)))+  = [t| 'AnnArg $(textToStrLit sn) $(textToStrLit mn) $(textToStrLit an) $(pure dv) |]+ -- | Reads a GraphQL 'TypeDefinition' and returns a 'Result'. typeToDec :: Name -> TypeMap -> SchemaMap -> GQL.TypeDefinition -> Q Result+typeToDec _ _ _ (GQL.TypeDefinitionInterface _)+  = fail "interface types are not supported"+typeToDec _ _ _ (GQL.TypeDefinitionUnion _)+  = fail "union types are not supported" typeToDec schemaName tm _ (GQL.TypeDefinitionScalar (GQL.ScalarTypeDefinition _ s _)) =   GQLScalar <$ gqlTypeToType s tm schemaName typeToDec schemaName tm sm (GQL.TypeDefinitionObject objs) = objToDec objs   where     objToDec :: GQL.ObjectTypeDefinition -> Q Result-    objToDec (GQL.ObjectTypeDefinition _ (coerce -> nm) _ _ flds) =-      GQLService <$> [t| 'Service $(textToStrLit nm) '[]-          $(typesToList <$> traverse (gqlFieldToType nm) flds) |]-    gqlFieldToType :: T.Text -> GQL.FieldDefinition -> Q Type-    gqlFieldToType sn (GQL.FieldDefinition _ (coerce -> fnm) args ftyp _) =-      [t| 'Method $(textToStrLit fnm) '[]-            $(typesToList <$> traverse argToType args)-            $(returnType sn ftyp)|]+    objToDec (GQL.ObjectTypeDefinition _ (coerce -> nm) _ _ flds) = do+      (fieldInfos, defaults) <- unzip <$> traverse (gqlFieldToType nm) flds+      GQLService <$> [t| 'Service $(textToStrLit nm)+                                  $(pure $ typesToList fieldInfos) |]+                 <*> pure ((nm,) <$> concat defaults)+    gqlFieldToType :: T.Text -> GQL.FieldDefinition+                   -> Q (Type, [(T.Text, (T.Text, Type))])+    gqlFieldToType sn (GQL.FieldDefinition _ (coerce -> fnm) args ftyp _) = do+      (argInfos, defaults) <- unzip <$> traverse argToType args+      (,) <$> [t| 'Method $(textToStrLit fnm)+                          $(pure $ typesToList argInfos)+                          $(returnType sn ftyp) |]+          <*> pure ((fnm,) <$> catMaybes defaults)     returnType :: T.Text -> GQL.GType -> Q Type     returnType serviceName typ =       case HM.lookup serviceName sm of         Just GQL.OperationTypeSubscription -> [t|'RetStream $(retToType typ)|]         _                                  -> [t|'RetSingle $(retToType typ)|]-    argToType :: GQL.InputValueDefinition -> Q Type+    argToType :: GQL.InputValueDefinition -> Q (Type, Maybe (T.Text, Type))     argToType (GQL.InputValueDefinition _ (coerce -> aname) atype Nothing) =-      [t| 'ArgSingle ('Just $(textToStrLit aname)) '[] $(retToType atype) |]+      (, Nothing) <$> [t| 'ArgSingle ('Just $(textToStrLit aname)) $(retToType atype) |]     argToType (GQL.InputValueDefinition _ (coerce -> aname) atype (Just defs)) =-      [t| 'ArgSingle ('Just $(textToStrLit aname))-                      '[DefaultValue $( defToVConst defs )] $(retToType atype) |]+      (,) <$> [t| 'ArgSingle ('Just $(textToStrLit aname)) $(retToType atype) |]+          <*> (Just . (aname,) <$> [t| 'DefaultValue $( defToVConst defs ) |])     defToVConst :: GQL.DefaultValue -> Q Type-    defToVConst (GQL.VCInt _)                         = [t| 'VCInt |]-    defToVConst (GQL.VCFloat _)                       = fail "floats as default arguments are not supported"-    defToVConst (GQL.VCString (coerce -> s))          = [t| 'VCString $(textToStrLit s) |]-    defToVConst (GQL.VCBoolean _)                     = [t| 'VCBoolean|]-    defToVConst GQL.VCNull                            = [t| 'VCNull |]-    defToVConst (GQL.VCEnum (coerce -> e))            = [t| 'VCEnum $(textToStrLit e) |]-    defToVConst (GQL.VCList (GQL.ListValueG xs))      = [t| 'VCList $(typesToList <$> traverse defToVConst xs) |]-    defToVConst (GQL.VCObject (GQL.ObjectValueG obj)) = [t| 'VCObject $(typesToList <$> traverse fromGQLField obj) |]+    defToVConst (GQL.VCBoolean _) = [t| 'VCBoolean|]+    defToVConst GQL.VCNull        = [t| 'VCNull |]+    defToVConst (GQL.VCInt _)     = [t| 'VCInt |]+    defToVConst (GQL.VCFloat _)+      = fail "floats as default arguments are not supported"+    defToVConst (GQL.VCString (coerce -> s))+      = [t| 'VCString $(textToStrLit s) |]+    defToVConst (GQL.VCEnum (coerce -> e))+      = [t| 'VCEnum $(textToStrLit e) |]+    defToVConst (GQL.VCList (GQL.ListValueG xs))+      = [t| 'VCList $(typesToList <$> traverse defToVConst xs) |]+    defToVConst (GQL.VCObject (GQL.ObjectValueG obj))+      = [t| 'VCObject $(typesToList <$> traverse fromGQLField obj) |]     fromGQLField :: GQL.ObjectFieldG GQL.ValueConst -> Q Type     fromGQLField (GQL.ObjectFieldG (coerce -> n) v)   = [t| ($(textToStrLit n), $(defToVConst v)) |]     retToType :: GQL.GType -> Q Type@@ -144,8 +173,6 @@     retToType (GQL.TypeList (coerce -> True) (coerce -> a)) =       [t| 'OptionalRef ('ListRef $(retToType a)) |]     retToType _ = fail "this should not happen, please, file an issue"-typeToDec _ _ _ (GQL.TypeDefinitionInterface _)       = fail "interface types are not supported"-typeToDec _ _ _ (GQL.TypeDefinitionUnion _)           = fail "union types are not supported" typeToDec _ _ _ (GQL.TypeDefinitionEnum enums)        = enumToDecl enums   where     enumToDecl :: GQL.EnumTypeDefinition -> Q Result

@@ -12,57 +12,63 @@ import           Mu.Rpc import           Mu.Schema -data Document (p :: Package snm mnm anm)+data Document (p :: Package snm mnm anm (TypeRef snm))               (qr :: Maybe snm) (mut :: Maybe snm) (sub :: Maybe snm) where   QueryDoc-    :: LookupService ss qr ~ 'Service qr qanns qms+    :: LookupService ss qr ~ 'Service qr qms     => ServiceQuery ('Package pname ss) (LookupService ss qr)     -> Document ('Package pname ss) ('Just qr) mut sub   MutationDoc-    :: LookupService ss mut ~ 'Service mut manns mms+    :: LookupService ss mut ~ 'Service mut mms     => ServiceQuery ('Package pname ss) (LookupService ss mut)     -> Document ('Package pname ss) qr ('Just mut) sub   SubscriptionDoc-    :: LookupService ss sub ~ 'Service sub manns mms+    :: LookupService ss sub ~ 'Service sub mms     => OneMethodQuery ('Package pname ss) (LookupService ss sub)     -> Document ('Package pname ss) qr mut ('Just sub) -type ServiceQuery (p :: Package snm mnm anm) (s :: Service snm mnm anm)+type ServiceQuery (p :: Package snm mnm anm (TypeRef snm))+                  (s :: Service snm mnm anm (TypeRef snm))   = [OneMethodQuery p s] -data OneMethodQuery (p :: Package snm mnm anm) (s :: Service snm mnm anm) where+data OneMethodQuery (p :: Package snm mnm anm (TypeRef snm))+                    (s :: Service snm mnm anm (TypeRef snm)) where   OneMethodQuery     :: Maybe Text     -> NS (ChosenMethodQuery p) ms-    -> OneMethodQuery p ('Service nm anns ms)+    -> OneMethodQuery p ('Service nm ms)   -- the special '__typename' field   TypeNameQuery     :: Maybe Text-    -> OneMethodQuery p ('Service nm anns ms)+    -> OneMethodQuery p ('Service nm ms)   -- introspection fields   SchemaQuery     :: Maybe Text     -> GQL.SelectionSet-    -> OneMethodQuery p ('Service nm anns ms)+    -> OneMethodQuery p ('Service nm ms)   TypeQuery     :: Maybe Text     -> Text     -> GQL.SelectionSet-    -> OneMethodQuery p ('Service nm anns ms)+    -> OneMethodQuery p ('Service nm ms) -data ChosenMethodQuery (p :: Package snm mnm anm) (m :: Method snm mnm anm) where+data ChosenMethodQuery (p :: Package snm mnm anm (TypeRef snm))+                       (m :: Method snm mnm anm (TypeRef snm)) where   ChosenMethodQuery-    :: NP (ArgumentValue p) args+    :: GQL.Field+    -> NP (ArgumentValue p) args     -> ReturnQuery p r-    -> ChosenMethodQuery p ('Method mname anns args r)+    -> ChosenMethodQuery p ('Method mname args r) -data ArgumentValue (p :: Package snm mnm anm) (a :: Argument snm anm) where+data ArgumentValue (p :: Package snm mnm anm (TypeRef snm))+                   (a :: Argument snm anm (TypeRef snm)) where   ArgumentValue  :: ArgumentValue' p r-                 -> ArgumentValue p ('ArgSingle aname anns r)+                 -> ArgumentValue p ('ArgSingle aname r)   ArgumentStream :: ArgumentValue' p ('ListRef r)-                 -> ArgumentValue p ('ArgStream aname anns r)+                 -> ArgumentValue p ('ArgStream aname r) -data ArgumentValue' (p :: Package snm mnm anm) (r :: TypeRef snm) where+data ArgumentValue' (p :: Package snm mnm anm (TypeRef snm))+                    (r :: TypeRef snm) where   ArgPrimitive :: t -> ArgumentValue' p ('PrimitiveRef t)   ArgSchema    :: Term sch (sch :/: sty)                -> ArgumentValue' p ('SchemaRef sch sty)@@ -71,12 +77,14 @@   ArgOptional  :: Maybe (ArgumentValue' p r)                -> ArgumentValue' p ('OptionalRef r) -data ReturnQuery (p :: Package snm mnm anm) (r :: Return snm) where+data ReturnQuery (p :: Package snm mnm anm (TypeRef snm))+                 (r :: Return snm (TypeRef snm)) where   RNothing :: ReturnQuery p 'RetNothing   RSingle  :: ReturnQuery' p r -> ReturnQuery p ('RetSingle r)   RStream  :: ReturnQuery' p r -> ReturnQuery p ('RetStream r) -data ReturnQuery' (p :: Package snm mnm anm) (r :: TypeRef snm) where+data ReturnQuery' (p :: Package snm mnm anm (TypeRef snm))+                  (r :: TypeRef snm) where   RetPrimitive :: ReturnQuery' p ('PrimitiveRef t)   RetSchema    :: SchemaQuery sch (sch :/: sty)                -> ReturnQuery' p ('SchemaRef sch sty)

@@ -167,7 +167,7 @@ instance ( KnownSymbol sname          , IntrospectFields smethods (IsSub sname sub)          , IntrospectServices ss sub )-         => IntrospectServices ('Service sname sanns smethods ': ss) sub where+         => IntrospectServices ('Service sname smethods ': ss) sub where   introspectServices _ psub = do     let name = T.pack $ symbolVal (Proxy @sname)     fs <- introspectFields (Proxy @smethods) (Proxy @(IsSub sname sub))@@ -186,7 +186,7 @@          , IntrospectInputs margs          , IntrospectReturn mret isSub          , IntrospectFields fs isSub)-         => IntrospectFields ('Method mname manns margs mret ': fs) isSub where+         => IntrospectFields ('Method mname margs mret ': fs) isSub where   introspectFields _ pIsSub = do     let name = T.pack $ symbolVal (Proxy @mname)     inputs <- introspectInputs (Proxy @margs)@@ -202,7 +202,7 @@ instance ( KnownMaybeSymbol nm          , IntrospectTypeRef r          , IntrospectInputs args )-         => IntrospectInputs ('ArgSingle nm anns r ': args) where+         => IntrospectInputs ('ArgSingle nm r ': args) where   introspectInputs _ = do     let nm = maybeSymbolVal (Proxy @nm)     t <- introspectTypeRef (Proxy @r) False@@ -212,7 +212,7 @@ instance ( KnownMaybeSymbol nm          , IntrospectTypeRef r          , IntrospectInputs args )-         => IntrospectInputs ('ArgStream nm anns r ': args) where+         => IntrospectInputs ('ArgStream nm r ': args) where   introspectInputs _ = do     let nm = maybeSymbolVal (Proxy @nm)     t <- tList <$> introspectTypeRef (Proxy @r) False@@ -220,7 +220,7 @@     let this = Input (fromMaybe "arg" nm) Nothing t     (this :) <$> introspectInputs (Proxy @args) -class IntrospectReturn (r :: Return Symbol) (isSub :: Bool) where+class IntrospectReturn (r :: Return Symbol (TypeRef Symbol)) (isSub :: Bool) where   introspectReturn     :: Proxy r -> Proxy isSub -> Writer TypeMap Type 

@@ -20,11 +20,10 @@ import qualified Data.Foldable                 as F import qualified Data.HashMap.Strict           as HM import           Data.Int                      (Int32)-import           Data.Kind import           Data.List                     (find) import           Data.Maybe import           Data.Proxy-import           Data.Scientific               (floatingOrInteger)+import           Data.Scientific               (Scientific, floatingOrInteger, toRealFloat) import           Data.SOP.NS import qualified Data.Text                     as T import           GHC.TypeLits@@ -43,7 +42,10 @@   parseJSON A.Null       = pure GQL.VCNull   parseJSON (A.Bool b)   = pure $ GQL.VCBoolean b   parseJSON (A.String s) = pure $ GQL.VCString $ coerce s-  parseJSON (A.Number n) = pure $ either GQL.VCFloat GQL.VCInt $ floatingOrInteger n+  parseJSON (A.Number n)+    | (Right i :: Either Double Integer) <- floatingOrInteger n+                = pure $ GQL.VCInt i+    | otherwise = pure $ GQL.VCFloat n   parseJSON (A.Array xs) = GQL.VCList . GQL.ListValueG . F.toList <$> traverse A.parseJSON xs   parseJSON (A.Object o) = GQL.VCObject . GQL.ObjectValueG . fmap toObjFld . HM.toList <$> traverse A.parseJSON o     where@@ -118,12 +120,12 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss qr ~ 'Service qr qanns qmethods,-    KnownName qr, ParseMethod p qmethods,-    LookupService ss mut ~ 'Service mut manns mmethods,-    KnownName mut, ParseMethod p mmethods,-    LookupService ss sub ~ 'Service sub sanns smethods,-    KnownName sub, ParseMethod p smethods+    LookupService ss qr ~ 'Service qr qmethods,+    KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,+    LookupService ss mut ~ 'Service mut mmethods,+    KnownName mut, ParseMethod p ('Service mut mmethods) mmethods,+    LookupService ss sub ~ 'Service sub smethods,+    KnownName sub, ParseMethod p ('Service sub smethods) smethods   ) => ParseTypedDoc p ('Just qr) ('Just mut) ('Just sub) where   parseTypedDocQuery vmap frmap sset     = QueryDoc <$> parseQuery Proxy Proxy vmap frmap sset@@ -137,10 +139,10 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss qr ~ 'Service qr qanns qmethods,-    KnownName qr, ParseMethod p qmethods,-    LookupService ss mut ~ 'Service mut manns mmethods,-    KnownName mut, ParseMethod p mmethods+    LookupService ss qr ~ 'Service qr qmethods,+    KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,+    LookupService ss mut ~ 'Service mut mmethods,+    KnownName mut, ParseMethod p ('Service mut mmethods) mmethods   ) => ParseTypedDoc p ('Just qr) ('Just mut) 'Nothing where   parseTypedDocQuery vmap frmap sset     = QueryDoc <$> parseQuery Proxy Proxy vmap frmap sset@@ -151,10 +153,10 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss qr ~ 'Service qr qanns qmethods,-    KnownName qr, ParseMethod p qmethods,-    LookupService ss sub ~ 'Service sub sanns smethods,-    KnownName sub, ParseMethod p smethods+    LookupService ss qr ~ 'Service qr qmethods,+    KnownName qr, ParseMethod p ('Service qr qmethods) qmethods,+    LookupService ss sub ~ 'Service sub smethods,+    KnownName sub, ParseMethod p ('Service sub smethods) smethods   ) => ParseTypedDoc p ('Just qr) 'Nothing ('Just sub) where   parseTypedDocQuery vmap frmap sset     = QueryDoc <$> parseQuery Proxy Proxy vmap frmap sset@@ -168,8 +170,8 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss qr ~ 'Service qr qanns qmethods,-    KnownName qr, ParseMethod p qmethods+    LookupService ss qr ~ 'Service qr qmethods,+    KnownName qr, ParseMethod p ('Service qr qmethods) qmethods   ) => ParseTypedDoc p ('Just qr) 'Nothing 'Nothing where   parseTypedDocQuery vmap frmap sset     = QueryDoc <$> parseQuery Proxy Proxy vmap frmap sset@@ -180,10 +182,10 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss mut ~ 'Service mut manns mmethods,-    KnownName mut, ParseMethod p mmethods,-    LookupService ss sub ~ 'Service sub sanns smethods,-    KnownName sub, ParseMethod p smethods+    LookupService ss mut ~ 'Service mut mmethods,+    KnownName mut, ParseMethod p ('Service mut mmethods) mmethods,+    LookupService ss sub ~ 'Service sub smethods,+    KnownName sub, ParseMethod p ('Service sub smethods) smethods   ) => ParseTypedDoc p 'Nothing ('Just mut) ('Just sub) where   parseTypedDocQuery _ _ _     = throwError "no queries are defined in the schema"@@ -197,8 +199,8 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss mut ~ 'Service mut manns mmethods,-    KnownName mut, ParseMethod p mmethods+    LookupService ss mut ~ 'Service mut mmethods,+    KnownName mut, ParseMethod p ('Service mut mmethods) mmethods   ) => ParseTypedDoc p 'Nothing ('Just mut) 'Nothing where   parseTypedDocQuery _ _ _     = throwError "no queries are defined in the schema"@@ -209,8 +211,8 @@  instance   ( p ~ 'Package pname ss,-    LookupService ss sub ~ 'Service sub sanns smethods,-    KnownName sub, ParseMethod p smethods+    LookupService ss sub ~ 'Service sub smethods,+    KnownName sub, ParseMethod p ('Service sub smethods) smethods   ) => ParseTypedDoc p 'Nothing 'Nothing ('Just sub) where   parseTypedDocQuery _ _ _     = throwError "no queries are defined in the schema"@@ -250,10 +252,10 @@       [ GQL.ObjectFieldG a (constToValue v) | GQL.ObjectFieldG a v <- n ]  parseQuery ::-  forall (p :: Package') (s :: Symbol) pname ss sanns methods f.+  forall (p :: Package') (s :: Symbol) pname ss methods f.   ( MonadError T.Text f, p ~ 'Package pname ss,-    LookupService ss s ~ 'Service s sanns methods,-    KnownName s, ParseMethod p methods+    LookupService ss s ~ 'Service s methods,+    KnownName s, ParseMethod p ('Service s methods) methods   ) =>   Proxy p ->   Proxy s ->@@ -264,8 +266,8 @@   = (++) <$> (maybeToList <$> fieldToMethod fld)          <*> parseQuery pp ps vmap frmap ss   where-    fieldToMethod :: GQL.Field -> f (Maybe (OneMethodQuery p ('Service sname sanns methods)))-    fieldToMethod (GQL.Field alias name args dirs sels)+    fieldToMethod :: GQL.Field -> f (Maybe (OneMethodQuery p ('Service sname methods)))+    fieldToMethod f@(GQL.Field alias name args dirs sels)       | any (shouldSkip vmap) dirs       = pure Nothing       | GQL.unName name == "__typename"@@ -289,7 +291,9 @@           _ -> throwError "__type requires one single argument"       | otherwise       = Just . OneMethodQuery (GQL.unName . GQL.unAlias <$> alias)-         <$> selectMethod (T.pack $ nameVal (Proxy @s)) vmap frmap name args sels+         <$> selectMethod (Proxy @('Service s methods))+                          (T.pack $ nameVal (Proxy @s))+                          vmap frmap f parseQuery pp ps vmap frmap (GQL.SelectionFragmentSpread (GQL.FragmentSpread nm dirs) : ss)   | Just fr <- HM.lookup (GQL.unName nm) frmap   = if not (any (shouldSkip vmap) dirs) && not (any (shouldSkip vmap) $ GQL._fdDirectives fr)@@ -328,95 +332,131 @@ unFragment _ _   = throwError "inline fragments are not (yet) supported" -class ParseMethod (p :: Package') (ms :: [Method']) where+class ParseMethod (p :: Package') (s :: Service') (ms :: [Method']) where   selectMethod ::     MonadError T.Text f =>+    Proxy s ->     T.Text ->     VariableMap ->     FragmentMap ->-    GQL.Name ->+    GQL.Field ->+    {- GQL.Name ->     [GQL.Argument] ->-    GQL.SelectionSet ->+    GQL.SelectionSet -> -}     f (NS (ChosenMethodQuery p) ms) -instance ParseMethod p '[] where-  selectMethod tyName _ _ (GQL.unName -> wanted) _ _+instance ParseMethod p s '[] where+  selectMethod _ tyName _ _ (GQL.unName . GQL._fName -> wanted)     = throwError $ "field '" <> wanted <> "' was not found on type '" <> tyName <> "'" instance-  (KnownSymbol mname, ParseMethod p ms, ParseArgs p args, ParseDifferentReturn p r) =>-  ParseMethod p ('Method mname manns args r ': ms)+  ( KnownSymbol mname, ParseMethod p s ms+  , ParseArgs p s ('Method mname args r) args+  , ParseDifferentReturn p r) =>+  ParseMethod p s ('Method mname args r ': ms)   where-  selectMethod tyName vmap frmap w@(GQL.unName -> wanted) args sels+  selectMethod s tyName vmap frmap f@(GQL.Field _ (GQL.unName -> wanted) args _ sels)     | wanted == mname-    = Z <$> (ChosenMethodQuery <$> parseArgs vmap args-                               <*> parseDiffReturn vmap frmap wanted sels)+    = Z <$> (ChosenMethodQuery f+               <$> parseArgs (Proxy @s) (Proxy @('Method mname args r)) vmap args+               <*> parseDiffReturn vmap frmap wanted sels)     | otherwise-    = S <$> selectMethod tyName vmap frmap w args sels+    = S <$> selectMethod s tyName vmap frmap f     where       mname = T.pack $ nameVal (Proxy @mname) -class ParseArgs (p :: Package') (args :: [Argument']) where+class ParseArgs (p :: Package') (s :: Service') (m :: Method') (args :: [Argument']) where   parseArgs :: MonadError T.Text f-            => VariableMap+            => Proxy s -> Proxy m+            -> VariableMap             -> [GQL.Argument]             -> f (NP (ArgumentValue p) args) -instance ParseArgs p '[] where-  parseArgs _ _ = pure Nil+instance ParseArgs p s m '[] where+  parseArgs _ _ _ _ = pure Nil -- one single argument without name instance ParseArg p a-         => ParseArgs p '[ 'ArgSingle 'Nothing anns a ] where-  parseArgs vmap [GQL.Argument _ x]+         => ParseArgs p s m '[ 'ArgSingle 'Nothing a ] where+  parseArgs _ _ vmap [GQL.Argument _ x]     = (\v -> ArgumentValue v :* Nil) <$> parseArg' vmap "arg" x-  parseArgs _ _+  parseArgs _ _ _ _     = throwError "this field receives one single argument" instance ParseArg p a-         => ParseArgs p '[ 'ArgStream 'Nothing anns a ] where-  parseArgs vmap [GQL.Argument _ x]+         => ParseArgs p s m '[ 'ArgStream 'Nothing a ] where+  parseArgs _ _ vmap [GQL.Argument _ x]     = (\v -> ArgumentStream v :* Nil) <$> parseArg' vmap "arg" x-  parseArgs _ _+  parseArgs _ _ _ _     = throwError "this field receives one single argument" -- more than one argument-instance (KnownName aname, ParseArg p a, ParseArgs p as, FindDefaultArgValue aanns)-         => ParseArgs p ('ArgSingle ('Just aname) aanns a ': as) where-  parseArgs vmap args+instance ( KnownName aname, ParseMaybeArg p a, ParseArgs p s m as+         , s ~ 'Service snm sms, m ~ 'Method mnm margs mr+         , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname+         , FindDefaultArgValue ann )+         => ParseArgs p s m ('ArgSingle ('Just aname) a ': as) where+  parseArgs ps pm vmap args     = let aname = T.pack $ nameVal (Proxy @aname)       in case find ((== nameVal (Proxy @aname)) . T.unpack . GQL.unName . GQL._aName) args of         Just (GQL.Argument _ x)-          -> (:*) <$> (ArgumentValue <$> parseArg' vmap aname x)-                  <*> parseArgs vmap args+          -> (:*) <$> (ArgumentValue <$> parseMaybeArg vmap aname (Just x))+                  <*> parseArgs ps pm vmap args         Nothing-          -> do x <- findDefaultArgValue (Proxy @aanns) aname-                (:*) <$> (ArgumentValue <$> parseArg' vmap aname (constToValue x))-                     <*> parseArgs vmap args-instance (KnownName aname, ParseArg p a, ParseArgs p as, FindDefaultArgValue aanns)-         => ParseArgs p ('ArgStream ('Just aname) aanns a ': as) where-  parseArgs vmap args+          -> do let x = findDefaultArgValue (Proxy @ann)+                (:*) <$> (ArgumentValue <$> parseMaybeArg vmap aname+                                            (constToValue <$> x))+                     <*> parseArgs ps pm vmap args+instance ( KnownName aname, ParseArg p a, ParseArgs p s m as+         , s ~ 'Service snm sms, m ~ 'Method mnm margs mr+         , ann ~ GetArgAnnotationMay (AnnotatedPackage DefaultValue p) snm mnm aname+         , FindDefaultArgValue ann )+         => ParseArgs p s m ('ArgStream ('Just aname) a ': as) where+  parseArgs ps pm vmap args     = let aname = T.pack $ nameVal (Proxy @aname)       in case find ((== nameVal (Proxy @aname)) . T.unpack . GQL.unName . GQL._aName) args of         Just (GQL.Argument _ x)-          -> (:*) <$> (ArgumentStream <$> parseArg' vmap aname x)-                  <*> parseArgs vmap args+          -> (:*) <$> (ArgumentStream <$> parseMaybeArg vmap aname (Just x))+                  <*> parseArgs ps pm vmap args         Nothing-          -> do x <- findDefaultArgValue (Proxy @aanns) aname-                (:*) <$> (ArgumentStream <$> parseArg' vmap aname (constToValue x))-                     <*> parseArgs vmap args+          -> do let x = findDefaultArgValue (Proxy @ann)+                (:*) <$> (ArgumentStream <$> parseMaybeArg vmap aname+                                             (constToValue <$> x))+                     <*> parseArgs ps pm vmap args -class FindDefaultArgValue (vs :: [Type]) where-  findDefaultArgValue :: MonadError T.Text f-                      => Proxy vs-                      -> T.Text-                      -> f GQL.ValueConst-instance FindDefaultArgValue '[] where-  findDefaultArgValue _ aname-    = throwError $ "argument '" <> aname <> "' was not given a value, and has no default one"-instance {-# OVERLAPPABLE #-} FindDefaultArgValue xs-         => FindDefaultArgValue (x ': xs) where-  findDefaultArgValue _ = findDefaultArgValue (Proxy @xs)-instance {-# OVERLAPS #-} ReflectValueConst v-         => FindDefaultArgValue (DefaultValue v ': xs) where-  findDefaultArgValue _ _ = pure $ reflectValueConst (Proxy @v)+class FindDefaultArgValue (vs :: Maybe DefaultValue) where+  findDefaultArgValue :: Proxy vs+                      -> Maybe GQL.ValueConst+instance FindDefaultArgValue 'Nothing where+  findDefaultArgValue _ = Nothing+instance ReflectValueConst v+         => FindDefaultArgValue ('Just ('DefaultValue v)) where+  findDefaultArgValue _ = Just $ reflectValueConst (Proxy @v) +class ParseMaybeArg (p :: Package') (a :: TypeRef Symbol) where+  parseMaybeArg :: MonadError T.Text f+                => VariableMap+                -> T.Text+                -> Maybe GQL.Value+                -> f (ArgumentValue' p a)++instance {-# OVERLAPS #-} (ParseArg p a)+         => ParseMaybeArg p ('OptionalRef a) where+  parseMaybeArg vmap aname (Just x)+    = ArgOptional . Just <$> parseArg' vmap aname x+  parseMaybeArg _ _ Nothing+    = pure $ ArgOptional Nothing+instance {-# OVERLAPS #-} (ParseArg p a)+         => ParseMaybeArg p ('ListRef a) where+  parseMaybeArg vmap aname (Just x)+    = parseArg' vmap aname x+  parseMaybeArg _ _ Nothing+    = pure $ ArgList []+instance {-# OVERLAPPABLE #-} (ParseArg p a)+         => ParseMaybeArg p a where+  parseMaybeArg vmap aname (Just x)+    = parseArg' vmap aname x+  parseMaybeArg _ aname Nothing+    = throwError $ "argument '" <> aname <>+                   "' was not given a value, and has no default one"++ parseArg' :: (ParseArg p a, MonadError T.Text f)           => VariableMap           -> T.Text@@ -442,22 +482,27 @@     = throwError $ "argument '" <> aname <> "' was not of right type" instance ParseArg p ('PrimitiveRef Bool) where   parseArg _ _ (GQL.VBoolean b)-    = pure (ArgPrimitive b)+    = pure $ ArgPrimitive b   parseArg _ aname _     = throwError $ "argument '" <> aname <> "' was not of right type" instance ParseArg p ('PrimitiveRef Int32) where   parseArg _ _ (GQL.VInt b)-    = pure (ArgPrimitive b)+    = pure $ ArgPrimitive $ fromIntegral b   parseArg _ aname _     = throwError $ "argument '" <> aname <> "' was not of right type" instance ParseArg p ('PrimitiveRef Integer) where   parseArg _ _ (GQL.VInt b)-    = pure $ ArgPrimitive $ fromIntegral b+    = pure $ ArgPrimitive b   parseArg _ aname _     = throwError $ "argument '" <> aname <> "' was not of right type"+instance ParseArg p ('PrimitiveRef Scientific) where+  parseArg _ _ (GQL.VFloat b)+    = pure $ ArgPrimitive b+  parseArg _ aname _+    = throwError $ "argument '" <> aname <> "' was not of right type" instance ParseArg p ('PrimitiveRef Double) where   parseArg _ _ (GQL.VFloat b)-    = pure (ArgPrimitive b)+    = pure $ ArgPrimitive $ toRealFloat b   parseArg _ aname _     = throwError $ "argument '" <> aname <> "' was not of right type" instance ParseArg p ('PrimitiveRef T.Text) where@@ -570,19 +615,23 @@   valueParser _ fname _     = throwError $ "field '" <> fname <> "' was not of right type" instance ValueParser sch ('TPrimitive Bool) where-  valueParser _ _ (GQL.VBoolean b) = pure (FPrimitive b)+  valueParser _ _ (GQL.VBoolean b) = pure $ FPrimitive b   valueParser _ fname _     = throwError $ "field '" <> fname <> "' was not of right type" instance ValueParser sch ('TPrimitive Int32) where-  valueParser _ _ (GQL.VInt b) = pure (FPrimitive b)+  valueParser _ _ (GQL.VInt b) = pure $ FPrimitive $ fromIntegral b   valueParser _ fname _     = throwError $ "field '" <> fname <> "' was not of right type" instance ValueParser sch ('TPrimitive Integer) where-  valueParser _ _ (GQL.VInt b) = pure $ FPrimitive $ fromIntegral b+  valueParser _ _ (GQL.VInt b) = pure $ FPrimitive b   valueParser _ fname _     = throwError $ "field '" <> fname <> "' was not of right type"+instance ValueParser sch ('TPrimitive Scientific) where+  valueParser _ _ (GQL.VFloat b) = pure $ FPrimitive b+  valueParser _ fname _+    = throwError $ "field '" <> fname <> "' was not of right type" instance ValueParser sch ('TPrimitive Double) where-  valueParser _ _ (GQL.VFloat b) = pure (FPrimitive b)+  valueParser _ _ (GQL.VFloat b) = pure $ FPrimitive $ toRealFloat b   valueParser _ fname _     = throwError $ "field '" <> fname <> "' was not of right type" instance ValueParser sch ('TPrimitive T.Text) where@@ -610,7 +659,7 @@   valueParser vmap _ v     = FSchematic <$> parseObjectOrEnum' vmap (T.pack $ nameVal (Proxy @sty)) v -class ParseDifferentReturn (p :: Package') (r :: Return Symbol) where+class ParseDifferentReturn (p :: Package') (r :: Return Symbol (TypeRef Symbol)) where   parseDiffReturn :: MonadError T.Text f                   => VariableMap                   -> FragmentMap@@ -654,8 +703,8 @@   parseReturn vmap frmap fname s     = RetOptional <$> parseReturn vmap frmap fname s instance ( p ~ 'Package pname ss,-           LookupService ss s ~ 'Service s sanns methods,-           KnownName s, ParseMethod p methods+           LookupService ss s ~ 'Service s methods,+           KnownName s, ParseMethod p ('Service s methods) methods          ) => ParseReturn p ('ObjectRef s) where   parseReturn vmap frmap _ s     = RetObject <$> parseQuery (Proxy @p) (Proxy @s) vmap frmap s

@@ -31,6 +31,7 @@ import           Control.Monad.Writer import qualified Data.Aeson                     as Aeson import qualified Data.Aeson.Types               as Aeson+import           Data.Coerce                    (coerce) import           Data.Conduit import           Data.Conduit.Combinators       (sinkList, yieldMany) import           Data.Conduit.TQueue@@ -39,8 +40,8 @@ import qualified Data.Text                      as T import           GHC.TypeLits import qualified Language.GraphQL.Draft.Syntax  as GQL+import           Network.HTTP.Types.Header -import           Data.Coerce                    (coerce) import           Mu.GraphQL.Query.Definition import qualified Mu.GraphQL.Query.Introspection as Intro import           Mu.GraphQL.Query.Parse@@ -57,15 +58,16 @@ 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+  -> RequestHeaders+  -> ServerT chn GQL.Field p m hs   -> Proxy qr -> Proxy mut -> Proxy sub   -> Maybe T.Text -> VariableMapC -> GQL.ExecutableDocument   -> IO Aeson.Value-runPipeline f svr _ _ _ opName vmap doc+runPipeline f req svr _ _ _ opName vmap doc   = case parseDoc @qr @mut @sub opName vmap doc of       Left e -> pure $ singleErrValue e       Right (d :: Document p qr mut sub) -> do-        (data_, errors) <- runWriterT (runDocument f svr d)+        (data_, errors) <- runWriterT (runDocument f req svr d)         case errors of           [] -> pure $ Aeson.object [ ("data", data_) ]           _  -> pure $ Aeson.object [ ("data", data_), ("errors", Aeson.listValue errValue errors) ]@@ -73,17 +75,18 @@ 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+  -> RequestHeaders+  -> ServerT chn GQL.Field p m hs   -> Proxy qr -> Proxy mut -> Proxy sub   -> Maybe T.Text -> VariableMapC -> GQL.ExecutableDocument   -> ConduitT Aeson.Value Void IO ()   -> IO ()-runSubscriptionPipeline f svr _ _ _ opName vmap doc sink+runSubscriptionPipeline f req svr _ _ _ opName vmap doc sink   = case parseDoc @qr @mut @sub opName vmap doc of       Left e         -> yieldSingleError e sink       Right (d :: Document p qr mut sub)-        -> runDocumentSubscription f svr d sink+        -> runDocumentSubscription f req svr d sink  singleErrValue :: T.Text -> Aeson.Value singleErrValue e@@ -116,12 +119,14 @@                   m chn hs where   runDocument ::        (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> RequestHeaders+    -> ServerT chn GQL.Field p m hs     -> Document p qr mut sub     -> WriterT [GraphQLError] IO Aeson.Value   runDocumentSubscription ::        (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> RequestHeaders+    -> ServerT chn GQL.Field p m hs     -> Document p qr mut sub     -> ConduitT Aeson.Value Void IO ()     -> IO ()@@ -139,18 +144,18 @@   , 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 f svr d+  runDocument f req svr d     = let i = Intro.introspect (Proxy @p) (Proxy @('Just qr)) (Proxy @('Just mut)) (Proxy @('Just sub))       in case d of            QueryDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q            MutationDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q            SubscriptionDoc _              -> pure $ singleErrValue "cannot execute subscriptions in this wire"-  runDocumentSubscription f svr (SubscriptionDoc d)-    = runSubscription f svr [] () d-  runDocumentSubscription f svr d = yieldDocument f svr d+  runDocumentSubscription f req svr (SubscriptionDoc d)+    = runSubscription f req svr [] () d+  runDocumentSubscription f req svr d = yieldDocument f req svr d  instance   ( p ~ 'Package pname ss@@ -162,13 +167,13 @@   , MappingRight chn mut ~ ()   , Intro.Introspect p ('Just qr) ('Just mut) 'Nothing   ) => RunDocument p ('Just qr) ('Just mut) 'Nothing m chn hs where-  runDocument f svr d+  runDocument f req svr d     = let i = Intro.introspect (Proxy @p) (Proxy @('Just qr)) (Proxy @('Just mut)) (Proxy @'Nothing)       in case d of            QueryDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q            MutationDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q   runDocumentSubscription = yieldDocument  instance@@ -181,16 +186,16 @@   , MappingRight chn sub ~ ()   , Intro.Introspect p ('Just qr) 'Nothing ('Just sub)   ) => RunDocument p ('Just qr) 'Nothing ('Just sub) m chn hs where-  runDocument f svr d+  runDocument f req svr d     = let i = Intro.introspect (Proxy @p) (Proxy @('Just qr)) (Proxy @'Nothing) (Proxy @('Just sub))       in case d of            QueryDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q            SubscriptionDoc _              -> pure $ singleErrValue "cannot execute subscriptions in this wire"-  runDocumentSubscription f svr (SubscriptionDoc d)-    = runSubscription f svr [] () d-  runDocumentSubscription f svr d = yieldDocument f svr d+  runDocumentSubscription f req svr (SubscriptionDoc d)+    = runSubscription f req svr [] () d+  runDocumentSubscription f req svr d = yieldDocument f req svr d  instance   ( p ~ 'Package pname ss@@ -199,11 +204,11 @@   , MappingRight chn qr ~ ()   , Intro.Introspect p ('Just qr) 'Nothing 'Nothing   ) => RunDocument p ('Just qr) 'Nothing 'Nothing m chn hs where-  runDocument f svr d+  runDocument f req svr d     = let i = Intro.introspect (Proxy @p) (Proxy @('Just qr)) (Proxy @'Nothing) (Proxy @'Nothing)       in case d of            QueryDoc q-             -> runQuery f i svr [] () q+             -> runQuery f req i svr [] () q   runDocumentSubscription = yieldDocument  instance@@ -216,12 +221,13 @@      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+  -> RequestHeaders+  -> ServerT chn GQL.Field p m hs   -> Document p qr mut sub   -> ConduitT Aeson.Value Void IO ()   -> IO ()-yieldDocument f svr doc sink = do-  (data_, errors) <- runWriterT (runDocument @p @qr @mut @sub @m @chn @hs f svr doc)+yieldDocument f req svr doc sink = do+  (data_, errors) <- runWriterT (runDocument @p @qr @mut @sub @m @chn @hs f req svr doc)   let (val :: Aeson.Value)         = case errors of             [] -> Aeson.object [ ("data", data_) ]@@ -229,55 +235,59 @@   runConduit $ yieldMany ([val] :: [Aeson.Value]) .| sink  runQuery-  :: forall m p s pname ss hs sname sanns ms chn inh.+  :: forall m p s pname ss hs sname ms chn inh.      ( RunQueryFindHandler m p hs chn ss s hs      , p ~ 'Package pname ss-     , s ~ 'Service sname sanns ms+     , s ~ 'Service sname ms      , inh ~ MappingRight chn sname )   => (forall a. m a -> ServerErrorIO a)-  -> Intro.Schema -> ServerT chn p m hs+  -> RequestHeaders+  -> Intro.Schema -> ServerT chn GQL.Field p m hs   -> [T.Text]   -> inh   -> ServiceQuery p s   -> WriterT [GraphQLError] IO Aeson.Value-runQuery f sch whole@(Services ss) path = runQueryFindHandler f sch whole path ss+runQuery f req sch whole@(Services ss) path = runQueryFindHandler f req sch whole path ss  runSubscription-  :: forall m p s pname ss hs sname sanns ms chn inh.+  :: forall m p s pname ss hs sname ms chn inh.      ( RunQueryFindHandler m p hs chn ss s hs      , p ~ 'Package pname ss-     , s ~ 'Service sname sanns ms+     , s ~ 'Service sname ms      , inh ~ MappingRight chn sname )   => (forall a. m a -> ServerErrorIO a)-  -> ServerT chn p m hs+  -> RequestHeaders+  -> ServerT chn GQL.Field p m hs   -> [T.Text]   -> inh   -> OneMethodQuery p s   -> ConduitT Aeson.Value Void IO ()   -> IO ()-runSubscription f whole@(Services ss) path-  = runSubscriptionFindHandler f whole path ss+runSubscription f req whole@(Services ss) path+  = runSubscriptionFindHandler f req whole path ss  class RunQueryFindHandler m p whole chn ss s hs where   runQueryFindHandler-    :: ( p ~  'Package pname wholess-       , s ~ 'Service sname sanns ms+    :: ( p ~ 'Package pname wholess+       , s ~ 'Service sname ms        , inh ~ MappingRight chn sname )     => (forall a. m a -> ServerErrorIO a)-    -> Intro.Schema -> ServerT chn p m whole+    -> RequestHeaders+    -> Intro.Schema -> ServerT chn GQL.Field p m whole     -> [T.Text]-    -> ServicesT chn ss m hs+    -> ServicesT chn GQL.Field ss m hs     -> inh     -> ServiceQuery p s     -> WriterT [GraphQLError] IO Aeson.Value   runSubscriptionFindHandler-    :: ( p ~  'Package pname wholess-       , s ~ 'Service sname sanns ms+    :: ( p ~ 'Package pname wholess+       , s ~ 'Service sname ms        , inh ~ MappingRight chn sname )     => (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m whole+    -> RequestHeaders+    -> ServerT chn GQL.Field p m whole     -> [T.Text]-    -> ServicesT chn ss m hs+    -> ServicesT chn GQL.Field ss m hs     -> inh     -> OneMethodQuery p s     -> ConduitT Aeson.Value Void IO ()@@ -290,19 +300,21 @@ instance {-# OVERLAPPABLE #-}          RunQueryFindHandler m p whole chn ss s hs          => RunQueryFindHandler m p whole chn (other ': ss) s (h ': hs) where-  runQueryFindHandler f sch whole path (_ :<&>: that)-    = runQueryFindHandler f sch whole path that-  runSubscriptionFindHandler f whole path (_ :<&>: that)-    = runSubscriptionFindHandler f whole path that-instance {-# OVERLAPS #-} (s ~ 'Service sname sanns ms, KnownName sname, RunMethod m p whole chn sname ms h)+  runQueryFindHandler f req sch whole path (_ :<&>: that)+    = runQueryFindHandler f req sch whole path that+  runSubscriptionFindHandler f req whole path (_ :<&>: that)+    = runSubscriptionFindHandler f req whole path that+instance {-# OVERLAPS #-}+         ( s ~ 'Service sname ms, KnownName sname+         , RunMethod m p whole chn s ms h )          => RunQueryFindHandler m p whole chn (s ': ss) s (h ': hs) where-  runQueryFindHandler f sch whole path (this :<&>: _) inh queries+  runQueryFindHandler f req sch whole path (this :<&>: _) inh queries     = Aeson.object . catMaybes <$> mapM runOneQuery queries     where       -- if we include the signature we have to write       -- an explicit type signature for 'runQueryFindHandler'       runOneQuery (OneMethodQuery nm args)-        = runMethod f whole (Proxy @sname) path nm inh this args+        = runMethod f req whole (Proxy @s) path nm inh this args       -- handle __typename       runOneQuery (TypeNameQuery nm)         = let realName = fromMaybe "__typename" nm@@ -323,35 +335,39 @@                                     path]                               pure $ Just (realName, Aeson.Null)   -- subscriptions should only have one element-  runSubscriptionFindHandler f whole path (this :<&>: _) inh (OneMethodQuery nm args) sink-    = runMethodSubscription f whole (Proxy @sname) path nm inh this args sink-  runSubscriptionFindHandler _ _ _ _ _ (TypeNameQuery nm) sink+  runSubscriptionFindHandler f req whole path (this :<&>: _) inh (OneMethodQuery nm args) sink+    = runMethodSubscription f req whole (Proxy @s) path nm inh this args sink+  runSubscriptionFindHandler _ _ _ _ _ _ (TypeNameQuery nm) sink     = let realName = fromMaybe "__typename" nm           o = Aeson.object [(realName, Aeson.String $ T.pack $ nameVal (Proxy @sname))]       in runConduit $ yieldMany ([o] :: [Aeson.Value]) .| sink-  runSubscriptionFindHandler _ _ _ _ _ _ sink+  runSubscriptionFindHandler _ _ _ _ _ _ _ sink     = runConduit $ yieldMany                    ([singleErrValue "__schema and __type are not supported in subscriptions"]                       :: [Aeson.Value])                    .| sink -class RunMethod m p whole chn sname ms hs where+class RunMethod m p whole chn s ms hs where   runMethod     :: ( p ~ 'Package pname wholess+       , s ~ 'Service sname allMs        , 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+    -> RequestHeaders+    -> ServerT chn GQL.Field p m whole+    -> Proxy s -> [T.Text] -> Maybe T.Text -> inh+    -> HandlersT chn GQL.Field inh ms m hs     -> NS (ChosenMethodQuery p) ms     -> WriterT [GraphQLError] IO (Maybe (T.Text, Aeson.Value))   runMethodSubscription     :: ( p ~ 'Package pname wholess+       , s ~ 'Service sname allMs        , 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+    -> RequestHeaders+    -> ServerT chn GQL.Field p m whole+    -> Proxy s -> [T.Text] -> Maybe T.Text -> inh+    -> HandlersT chn GQL.Field inh ms m hs     -> NS (ChosenMethodQuery p) ms     -> ConduitT Aeson.Value Void IO ()     -> IO ()@@ -359,26 +375,32 @@ instance RunMethod m p whole chn s '[] '[] where   runMethod _ = error "this should never be called"   runMethodSubscription _ = 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+instance ( RunMethod m p whole chn s ms hs+         , KnownName mname+         , RunHandler m p whole chn args r h+         , ReflectRpcInfo p s ('Method mname args r) )+         => RunMethod m p whole chn s ('Method mname args r ': ms) (h ': hs) where   -- handle normal methods-  runMethod f whole _ path nm inh (h :<||>: _) (Z (ChosenMethodQuery args ret))-    = ((realName ,) <$>) <$> runHandler f whole (path ++ [realName]) (h inh) args ret+  runMethod f req whole _ path nm inh (h :<||>: _) (Z (ChosenMethodQuery fld args ret))+    = ((realName ,) <$>) <$> runHandler f req whole (path ++ [realName]) (h rpcInfo inh) args ret     where realName = fromMaybe (T.pack $ nameVal (Proxy @mname)) nm-  runMethod f whole p path nm inh (_ :<||>: r) (S cont)-    = runMethod f whole p path nm inh r cont+          rpcInfo = reflectRpcInfo (Proxy @p) (Proxy @s) (Proxy @('Method mname args r)) req fld+  runMethod f req whole p path nm inh (_ :<||>: r) (S cont)+    = runMethod f req whole p path nm inh r cont   -- handle subscriptions-  runMethodSubscription f whole _ path nm inh (h :<||>: _) (Z (ChosenMethodQuery args ret)) sink-    = runHandlerSubscription f whole (path ++ [realName]) (h inh) args ret sink+  runMethodSubscription f req whole _ path nm inh (h :<||>: _) (Z (ChosenMethodQuery fld args ret)) sink+    = runHandlerSubscription f req whole (path ++ [realName]) (h rpcInfo inh) args ret sink     where realName = fromMaybe (T.pack $ nameVal (Proxy @mname)) nm-  runMethodSubscription f whole p path nm inh (_ :<||>: r) (S cont) sink-    = runMethodSubscription f whole p path nm inh r cont sink+          rpcInfo = reflectRpcInfo (Proxy @p) (Proxy @s) (Proxy @('Method mname args r)) req fld+  runMethodSubscription f req whole p path nm inh (_ :<||>: r) (S cont) sink+    = runMethodSubscription f req whole p path nm inh r cont 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+    -> RequestHeaders+    -> ServerT chn GQL.Field p m whole     -> [T.Text]     -> h     -> NP (ArgumentValue p) args@@ -386,7 +408,8 @@     -> WriterT [GraphQLError] IO (Maybe Aeson.Value)   runHandlerSubscription     :: (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m whole+    -> RequestHeaders+    -> ServerT chn GQL.Field p m whole     -> [T.Text]     -> h     -> NP (ArgumentValue p) args@@ -395,46 +418,46 @@     -> 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 f whole path h (ArgumentValue one :* rest)-    = runHandler f whole path (h (convertArg (Proxy @chn) one)) rest-  runHandlerSubscription f whole path h (ArgumentValue one :* rest)-    = runHandlerSubscription f whole path (h (convertArg (Proxy @chn) one)) rest+         => RunHandler m p whole chn ('ArgSingle aname ref ': rest) r (t -> h) where+  runHandler f req whole path h (ArgumentValue one :* rest)+    = runHandler f req whole path (h (convertArg (Proxy @chn) one)) rest+  runHandlerSubscription f req whole path h (ArgumentValue one :* rest)+    = runHandlerSubscription f req whole path (h (convertArg (Proxy @chn) one)) 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 f whole path h (ArgumentStream lst :* rest)+         => RunHandler m p whole chn ('ArgStream aname ref ': rest) r (ConduitT () t m () -> h) where+  runHandler f req whole path h (ArgumentStream lst :* rest)     = let converted :: [t] = convertArg (Proxy @chn) lst-      in runHandler f whole path (h (yieldMany converted)) rest-  runHandlerSubscription f whole path h (ArgumentStream lst :* rest) sink+      in runHandler f req whole path (h (yieldMany converted)) rest+  runHandlerSubscription f req whole path h (ArgumentStream lst :* rest) sink     = let converted :: [t] = convertArg (Proxy @chn) lst-      in runHandlerSubscription f whole path (h (yieldMany converted)) rest sink+      in runHandlerSubscription f req whole path (h (yieldMany converted)) rest sink instance (MonadError ServerError m)          => RunHandler m p whole chn '[] 'RetNothing (m ()) where-  runHandler f _ path h Nil _ = do+  runHandler f _req _ path h Nil _ = do     res <- liftIO $ runExceptT (f h)     case res of       Right _ -> pure $ Just Aeson.Null       Left e  -> tell [GraphQLError e path] >> pure Nothing-  runHandlerSubscription f _ path h Nil _ sink = do+  runHandlerSubscription f _req _ path h Nil _ sink = do     res <- liftIO $ runExceptT (f h)     case res of       Right _ -> runConduit $ yieldMany ([] :: [Aeson.Value]) .| sink       Left e  -> yieldError e path sink instance (MonadError ServerError m, ResultConversion m p whole chn r l)          => RunHandler m p whole chn '[] ('RetSingle r) (m l) where-  runHandler f whole path h Nil (RSingle q) = do+  runHandler f req whole path h Nil (RSingle q) = do     res <- liftIO $ runExceptT (f h)     case res of-      Right v -> convertResult f whole path q v+      Right v -> convertResult f req whole path q v       Left e  -> tell [GraphQLError e path] >> pure Nothing-  runHandlerSubscription f whole path h Nil (RSingle q) sink = do+  runHandlerSubscription f req whole path h Nil (RSingle q) sink = do     res <- liftIO $ runExceptT (f h)     val <- case res of       Right v -> do-        (data_, errors) <- runWriterT (convertResult f whole path q v)+        (data_, errors) <- runWriterT (convertResult f req whole path q v)         case errors of           [] -> pure $ Aeson.object [ ("data", fromMaybe Aeson.Null data_) ]           _  -> pure $ Aeson.object [ ("data", fromMaybe Aeson.Null data_)@@ -443,15 +466,15 @@     runConduit $ yieldMany ([val] :: [Aeson.Value]) .| 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 f whole path h Nil (RStream q) = do+  runHandler f req whole path h Nil (RStream q) = do     queue <- liftIO newTMQueueIO     res <- liftIO $ runExceptT $ f $ h (sinkTMQueue queue)     case res of       Right _ -> do         info <- runConduit $ sourceTMQueue queue .| sinkList-        Just . Aeson.toJSON . catMaybes <$> traverse (convertResult f whole path q) info+        Just . Aeson.toJSON . catMaybes <$> traverse (convertResult f req whole path q) info       Left e  -> tell [GraphQLError e []] >> pure Nothing-  runHandlerSubscription f whole path h Nil (RStream q) sink = do+  runHandlerSubscription f req whole path h Nil (RStream q) sink = do     res <- liftIO $ runExceptT $ f $ h       (transPipe liftIO (mapInputM convert (error "this should not be called") sink))     case res of@@ -460,7 +483,7 @@     where       convert :: l -> IO Aeson.Value       convert v = do-        (data_, errors) <- runWriterT (convertResult f whole path q v)+        (data_, errors) <- runWriterT (convertResult f req whole path q v)         case errors of           [] -> pure $ Aeson.object [ ("data", fromMaybe Aeson.Null data_) ]           _  -> pure $ Aeson.object [ ("data", fromMaybe Aeson.Null data_)@@ -483,37 +506,38 @@  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+                -> RequestHeaders+                -> ServerT chn GQL.Field p m whole                 -> [T.Text]                 -> ReturnQuery' p r                 -> l -> WriterT [GraphQLError] IO (Maybe Aeson.Value)  instance Aeson.ToJSON t => ResultConversion m p whole chn ('PrimitiveRef t) t where-  convertResult _ _ _ RetPrimitive = pure . Just . Aeson.toJSON+  convertResult _ _ _ _ RetPrimitive = pure . Just . Aeson.toJSON instance ( ToSchema sch l r          , RunSchemaQuery sch (sch :/: l) )          => ResultConversion m p whole chn ('SchemaRef sch l) r where-  convertResult _ _ _ (RetSchema r) t+  convertResult _ _ _ _ (RetSchema r) t     = pure $ Just $ runSchemaQuery (toSchema' @_ @_ @sch @r t) 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)+         , LookupService ss ref ~ 'Service sname ms+         , RunQueryFindHandler m ('Package pname ss) whole chn ss ('Service sname ms) whole)          => ResultConversion m ('Package pname ss) whole chn ('ObjectRef ref) t where-  convertResult f whole path (RetObject q) h-    = Just <$> runQuery @m @('Package pname ss) @(LookupService ss ref) f+  convertResult f req whole path (RetObject q) h+    = Just <$> runQuery @m @('Package pname ss) @(LookupService ss ref) f req                         (error "cannot inspect schema inside a field")                         whole path h q instance ResultConversion m p whole chn r s         => ResultConversion m p whole chn ('OptionalRef r) (Maybe s) where-  convertResult _ _ _ _ Nothing+  convertResult _ _ _ _ _ Nothing     = pure Nothing-  convertResult f whole path (RetOptional q) (Just x)-    = convertResult f whole path q x+  convertResult f req whole path (RetOptional q) (Just x)+    = convertResult f req whole path q x instance ResultConversion m p whole chn r s         => ResultConversion m p whole chn ('ListRef r) [s] where-  convertResult f whole path (RetList q) xs-    = Just . Aeson.toJSON . catMaybes <$> mapM (convertResult f whole path q) xs+  convertResult f req whole path (RetList q) xs+    = Just . Aeson.toJSON . catMaybes <$> mapM (convertResult f req whole path q) xs  class RunSchemaQuery sch r where   runSchemaQuery

@@ -30,19 +30,25 @@   , graphQLAppQuery   , graphQLAppTrans   , graphQLAppTransQuery+  -- * Lifting of 'Conduit's+  , liftServerConduit ) where  import           Control.Applicative              ((<|>))-import           Control.Monad                    (join)+import           Control.Exception                (throw)+import           Control.Monad.Except import qualified Data.Aeson                       as A import           Data.Aeson.Text                  (encodeToLazyText) import           Data.ByteString.Lazy             (fromStrict, toStrict)+import           Data.Conduit import qualified Data.HashMap.Strict              as HM import           Data.Proxy import qualified Data.Text                        as T import           Data.Text.Encoding               (decodeUtf8) import qualified Data.Text.Lazy.Encoding          as T import           Language.GraphQL.Draft.Parser    (parseExecutableDoc)+import qualified Language.GraphQL.Draft.Syntax    as GQL+import           Mu.Adapter.Json                  () import           Network.HTTP.Types.Header        (hContentType) import           Network.HTTP.Types.Method        (StdMethod (..), parseMethod) import           Network.HTTP.Types.Status        (ok200)@@ -70,7 +76,7 @@ --   queries, but also mutations or subscriptions. graphQLApp ::     ( GraphQLApp p qr mut sub ServerErrorIO chn hs )-    => ServerT chn p ServerErrorIO hs+    => ServerT chn GQL.Field p ServerErrorIO hs     -> Proxy qr     -> Proxy mut     -> Proxy sub@@ -82,7 +88,7 @@ graphQLAppQuery ::     forall qr p chn hs.     ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs )-    => ServerT chn p ServerErrorIO hs+    => ServerT chn GQL.Field p ServerErrorIO hs     -> Proxy qr     -> Application graphQLAppQuery svr _@@ -95,7 +101,7 @@     forall qr m p chn hs.     ( GraphQLApp p ('Just qr) 'Nothing 'Nothing m chn hs )     => (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> ServerT chn GQL.Field p m hs     -> Proxy qr     -> Application graphQLAppTransQuery f svr _@@ -107,7 +113,7 @@ graphQLAppTrans ::     ( GraphQLApp p qr mut sub m chn hs )     => (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> ServerT chn GQL.Field p m hs     -> Proxy qr     -> Proxy mut     -> Proxy sub@@ -120,7 +126,7 @@ httpGraphQLAppTrans ::     ( GraphQLApp p qr mut sub m chn hs )     => (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> ServerT chn GQL.Field p m hs     -> Proxy qr     -> Proxy mut     -> Proxy sub@@ -154,7 +160,8 @@     execQuery opn vals qry =       case parseExecutableDoc qry of         Left err  -> toError err-        Right doc -> runPipeline f server q m s opn vals doc >>= toResponse+        Right doc -> runPipeline f (requestHeaders req) server q m s opn vals doc+                       >>= toResponse     toError :: T.Text -> IO ResponseReceived     toError err = toResponse $ A.object [ ("errors", A.Array [ A.object [ ("message", A.String err) ] ])]     toResponse :: A.Value -> IO ResponseReceived@@ -163,14 +170,15 @@ wsGraphQLAppTrans     :: ( GraphQLApp p qr mut sub m chn hs )     => (forall a. m a -> ServerErrorIO a)-    -> ServerT chn p m hs+    -> ServerT chn GQL.Field p m hs     -> Proxy qr     -> Proxy mut     -> Proxy sub     -> WS.ServerApp wsGraphQLAppTrans f server q m s conn-  = do conn' <- WS.acceptRequest conn-       flip protocol conn' $ runSubscriptionPipeline f server q m s+  = do let headers = WS.requestHeaders $ WS.pendingRequest conn+       conn' <- WS.acceptRequest conn+       flip protocol conn' $ runSubscriptionPipeline f headers server q m s  -- | Run a Mu 'graphQLApp' using the given 'Settings'. --@@ -178,7 +186,7 @@ runGraphQLAppSettings ::   ( GraphQLApp p qr mut sub ServerErrorIO chn hs )   => Settings-  -> ServerT chn p ServerErrorIO hs+  -> ServerT chn GQL.Field p ServerErrorIO hs   -> Proxy qr   -> Proxy mut   -> Proxy sub@@ -189,7 +197,7 @@ runGraphQLApp ::   ( GraphQLApp p qr mut sub ServerErrorIO chn hs )   => Port-  -> ServerT chn p ServerErrorIO hs+  -> ServerT chn GQL.Field p ServerErrorIO hs   -> Proxy qr   -> Proxy mut   -> Proxy sub@@ -201,7 +209,7 @@   ( GraphQLApp p qr mut sub m chn hs )   => Port   -> (forall a. m a -> ServerErrorIO a)-  -> ServerT chn p m hs+  -> ServerT chn GQL.Field p m hs   -> Proxy qr   -> Proxy mut   -> Proxy sub@@ -212,7 +220,26 @@ runGraphQLAppQuery ::   ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs )   => Port-  -> ServerT chn p ServerErrorIO hs+  -> ServerT chn GQL.Field p ServerErrorIO hs   -> Proxy qr   -> IO () runGraphQLAppQuery port svr q = run port (graphQLAppQuery svr q)++-- | Turns a 'Conduit' working on 'ServerErrorIO'+--   into any other base monad which supports 'IO',+--   by raising any error as an exception.+--+--   This function is useful to interoperate with+--   libraries which generate 'Conduit's with other+--   base monads, such as @persistent@.+liftServerConduit+  :: MonadIO m+  => ConduitT i o ServerErrorIO r -> ConduitT i o m r+liftServerConduit = transPipe raiseErrors+  where raiseErrors :: forall m a. MonadIO m => ServerErrorIO a -> m a+        raiseErrors h+          = liftIO $ do+              h' <- runExceptT h+              case h' of+                Right r -> pure r+                Left  e -> throw e