{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
module RIO.PrettyPrint.PrettyException
( PrettyException (..)
, ppException
, prettyThrowIO
, prettyThrowM
) where
import RIO
( Exception (..), Maybe (..), MonadIO, MonadThrow, Show, SomeException
, Typeable, (.), throwIO, throwM
)
import Text.PrettyPrint.Leijen.Extended ( Pretty (..), StyleDoc, string )
data PrettyException
= forall e. (Exception e, Pretty e) => PrettyException e
deriving Typeable
deriving instance Show PrettyException
instance Pretty PrettyException where
pretty :: PrettyException -> StyleDoc
pretty (PrettyException e
e) = e -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty e
e
instance Exception PrettyException where
displayException :: PrettyException -> String
displayException (PrettyException e
e) = e -> String
forall e. Exception e => e -> String
displayException e
e
ppException :: SomeException -> StyleDoc
ppException :: SomeException -> StyleDoc
ppException SomeException
e = case SomeException -> Maybe PrettyException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (PrettyException e
e') -> e -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty e
e'
Maybe PrettyException
Nothing -> (String -> StyleDoc
string (String -> StyleDoc)
-> (SomeException -> String) -> SomeException -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) SomeException
e
prettyThrowIO :: (Exception e, MonadIO m, Pretty e) => e -> m a
prettyThrowIO :: forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO = PrettyException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (PrettyException -> m a) -> (e -> PrettyException) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> PrettyException
forall e. (Exception e, Pretty e) => e -> PrettyException
PrettyException
prettyThrowM :: (Exception e, MonadThrow m, Pretty e) => e -> m a
prettyThrowM :: forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM = PrettyException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PrettyException -> m a) -> (e -> PrettyException) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> PrettyException
forall e. (Exception e, Pretty e) => e -> PrettyException
PrettyException