{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.Error
( CollectErrsT
, Error(..)
, Path(..)
, Resolution(..)
, ResolverException(..)
, Response(..)
, ResponseEventStream
, parseError
, runCollectErrs
) where
import Conduit
import Control.Exception (Exception(..))
import Control.Monad.Trans.State (StateT, runStateT)
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 Language.GraphQL.AST (Location(..), Name)
import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Type.Schema as Schema
import Prelude hiding (null)
import Text.Megaparsec
( ParseErrorBundle(..)
, PosState(..)
, SourcePos(..)
, errorOffset
, parseErrorTextPretty
, reachOffset
, unPos
)
parseError :: (Applicative f, Serialize a)
=> ParseErrorBundle Text Void
-> f (Response a)
parseError :: forall (f :: * -> *) a.
(Applicative f, Serialize a) =>
ParseErrorBundle Text Void -> f (Response a)
parseError ParseErrorBundle{NonEmpty (ParseError Text Void)
PosState Text
bundleErrors :: forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundlePosState :: forall s e. ParseErrorBundle s e -> PosState s
bundlePosState :: PosState Text
bundleErrors :: NonEmpty (ParseError Text Void)
..} =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {s} {e} {s}.
(VisualStream s, ShowErrorComponent e, TraversableStream s) =>
(Seq Error, PosState s)
-> ParseError s e -> (Seq Error, PosState s)
go (forall a. Seq a
Seq.empty, PosState Text
bundlePosState) NonEmpty (ParseError Text Void)
bundleErrors
where
errorObject :: ParseError s e -> SourcePos -> Error
errorObject ParseError s e
s SourcePos{FilePath
Pos
sourceName :: SourcePos -> FilePath
sourceLine :: SourcePos -> Pos
sourceColumn :: SourcePos -> Pos
sourceColumn :: Pos
sourceLine :: Pos
sourceName :: FilePath
..} = Error
{ $sel:message:Error :: Text
message = FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> FilePath
parseErrorTextPretty ParseError s e
s
, $sel:locations:Error :: [Location]
locations = [Word -> Word -> Location
Location (Pos -> Word
unPos' Pos
sourceLine) (Pos -> Word
unPos' Pos
sourceColumn)]
, $sel:path:Error :: [Path]
path = []
}
unPos' :: Pos -> Word
unPos' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos
go :: (Seq Error, PosState s)
-> ParseError s e -> (Seq Error, PosState s)
go (Seq Error
result, PosState s
state) ParseError s e
x =
let (Maybe FilePath
_, PosState s
newState) = forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe FilePath, PosState s)
reachOffset (forall s e. ParseError s e -> Int
errorOffset ParseError s e
x) PosState s
state
sourcePosition :: SourcePos
sourcePosition = forall s. PosState s -> SourcePos
pstateSourcePos PosState s
newState
in (Seq Error
result forall a. Seq a -> a -> Seq a
|> forall {s} {e}.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> SourcePos -> Error
errorObject ParseError s e
x SourcePos
sourcePosition, PosState s
newState)
data Path
= Segment Text
| Index Int
deriving (Path -> Path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> FilePath
$cshow :: Path -> FilePath
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)
data Error = Error
{ Error -> Text
message :: Text
, Error -> [Location]
locations :: [Location]
, Error -> [Path]
path :: [Path]
} deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> FilePath
$cshow :: Error -> FilePath
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)
data Response a = Response
{ forall a. Response a -> a
data' :: a
, forall a. Response a -> Seq Error
errors :: Seq Error
} deriving (Response a -> Response a -> Bool
forall a. Eq a => Response a -> Response a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response a -> Response a -> Bool
$c/= :: forall a. Eq a => Response a -> Response a -> Bool
== :: Response a -> Response a -> Bool
$c== :: forall a. Eq a => Response a -> Response a -> Bool
Eq, Int -> Response a -> ShowS
forall a. Show a => Int -> Response a -> ShowS
forall a. Show a => [Response a] -> ShowS
forall a. Show a => Response a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Response a] -> ShowS
$cshowList :: forall a. Show a => [Response a] -> ShowS
show :: Response a -> FilePath
$cshow :: forall a. Show a => Response a -> FilePath
showsPrec :: Int -> Response a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Response a -> ShowS
Show)
type ResponseEventStream m a = ConduitT () (Response a) m ()
data ResolverException = forall e. Exception e => ResolverException e
instance Show ResolverException where
show :: ResolverException -> FilePath
show (ResolverException e
e) = forall a. Show a => a -> FilePath
show e
e
instance Exception ResolverException
{-# DEPRECATED runCollectErrs "runCollectErrs was part of the old executor and isn't used anymore" #-}
runCollectErrs :: (Monad m, Serialize a)
=> HashMap Name (Schema.Type m)
-> CollectErrsT m a
-> m (Response a)
runCollectErrs :: forall (m :: * -> *) a.
(Monad m, Serialize a) =>
HashMap Text (Type m) -> CollectErrsT m a -> m (Response a)
runCollectErrs HashMap Text (Type m)
types' CollectErrsT m a
res = do
(a
dat, Resolution{Seq Error
HashMap Text (Type m)
$sel:types:Resolution :: forall (m :: * -> *). Resolution m -> HashMap Text (Type m)
$sel:errors:Resolution :: forall (m :: * -> *). Resolution m -> Seq Error
types :: HashMap Text (Type m)
errors :: Seq Error
..}) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT CollectErrsT m a
res
forall a b. (a -> b) -> a -> b
$ Resolution{ $sel:errors:Resolution :: Seq Error
errors = forall a. Seq a
Seq.empty, $sel:types:Resolution :: HashMap Text (Type m)
types = HashMap Text (Type m)
types' }
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response a
dat Seq Error
errors
{-# DEPRECATED Resolution "Resolution was part of the old executor and isn't used anymore" #-}
data Resolution m = Resolution
{ forall (m :: * -> *). Resolution m -> Seq Error
errors :: Seq Error
, forall (m :: * -> *). Resolution m -> HashMap Text (Type m)
types :: HashMap Name (Schema.Type m)
}
{-# DEPRECATED CollectErrsT "CollectErrsT was part of the old executor and isn't used anymore" #-}
type CollectErrsT m = StateT (Resolution m) m