Report parse errors with line and column numbers

This commit is contained in:
Eugen Wissner 2019-07-19 06:38:54 +02:00
parent bc6a7dddd1
commit 5cf10b38ec
2 changed files with 24 additions and 8 deletions

View File

@ -8,9 +8,7 @@ import Control.Monad.IO.Class (MonadIO)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Text.Megaparsec ( errorBundlePretty import Text.Megaparsec (parse)
, parse
)
import Language.GraphQL.Execute import Language.GraphQL.Execute
import Language.GraphQL.Parser import Language.GraphQL.Parser
@ -34,5 +32,5 @@ graphql = flip graphqlSubs $ const Nothing
-- Returns the response as an @Aeson.@'Aeson.Value'. -- Returns the response as an @Aeson.@'Aeson.Value'.
graphqlSubs :: MonadIO m => Schema m -> Subs -> T.Text -> m Aeson.Value graphqlSubs :: MonadIO m => Schema m -> Subs -> T.Text -> m Aeson.Value
graphqlSubs schema f = graphqlSubs schema f =
either (parseError . errorBundlePretty) (execute schema f) either parseError (execute schema f)
. parse document "" . parse document ""

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.Error module Language.GraphQL.Error
( parseError ( parseError
, CollectErrsT , CollectErrsT
@ -9,17 +10,34 @@ module Language.GraphQL.Error
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Text (Text, pack) import Data.Text (Text)
import Data.Void (Void)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State ( StateT import Control.Monad.Trans.State ( StateT
, modify , modify
, runStateT , runStateT
) )
import Text.Megaparsec ( ParseErrorBundle(..)
, SourcePos(..)
, errorOffset
, parseErrorTextPretty
, reachOffset
, unPos
)
-- | Wraps a parse error into a list of errors. -- | Wraps a parse error into a list of errors.
parseError :: Applicative f => String -> f Aeson.Value parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
parseError s = parseError ParseErrorBundle{..} =
pure $ Aeson.object [("errors", Aeson.toJSON [makeErrorMsg $ pack s])] pure $ Aeson.object [("errors", Aeson.toJSON $ fst $ foldl go ([], bundlePosState) bundleErrors)]
where
errorObject s SourcePos{..} = Aeson.object
[ ("message", Aeson.toJSON $ init $ parseErrorTextPretty s)
, ("line", Aeson.toJSON $ unPos sourceLine)
, ("column", Aeson.toJSON $ unPos sourceColumn)
]
go (result, state) x =
let (sourcePosition, _, newState) = reachOffset (errorOffset x) state
in (errorObject x sourcePosition : result, newState)
-- | A wrapper to pass error messages around. -- | A wrapper to pass error messages around.
type CollectErrsT m = StateT [Aeson.Value] m type CollectErrsT m = StateT [Aeson.Value] m