summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2019-09-20 08:47:14 +0200
committerEugen Wissner <belka@caraus.de>2019-09-20 08:47:14 +0200
commit2b5c719ab06b28aef8a242ffbbda256191e32655 (patch)
tree4fbbd4e82bd478ec9cb1a8a8d51c222b44a1c1b6
parentc075a41582279be2ed1f2b5d5c758ab14d664770 (diff)
downloadgraphql-2b5c719ab06b28aef8a242ffbbda256191e32655.tar.gz
Fix haddoc warnings
Fix #14.
-rwxr-xr-xsemaphoreci.sh2
-rw-r--r--src/Language/GraphQL/AST/Transform.hs4
-rw-r--r--src/Language/GraphQL/Error.hs2
-rw-r--r--src/Language/GraphQL/Schema.hs27
-rw-r--r--stack.yaml2
5 files changed, 17 insertions, 20 deletions
diff --git a/semaphoreci.sh b/semaphoreci.sh
index 309798a..28fdb18 100755
--- a/semaphoreci.sh
+++ b/semaphoreci.sh
@@ -20,7 +20,7 @@ test() {
test_docs() {
$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
- $STACK --no-terminal haddock --no-haddock-deps
+ $STACK --no-terminal haddock --no-haddock-deps
}
setup_lint() {
diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs
index 99e0f3e..f3d2a38 100644
--- a/src/Language/GraphQL/AST/Transform.hs
+++ b/src/Language/GraphQL/AST/Transform.hs
@@ -14,8 +14,8 @@ import qualified Language.GraphQL.AST as Full
import qualified Language.GraphQL.AST.Core as Core
import qualified Language.GraphQL.Schema as Schema
--- | Replaces a fragment name by a list of 'Field'. If the name doesn't match an
--- empty list is returned.
+-- | Replaces a fragment name by a list of 'Core.Field'. If the name doesn't
+-- match an empty list is returned.
type Fragmenter = Core.Name -> [Core.Field]
-- | Rewrites the original syntax tree into an intermediate representation used
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index d0bc84d..41a2a9c 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+
+-- | Error handling.
module Language.GraphQL.Error
( parseError
, CollectErrsT
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs
index 428b80e..99de5a9 100644
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@@ -28,9 +28,7 @@ module Language.GraphQL.Schema
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (runExceptT)
-import Data.Foldable ( find
- , fold
- )
+import Data.Foldable (find, fold)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import qualified Data.Aeson as Aeson
@@ -48,16 +46,13 @@ import Language.GraphQL.AST.Core
-- @m@ is usually expected to be an instance of 'MonadIO'.
type Schema m = NonEmpty (Resolver m)
--- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information
--- (or 'empty'). @m@ is usually expected to be an instance of 'MonadIO.
+-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
+-- information (if an error has occurred). @m@ is usually expected to be an
+-- instance of 'MonadIO'.
data Resolver m = Resolver
Text -- ^ Name
(Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
-type Fields = [Field]
-
-type Arguments = [Argument]
-
-- | Variable substitution function.
type Subs = Name -> Maybe Value
@@ -67,14 +62,14 @@ object name = objectA name . const
-- | Like 'object' but also taking 'Argument's.
objectA :: MonadIO m
- => Name -> (Arguments -> ActionT m [Resolver m]) -> Resolver m
+ => Name -> ([Argument] -> ActionT m [Resolver m]) -> Resolver m
objectA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld@(Field _ _ _ flds) resolver = withField (resolve resolver flds) fld
-- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
wrappedObjectA :: MonadIO m
- => Name -> (Arguments -> ActionT m (Wrapping [Resolver m])) -> Resolver m
+ => Name -> ([Argument] -> ActionT m (Wrapping [Resolver m])) -> Resolver m
wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld@(Field _ _ _ sels) resolver
@@ -91,14 +86,14 @@ scalar name = scalarA name . const
-- | Like 'scalar' but also taking 'Argument's.
scalarA :: (MonadIO m, Aeson.ToJSON a)
- => Name -> (Arguments -> ActionT m a) -> Resolver m
+ => Name -> ([Argument] -> ActionT m a) -> Resolver m
scalarA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld result = withField (return result) fld
-- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars.
wrappedScalarA :: (MonadIO m, Aeson.ToJSON a)
- => Name -> (Arguments -> ActionT m (Wrapping a)) -> Resolver m
+ => Name -> ([Argument] -> ActionT m (Wrapping a)) -> Resolver m
wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld (Named result) = withField (return result) fld
@@ -116,14 +111,14 @@ enum :: MonadIO m => Name -> ActionT m [Text] -> Resolver m
enum name = enumA name . const
{-# DEPRECATED enumA "Use scalarA instead" #-}
-enumA :: MonadIO m => Name -> (Arguments -> ActionT m [Text]) -> Resolver m
+enumA :: MonadIO m => Name -> ([Argument] -> ActionT m [Text]) -> Resolver m
enumA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld resolver = withField (return resolver) fld
{-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-}
wrappedEnumA :: MonadIO m
- => Name -> (Arguments -> ActionT m (Wrapping [Text])) -> Resolver m
+ => Name -> ([Argument] -> ActionT m (Wrapping [Text])) -> Resolver m
wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
where
resolveRight fld (Named resolver) = withField (return resolver) fld
@@ -158,7 +153,7 @@ withField v fld
-- 'Resolver' to each 'Field'. Resolves into a value containing the
-- resolved 'Field', or a null value and error information.
resolve :: MonadIO m
- => [Resolver m] -> Fields -> CollectErrsT m Aeson.Value
+ => [Resolver m] -> [Field] -> CollectErrsT m Aeson.Value
resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
where
tryResolvers fld = maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers fld) resolvers
diff --git a/stack.yaml b/stack.yaml
index fb57c3f..2e2e263 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-14.5
+resolver: lts-14.6
packages:
- '.'
extra-deps: []