{- 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 :: 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)

-- | 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 (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)

-- | @GraphQL@ error.
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)

-- | 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
    { 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)

-- | 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 -> FilePath
show (ResolverException e
e) = forall a. Show a => a -> FilePath
show e
e

instance Exception ResolverException

-- * Deprecated

{-# DEPRECATED runCollectErrs "runCollectErrs was part of the old executor and isn't used anymore" #-}
-- | Runs the given query computation, but collects the errors into an error
-- list, which is then sent back with the data.
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" #-}
-- | Executor context.
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" #-}
-- | A wrapper to pass error messages around.
type CollectErrsT m = StateT (Resolution m) m