{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ViewPatterns #-}
module Universum.Exception
( module Control.Exception.Safe
, Bug (..)
, bug
, pattern Exc
, note
) where
import Control.Exception.Safe (Exception (..), MonadCatch, MonadMask (..), MonadThrow,
SomeException (..), bracket, bracketOnError, bracket_, catch,
catchAny, displayException, finally, handleAny, onException, throwM,
try, tryAny)
import Control.Monad.Except (MonadError, throwError)
import Universum.Applicative (Applicative (pure))
import Universum.Monad (Maybe (..), maybe)
import Data.List ((++))
import GHC.Show (Show)
import GHC.Stack (CallStack, HasCallStack, callStack, prettyCallStack)
import qualified Control.Exception.Safe as Safe (displayException, impureThrow, toException)
data Bug = Bug SomeException CallStack
deriving stock (Show)
instance Exception Bug where
displayException (Bug e cStack) = Safe.displayException e ++ "\n"
++ prettyCallStack cStack
bug :: (HasCallStack, Exception e) => e -> a
bug e = Safe.impureThrow (Bug (Safe.toException e) callStack)
note :: (MonadError e m) => e -> Maybe a -> m a
note err = maybe (throwError err) pure
pattern Exc :: Exception e => e -> SomeException
pattern Exc e <- (fromException -> Just e)
where
Exc e = toException e