Handle errors using custom types

Fixes #32.

src/Language/GraphQL/Error.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -5,7 +6,9 @@
 module Language.GraphQL.Error
     ( parseError
     , CollectErrsT
+    , Error(..)
     , Resolution(..)
+    , Response(..)
     , addErr
     , addErrMsg
     , runCollectErrs
@@ -13,12 +16,16 @@ module Language.GraphQL.Error
     ) where
 
 import Control.Monad.Trans.State (StateT, modify, runStateT)
-import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
+import Data.Sequence (Seq(..), (|>))
+import qualified Data.Sequence as Seq
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Data.Void (Void)
 import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Type.Schema
+import Prelude hiding (null)
 import Text.Megaparsec
     ( ParseErrorBundle(..)
     , PosState(..)
@@ -31,59 +38,72 @@ import Text.Megaparsec
 
 -- | Executor context.
 data Resolution m = Resolution
-    { errors :: [Aeson.Value]
+    { errors :: Seq Error
     , types :: HashMap Name (Type m)
     }
 
 -- | Wraps a parse error into a list of errors.
-parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
+parseError :: (Applicative f, Serialize a)
+    => ParseErrorBundle Text Void
+    -> f (Response a)
 parseError ParseErrorBundle{..}  =
-    pure $ Aeson.object [("errors", Aeson.toJSON $ fst $ foldl go ([], bundlePosState) bundleErrors)]
+    pure $ Response null $ fst
+        $ foldl go (Seq.empty, bundlePosState) bundleErrors
   where
-    errorObject s SourcePos{..} = Aeson.object
-        [ ("message", Aeson.toJSON $ init $ parseErrorTextPretty s)
-        , ("line", Aeson.toJSON $ unPos sourceLine)
-        , ("column", Aeson.toJSON $ unPos sourceColumn)
-        ]
+    errorObject s SourcePos{..} = Error
+        (Text.pack $ init $ parseErrorTextPretty s)
+        (unPos' sourceLine)
+        (unPos' sourceColumn)
+    unPos' = fromIntegral . unPos
     go (result, state) x =
         let (_, newState) = reachOffset (errorOffset x) state
             sourcePosition = pstateSourcePos newState
-         in (errorObject x sourcePosition : result, newState)
+         in (result |> errorObject x sourcePosition, newState)
 
 -- | A wrapper to pass error messages around.
 type CollectErrsT m = StateT (Resolution m) m
 
 -- | Adds an error to the list of errors.
-addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
+addErr :: Monad m => Error -> CollectErrsT m ()
 addErr v = modify appender
   where
-    appender resolution@Resolution{..} = resolution{ errors = v : errors }
+    appender :: Monad m => Resolution m -> Resolution m
+    appender resolution@Resolution{..} = resolution{ errors = errors |> v }
 
-makeErrorMessage :: Text -> Aeson.Value
-makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
+makeErrorMessage :: Text -> Error
+makeErrorMessage s = Error s 0 0
 
 -- | Constructs a response object containing only the error with the given
---   message.
-singleError :: Text -> Aeson.Value
-singleError message = Aeson.object
-    [ ("errors", Aeson.toJSON [makeErrorMessage message])
-    ]
+-- message.
+singleError :: Serialize a => Text -> Response a
+singleError message = Response null $ Seq.singleton $ makeErrorMessage message
 
 -- | Convenience function for just wrapping an error message.
 addErrMsg :: Monad m => Text -> CollectErrsT m ()
 addErrMsg = addErr . makeErrorMessage
 
+-- | @GraphQL@ error.
+data Error = Error
+    { message :: Text
+    , line :: Word
+    , column :: Word
+    } deriving (Eq, Show)
+
+-- | The server\'s response describes the result of executing the requested
+-- operation if successful, and describes any errors encountered during the
+-- request.
+data Response a = Response
+    { data' :: a
+    , errors :: Seq Error
+    } deriving (Eq, Show)
+
 -- | Runs the given query computation, but collects the errors into an error
---   list, which is then sent back with the data.
-runCollectErrs :: Monad m
+-- list, which is then sent back with the data.
+runCollectErrs :: (Monad m, Serialize a)
     => HashMap Name (Type m)
-    -> CollectErrsT m Aeson.Value
-    -> m Aeson.Value
+    -> CollectErrsT m a
+    -> m (Response a)
 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 errors)
-           ]
+    (dat, Resolution{..}) <- runStateT res
+        $ Resolution{ errors = Seq.empty, types = types' }
+    pure $ Response dat errors