Fix haddoc warnings

Fix #14.
This commit is contained in:
Eugen Wissner 2019-09-20 08:47:14 +02:00
parent c075a41582
commit 2b5c719ab0
5 changed files with 17 additions and 20 deletions

View File

@ -20,7 +20,7 @@ test() {
test_docs() { test_docs() {
$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs $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() { setup_lint() {

View File

@ -14,8 +14,8 @@ import qualified Language.GraphQL.AST as Full
import qualified Language.GraphQL.AST.Core as Core import qualified Language.GraphQL.AST.Core as Core
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
-- | Replaces a fragment name by a list of 'Field'. If the name doesn't match an -- | Replaces a fragment name by a list of 'Core.Field'. If the name doesn't
-- empty list is returned. -- match an empty list is returned.
type Fragmenter = Core.Name -> [Core.Field] type Fragmenter = Core.Name -> [Core.Field]
-- | Rewrites the original syntax tree into an intermediate representation used -- | Rewrites the original syntax tree into an intermediate representation used

View File

@ -1,5 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
-- | Error handling.
module Language.GraphQL.Error module Language.GraphQL.Error
( parseError ( parseError
, CollectErrsT , CollectErrsT

View File

@ -28,9 +28,7 @@ module Language.GraphQL.Schema
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Except (runExceptT)
import Data.Foldable ( find import Data.Foldable (find, fold)
, fold
)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Aeson as Aeson 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'. -- @m@ is usually expected to be an instance of 'MonadIO'.
type Schema m = NonEmpty (Resolver m) type Schema m = NonEmpty (Resolver m)
-- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
-- (or 'empty'). @m@ is usually expected to be an instance of 'MonadIO. -- information (if an error has occurred). @m@ is usually expected to be an
-- instance of 'MonadIO'.
data Resolver m = Resolver data Resolver m = Resolver
Text -- ^ Name Text -- ^ Name
(Field -> CollectErrsT m Aeson.Object) -- ^ Resolver (Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
type Fields = [Field]
type Arguments = [Argument]
-- | Variable substitution function. -- | Variable substitution function.
type Subs = Name -> Maybe Value type Subs = Name -> Maybe Value
@ -67,14 +62,14 @@ object name = objectA name . const
-- | Like 'object' but also taking 'Argument's. -- | Like 'object' but also taking 'Argument's.
objectA :: MonadIO m 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 objectA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld@(Field _ _ _ flds) resolver = withField (resolve resolver flds) fld 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. -- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
wrappedObjectA :: MonadIO m 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 wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld@(Field _ _ _ sels) resolver resolveRight fld@(Field _ _ _ sels) resolver
@ -91,14 +86,14 @@ scalar name = scalarA name . const
-- | Like 'scalar' but also taking 'Argument's. -- | Like 'scalar' but also taking 'Argument's.
scalarA :: (MonadIO m, Aeson.ToJSON a) 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 scalarA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld result = withField (return result) fld resolveRight fld result = withField (return result) fld
-- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars. -- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars.
wrappedScalarA :: (MonadIO m, Aeson.ToJSON a) 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 wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld (Named result) = withField (return result) fld 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 enum name = enumA name . const
{-# DEPRECATED enumA "Use scalarA instead" #-} {-# 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 enumA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld resolver = withField (return resolver) fld resolveRight fld resolver = withField (return resolver) fld
{-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-} {-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-}
wrappedEnumA :: MonadIO m 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 wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld (Named resolver) = withField (return resolver) fld 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 -- 'Resolver' to each 'Field'. Resolves into a value containing the
-- resolved 'Field', or a null value and error information. -- resolved 'Field', or a null value and error information.
resolve :: MonadIO m 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 resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
where where
tryResolvers fld = maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers fld) resolvers tryResolvers fld = maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers fld) resolvers

View File

@ -1,4 +1,4 @@
resolver: lts-14.5 resolver: lts-14.6
packages: packages:
- '.' - '.'
extra-deps: [] extra-deps: []