packages feed

morpheus-graphql-app 0.28.1 → 0.28.2

raw patch · 17 files changed

+161/−161 lines, 17 filesdep ~bytestringdep ~containersdep ~tasty

Dependency ranges changed: bytestring, containers, tasty, th-lift-instances, transformers, unordered-containers, vector

Files

morpheus-graphql-app.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           morpheus-graphql-app-version:        0.28.1+version:        0.28.2 synopsis:       Morpheus GraphQL App description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -163,8 +163,8 @@       aeson >=1.4.4 && <3.0.0     , attoparsec-aeson >=2.1.0.0 && <3.0.0     , base >=4.7.0 && <5.0.0-    , bytestring >=0.10.4 && <0.15.0-    , containers >=0.4.2.1 && <=0.7+    , bytestring >=0.10.4 && <1.0.0+    , containers >=0.4.2.1 && <1.0.0     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0     , morpheus-graphql-core >=0.28.0 && <0.29.0@@ -173,10 +173,10 @@     , scientific >=0.3.6.2 && <0.4.0     , template-haskell >=2.0.0 && <3.0.0     , text >=1.2.3 && <3.0.0-    , th-lift-instances >=0.1.1 && <0.3.0-    , transformers >=0.3.0 && <0.7.0-    , unordered-containers >=0.2.8 && <0.3.0-    , vector >=0.12.0.1 && <0.15.0+    , th-lift-instances >=0.1.1 && <1.0.0+    , transformers >=0.3.0 && <1.0.0+    , unordered-containers >=0.2.8 && <1.0.0+    , vector >=0.12.0.1 && <1.0.0   default-language: Haskell2010  test-suite morpheus-graphql-app-test@@ -196,8 +196,8 @@       aeson >=1.4.4 && <3.0.0     , attoparsec-aeson >=2.1.0.0 && <3.0.0     , base >=4.7.0 && <5.0.0-    , bytestring >=0.10.4 && <0.15.0-    , containers >=0.4.2.1 && <=0.7+    , bytestring >=0.10.4 && <1.0.0+    , containers >=0.4.2.1 && <1.0.0     , directory >=1.0.0 && <2.0.0     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0@@ -207,12 +207,12 @@     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0-    , tasty >=0.1.0 && <=1.5+    , tasty >=0.1.0 && <2.0.0     , tasty-hunit >=0.1.0 && <1.0.0     , template-haskell >=2.0.0 && <3.0.0     , text >=1.2.3 && <3.0.0-    , th-lift-instances >=0.1.1 && <0.3.0-    , transformers >=0.3.0 && <0.7.0-    , unordered-containers >=0.2.8 && <0.3.0-    , vector >=0.12.0.1 && <0.15.0+    , th-lift-instances >=0.1.1 && <1.0.0+    , transformers >=0.3.0 && <1.0.0+    , unordered-containers >=0.2.8 && <1.0.0+    , vector >=0.12.0.1 && <1.0.0   default-language: Haskell2010
src/Data/Morpheus/App.hs view
@@ -141,36 +141,36 @@   Config ->   GQLRequest ->   ResponseStream event m ResolverContext-validateReq constraints inputSchema config request = ResultT $-  pure $-    do-      validSchema <- validateSchema True config inputSchema-      schema <- internalSchema <:> validSchema-      operation <- parseRequestWith config validSchema request-      checkConstraints schema operation constraints-      pure-        ( [],-          ResolverContext-            { schema,-              config,-              operation,-              currentType =-                toAny $-                  fromMaybe-                    (AST.query schema)-                    (rootType (operationType operation) schema),-              currentSelection =-                Selection-                  { selectionName = "Root",-                    selectionArguments = empty,-                    selectionPosition = operationPosition operation,-                    selectionAlias = Nothing,-                    selectionContent = SelectionSet (operationSelection operation),-                    selectionDirectives = empty,-                    selectionOrigin = Nothing-                  }-            }-        )+validateReq constraints inputSchema config request = ResultT+  $ pure+  $ do+    validSchema <- validateSchema True config inputSchema+    schema <- internalSchema <:> validSchema+    operation <- parseRequestWith config validSchema request+    checkConstraints schema operation constraints+    pure+      ( [],+        ResolverContext+          { schema,+            config,+            operation,+            currentType =+              toAny+                $ fromMaybe+                  (AST.query schema)+                  (rootType (operationType operation) schema),+            currentSelection =+              Selection+                { selectionName = "Root",+                  selectionArguments = empty,+                  selectionPosition = operationPosition operation,+                  selectionAlias = Nothing,+                  selectionContent = SelectionSet (operationSelection operation),+                  selectionDirectives = empty,+                  selectionOrigin = Nothing+                }+          }+      )  rootType :: OperationType -> Schema s -> Maybe (AST.TypeDefinition AST.OBJECT s) rootType OPERATION_QUERY = Just . AST.query
src/Data/Morpheus/App/Internal/Resolving/Batching.hs view
@@ -116,20 +116,20 @@ instance MonadTrans ResolverMapT where   lift = ResolverMapT . lift . lift -deriving instance MonadError GQLError m => MonadError GQLError (ResolverMapT m)+deriving instance (MonadError GQLError m) => MonadError GQLError (ResolverMapT m) -runBatchedT :: Monad m => ResolverMapT m a -> ResolverMap m -> m a+runBatchedT :: (Monad m) => ResolverMapT m a -> ResolverMap m -> m a runBatchedT (ResolverMapT m) rmap = fst <$> runStateT (runReaderT m rmap) empty  toKeys :: BatchEntry -> [CacheKey] toKeys (BatchEntry sel name deps) = map (CacheKey sel name) deps -inCache :: Monad m => CacheT m a -> ResolverMapT m a+inCache :: (Monad m) => CacheT m a -> ResolverMapT m a inCache = ResolverMapT . lift -class MonadTrans t => MonadBatching t where-  resolveRef :: ResolverMonad m => SelectionContent VALID -> NamedResolverRef -> t m (CacheKey, CacheValue m)-  storeValue :: ResolverMonad m => CacheKey -> ValidValue -> t m ValidValue+class (MonadTrans t) => MonadBatching t where+  resolveRef :: (ResolverMonad m) => SelectionContent VALID -> NamedResolverRef -> t m (CacheKey, CacheValue m)+  storeValue :: (ResolverMonad m) => CacheKey -> ValidValue -> t m ValidValue  instance MonadBatching IdentityT where   resolveRef _ _ = throwError $ internal "batching is only allowed with named resolvers"@@ -148,7 +148,7 @@   resolveRef _ ref = throwError (internal ("expected only one resolved value for " <> msg (show ref :: String)))   storeValue key = inCache . cacheValue key -prefetch :: ResolverMonad m => BatchEntry -> ResolverMapT m ()+prefetch :: (ResolverMonad m) => BatchEntry -> ResolverMapT m () prefetch batch = do   value <- run batch   batches <- buildBatches . concat <$> traverse (lift . scanRefs (batchedSelection batch)) value
src/Data/Morpheus/App/Internal/Resolving/Cache.hs view
@@ -42,7 +42,7 @@  type CacheT m = (StateT (CacheStore m) m) -printSelectionKey :: RenderGQL a => a -> String+printSelectionKey :: (RenderGQL a) => a -> String printSelectionKey sel = map replace $ filter ignoreSpaces $ unpack (render sel)   where     ignoreSpaces x = x /= ' '@@ -80,21 +80,21 @@ instance Empty (CacheStore m) where   empty = CacheStore empty -cacheResolverValues :: ResolverMonad m => [(CacheKey, ResolverValue m)] -> CacheT m ()+cacheResolverValues :: (ResolverMonad m) => [(CacheKey, ResolverValue m)] -> CacheT m () cacheResolverValues pres = do   CacheStore oldCache <- get   let updates = unsafeFromList (map (second CachedResolver) pres)   cache <- labeledDebug "\nUPDATE|>" $ CacheStore $ updates <> oldCache   modify (const cache) -useCached :: ResolverMonad m => CacheKey -> CacheT m (CacheValue m)+useCached :: (ResolverMonad m) => CacheKey -> CacheT m (CacheValue m) useCached v = do   cache <- get >>= labeledDebug "\nUSE|>"   case lookup v (_unpackStore cache) of     Just x -> pure x     Nothing -> throwError (internal $ "cache value could not found for key" <> msg (show v :: String)) -isCached :: Monad m => CacheKey -> CacheT m Bool+isCached :: (Monad m) => CacheKey -> CacheT m Bool isCached key = isJust . lookup key . _unpackStore <$> get  setValue :: (CacheKey, ValidValue) -> CacheStore m -> CacheStore m@@ -110,5 +110,5 @@ withDebug :: (Show a, MonadReader ResolverContext m) => a -> m a withDebug = labeledDebug "" -cacheValue :: Monad m => CacheKey -> ValidValue -> CacheT m ValidValue+cacheValue :: (Monad m) => CacheKey -> ValidValue -> CacheT m ValidValue cacheValue key value = modify (setValue (key, value)) $> value
src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs view
@@ -55,13 +55,13 @@ import Relude hiding (empty)  -- UNCACHED-resolvePlainRoot :: MonadResolver m => ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue+resolvePlainRoot :: (MonadResolver m) => ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue resolvePlainRoot resolver selection = do   name <- asks (typeName . currentType)   runIdentityT (resolveSelection (SelectionSet selection) (ResObject (Just name) resolver))  -- CACHED-resolveNamedRoot :: MonadResolver m => TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue+resolveNamedRoot :: (MonadResolver m) => TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue resolveNamedRoot typeName resolvers selection =   runBatchedT     (resolveSelection (SelectionSet selection) (ResRef $ pure (NamedResolverRef typeName ["ROOT"])))
src/Data/Morpheus/App/Internal/Resolving/Resolver.hs view
@@ -178,7 +178,7 @@   local f (ResolverS resM) = ResolverS $ mapReaderT (local f) <$> resM  class LiftOperation (o :: OperationType) where-  packResolver :: Monad m => ResolverStateT e m a -> Resolver o e m a+  packResolver :: (Monad m) => ResolverStateT e m a -> Resolver o e m a  instance LiftOperation QUERY where   packResolver = ResolverQ . clearStateResolverEvents@@ -189,7 +189,7 @@ instance LiftOperation SUBSCRIPTION where   packResolver = ResolverS . pure . lift . clearStateResolverEvents -toEventResolver :: Monad m => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse)+toEventResolver :: (Monad m) => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse) toEventResolver sel (ReaderT subRes) event = renderResponse <$> runResolverStateValueM (subRes event) sel  subscriptionEvents ::
src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs view
@@ -110,15 +110,15 @@  inSelectionField :: (MonadReader ResolverContext m, MonadError GQLError m) => Selection VALID -> m b -> m b inSelectionField selection m = do-  inField (selectionName selection) $-    local (\ctx -> ctx {currentSelection = selection}) m+  inField (selectionName selection)+    $ local (\ctx -> ctx {currentSelection = selection}) m  inField :: (MonadReader ResolverContext m, MonadError GQLError m) => FieldName -> m b -> m b inField fieldName m = do   fieldType <- askFieldTypeName fieldName   updateCurrentType fieldType m -askFieldTypeName :: MonadReader ResolverContext m => FieldName -> m (Maybe TypeName)+askFieldTypeName :: (MonadReader ResolverContext m) => FieldName -> m (Maybe TypeName) askFieldTypeName name = asks (fieldTypeName name . currentType)  type ResolverState = ResolverStateT () Identity@@ -129,7 +129,7 @@ runResolverStateM :: ResolverStateT e m a -> ResolverContext -> m (Result GQLError ([e], a)) runResolverStateM res = runResultT . runResolverStateT res -runResolverStateValueM :: Functor m => ResolverStateT e m a -> ResolverContext -> m (Result GQLError a)+runResolverStateValueM :: (Functor m) => ResolverStateT e m a -> ResolverContext -> m (Result GQLError a) runResolverStateValueM res = fmap (fmap snd) . runResolverStateM res  runResolverState :: ResolverState a -> ResolverContext -> GQLResult a@@ -153,10 +153,10 @@   throwError err = do     ctx <- asks id     let f = if isInternal err then renderInternalResolverError ctx else resolverFailureMessage ctx-    ResolverStateT $-      lift $-        throwError $-          f err+    ResolverStateT+      $ lift+      $ throwError+      $ f err   catchError (ResolverStateT mx) f = ResolverStateT $ catchError mx (_runResolverStateT . f)  instance (Monad m) => PushEvents e (ResolverStateT e m) where@@ -171,7 +171,7 @@ mapResolverState f (ResolverStateT x) = ResolverStateT (mapReaderT f x)  toResolverStateT ::-  Applicative m =>+  (Applicative m) =>   ResolverState a ->   ResolverStateT e m a toResolverStateT = mapResolverState injectResult@@ -204,9 +204,9 @@  renderInternalResolverError :: ResolverContext -> GQLError -> GQLError renderInternalResolverError ctx@ResolverContext {currentSelection} err =-  internal $-    (err <> ". " <> msg (renderContext ctx))-      `at` selectionPosition currentSelection+  internal+    $ (err <> ". " <> msg (renderContext ctx))+    `at` selectionPosition currentSelection  withInternalContext :: ResolverContext -> GQLError withInternalContext ResolverContext {config = Config {debug = False}} = ""@@ -225,7 +225,7 @@       <> renderSection "OperationDefinition" operation       <> renderSection "SchemaDefinition" schema -renderSection :: RenderGQL a => GQLError -> a -> GQLError+renderSection :: (RenderGQL a) => GQLError -> a -> GQLError renderSection label content =   "\n\n"     <> label
src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs view
@@ -42,8 +42,8 @@  resolveSchema :: (MonadResolver m) => Schema VALID -> m (ResolverValue m) resolveSchema schema@Schema {..} =-  pure $-    mkObject+  pure+    $ mkObject       "__Schema"       [ ("types", renderI $ toList $ typeDefinitions schema),         ("queryType", renderI (Just query)),
src/Data/Morpheus/App/Internal/Resolving/Utils.hs view
@@ -76,7 +76,7 @@     fields lookupResJSON _ _ = mkEmptyObject -mkEmptyObject :: Monad m => m (ObjectTypeResolver a)+mkEmptyObject :: (Monad m) => m (ObjectTypeResolver a) mkEmptyObject = pure $ ObjectTypeResolver mempty  mkValue ::@@ -110,7 +110,7 @@     _ -> NoAPI txt   _ -> NoAPI txt -requireObject :: MonadError GQLError f => ResolverValue m -> f (ObjectTypeResolver m)+requireObject :: (MonadError GQLError f) => ResolverValue m -> f (ObjectTypeResolver m) requireObject (ResObject _ x) = pure x requireObject _ = throwError (internal "resolver must be an object") @@ -118,7 +118,7 @@ unpackJSONName (String x) = Just (packName x) unpackJSONName _ = Nothing -withField :: Monad m' => a -> (m (ResolverValue m) -> m' a) -> FieldName -> ObjectTypeResolver m -> m' a+withField :: (Monad m') => a -> (m (ResolverValue m) -> m' a) -> FieldName -> ObjectTypeResolver m -> m' a withField fb suc selectionName ObjectTypeResolver {..} = maybe (pure fb) suc (lookup selectionName objectFields)  withObject ::
src/Data/Morpheus/App/Internal/Stitching.hs view
@@ -50,7 +50,7 @@   | p1 == p2 = pure p2   | otherwise = throwError err -fstM :: Applicative m => a -> a -> m a+fstM :: (Applicative m) => a -> a -> m a fstM x _ = pure x  concatM :: (Applicative m, Semigroup a) => a -> a -> m a@@ -59,7 +59,7 @@ class Stitching a where   stitch :: (Monad m, MonadError GQLError m) => a -> a -> m a -instance Stitching a => Stitching (Maybe a) where+instance (Stitching a) => Stitching (Maybe a) where   stitch = optional stitch  instance Stitching (Schema s) where@@ -80,7 +80,7 @@ instance Stitching (Directives s) where   stitch = merge -optional :: Applicative f => (t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)+optional :: (Applicative f) => (t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t) optional _ Nothing y = pure y optional _ (Just x) Nothing = pure (Just x) optional f (Just x) (Just y) = Just <$> f x y@@ -132,7 +132,7 @@   y' <- f y   merge x' y' -stitchSubscriptions :: MonadError GQLError m => Maybe a -> Maybe a -> m (Maybe a)+stitchSubscriptions :: (MonadError GQLError m) => Maybe a -> Maybe a -> m (Maybe a) stitchSubscriptions Just {} Just {} = throwError ("can't merge  subscription applications" :: GQLError) stitchSubscriptions x Nothing = pure x stitchSubscriptions Nothing x = pure x@@ -165,11 +165,11 @@             }     | otherwise = throwError "ResolverMap must have same resolverName" -instance Monad m => Stitching (RootResolverValue e m) where+instance (Monad m) => Stitching (RootResolverValue e m) where   stitch x@RootResolverValue {} y@RootResolverValue {} = do     channelMap <- stitchSubscriptions (channelMap x) (channelMap y)-    pure $-      RootResolverValue+    pure+      $ RootResolverValue         { queryResolver = rootProp queryResolver x y,           mutationResolver = rootProp mutationResolver x y,           subscriptionResolver = rootProp subscriptionResolver x y,
src/Data/Morpheus/App/NamedResolvers.hs view
@@ -50,10 +50,10 @@ list :: [ResolverValue m] -> ResolverValue m list = mkList -ref :: Applicative m => TypeName -> ValidValue -> ResolverValue m+ref :: (Applicative m) => TypeName -> ValidValue -> ResolverValue m ref typeName = ResRef . pure . NamedResolverRef typeName . pure -refs :: Applicative m => TypeName -> [ValidValue] -> ResolverValue m+refs :: (Applicative m) => TypeName -> [ValidValue] -> ResolverValue m refs typeName = mkList . map (ref typeName)  type NamedResolverFunction o e m = NamedFunction (Resolver o e m)@@ -70,7 +70,7 @@ nullRes :: (MonadResolver m) => m (ResultBuilder m) nullRes = pure Null -queryResolvers :: Monad m => [(TypeName, NamedFunction (Resolver QUERY e m))] -> RootResolverValue e m+queryResolvers :: (Monad m) => [(TypeName, NamedFunction (Resolver QUERY e m))] -> RootResolverValue e m queryResolvers = NamedResolversValue . mkResolverMap  -- INTERNAL@@ -79,10 +79,10 @@   | Union TypeName ValidValue   | Null -mkResolverMap :: MonadResolver m => [(TypeName, NamedFunction m)] -> ResolverMap m+mkResolverMap :: (MonadResolver m) => [(TypeName, NamedFunction m)] -> ResolverMap m mkResolverMap = HM.fromList . map packRes   where-    packRes :: MonadResolver m => (TypeName, NamedFunction m) -> (TypeName, NamedResolver m)+    packRes :: (MonadResolver m) => (TypeName, NamedFunction m) -> (TypeName, NamedResolver m)     packRes (typeName, f) = (typeName, NamedResolver typeName (fmap (map mapValue) . f))       where         mapValue (Object x) = NamedObjectResolver (ObjectTypeResolver $ HM.fromList x)
src/Data/Morpheus/App/RenderIntrospection.hs view
@@ -13,7 +13,7 @@   ) where -import Control.Monad.Except (MonadError (throwError))+import Control.Monad.Except (MonadError (..)) import Data.Morpheus.App.Internal.Resolving.MonadResolver   ( MonadResolver,     ResolverContext (..),@@ -76,13 +76,13 @@ iError :: GQLError -> GQLError iError x = internal ("INTROSPECTION" <> x) -getType :: MonadResolver m => TypeName -> m TypeDef+getType :: (MonadResolver m) => TypeName -> m TypeDef getType name =   asks schema     >>= selectBy (iError $ "type \"" <> msg name <> "\" not found!") name-      . typeDefinitions+    . typeDefinitions -assertINTERFACE :: MonadResolver m => TypeDef -> m TypeDef+assertINTERFACE :: (MonadResolver m) => TypeDef -> m TypeDef assertINTERFACE t@TypeDefinition {typeContent = DataInterface {}} = pure t assertINTERFACE t = throwError $ iError $ "Type " <> msg (typeName t) <> " must be an Interface!" @@ -93,7 +93,7 @@ type IField m = (FieldName, IValue m)  class RenderI a where-  renderI :: MonadResolver m => a -> IValue m+  renderI :: (MonadResolver m) => a -> IValue m  instance RenderI (Name t) where   renderI = pure . mkString . unpackName@@ -101,10 +101,10 @@ instance RenderI Description where   renderI = pure . mkString -instance RenderI a => RenderI [a] where+instance (RenderI a) => RenderI [a] where   renderI ls = mkList <$> traverse renderI ls -instance RenderI a => RenderI (Maybe a) where+instance (RenderI a) => RenderI (Maybe a) where   renderI (Just value) = renderI value   renderI Nothing = pure mkNull @@ -130,9 +130,9 @@ instance RenderI (TypeDefinition c VALID) where   renderI TypeDefinition {..} = renderContent typeContent     where-      __type :: MonadResolver m => TypeKind -> [IField m] -> IValue m+      __type :: (MonadResolver m) => TypeKind -> [IField m] -> IValue m       __type kind = __Type kind typeName typeDescription-      renderContent :: MonadResolver m => TypeContent bool a VALID -> IValue m+      renderContent :: (MonadResolver m) => TypeContent bool a VALID -> IValue m       renderContent DataScalar {} = __type KIND_SCALAR []       renderContent (DataEnum enums) = __type KIND_ENUM [("enumValues", renderI enums)]       renderContent (DataInputObject inputFields) =@@ -175,7 +175,7 @@ instance RenderI (UnionMember OUT s) where   renderI UnionMember {memberName} = getType memberName >>= renderI -instance RenderI (FieldDefinition cat s) => RenderI (FieldsDefinition cat s) where+instance (RenderI (FieldDefinition cat s)) => RenderI (FieldsDefinition cat s) where   renderI = renderI . filter fieldVisibility . toList  instance RenderI (FieldContent TRUE IN VALID) where@@ -187,13 +187,13 @@  instance RenderI (FieldDefinition OUT VALID) where   renderI FieldDefinition {..} =-    object "__Field" $-      [ fName fieldName,-        fDescription fieldDescription,-        fType fieldType,-        ("args", maybe (pure $ mkList []) renderI fieldContent)-      ]-        <> fDeprecated fieldDirectives+    object "__Field"+      $ [ fName fieldName,+          fDescription fieldDescription,+          fType fieldType,+          ("args", maybe (pure $ mkList []) renderI fieldContent)+        ]+      <> fDeprecated fieldDirectives  instance RenderI (FieldContent TRUE OUT VALID) where   renderI (FieldArgs args) = renderI args@@ -213,11 +213,11 @@  instance RenderI (DataEnumValue VALID) where   renderI DataEnumValue {..} =-    object "__EnumValue" $-      [ fName enumName,-        fDescription enumDescription-      ]-        <> fDeprecated enumDirectives+    object "__EnumValue"+      $ [ fName enumName,+          fDescription enumDescription+        ]+      <> fDeprecated enumDirectives  instance RenderI TypeRef where   renderI TypeRef {..} = renderWrapper typeWrappers@@ -229,12 +229,12 @@           kind <- kindOf <$> getType typeConName           __Type kind typeConName Nothing [] -withNonNull :: MonadResolver m => Bool -> IValue m -> IValue m+withNonNull :: (MonadResolver m) => Bool -> IValue m -> IValue m withNonNull True = wrapper KIND_NON_NULL withNonNull False = id  __Type ::-  MonadResolver m =>+  (MonadResolver m) =>   TypeKind ->   Name t ->   Maybe Description ->@@ -250,7 +250,7 @@         <> etc     ) -wrapper :: MonadResolver m => TypeKind -> IValue m -> IValue m+wrapper :: (MonadResolver m) => TypeKind -> IValue m -> IValue m wrapper k t =   object     "__Type"@@ -258,26 +258,26 @@       ("ofType", t)     ] -object :: Monad m => TypeName -> [IField m] -> IValue m+object :: (Monad m) => TypeName -> [IField m] -> IValue m object name = pure . mkObject name -fDeprecated :: MonadResolver m => Directives s -> [IField m]+fDeprecated :: (MonadResolver m) => Directives s -> [IField m] fDeprecated dirs =   [ ("isDeprecated", renderI (isJust $ lookupDeprecated dirs)),     ("deprecationReason", renderI (lookupDeprecated dirs >>= lookupDeprecatedReason))   ] -fDescription :: MonadResolver m => Maybe Description -> IField m+fDescription :: (MonadResolver m) => Maybe Description -> IField m fDescription = ("description",) . renderI -fName :: MonadResolver m => Name t -> IField m+fName :: (MonadResolver m) => Name t -> IField m fName = ("name",) . renderI -fKind :: MonadResolver m => TypeKind -> IField m+fKind :: (MonadResolver m) => TypeKind -> IField m fKind = ("kind",) . renderI -fType :: MonadResolver m => TypeRef -> IField m+fType :: (MonadResolver m) => TypeRef -> IField m fType = ("type",) . renderI -fDefaultValue :: MonadResolver m => Maybe (FieldContent TRUE IN VALID) -> IField m+fDefaultValue :: (MonadResolver m) => Maybe (FieldContent TRUE IN VALID) -> IField m fDefaultValue = ("defaultValue",) . renderI
src/Data/Morpheus/Types/GQLWrapper.hs view
@@ -108,7 +108,7 @@   | otherwise = ExceptT $ pure $ Left (fromString ("Expected a List without duplicates, found " <> show (length listVal - length setVal) <> " duplicates"))  withRefinedList ::-  Monad m =>+  (Monad m) =>   ([a] -> Either GQLError (rList a)) ->   (ValidValue -> m a) ->   ValidValue ->
test/APIConstraints.hs view
@@ -44,13 +44,13 @@   ( TestTree,   ) -resolvers :: Monad m => RootResolverValue e m+resolvers :: (Monad m) => RootResolverValue e m resolvers =   queryResolvers     [ ( "Query",         traverse-          ( const $-              object+          ( const+              $ object                 [ ("success", pure "success"),                   ("forbidden", pure "forbidden!"),                   ("limited", pure "num <= 5")
test/Batching.hs view
@@ -61,10 +61,10 @@  type BatchingConstraints = Map Text BatchedValues -typeConstraint :: Monad m => BatchingConstraints -> (TypeName, NamedResolverFunction QUERY e m) -> (TypeName, NamedResolverFunction QUERY e m)+typeConstraint :: (Monad m) => BatchingConstraints -> (TypeName, NamedResolverFunction QUERY e m) -> (TypeName, NamedResolverFunction QUERY e m) typeConstraint cons (name, f) = (name,) $ maybe f (require f) (lookup (unpackName name) cons) -require :: Monad m => NamedResolverFunction QUERY e m -> BatchedValues -> NamedResolverFunction QUERY e m+require :: (Monad m) => NamedResolverFunction QUERY e m -> BatchedValues -> NamedResolverFunction QUERY e m require f req args   | fromList args == req = f args   | otherwise = throwError ("was not batched! expected: " <> msg (List $ toList req) <> "got: " <> msg (List args))@@ -84,7 +84,7 @@ getPowers "morpheus" = [enum "Shapeshifting"] getPowers _ = [] -deityResolver :: Monad m => NamedResolverFunction QUERY e m+deityResolver :: (Monad m) => NamedResolverFunction QUERY e m deityResolver = traverse getDeity   where     getDeity name@@ -95,7 +95,7 @@             ]       | otherwise = nullRes -resolveQuery :: Monad m => NamedResolverFunction QUERY e m+resolveQuery :: (Monad m) => NamedResolverFunction QUERY e m resolveQuery = traverse getQuery   where     getQuery _ =@@ -104,13 +104,13 @@           ("deities", pure $ refs "Deity" ["zeus", "morpheus"])         ] -resolvers :: Monad m => BatchingConstraints -> RootResolverValue e m+resolvers :: (Monad m) => BatchingConstraints -> RootResolverValue e m resolvers cons =-  queryResolvers $-    typeConstraint cons-      <$> [ ("Query", resolveQuery),-            ("Deity", deityResolver)-          ]+  queryResolvers+    $ typeConstraint cons+    <$> [ ("Query", resolveQuery),+          ("Deity", deityResolver)+        ]  getSchema :: FileUrl -> IO (Schema VALID) getSchema url = LBS.readFile (toString url) >>= resultOr (fail . show) pure . parseSchema
test/Execution.hs view
@@ -56,23 +56,23 @@ getName "cronos" = "Cronos" getName _ = "" -restrictExecutions :: Monad m => Int -> ResQ m ()+restrictExecutions :: (Monad m) => Int -> ResQ m () restrictExecutions expected = do   count <- lift get   if expected == count then pure () else throwError ("unexpected execution count. expected " <> msg expected <> " but got " <> msg count <> ".") -deityResolver :: Monad m => ValidValue -> ResQ m (ResolverValue (ResQ m))+deityResolver :: (Monad m) => ValidValue -> ResQ m (ResolverValue (ResQ m)) deityResolver name = do   lift (modify (+ 1))   pure $ mkObject "Deity" [("name", pure $ getName name)] -resolvers :: Monad m => RootResolverValue () (ExecState m)+resolvers :: (Monad m) => RootResolverValue () (ExecState m) resolvers =   RootResolverValue     { queryResolver =         pure-          ( ObjectTypeResolver $-              fromList+          ( ObjectTypeResolver+              $ fromList                 [ ("deity", (getArgument "id" >>= deityResolver) <* restrictExecutions 1),                   ("deities", (list <$> traverse deityResolver ["zeus", "morpheus"]) <* restrictExecutions 2)                 ]
test/NamedResolvers.hs view
@@ -47,13 +47,13 @@   )  -- DEITIES-resolverDeities :: Monad m => RootResolverValue e m+resolverDeities :: (Monad m) => RootResolverValue e m resolverDeities =   queryResolvers     [ ( "Query",         traverse-          ( const $-              object+          ( const+              $ object                 [ ("deity", ref "Deity" <$> getArgument "id"),                   ("deities", pure $ refs "Deity" ["zeus", "morpheus"])                 ]@@ -62,7 +62,7 @@       ("Deity", deityResolver)     ] -deityResolver :: Monad m => NamedResolverFunction QUERY e m+deityResolver :: (Monad m) => NamedResolverFunction QUERY e m deityResolver = traverse deityRes   where     deityRes "zeus" =@@ -77,13 +77,13 @@         ]  -- REALMS-resolverRealms :: Monad m => RootResolverValue e m+resolverRealms :: (Monad m) => RootResolverValue e m resolverRealms =   queryResolvers     [ ( "Query",         traverse-          ( const $-              object+          ( const+              $ object                 [ ("realm", ref "Realm" <$> getArgument "id"),                   ("realms", pure $ refs "Realm" ["olympus", "dreams"])                 ]@@ -93,14 +93,14 @@       ("Realm", realmResolver)     ] -deityResolverExt :: Monad m => NamedResolverFunction QUERY e m+deityResolverExt :: (Monad m) => NamedResolverFunction QUERY e m deityResolverExt = traverse deityExt   where     deityExt "zeus" = object [("realm", pure $ ref "Realm" "olympus")]     deityExt "morpheus" = object [("realm", pure $ ref "Realm" "dreams")]     deityExt _ = object [] -realmResolver :: Monad m => NamedResolverFunction QUERY e m+realmResolver :: (Monad m) => NamedResolverFunction QUERY e m realmResolver = traverse realmResolver'   where     realmResolver' "olympus" =@@ -119,17 +119,17 @@         ]  -- ENTITIES-resolverEntities :: Monad m => RootResolverValue e m+resolverEntities :: (Monad m) => RootResolverValue e m resolverEntities =   queryResolvers     [ ( "Query",         traverse-          ( const $-              object+          ( const+              $ object                 [ ("entity", ref "Entity" <$> getArgument "id"),                   ( "entities",-                    pure $-                      refs+                    pure+                      $ refs                         "Entity"                         ["zeus", "morpheus", "olympus", "dreams"]                   )@@ -139,7 +139,7 @@       ("Entity", resolveEntity)     ] -resolveEntity :: Monad m => NamedResolverFunction QUERY e m+resolveEntity :: (Monad m) => NamedResolverFunction QUERY e m resolveEntity = traverse resEntity   where     resEntity "zeus" = variant "Deity" "zeus"@@ -156,10 +156,10 @@   schemaDeities <- getSchema "test/named-resolvers/deities.gql"   schemaRealms <- getSchema "test/named-resolvers/realms.gql"   schemaEntities <- getSchema "test/named-resolvers/entities.gql"-  pure $-    mkApp schemaDeities resolverDeities-      <> mkApp schemaRealms resolverRealms-      <> mkApp schemaEntities resolverEntities+  pure+    $ mkApp schemaDeities resolverDeities+    <> mkApp schemaRealms resolverRealms+    <> mkApp schemaEntities resolverEntities  runNamedResolversTest :: FileUrl -> FileUrl -> TestTree runNamedResolversTest url = testApi api