-- Copyright (c) 2014-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is distributed under the terms of a BSD license,
-- found in the LICENSE file.

{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}

-- | An exception hierarchy that can be used with the 'Haxl' monad.
--
-- The Haxl framework may throw exceptions from this hierarchy: for
-- example, a misbehaving data source causes 'dataFetch' to throw a
-- 'DataSourceError'.  The combinator 'withDefault' from
-- "Haxl.Core.Prelude" uses this hierarchy to provide default values
-- for expressions that raise 'TransientError' or 'LogicError'
-- exceptions.
--
-- You are under no obligations to use this hierarchy for your own
-- exceptions, but you might find it useful nonetheless; for
-- 'withDefault' to be useful, for example, you'll want your
-- exceptions to be children of 'LogicError' or 'TransientError' as
-- appropriate.
--
-- Most users should import "Haxl.Core" instead of importing this
-- module directly.
--
module Haxl.Core.Exception (

  HaxlException(..),

  -- * Exception categories
  InternalError(..),
  internalErrorToException,
  internalErrorFromException,

  LogicError(..),
  logicErrorToException,
  logicErrorFromException,

  LogicBug(..),
  logicBugToException,
  logicBugFromException,

  TransientError(..),
  transientErrorToException,
  transientErrorFromException,

  -- ** Internal exceptions
  CriticalError(..),
  DataSourceError(..),
  NonHaxlException(..),

  -- ** Logic exceptions
  NotFound(..),
  UnexpectedType(..),
  EmptyList(..),
  JSONError(..),
  InvalidParameter(..),
  MonadFail(..),

  -- ** Transient exceptions
  FetchError(..),

  -- * Exception utilities
  asHaxlException,
  MiddleException(..),
  rethrowAsyncExceptions,
  tryWithRethrow,
  ) where

#if __GLASGOW_HASKELL__ >= 808
import Prelude hiding (MonadFail)
#endif
import Control.Exception as Exception
import Data.Aeson
import Data.Binary (Binary)
import Data.Typeable
import Data.Text (Text)
import qualified Data.Text as Text

import Haxl.Core.Util
import GHC.Stack

-- | We have a 3-tiered hierarchy of exceptions, with 'HaxlException' at
-- the top, and all Haxl exceptions as children of this. Users should
-- never deal directly with 'HaxlException's.
--
-- The main types of exceptions are:
--
--   ['InternalError']  Something is wrong with Haxl core.
--
--   ['LogicBug']       Something is wrong with Haxl client code.
--
--   ['LogicError']     Things that really should be return values, e.g.
--                      NotFound.
--
--   ['TransientError'] Something is temporarily failing (usually in a fetch).
--
-- These are not meant to be thrown (but likely be caught). Thrown
-- exceptions should be a subclass of one of these. There are some
-- generic leaf exceptions defined below this, such as 'FetchError'
-- (generic transient failure) or 'CriticalError' (internal failure).
--
data HaxlException
  = forall e. (MiddleException e)
    => HaxlException
         (Maybe Stack)  -- filled in with the call stack when thrown,
                        -- if PROFILING is on
         e
  deriving (Typeable)

type Stack = [Text]
  -- hopefully this will get more informative in the future

instance Show HaxlException where
  show :: HaxlException -> String
show (HaxlException (Just stk :: Stack
stk@(Text
_:Stack
_)) e
e) =
    e -> String
forall a. Show a => a -> String
show e
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: [String] -> String
renderStack ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> Stack -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Text.unpack Stack
stk)
  show (HaxlException Maybe Stack
_ e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception HaxlException

-- | These need to be serializable to JSON to cross FFI boundaries.
instance ToJSON HaxlException where
  toJSON :: HaxlException -> Value
toJSON (HaxlException Maybe Stack
stk e
e) = [Pair] -> Value
object [Pair]
fields
    where
      fields :: [Pair]
fields | Just s :: Stack
s@(Text
_:Stack
_) <- Maybe Stack
stk = (Key
"stack" Key -> Stack -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Stack
s) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
rest
             | Bool
otherwise = [Pair]
rest
      rest :: [Pair]
rest =
        [ Key
"type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e)
        , Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= e -> String
forall a. MiddleException a => a -> String
eName e
e
        , Key
"txt"  Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= e -> String
forall a. Show a => a -> String
show e
e
        ]

haxlExceptionToException
  :: (MiddleException e) => e -> SomeException
haxlExceptionToException :: e -> SomeException
haxlExceptionToException = HaxlException -> SomeException
forall e. Exception e => e -> SomeException
toException (HaxlException -> SomeException)
-> (e -> HaxlException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Stack -> e -> HaxlException
forall e. MiddleException e => Maybe Stack -> e -> HaxlException
HaxlException Maybe Stack
forall a. Maybe a
Nothing

haxlExceptionFromException
  :: (MiddleException e) => SomeException -> Maybe e
haxlExceptionFromException :: SomeException -> Maybe e
haxlExceptionFromException SomeException
x = do
  HaxlException Maybe Stack
_ e
a <- SomeException -> Maybe HaxlException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

class (Exception a) => MiddleException a where
  eName :: a -> String

-- | For transient failures.
data TransientError = forall e . (Exception e) => TransientError e
  deriving (Typeable)

deriving instance Show TransientError

instance Exception TransientError where
 toException :: TransientError -> SomeException
toException   = TransientError -> SomeException
forall e. MiddleException e => e -> SomeException
haxlExceptionToException
 fromException :: SomeException -> Maybe TransientError
fromException = SomeException -> Maybe TransientError
forall e. MiddleException e => SomeException -> Maybe e
haxlExceptionFromException

instance MiddleException TransientError where
  eName :: TransientError -> String
eName (TransientError e
e) = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e

transientErrorToException :: (Exception e) => e -> SomeException
transientErrorToException :: e -> SomeException
transientErrorToException = TransientError -> SomeException
forall e. Exception e => e -> SomeException
toException (TransientError -> SomeException)
-> (e -> TransientError) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TransientError
forall e. Exception e => e -> TransientError
TransientError

transientErrorFromException
  :: (Exception e) => SomeException -> Maybe e
transientErrorFromException :: SomeException -> Maybe e
transientErrorFromException SomeException
x = do
  TransientError e
a <- SomeException -> Maybe TransientError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

-- | For errors in Haxl core code.
data InternalError = forall e . (Exception e) => InternalError e
  deriving (Typeable)

deriving instance Show InternalError

instance Exception InternalError where
  toException :: InternalError -> SomeException
toException   = InternalError -> SomeException
forall e. MiddleException e => e -> SomeException
haxlExceptionToException
  fromException :: SomeException -> Maybe InternalError
fromException = SomeException -> Maybe InternalError
forall e. MiddleException e => SomeException -> Maybe e
haxlExceptionFromException

instance MiddleException InternalError where
  eName :: InternalError -> String
eName (InternalError e
e) = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e

internalErrorToException :: (Exception e) => e -> SomeException
internalErrorToException :: e -> SomeException
internalErrorToException = InternalError -> SomeException
forall e. Exception e => e -> SomeException
toException (InternalError -> SomeException)
-> (e -> InternalError) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> InternalError
forall e. Exception e => e -> InternalError
InternalError

internalErrorFromException
  :: (Exception e) => SomeException -> Maybe e
internalErrorFromException :: SomeException -> Maybe e
internalErrorFromException SomeException
x = do
  InternalError e
a <- SomeException -> Maybe InternalError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

-- | For errors in Haxl client code.
data LogicError = forall e . (Exception e) => LogicError e
  deriving (Typeable)

deriving instance Show LogicError

instance Exception LogicError where
 toException :: LogicError -> SomeException
toException   = LogicError -> SomeException
forall e. MiddleException e => e -> SomeException
haxlExceptionToException
 fromException :: SomeException -> Maybe LogicError
fromException = SomeException -> Maybe LogicError
forall e. MiddleException e => SomeException -> Maybe e
haxlExceptionFromException

instance MiddleException LogicError where
  eName :: LogicError -> String
eName (LogicError e
e) = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e

logicErrorToException :: (Exception e) => e -> SomeException
logicErrorToException :: e -> SomeException
logicErrorToException = LogicError -> SomeException
forall e. Exception e => e -> SomeException
toException (LogicError -> SomeException)
-> (e -> LogicError) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> LogicError
forall e. Exception e => e -> LogicError
LogicError

logicErrorFromException
  :: (Exception e) => SomeException -> Maybe e
logicErrorFromException :: SomeException -> Maybe e
logicErrorFromException SomeException
x = do
  LogicError e
a <- SomeException -> Maybe LogicError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

data LogicBug = forall e . (Exception e) => LogicBug e
  deriving (Typeable)

deriving instance Show LogicBug

instance Exception LogicBug where
 toException :: LogicBug -> SomeException
toException   = LogicBug -> SomeException
forall e. MiddleException e => e -> SomeException
haxlExceptionToException
 fromException :: SomeException -> Maybe LogicBug
fromException = SomeException -> Maybe LogicBug
forall e. MiddleException e => SomeException -> Maybe e
haxlExceptionFromException

instance MiddleException LogicBug where
  eName :: LogicBug -> String
eName (LogicBug e
e) = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e

logicBugToException :: (Exception e) => e -> SomeException
logicBugToException :: e -> SomeException
logicBugToException = LogicBug -> SomeException
forall e. Exception e => e -> SomeException
toException (LogicBug -> SomeException)
-> (e -> LogicBug) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> LogicBug
forall e. Exception e => e -> LogicBug
LogicBug

logicBugFromException
  :: (Exception e) => SomeException -> Maybe e
logicBugFromException :: SomeException -> Maybe e
logicBugFromException SomeException
x = do
  LogicBug e
a <- SomeException -> Maybe LogicBug
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

------------------------------------------------------------------------
-- Leaf exceptions. You should throw these. Or make your own.
------------------------------------------------------------------------

-- | Generic \"critical\" exception. Something internal is
-- borked. Panic.
newtype CriticalError = CriticalError Text
  deriving (Typeable, Get CriticalError
[CriticalError] -> Put
CriticalError -> Put
(CriticalError -> Put)
-> Get CriticalError
-> ([CriticalError] -> Put)
-> Binary CriticalError
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CriticalError] -> Put
$cputList :: [CriticalError] -> Put
get :: Get CriticalError
$cget :: Get CriticalError
put :: CriticalError -> Put
$cput :: CriticalError -> Put
Binary, CriticalError -> CriticalError -> Bool
(CriticalError -> CriticalError -> Bool)
-> (CriticalError -> CriticalError -> Bool) -> Eq CriticalError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CriticalError -> CriticalError -> Bool
$c/= :: CriticalError -> CriticalError -> Bool
== :: CriticalError -> CriticalError -> Bool
$c== :: CriticalError -> CriticalError -> Bool
Eq, Int -> CriticalError -> ShowS
[CriticalError] -> ShowS
CriticalError -> String
(Int -> CriticalError -> ShowS)
-> (CriticalError -> String)
-> ([CriticalError] -> ShowS)
-> Show CriticalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CriticalError] -> ShowS
$cshowList :: [CriticalError] -> ShowS
show :: CriticalError -> String
$cshow :: CriticalError -> String
showsPrec :: Int -> CriticalError -> ShowS
$cshowsPrec :: Int -> CriticalError -> ShowS
Show)

instance Exception CriticalError where
  toException :: CriticalError -> SomeException
toException   = CriticalError -> SomeException
forall e. Exception e => e -> SomeException
internalErrorToException
  fromException :: SomeException -> Maybe CriticalError
fromException = SomeException -> Maybe CriticalError
forall e. Exception e => SomeException -> Maybe e
internalErrorFromException

-- | Exceptions that are converted to HaxlException by
-- asHaxlException.  Typically these will be pure exceptions,
-- e.g., the 'error' function in pure code, or a pattern-match
-- failure.
newtype NonHaxlException = NonHaxlException Text
  deriving (Typeable, Get NonHaxlException
[NonHaxlException] -> Put
NonHaxlException -> Put
(NonHaxlException -> Put)
-> Get NonHaxlException
-> ([NonHaxlException] -> Put)
-> Binary NonHaxlException
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [NonHaxlException] -> Put
$cputList :: [NonHaxlException] -> Put
get :: Get NonHaxlException
$cget :: Get NonHaxlException
put :: NonHaxlException -> Put
$cput :: NonHaxlException -> Put
Binary, NonHaxlException -> NonHaxlException -> Bool
(NonHaxlException -> NonHaxlException -> Bool)
-> (NonHaxlException -> NonHaxlException -> Bool)
-> Eq NonHaxlException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonHaxlException -> NonHaxlException -> Bool
$c/= :: NonHaxlException -> NonHaxlException -> Bool
== :: NonHaxlException -> NonHaxlException -> Bool
$c== :: NonHaxlException -> NonHaxlException -> Bool
Eq, Int -> NonHaxlException -> ShowS
[NonHaxlException] -> ShowS
NonHaxlException -> String
(Int -> NonHaxlException -> ShowS)
-> (NonHaxlException -> String)
-> ([NonHaxlException] -> ShowS)
-> Show NonHaxlException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonHaxlException] -> ShowS
$cshowList :: [NonHaxlException] -> ShowS
show :: NonHaxlException -> String
$cshow :: NonHaxlException -> String
showsPrec :: Int -> NonHaxlException -> ShowS
$cshowsPrec :: Int -> NonHaxlException -> ShowS
Show)

instance Exception NonHaxlException where
  toException :: NonHaxlException -> SomeException
toException   = NonHaxlException -> SomeException
forall e. Exception e => e -> SomeException
internalErrorToException
  fromException :: SomeException -> Maybe NonHaxlException
fromException = SomeException -> Maybe NonHaxlException
forall e. Exception e => SomeException -> Maybe e
internalErrorFromException

-- | Generic \"something was not found\" exception.
newtype NotFound = NotFound Text
  deriving (Typeable, Get NotFound
[NotFound] -> Put
NotFound -> Put
(NotFound -> Put)
-> Get NotFound -> ([NotFound] -> Put) -> Binary NotFound
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [NotFound] -> Put
$cputList :: [NotFound] -> Put
get :: Get NotFound
$cget :: Get NotFound
put :: NotFound -> Put
$cput :: NotFound -> Put
Binary, NotFound -> NotFound -> Bool
(NotFound -> NotFound -> Bool)
-> (NotFound -> NotFound -> Bool) -> Eq NotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotFound -> NotFound -> Bool
$c/= :: NotFound -> NotFound -> Bool
== :: NotFound -> NotFound -> Bool
$c== :: NotFound -> NotFound -> Bool
Eq, Int -> NotFound -> ShowS
[NotFound] -> ShowS
NotFound -> String
(Int -> NotFound -> ShowS)
-> (NotFound -> String) -> ([NotFound] -> ShowS) -> Show NotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFound] -> ShowS
$cshowList :: [NotFound] -> ShowS
show :: NotFound -> String
$cshow :: NotFound -> String
showsPrec :: Int -> NotFound -> ShowS
$cshowsPrec :: Int -> NotFound -> ShowS
Show)

instance Exception NotFound where
  toException :: NotFound -> SomeException
toException = NotFound -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe NotFound
fromException = SomeException -> Maybe NotFound
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException

-- | Generic \"something had the wrong type\" exception.
newtype UnexpectedType = UnexpectedType Text
  deriving (Typeable, UnexpectedType -> UnexpectedType -> Bool
(UnexpectedType -> UnexpectedType -> Bool)
-> (UnexpectedType -> UnexpectedType -> Bool) -> Eq UnexpectedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnexpectedType -> UnexpectedType -> Bool
$c/= :: UnexpectedType -> UnexpectedType -> Bool
== :: UnexpectedType -> UnexpectedType -> Bool
$c== :: UnexpectedType -> UnexpectedType -> Bool
Eq, Int -> UnexpectedType -> ShowS
[UnexpectedType] -> ShowS
UnexpectedType -> String
(Int -> UnexpectedType -> ShowS)
-> (UnexpectedType -> String)
-> ([UnexpectedType] -> ShowS)
-> Show UnexpectedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnexpectedType] -> ShowS
$cshowList :: [UnexpectedType] -> ShowS
show :: UnexpectedType -> String
$cshow :: UnexpectedType -> String
showsPrec :: Int -> UnexpectedType -> ShowS
$cshowsPrec :: Int -> UnexpectedType -> ShowS
Show)

instance Exception UnexpectedType where
  toException :: UnexpectedType -> SomeException
toException = UnexpectedType -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe UnexpectedType
fromException = SomeException -> Maybe UnexpectedType
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException

-- | Generic \"input list was empty\" exception.
newtype EmptyList = EmptyList Text
  deriving (Typeable, EmptyList -> EmptyList -> Bool
(EmptyList -> EmptyList -> Bool)
-> (EmptyList -> EmptyList -> Bool) -> Eq EmptyList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyList -> EmptyList -> Bool
$c/= :: EmptyList -> EmptyList -> Bool
== :: EmptyList -> EmptyList -> Bool
$c== :: EmptyList -> EmptyList -> Bool
Eq, Int -> EmptyList -> ShowS
[EmptyList] -> ShowS
EmptyList -> String
(Int -> EmptyList -> ShowS)
-> (EmptyList -> String)
-> ([EmptyList] -> ShowS)
-> Show EmptyList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyList] -> ShowS
$cshowList :: [EmptyList] -> ShowS
show :: EmptyList -> String
$cshow :: EmptyList -> String
showsPrec :: Int -> EmptyList -> ShowS
$cshowsPrec :: Int -> EmptyList -> ShowS
Show)

instance Exception EmptyList where
  toException :: EmptyList -> SomeException
toException = EmptyList -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe EmptyList
fromException = SomeException -> Maybe EmptyList
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException
  -- TODO: should be a child of LogicBug

-- | Generic \"Incorrect assumptions about JSON data\" exception.
newtype JSONError = JSONError Text
  deriving (Typeable, JSONError -> JSONError -> Bool
(JSONError -> JSONError -> Bool)
-> (JSONError -> JSONError -> Bool) -> Eq JSONError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONError -> JSONError -> Bool
$c/= :: JSONError -> JSONError -> Bool
== :: JSONError -> JSONError -> Bool
$c== :: JSONError -> JSONError -> Bool
Eq, Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> String
(Int -> JSONError -> ShowS)
-> (JSONError -> String)
-> ([JSONError] -> ShowS)
-> Show JSONError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> String
$cshow :: JSONError -> String
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show)

instance Exception JSONError where
  toException :: JSONError -> SomeException
toException = JSONError -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe JSONError
fromException = SomeException -> Maybe JSONError
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException

-- | Generic \"passing some invalid parameter\" exception.
newtype InvalidParameter = InvalidParameter Text
  deriving (Typeable, InvalidParameter -> InvalidParameter -> Bool
(InvalidParameter -> InvalidParameter -> Bool)
-> (InvalidParameter -> InvalidParameter -> Bool)
-> Eq InvalidParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidParameter -> InvalidParameter -> Bool
$c/= :: InvalidParameter -> InvalidParameter -> Bool
== :: InvalidParameter -> InvalidParameter -> Bool
$c== :: InvalidParameter -> InvalidParameter -> Bool
Eq, Int -> InvalidParameter -> ShowS
[InvalidParameter] -> ShowS
InvalidParameter -> String
(Int -> InvalidParameter -> ShowS)
-> (InvalidParameter -> String)
-> ([InvalidParameter] -> ShowS)
-> Show InvalidParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidParameter] -> ShowS
$cshowList :: [InvalidParameter] -> ShowS
show :: InvalidParameter -> String
$cshow :: InvalidParameter -> String
showsPrec :: Int -> InvalidParameter -> ShowS
$cshowsPrec :: Int -> InvalidParameter -> ShowS
Show)

instance Exception InvalidParameter where
  toException :: InvalidParameter -> SomeException
toException = InvalidParameter -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe InvalidParameter
fromException = SomeException -> Maybe InvalidParameter
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException
  -- TODO: should be a child of LogicBug

-- | Generic \"fail was called\" exception.
newtype MonadFail = MonadFail Text
  deriving (Typeable, MonadFail -> MonadFail -> Bool
(MonadFail -> MonadFail -> Bool)
-> (MonadFail -> MonadFail -> Bool) -> Eq MonadFail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonadFail -> MonadFail -> Bool
$c/= :: MonadFail -> MonadFail -> Bool
== :: MonadFail -> MonadFail -> Bool
$c== :: MonadFail -> MonadFail -> Bool
Eq, Int -> MonadFail -> ShowS
[MonadFail] -> ShowS
MonadFail -> String
(Int -> MonadFail -> ShowS)
-> (MonadFail -> String)
-> ([MonadFail] -> ShowS)
-> Show MonadFail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonadFail] -> ShowS
$cshowList :: [MonadFail] -> ShowS
show :: MonadFail -> String
$cshow :: MonadFail -> String
showsPrec :: Int -> MonadFail -> ShowS
$cshowsPrec :: Int -> MonadFail -> ShowS
Show)

instance Exception MonadFail where
  toException :: MonadFail -> SomeException
toException = MonadFail -> SomeException
forall e. Exception e => e -> SomeException
logicErrorToException
  fromException :: SomeException -> Maybe MonadFail
fromException = SomeException -> Maybe MonadFail
forall e. Exception e => SomeException -> Maybe e
logicErrorFromException

-- | Generic transient fetching exceptions.
newtype FetchError = FetchError Text
  deriving (Typeable, FetchError -> FetchError -> Bool
(FetchError -> FetchError -> Bool)
-> (FetchError -> FetchError -> Bool) -> Eq FetchError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FetchError -> FetchError -> Bool
$c/= :: FetchError -> FetchError -> Bool
== :: FetchError -> FetchError -> Bool
$c== :: FetchError -> FetchError -> Bool
Eq, Int -> FetchError -> ShowS
[FetchError] -> ShowS
FetchError -> String
(Int -> FetchError -> ShowS)
-> (FetchError -> String)
-> ([FetchError] -> ShowS)
-> Show FetchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchError] -> ShowS
$cshowList :: [FetchError] -> ShowS
show :: FetchError -> String
$cshow :: FetchError -> String
showsPrec :: Int -> FetchError -> ShowS
$cshowsPrec :: Int -> FetchError -> ShowS
Show)

instance Exception FetchError where
  toException :: FetchError -> SomeException
toException   = FetchError -> SomeException
forall e. Exception e => e -> SomeException
transientErrorToException
  fromException :: SomeException -> Maybe FetchError
fromException = SomeException -> Maybe FetchError
forall e. Exception e => SomeException -> Maybe e
transientErrorFromException

-- | A data source did something wrong
newtype DataSourceError = DataSourceError Text
  deriving (Typeable, DataSourceError -> DataSourceError -> Bool
(DataSourceError -> DataSourceError -> Bool)
-> (DataSourceError -> DataSourceError -> Bool)
-> Eq DataSourceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataSourceError -> DataSourceError -> Bool
$c/= :: DataSourceError -> DataSourceError -> Bool
== :: DataSourceError -> DataSourceError -> Bool
$c== :: DataSourceError -> DataSourceError -> Bool
Eq, Int -> DataSourceError -> ShowS
[DataSourceError] -> ShowS
DataSourceError -> String
(Int -> DataSourceError -> ShowS)
-> (DataSourceError -> String)
-> ([DataSourceError] -> ShowS)
-> Show DataSourceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSourceError] -> ShowS
$cshowList :: [DataSourceError] -> ShowS
show :: DataSourceError -> String
$cshow :: DataSourceError -> String
showsPrec :: Int -> DataSourceError -> ShowS
$cshowsPrec :: Int -> DataSourceError -> ShowS
Show)

instance Exception DataSourceError where
  toException :: DataSourceError -> SomeException
toException   = DataSourceError -> SomeException
forall e. Exception e => e -> SomeException
internalErrorToException
  fromException :: SomeException -> Maybe DataSourceError
fromException = SomeException -> Maybe DataSourceError
forall e. Exception e => SomeException -> Maybe e
internalErrorFromException

-- | Converts all exceptions that are not derived from 'HaxlException'
-- into 'NonHaxlException', using 'show'.
asHaxlException :: SomeException -> HaxlException
asHaxlException :: SomeException -> HaxlException
asHaxlException SomeException
e
  | Just HaxlException
haxl_exception <- SomeException -> Maybe HaxlException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = -- it's a HaxlException
     HaxlException
haxl_exception
  | Bool
otherwise =
     Maybe Stack -> InternalError -> HaxlException
forall e. MiddleException e => Maybe Stack -> e -> HaxlException
HaxlException Maybe Stack
forall a. Maybe a
Nothing (NonHaxlException -> InternalError
forall e. Exception e => e -> InternalError
InternalError (Text -> NonHaxlException
NonHaxlException (SomeException -> Text
forall a. Show a => a -> Text
textShow SomeException
e)))

-- We must be careful about turning IO monad exceptions into Haxl
-- exceptions.  An IO monad exception will normally propagate right
-- out of runHaxl and terminate the whole computation, whereas a Haxl
-- exception can get dropped on the floor, if it is on the right of
-- <*> and the left side also throws, for example.  So turning an IO
-- monad exception into a Haxl exception is a dangerous thing to do.
-- In particular, we never want to do it for an asynchronous exception
-- (AllocationLimitExceeded, ThreadKilled, etc.), because these are
-- supposed to unconditionally terminate the computation.
--
-- There are three places where we take an arbitrary IO monad exception and
-- turn it into a Haxl exception:
--
--  * wrapFetchInCatch.  Here we want to propagate a failure of the
--    data source to the callers of the data source, but if the
--    failure came from elsewhere (an asynchronous exception), then we
--    should just propagate it
--
--  * cacheResult (cache the results of IO operations): again,
--    failures of the IO operation should be visible to the caller as
--    a Haxl exception, but we exclude asynchronous exceptions from
--    this.

--  * unsafeToHaxlException: assume the caller knows what they're
--    doing, and just wrap all exceptions.
--
rethrowAsyncExceptions :: SomeException -> IO ()
rethrowAsyncExceptions :: SomeException -> IO ()
rethrowAsyncExceptions SomeException
e
  | Just SomeAsyncException{} <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = SomeException -> IO ()
forall a e. Exception e => e -> a
Exception.throw SomeException
e
  | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tryWithRethrow :: IO a -> IO (Either SomeException a)
tryWithRethrow :: IO a -> IO (Either SomeException a)
tryWithRethrow IO a
io =
  (a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a)
-> IO a -> IO (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
io) IO (Either SomeException a)
-> (SomeException -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do SomeException -> IO ()
rethrowAsyncExceptions SomeException
e ; Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)