1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
-- | Error handling.
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
)
-- | Wraps a parse error into a list of errors.
parseError :: (Applicative f, Serialize a)
=> ParseErrorBundle Text Void
-> f (Response a)
parseError ParseErrorBundle{..} =
pure $ Response null $ fst
$ foldl go (Seq.empty, bundlePosState) bundleErrors
where
errorObject s SourcePos{..} = Error
{ message = Text.pack $ init $ parseErrorTextPretty s
, locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
, path = []
}
unPos' = fromIntegral . unPos
go (result, state) x =
let (_, newState) = reachOffset (errorOffset x) state
sourcePosition = pstateSourcePos newState
in (result |> errorObject x sourcePosition, newState)
-- | If an error can be associated to a particular field in the GraphQL result,
-- it must contain an entry with the key path that details the path of the
-- response field which experienced the error. This allows clients to identify
-- whether a null result is intentional or caused by a runtime error.
data Path
= Segment Text -- ^ Field name.
| Index Int -- ^ List index if a field returned a list.
deriving (Eq, Show)
-- | @GraphQL@ error.
data Error = Error
{ message :: Text
, locations :: [Location]
, path :: [Path]
} 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)
-- | Each event in the underlying Source Stream triggers execution of the
-- subscription selection set. The results of the execution generate a Response
-- Stream.
type ResponseEventStream m a = ConduitT () (Response a) m ()
-- | Only exceptions that inherit from 'ResolverException' a cought by the
-- executor.
data ResolverException = forall e. Exception e => ResolverException e
instance Show ResolverException where
show (ResolverException e) = show e
instance Exception ResolverException
-- * Deprecated
-- | Runs the given query computation, but collects the errors into an error
-- list, which is then sent back with the data.
--
-- {-# DEPRECATED 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 types' res = do
(dat, Resolution{..}) <- runStateT res
$ Resolution{ errors = Seq.empty, types = types' }
pure $ Response dat errors
-- | Executor context.
--
-- {-# DEPRECATED Resolution was part of the old executor and isn't used
-- anymore #-}
data Resolution m = Resolution
{ errors :: Seq Error
, types :: HashMap Name (Schema.Type m)
}
-- | A wrapper to pass error messages around.
--
-- {-# DEPRECATED CollectErrsT was part of the old executor and isn't used
-- anymore #-}
type CollectErrsT m = StateT (Resolution m) m
|
