{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Monad.Rail.Types
( RailT (..),
Rail,
runRailT,
runRail,
throwError,
throwUnhandledException,
throwUnhandledExceptionWithCode,
tryRail,
tryRailWithCode,
tryRailWithError,
(<!>),
)
where
import qualified Control.Exception as Ex
import Control.Monad.Except (ExceptT (..), runExceptT)
import qualified Control.Monad.Except as E
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Text as T
import Data.Typeable (Typeable)
import GHC.Stack (HasCallStack, callStack)
import Monad.Rail.Error (Failure (..), HasErrorInfo (..), SomeError (..), UnhandledException (..))
newtype RailT e m a = RailT
{
forall e (m :: * -> *) a. RailT e m a -> ExceptT e m a
unRailT :: ExceptT e m a
}
deriving ((forall a b. (a -> b) -> RailT e m a -> RailT e m b)
-> (forall a b. a -> RailT e m b -> RailT e m a)
-> Functor (RailT e m)
forall a b. a -> RailT e m b -> RailT e m a
forall a b. (a -> b) -> RailT e m a -> RailT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> RailT e m b -> RailT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> RailT e m a -> RailT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> RailT e m a -> RailT e m b
fmap :: forall a b. (a -> b) -> RailT e m a -> RailT e m b
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> RailT e m b -> RailT e m a
<$ :: forall a b. a -> RailT e m b -> RailT e m a
Functor, Functor (RailT e m)
Functor (RailT e m) =>
(forall a. a -> RailT e m a)
-> (forall a b. RailT e m (a -> b) -> RailT e m a -> RailT e m b)
-> (forall a b c.
(a -> b -> c) -> RailT e m a -> RailT e m b -> RailT e m c)
-> (forall a b. RailT e m a -> RailT e m b -> RailT e m b)
-> (forall a b. RailT e m a -> RailT e m b -> RailT e m a)
-> Applicative (RailT e m)
forall a. a -> RailT e m a
forall a b. RailT e m a -> RailT e m b -> RailT e m a
forall a b. RailT e m a -> RailT e m b -> RailT e m b
forall a b. RailT e m (a -> b) -> RailT e m a -> RailT e m b
forall a b c.
(a -> b -> c) -> RailT e m a -> RailT e m b -> RailT e m c
forall e (m :: * -> *). Monad m => Functor (RailT e m)
forall e (m :: * -> *) a. Monad m => a -> RailT e m a
forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m a
forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m b
forall e (m :: * -> *) a b.
Monad m =>
RailT e m (a -> b) -> RailT e m a -> RailT e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> RailT e m a -> RailT e m b -> RailT e m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall e (m :: * -> *) a. Monad m => a -> RailT e m a
pure :: forall a. a -> RailT e m a
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
RailT e m (a -> b) -> RailT e m a -> RailT e m b
<*> :: forall a b. RailT e m (a -> b) -> RailT e m a -> RailT e m b
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> RailT e m a -> RailT e m b -> RailT e m c
liftA2 :: forall a b c.
(a -> b -> c) -> RailT e m a -> RailT e m b -> RailT e m c
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m b
*> :: forall a b. RailT e m a -> RailT e m b -> RailT e m b
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m a
<* :: forall a b. RailT e m a -> RailT e m b -> RailT e m a
Applicative, Applicative (RailT e m)
Applicative (RailT e m) =>
(forall a b. RailT e m a -> (a -> RailT e m b) -> RailT e m b)
-> (forall a b. RailT e m a -> RailT e m b -> RailT e m b)
-> (forall a. a -> RailT e m a)
-> Monad (RailT e m)
forall a. a -> RailT e m a
forall a b. RailT e m a -> RailT e m b -> RailT e m b
forall a b. RailT e m a -> (a -> RailT e m b) -> RailT e m b
forall e (m :: * -> *). Monad m => Applicative (RailT e m)
forall e (m :: * -> *) a. Monad m => a -> RailT e m a
forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m b
forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> (a -> RailT e m b) -> RailT e m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> (a -> RailT e m b) -> RailT e m b
>>= :: forall a b. RailT e m a -> (a -> RailT e m b) -> RailT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
RailT e m a -> RailT e m b -> RailT e m b
>> :: forall a b. RailT e m a -> RailT e m b -> RailT e m b
$creturn :: forall e (m :: * -> *) a. Monad m => a -> RailT e m a
return :: forall a. a -> RailT e m a
Monad, Monad (RailT e m)
Monad (RailT e m) =>
(forall a. IO a -> RailT e m a) -> MonadIO (RailT e m)
forall a. IO a -> RailT e m a
forall e (m :: * -> *). MonadIO m => Monad (RailT e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> RailT e m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> RailT e m a
liftIO :: forall a. IO a -> RailT e m a
MonadIO)
type Rail a = RailT Failure IO a
runRailT :: (Monad m) => RailT e m a -> m (Either e a)
runRailT :: forall (m :: * -> *) e a. Monad m => RailT e m a -> m (Either e a)
runRailT = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m a -> m (Either e a))
-> (RailT e m a -> ExceptT e m a) -> RailT e m a -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RailT e m a -> ExceptT e m a
forall e (m :: * -> *) a. RailT e m a -> ExceptT e m a
unRailT
runRail :: Rail a -> IO (Either Failure a)
runRail :: forall a. Rail a -> IO (Either Failure a)
runRail = ExceptT Failure IO a -> IO (Either Failure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Failure IO a -> IO (Either Failure a))
-> (Rail a -> ExceptT Failure IO a)
-> Rail a
-> IO (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rail a -> ExceptT Failure IO a
forall e (m :: * -> *) a. RailT e m a -> ExceptT e m a
unRailT
throwError :: (HasErrorInfo e, Show e, Typeable e, Monad m) => e -> RailT Failure m a
throwError :: forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError e
err = ExceptT Failure m a -> RailT Failure m a
forall e (m :: * -> *) a. ExceptT e m a -> RailT e m a
RailT (ExceptT Failure m a -> RailT Failure m a)
-> ExceptT Failure m a -> RailT Failure m a
forall a b. (a -> b) -> a -> b
$ Failure -> ExceptT Failure m a
forall a. Failure -> ExceptT Failure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (Failure -> ExceptT Failure m a) -> Failure -> ExceptT Failure m a
forall a b. (a -> b) -> a -> b
$ NonEmpty SomeError -> Failure
Failure (e -> SomeError
forall e. (HasErrorInfo e, Show e, Typeable e) => e -> SomeError
SomeError e
err SomeError -> [SomeError] -> NonEmpty SomeError
forall a. a -> [a] -> NonEmpty a
:| [])
throwUnhandledException :: (HasCallStack, Monad m) => Ex.SomeException -> RailT Failure m a
throwUnhandledException :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
SomeException -> RailT Failure m a
throwUnhandledException SomeException
ex = UnhandledException -> RailT Failure m a
forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError UnhandledException
ue
where
ue :: UnhandledException
ue =
UnhandledException
{ unhandledCode :: Maybe Text
unhandledCode = Maybe Text
forall a. Maybe a
Nothing,
unhandledException :: SomeException
unhandledException = SomeException
ex,
unhandledCallStack :: Maybe CallStack
unhandledCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack,
unhandledMessage :: Maybe Text
unhandledMessage = Maybe Text
forall a. Maybe a
Nothing
}
throwUnhandledExceptionWithCode :: (HasCallStack, Monad m) => T.Text -> Ex.SomeException -> RailT Failure m a
throwUnhandledExceptionWithCode :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
Text -> SomeException -> RailT Failure m a
throwUnhandledExceptionWithCode Text
errCode SomeException
ex = UnhandledException -> RailT Failure m a
forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError UnhandledException
ue
where
ue :: UnhandledException
ue =
UnhandledException
{ unhandledCode :: Maybe Text
unhandledCode = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
errCode,
unhandledException :: SomeException
unhandledException = SomeException
ex,
unhandledCallStack :: Maybe CallStack
unhandledCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack,
unhandledMessage :: Maybe Text
unhandledMessage = Maybe Text
forall a. Maybe a
Nothing
}
tryRail :: (HasCallStack) => IO a -> Rail a
tryRail :: forall a. HasCallStack => IO a -> Rail a
tryRail IO a
action = do
result <- IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a. IO a -> RailT Failure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a))
-> IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try IO a
action
case result of
Right a
value -> a -> RailT Failure IO a
forall a. a -> RailT Failure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
Left SomeException
ex -> UnhandledException -> RailT Failure IO a
forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError UnhandledException
ue
where
ue :: UnhandledException
ue =
UnhandledException
{ unhandledCode :: Maybe Text
unhandledCode = Maybe Text
forall a. Maybe a
Nothing,
unhandledException :: SomeException
unhandledException = SomeException
ex,
unhandledCallStack :: Maybe CallStack
unhandledCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack,
unhandledMessage :: Maybe Text
unhandledMessage = Maybe Text
forall a. Maybe a
Nothing
}
tryRailWithCode :: (HasCallStack) => (Ex.SomeException -> T.Text) -> IO a -> Rail a
tryRailWithCode :: forall a. HasCallStack => (SomeException -> Text) -> IO a -> Rail a
tryRailWithCode SomeException -> Text
mkCode IO a
action = do
result <- IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a. IO a -> RailT Failure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a))
-> IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try IO a
action
case result of
Right a
value -> a -> RailT Failure IO a
forall a. a -> RailT Failure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
Left SomeException
ex -> UnhandledException -> RailT Failure IO a
forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError UnhandledException
ue
where
ue :: UnhandledException
ue =
UnhandledException
{ unhandledCode :: Maybe Text
unhandledCode = Text -> Maybe Text
forall a. a -> Maybe a
Just (SomeException -> Text
mkCode SomeException
ex),
unhandledException :: SomeException
unhandledException = SomeException
ex,
unhandledCallStack :: Maybe CallStack
unhandledCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack,
unhandledMessage :: Maybe Text
unhandledMessage = Maybe Text
forall a. Maybe a
Nothing
}
tryRailWithError :: (HasCallStack, HasErrorInfo e) => (Ex.SomeException -> e) -> IO a -> Rail a
tryRailWithError :: forall e a.
(HasCallStack, HasErrorInfo e) =>
(SomeException -> e) -> IO a -> Rail a
tryRailWithError SomeException -> e
mkErr IO a
action = do
result <- IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a. IO a -> RailT Failure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a))
-> IO (Either SomeException a)
-> RailT Failure IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try IO a
action
case result of
Right a
value -> a -> RailT Failure IO a
forall a. a -> RailT Failure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
Left SomeException
ex -> UnhandledException -> RailT Failure IO a
forall e (m :: * -> *) a.
(HasErrorInfo e, Show e, Typeable e, Monad m) =>
e -> RailT Failure m a
throwError UnhandledException
ue
where
err :: e
err = SomeException -> e
mkErr SomeException
ex
ue :: UnhandledException
ue =
UnhandledException
{ unhandledCode :: Maybe Text
unhandledCode = Text -> Maybe Text
forall a. a -> Maybe a
Just (e -> Text
forall e. HasErrorInfo e => e -> Text
errorCode e
err),
unhandledException :: SomeException
unhandledException = SomeException
ex,
unhandledCallStack :: Maybe CallStack
unhandledCallStack = CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack,
unhandledMessage :: Maybe Text
unhandledMessage = Text -> Maybe Text
forall a. a -> Maybe a
Just (e -> Text
forall e. HasErrorInfo e => e -> Text
errorPublicMessage e
err)
}
(<!>) :: (Monad m) => RailT Failure m () -> RailT Failure m () -> RailT Failure m ()
RailT Failure m ()
v1 <!> :: forall (m :: * -> *).
Monad m =>
RailT Failure m () -> RailT Failure m () -> RailT Failure m ()
<!> RailT Failure m ()
v2 = ExceptT Failure m () -> RailT Failure m ()
forall e (m :: * -> *) a. ExceptT e m a -> RailT e m a
RailT (ExceptT Failure m () -> RailT Failure m ())
-> ExceptT Failure m () -> RailT Failure m ()
forall a b. (a -> b) -> a -> b
$ m (Either Failure ()) -> ExceptT Failure m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Failure ()) -> ExceptT Failure m ())
-> m (Either Failure ()) -> ExceptT Failure m ()
forall a b. (a -> b) -> a -> b
$ do
r1 <- ExceptT Failure m () -> m (Either Failure ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (RailT Failure m () -> ExceptT Failure m ()
forall e (m :: * -> *) a. RailT e m a -> ExceptT e m a
unRailT RailT Failure m ()
v1)
r2 <- runExceptT (unRailT v2)
case (r1, r2) of
(Right (), Right ()) -> Either Failure () -> m (Either Failure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Failure ()
forall a b. b -> Either a b
Right ())
(Left Failure
e1, Right ()) -> Either Failure () -> m (Either Failure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Failure -> Either Failure ()
forall a b. a -> Either a b
Left Failure
e1)
(Right (), Left Failure
e2) -> Either Failure () -> m (Either Failure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Failure -> Either Failure ()
forall a b. a -> Either a b
Left Failure
e2)
(Left Failure
e1, Left Failure
e2) -> Either Failure () -> m (Either Failure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Failure -> Either Failure ()
forall a b. a -> Either a b
Left (Failure
e1 Failure -> Failure -> Failure
forall a. Semigroup a => a -> a -> a
<> Failure
e2))
infixl 5 <!>