summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/Error.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/Error.hs')
-rw-r--r--src/Language/GraphQL/Error.hs50
1 files changed, 25 insertions, 25 deletions
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index 91911b7..e41782d 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -5,21 +5,20 @@
module Language.GraphQL.Error
( parseError
, CollectErrsT
+ , Resolution(..)
, addErr
, addErrMsg
, runCollectErrs
- , runAppendErrs
, singleError
) where
+import Control.Monad.Trans.State (StateT, modify, runStateT)
import qualified Data.Aeson as Aeson
+import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Data.Void (Void)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State ( StateT
- , modify
- , runStateT
- )
+import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Type.Schema
import Text.Megaparsec
( ParseErrorBundle(..)
, PosState(..)
@@ -30,6 +29,11 @@ import Text.Megaparsec
, unPos
)
+data Resolution m = Resolution
+ { errors :: [Aeson.Value]
+ , types :: HashMap Name (Type m)
+ }
+
-- | Wraps a parse error into a list of errors.
parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
parseError ParseErrorBundle{..} =
@@ -46,11 +50,13 @@ parseError ParseErrorBundle{..} =
in (errorObject x sourcePosition : result, newState)
-- | A wrapper to pass error messages around.
-type CollectErrsT m = StateT [Aeson.Value] m
+type CollectErrsT m = StateT (Resolution m) m
-- | Adds an error to the list of errors.
addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
-addErr v = modify (v :)
+addErr v = modify appender
+ where
+ appender resolution@Resolution{..} = resolution{ errors = v : errors }
makeErrorMessage :: Text -> Aeson.Value
makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
@@ -66,23 +72,17 @@ singleError message = Aeson.object
addErrMsg :: Monad m => Text -> CollectErrsT m ()
addErrMsg = addErr . makeErrorMessage
--- | Appends the given list of errors to the current list of errors.
-appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
-appendErrs errs = modify (errs ++)
-
-- | Runs the given query computation, but collects the errors into an error
-- list, which is then sent back with the data.
-runCollectErrs :: Monad m => CollectErrsT m Aeson.Value -> m Aeson.Value
-runCollectErrs res = do
- (dat, errs) <- runStateT res []
- if null errs
+runCollectErrs :: Monad m
+ => HashMap Name (Type m)
+ -> CollectErrsT m Aeson.Value
+ -> m Aeson.Value
+runCollectErrs types' res = do
+ (dat, Resolution{..}) <- runStateT res $ Resolution{ errors = [], types = types' }
+ if null errors
then return $ Aeson.object [("data", dat)]
- else return $ Aeson.object [("data", dat), ("errors", Aeson.toJSON $ reverse errs)]
-
--- | Runs the given computation, collecting the errors and appending them
--- to the previous list of errors.
-runAppendErrs :: Monad m => CollectErrsT m a -> CollectErrsT m a
-runAppendErrs f = do
- (v, errs) <- lift $ runStateT f []
- appendErrs errs
- return v
+ else return $ Aeson.object
+ [ ("data", dat)
+ , ("errors", Aeson.toJSON $ reverse errors)
+ ]