module Freckle.App.Exception.MonadThrow
( throwM
, throwString
, fromJustNoteM
, impossible
, catch
, catchJust
, catches
, try
, tryJust
, checkpoint
, checkpointMany
, checkpointCallStack
, MonadThrow
, MonadCatch
, MonadMask
, module Freckle.App.Exception.Types
) where
import Freckle.App.Exception.Types
import Control.Applicative (pure)
import Control.Exception.Annotated (checkpoint, checkpointMany)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Data.Either (Either (..))
import Data.Function (($), (.))
import Data.Functor (fmap, (<$>))
import Data.Maybe (Maybe, maybe)
import Data.String (String)
import GHC.IO.Exception (userError)
import GHC.Stack (withFrozenCallStack)
import qualified Control.Exception.Annotated as Annotated
import qualified Control.Monad.Catch
throwM :: forall e m a. (Exception e, MonadThrow m, HasCallStack) => e -> m a
throwM :: forall e (m :: * -> *) a.
(Exception e, MonadThrow m, HasCallStack) =>
e -> m a
throwM e
e = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
Annotated.throw e
e
throwString :: forall m a. (MonadThrow m, HasCallStack) => String -> m a
throwString :: forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
s = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
(Exception e, MonadThrow m, HasCallStack) =>
e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
s
fromJustNoteM
:: forall m a. (MonadThrow m, HasCallStack) => String -> Maybe a -> m a
fromJustNoteM :: forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> Maybe a -> m a
fromJustNoteM String
err = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
impossible :: forall m a. (MonadThrow m, HasCallStack) => m a
impossible :: forall (m :: * -> *) a. (MonadThrow m, HasCallStack) => m a
impossible = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
"Impossible"
catch
:: forall e m a
. (Exception e, MonadCatch m, HasCallStack)
=> m a
-> (e -> m a)
-> m a
catch :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m, HasCallStack) =>
m a -> (e -> m a) -> m a
catch m a
action e -> m a
handler = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
Annotated.catch m a
action e -> m a
handler
catchJust
:: forall e b m a
. (Exception e, MonadCatch m, HasCallStack)
=> (e -> Maybe b)
-> m a
-> (b -> m a)
-> m a
catchJust :: forall e b (m :: * -> *) a.
(Exception e, MonadCatch m, HasCallStack) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
test m a
action b -> m a
handler =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
Annotated.catch m a
action forall a b. (a -> b) -> a -> b
$ \e
e ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Control.Monad.Catch.throwM e
e) b -> m a
handler (e -> Maybe b
test e
e)
catches
:: forall m a
. (MonadCatch m, HasCallStack)
=> m a
-> [ExceptionHandler m a]
-> m a
catches :: forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
m a -> [ExceptionHandler m a] -> m a
catches m a
action [ExceptionHandler m a]
handlers =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(MonadCatch m, HasCallStack) =>
m a -> [Handler m a] -> m a
Annotated.catches
m a
action
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case (ExceptionHandler e -> m a
f) -> forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Annotated.Handler e -> m a
f) [ExceptionHandler m a]
handlers)
try
:: forall e m a
. (Exception e, MonadCatch m, HasCallStack)
=> m a
-> m (Either e a)
try :: forall e (m :: * -> *) a.
(Exception e, MonadCatch m, HasCallStack) =>
m a -> m (Either e a)
try m a
action = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
(Exception e, MonadCatch m) =>
m a -> m (Either e a)
Annotated.try m a
action
tryJust
:: forall e b m a
. (Exception e, MonadCatch m, HasCallStack)
=> (e -> Maybe b)
-> m a
-> m (Either b a)
tryJust :: forall e b (m :: * -> *) a.
(Exception e, MonadCatch m, HasCallStack) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
test m a
action =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadCatch m) =>
m a -> (e -> m a) -> m a
Annotated.catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) forall a b. (a -> b) -> a -> b
$ \e
e ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Control.Monad.Catch.throwM e
e) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (e -> Maybe b
test e
e)
checkpointCallStack
:: forall m a
. (MonadCatch m, HasCallStack)
=> m a
-> m a
checkpointCallStack :: forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
checkpointCallStack m a
action =
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
Annotated.checkpointCallStack m a
action