{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_exceptions #define MIN_VERSION_exceptions 1 #endif #if !(MIN_VERSION_exceptions(0,4,0)) #define MonadThrow MonadCatch #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Lens -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional -- Portability : Control.Exception -- -- @Control.Exception@ provides an example of a large open hierarchy -- that we can model with prisms and isomorphisms. -- -- Additional combinators for working with 'IOException' results can -- be found in "System.IO.Error.Lens". -- -- The combinators in this module have been generalized to work with -- 'MonadCatch' instead of just 'IO'. This enables them to be used -- more easily in 'Monad' transformer stacks. ---------------------------------------------------------------------------- module Control.Exception.Lens ( -- * Handling catching, catching_ , handling, handling_ -- * Trying , trying, trying_ -- * Throwing , throwing , throwingM , throwingTo -- * Mapping , mappedException, mappedException' -- * Exceptions , exception -- * Exception Handlers , Handleable(..) -- ** IOExceptions , AsIOException(..) -- ** Arithmetic Exceptions , AsArithException(..) , _Overflow , _Underflow , _LossOfPrecision , _DivideByZero , _Denormal #if MIN_VERSION_base(4,6,0) , _RatioZeroDenominator #endif -- ** Array Exceptions , AsArrayException(..) , _IndexOutOfBounds , _UndefinedElement -- ** Assertion Failed , AsAssertionFailed(..) -- ** Async Exceptions , AsAsyncException(..) , _StackOverflow , _HeapOverflow , _ThreadKilled , _UserInterrupt -- ** Non-Termination , AsNonTermination(..) -- ** Nested Atomically , AsNestedAtomically(..) -- ** Blocked Indefinitely -- *** on MVar , AsBlockedIndefinitelyOnMVar(..) -- *** on STM , AsBlockedIndefinitelyOnSTM(..) -- ** Deadlock , AsDeadlock(..) -- ** No Such Method , AsNoMethodError(..) -- ** Pattern Match Failure , AsPatternMatchFail(..) -- ** Record , AsRecConError(..) , AsRecSelError(..) , AsRecUpdError(..) -- ** Error Call , AsErrorCall(..) -- * Handling Exceptions , AsHandlingException(..) ) where import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Control.Monad.Catch as Catch import Control.Exception as Exception hiding (try, tryJust, catchJust) import Control.Lens import Control.Lens.Internal.Exception import Data.Monoid import GHC.Conc (ThreadId) import Prelude ( const, either, flip, id , (.) , Maybe(..), Either(..), String ) #ifdef HLINT {-# ANN module "HLint: ignore Use Control.Exception.catch" #-} #endif -- $setup -- >>> :set -XNoOverloadedStrings -- >>> :m + Control.Exception Control.Monad Data.List Prelude ------------------------------------------------------------------------------ -- Exceptions as Prisms ------------------------------------------------------------------------------ -- | Traverse the strongly typed 'Exception' contained in 'SomeException' where the type of your function matches -- the desired 'Exception'. -- -- @ -- 'exception' :: ('Applicative' f, 'Exception' a) -- => (a -> f a) -> 'SomeException' -> f 'SomeException' -- @ exception :: Exception a => Prism' SomeException a exception = prism' toException fromException {-# INLINE exception #-} ------------------------------------------------------------------------------ -- Catching ------------------------------------------------------------------------------ -- | Catch exceptions that match a given 'Prism' (or any 'Getter', really). -- -- >>> catching _AssertionFailed (assert False (return "uncaught")) $ \ _ -> return "caught" -- "caught" -- -- @ -- 'catching' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> (a -> m r) -> m r -- @ catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} -- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding -- the information about the match. This is particuarly useful when you have -- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't -- particularly valuable, just the fact that it matches. -- -- >>> catching_ _AssertionFailed (assert False (return "uncaught")) $ return "caught" -- "caught" -- -- @ -- 'catching_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m r -> m r -- @ catching_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} ------------------------------------------------------------------------------ -- Handling ------------------------------------------------------------------------------ -- | A version of 'catching' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- >>> handling _NonTermination (\_ -> return "caught") $ throwIO NonTermination -- "caught" -- -- @ -- 'handling' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> (a -> m r) -> m r -> m r -- @ handling :: MonadCatch m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} -- | A version of 'catching_' with the arguments swapped around; useful in -- situations where the code for the handler is shorter. -- -- >>> handling_ _NonTermination (return "caught") $ throwIO NonTermination -- "caught" -- -- @ -- 'handling_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m r -> m r -- @ handling_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} ------------------------------------------------------------------------------ -- Trying ------------------------------------------------------------------------------ -- | A variant of 'Control.Exception.try' that takes a 'Prism' (or any 'Getter') to select which -- exceptions are caught (c.f. 'Control.Exception.tryJust', 'Control.Exception.catchJust'). If the -- 'Exception' does not match the predicate, it is re-thrown. -- -- @ -- 'trying' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m ('Either' a r) -- @ trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r) trying l = tryJust (preview l) {-# INLINE trying #-} -- | A version of 'trying' that discards the specific exception thrown. -- -- @ -- 'trying_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Getter' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Fold' 'SomeException' a -> m r -> m (Maybe r) -- @ trying_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Maybe r) trying_ l m = preview _Right `liftM` trying l m {-# INLINE trying_ #-} ------------------------------------------------------------------------------ -- Throwing ------------------------------------------------------------------------------ -- | Throw an 'Exception' described by a 'Prism'. Exceptions may be thrown from -- purely functional code, but may only be caught within the 'IO' 'Monad'. -- -- @ -- 'throwing' l ≡ 'reviews' l 'throw' -- @ -- -- @ -- 'throwing' :: 'Prism'' 'SomeException' t -> t -> r -- 'throwing' :: 'Iso'' 'SomeException' t -> t -> r -- @ throwing :: AReview s SomeException a b -> b -> r throwing l = reviews l Exception.throw {-# INLINE throwing #-} -- | A variant of 'throwing' that can only be used within the 'IO' 'Monad' -- (or any other 'MonadCatch' instance) to throw an 'Exception' described -- by a 'Prism'. -- -- Although 'throwingM' has a type that is a specialization of the type of -- 'throwing', the two functions are subtly different: -- -- @ -- 'throwing' l e \`seq\` x ≡ 'throwing' e -- 'throwingM' l e \`seq\` x ≡ x -- @ -- -- The first example will cause the 'Exception' @e@ to be raised, whereas the -- second one won't. In fact, 'throwingM' will only cause an 'Exception' to -- be raised when it is used within the 'MonadCatch' instance. The 'throwingM' -- variant should be used in preference to 'throwing' to raise an 'Exception' -- within the 'Monad' because it guarantees ordering with respect to other -- monadic operations, whereas 'throwing' does not. -- -- @ -- 'throwingM' l ≡ 'reviews' l 'CatchIO.throw' -- @ -- -- @ -- 'throwingM' :: 'MonadThrow' m => 'Prism'' 'SomeException' t -> t -> m r -- 'throwingM' :: 'MonadThrow' m => 'Iso'' 'SomeException' t -> t -> m r -- @ throwingM :: MonadThrow m => AReview s SomeException a b -> b -> m r throwingM l = reviews l throwM {-# INLINE throwingM #-} -- | 'throwingTo' raises an 'Exception' specified by a 'Prism' in the target thread. -- -- @ -- 'throwingTo' thread l ≡ 'reviews' l ('throwTo' thread) -- @ -- -- @ -- 'throwingTo' :: 'ThreadId' -> 'Prism'' 'SomeException' t -> t -> m a -- 'throwingTo' :: 'ThreadId' -> 'Iso'' 'SomeException' t -> t -> m a -- @ throwingTo :: MonadIO m => ThreadId -> AReview s SomeException a b -> b -> m () throwingTo tid l = reviews l (liftIO . throwTo tid) {-# INLINE throwingTo #-} ---------------------------------------------------------------------------- -- Mapping ---------------------------------------------------------------------------- -- | This 'Setter' can be used to purely map over the 'Exception's an -- arbitrary expression might throw; it is a variant of 'mapException' in -- the same way that 'mapped' is a variant of 'fmap'. -- -- > 'mapException' ≡ 'over' 'mappedException' -- -- This view that every Haskell expression can be regarded as carrying a bag -- of 'Exception's is detailed in “A Semantics for Imprecise Exceptions” by -- Peyton Jones & al. at PLDI ’99. -- -- The following maps failed assertions to arithmetic overflow: -- -- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException %~ \ (AssertionFailed _) -> Overflow -- "caught" mappedException :: (Exception e, Exception e') => Setter s s e e' mappedException = sets mapException {-# INLINE mappedException #-} -- | This is a type restricted version of 'mappedException', which avoids -- the type ambiguity in the input 'Exception' when using 'set'. -- -- The following maps any exception to arithmetic overflow: -- -- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException' .~ Overflow -- "caught" mappedException' :: Exception e' => Setter s s SomeException e' mappedException' = mappedException {-# INLINE mappedException' #-} ---------------------------------------------------------------------------- -- IOException ---------------------------------------------------------------------------- -- | Exceptions that occur in the 'IO' 'Monad'. An 'IOException' records a -- more specific error type, a descriptive string and maybe the handle that was -- used when the error was flagged. -- -- Due to their richer structure relative to other exceptions, these have -- a more carefully overloaded signature. class AsIOException t where -- | Unfortunately the name 'ioException' is taken by @base@ for -- throwing IOExceptions. -- -- @ -- '_IOException' :: 'Prism'' 'IOException' 'IOException' -- '_IOException' :: 'Prism'' 'SomeException' 'IOException' -- @ -- -- Many combinators for working with an 'IOException' are available -- in "System.IO.Error.Lens". _IOException :: Prism' t IOException instance AsIOException IOException where _IOException = id {-# INLINE _IOException #-} instance AsIOException SomeException where _IOException = exception {-# INLINE _IOException #-} ---------------------------------------------------------------------------- -- ArithException ---------------------------------------------------------------------------- -- | Arithmetic exceptions. class AsArithException t where -- '_ArithException' :: 'Prism'' 'ArithException' 'ArithException' -- '_ArithException' :: 'Prism'' 'SomeException' 'ArithException' _ArithException :: Prism' t ArithException instance AsArithException ArithException where _ArithException = id {-# INLINE _ArithException #-} instance AsArithException SomeException where _ArithException = exception {-# INLINE _ArithException #-} -- | Handle arithmetic '_Overflow'. -- -- @ -- '_Overflow' ≡ '_ArithException' '.' '_Overflow' -- @ -- -- @ -- '_Overflow' :: 'Prism'' 'ArithException' 'ArithException' -- '_Overflow' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Overflow :: AsArithException t => Prism' t () _Overflow = _ArithException . dimap seta (either id id) . right' . rmap (Overflow <$) where seta Overflow = Right () seta t = Left (pure t) {-# INLINE _Overflow #-} -- | Handle arithmetic '_Underflow'. -- -- @ -- '_Underflow' ≡ '_ArithException' '.' '_Underflow' -- @ -- -- @ -- '_Underflow' :: 'Prism'' 'ArithException' 'ArithException' -- '_Underflow' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Underflow :: AsArithException t => Prism' t () _Underflow = _ArithException . dimap seta (either id id) . right' . rmap (Underflow <$) where seta Underflow = Right () seta t = Left (pure t) {-# INLINE _Underflow #-} -- | Handle arithmetic loss of precision. -- -- @ -- '_LossOfPrecision' ≡ '_ArithException' '.' '_LossOfPrecision' -- @ -- -- @ -- '_LossOfPrecision' :: 'Prism'' 'ArithException' 'ArithException' -- '_LossOfPrecision' :: 'Prism'' 'SomeException' 'ArithException' -- @ _LossOfPrecision :: AsArithException t => Prism' t () _LossOfPrecision = _ArithException . dimap seta (either id id) . right' . rmap (LossOfPrecision <$) where seta LossOfPrecision = Right () seta t = Left (pure t) {-# INLINE _LossOfPrecision #-} -- | Handle division by zero. -- -- @ -- '_DivideByZero' ≡ '_ArithException' '.' '_DivideByZero' -- @ -- -- @ -- '_DivideByZero' :: 'Prism'' 'ArithException' 'ArithException' -- '_DivideByZero' :: 'Prism'' 'SomeException' 'ArithException' -- @ _DivideByZero :: AsArithException t => Prism' t () _DivideByZero = _ArithException . dimap seta (either id id) . right' . rmap (DivideByZero <$) where seta DivideByZero = Right () seta t = Left (pure t) {-# INLINE _DivideByZero #-} -- | Handle exceptional _Denormalized floating pure. -- -- @ -- '_Denormal' ≡ '_ArithException' '.' '_Denormal' -- @ -- -- @ -- '_Denormal' :: 'Prism'' 'ArithException' 'ArithException' -- '_Denormal' :: 'Prism'' 'SomeException' 'ArithException' -- @ _Denormal :: AsArithException t => Prism' t () _Denormal = _ArithException . dimap seta (either id id) . right' . rmap (Denormal <$) where seta Denormal = Right () seta t = Left (pure t) {-# INLINE _Denormal #-} #if MIN_VERSION_base(4,6,0) -- | Added in @base@ 4.6 in response to this libraries discussion: -- -- <http://haskell.1045720.n5.nabble.com/Data-Ratio-and-exceptions-td5711246.html> -- -- @ -- '_RatioZeroDenominator' ≡ '_ArithException' '.' '_RatioZeroDenominator' -- @ -- -- @ -- '_RatioZeroDenominator' :: 'Prism'' 'ArithException' 'ArithException' -- '_RatioZeroDenominator' :: 'Prism'' 'SomeException' 'ArithException' -- @ _RatioZeroDenominator :: AsArithException t => Prism' t () _RatioZeroDenominator = _ArithException . dimap seta (either id id) . right' . rmap (RatioZeroDenominator <$) where seta RatioZeroDenominator = Right () seta t = Left (pure t) {-# INLINE _RatioZeroDenominator #-} #endif ---------------------------------------------------------------------------- -- ArrayException ---------------------------------------------------------------------------- -- | Exceptions generated by array operations. class AsArrayException t where -- | Extract information about an 'ArrayException'. -- -- @ -- '_ArrayException' :: 'Prism'' 'ArrayException' 'ArrayException' -- '_ArrayException' :: 'Prism'' 'SomeException' 'ArrayException' -- @ _ArrayException :: Prism' t ArrayException instance AsArrayException ArrayException where _ArrayException = id {-# INLINE _ArrayException #-} instance AsArrayException SomeException where _ArrayException = exception {-# INLINE _ArrayException #-} -- | An attempt was made to index an array outside its declared bounds. -- -- @ -- '_IndexOutOfBounds' ≡ '_ArrayException' '.' '_IndexOutOfBounds' -- @ -- -- @ -- '_IndexOutOfBounds' :: 'Prism'' 'ArrayException' 'String' -- '_IndexOutOfBounds' :: 'Prism'' 'SomeException' 'String' -- @ _IndexOutOfBounds :: AsArrayException t => Prism' t String _IndexOutOfBounds = _ArrayException . dimap seta (either id id) . right' . rmap (fmap IndexOutOfBounds) where seta (IndexOutOfBounds r) = Right r seta t = Left (pure t) {-# INLINE _IndexOutOfBounds #-} -- | An attempt was made to evaluate an element of an array that had not been initialized. -- -- @ -- '_UndefinedElement' ≡ '_ArrayException' '.' '_UndefinedElement' -- @ -- -- @ -- '_UndefinedElement' :: 'Prism'' 'ArrayException' 'String' -- '_UndefinedElement' :: 'Prism'' 'SomeException' 'String' -- @ _UndefinedElement :: AsArrayException t => Prism' t String _UndefinedElement = _ArrayException . dimap seta (either id id) . right' . rmap (fmap UndefinedElement) where seta (UndefinedElement r) = Right r seta t = Left (pure t) {-# INLINE _UndefinedElement #-} ---------------------------------------------------------------------------- -- AssertionFailed ---------------------------------------------------------------------------- -- | 'assert' was applied to 'Prelude.False'. class AsAssertionFailed t where -- | This 'Exception' contains provides information about what assertion failed in the 'String'. -- -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("<interactive>" `isInfixOf` xs) ) $ assert False (return "uncaught") -- "caught" -- -- @ -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String' -- '_AssertionFailed' :: 'Prism'' 'SomeException' 'String' -- @ _AssertionFailed :: Prism' t String instance AsAssertionFailed AssertionFailed where _AssertionFailed = _Wrapping AssertionFailed {-# INLINE _AssertionFailed #-} instance AsAssertionFailed SomeException where _AssertionFailed = exception._Wrapping AssertionFailed {-# INLINE _AssertionFailed #-} ---------------------------------------------------------------------------- -- AsyncException ---------------------------------------------------------------------------- -- | Asynchronous exceptions. class AsAsyncException t where -- | There are several types of 'AsyncException'. -- -- @ -- '_AsyncException' :: 'Equality'' 'AsyncException' 'AsyncException' -- '_AsyncException' :: 'Prism'' 'SomeException' 'AsyncException' -- @ _AsyncException :: Prism' t AsyncException instance AsAsyncException AsyncException where _AsyncException = id {-# INLINE _AsyncException #-} instance AsAsyncException SomeException where _AsyncException = exception {-# INLINE _AsyncException #-} -- | The current thread's stack exceeded its limit. Since an 'Exception' has -- been raised, the thread's stack will certainly be below its limit again, -- but the programmer should take remedial action immediately. -- -- @ -- '_StackOverflow' :: 'Prism'' 'AsyncException' () -- '_StackOverflow' :: 'Prism'' 'SomeException' () -- @ _StackOverflow :: AsAsyncException t => Prism' t () _StackOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (StackOverflow <$) where seta StackOverflow = Right () seta t = Left (pure t) {-# INLINE _StackOverflow #-} -- | The program's heap is reaching its limit, and the program should take action -- to reduce the amount of live data it has. -- -- Notes: -- -- * It is undefined which thread receives this 'Exception'. -- -- * GHC currently does not throw 'HeapOverflow' exceptions. -- -- @ -- '_HeapOverflow' :: 'Prism'' 'AsyncException' () -- '_HeapOverflow' :: 'Prism'' 'SomeException' () -- @ _HeapOverflow :: AsAsyncException t => Prism' t () _HeapOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (HeapOverflow <$) where seta HeapOverflow = Right () seta t = Left (pure t) {-# INLINE _HeapOverflow #-} -- | This 'Exception' is raised by another thread calling -- 'Control.Concurrent.killThread', or by the system if it needs to terminate -- the thread for some reason. -- -- @ -- '_ThreadKilled' :: 'Prism'' 'AsyncException' () -- '_ThreadKilled' :: 'Prism'' 'SomeException' () -- @ _ThreadKilled :: AsAsyncException t => Prism' t () _ThreadKilled = _AsyncException . dimap seta (either id id) . right' . rmap (ThreadKilled <$) where seta ThreadKilled = Right () seta t = Left (pure t) {-# INLINE _ThreadKilled #-} -- | This 'Exception' is raised by default in the main thread of the program when -- the user requests to terminate the program via the usual mechanism(s) -- (/e.g./ Control-C in the console). -- -- @ -- '_UserInterrupt' :: 'Prism'' 'AsyncException' () -- '_UserInterrupt' :: 'Prism'' 'SomeException' () -- @ _UserInterrupt :: AsAsyncException t => Prism' t () _UserInterrupt = _AsyncException . dimap seta (either id id) . right' . rmap (UserInterrupt <$) where seta UserInterrupt = Right () seta t = Left (pure t) {-# INLINE _UserInterrupt #-} ---------------------------------------------------------------------------- -- AsyncException ---------------------------------------------------------------------------- -- | Thrown when the runtime system detects that the computation is guaranteed -- not to terminate. Note that there is no guarantee that the runtime system -- will notice whether any given computation is guaranteed to terminate or not. class AsNonTermination t where -- | There is no additional information carried in a 'NonTermination' 'Exception'. -- -- @ -- '_NonTermination' :: 'Prism'' 'NonTermination' () -- '_NonTermination' :: 'Prism'' 'SomeException' () -- @ _NonTermination :: Prism' t () instance AsNonTermination NonTermination where _NonTermination = trivial NonTermination {-# INLINE _NonTermination #-} instance AsNonTermination SomeException where _NonTermination = exception.trivial NonTermination {-# INLINE _NonTermination #-} ---------------------------------------------------------------------------- -- NestedAtomically ---------------------------------------------------------------------------- -- | Thrown when the program attempts to call atomically, from the -- 'Control.Monad.STM' package, inside another call to atomically. class AsNestedAtomically t where -- | There is no additional information carried in a 'NestedAtomically' 'Exception'. -- -- @ -- '_NestedAtomically' :: 'Prism'' 'NestedAtomically' () -- '_NestedAtomically' :: 'Prism'' 'SomeException' () -- @ _NestedAtomically :: Prism' t () instance AsNestedAtomically NestedAtomically where _NestedAtomically = trivial NestedAtomically {-# INLINE _NestedAtomically #-} instance AsNestedAtomically SomeException where _NestedAtomically = exception.trivial NestedAtomically {-# INLINE _NestedAtomically #-} ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnMVar ---------------------------------------------------------------------------- -- | The thread is blocked on an 'Control.Concurrent.MVar.MVar', but there -- are no other references to the 'Control.Concurrent.MVar.MVar' so it can't -- ever continue. class AsBlockedIndefinitelyOnMVar t where -- | There is no additional information carried in a 'BlockedIndefinitelyOnMVar' 'Exception'. -- -- @ -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'BlockedIndefinitelyOnMVar' () -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'SomeException' () -- @ _BlockedIndefinitelyOnMVar :: Prism' t () instance AsBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar where _BlockedIndefinitelyOnMVar = trivial BlockedIndefinitelyOnMVar {-# INLINE _BlockedIndefinitelyOnMVar #-} instance AsBlockedIndefinitelyOnMVar SomeException where _BlockedIndefinitelyOnMVar = exception.trivial BlockedIndefinitelyOnMVar {-# INLINE _BlockedIndefinitelyOnMVar #-} ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnSTM ---------------------------------------------------------------------------- -- | The thread is waiting to retry an 'Control.Monad.STM.STM' transaction, -- but there are no other references to any TVars involved, so it can't ever -- continue. class AsBlockedIndefinitelyOnSTM t where -- | There is no additional information carried in a 'BlockedIndefinitelyOnSTM' 'Exception'. -- -- @ -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'BlockedIndefinitelyOnSTM' () -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'SomeException' () -- @ _BlockedIndefinitelyOnSTM :: Prism' t () instance AsBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM where _BlockedIndefinitelyOnSTM = trivial BlockedIndefinitelyOnSTM {-# INLINE _BlockedIndefinitelyOnSTM #-} instance AsBlockedIndefinitelyOnSTM SomeException where _BlockedIndefinitelyOnSTM = exception.trivial BlockedIndefinitelyOnSTM {-# INLINE _BlockedIndefinitelyOnSTM #-} ---------------------------------------------------------------------------- -- Deadlock ---------------------------------------------------------------------------- -- | There are no runnable threads, so the program is deadlocked. The -- 'Deadlock' 'Exception' is raised in the main thread only. class AsDeadlock t where -- | There is no information carried in a 'Deadlock' 'Exception'. -- -- @ -- '_Deadlock' :: 'Prism'' 'Deadlock' () -- '_Deadlock' :: 'Prism'' 'SomeException' () -- @ _Deadlock :: Prism' t () instance AsDeadlock Deadlock where _Deadlock = trivial Deadlock {-# INLINE _Deadlock #-} instance AsDeadlock SomeException where _Deadlock = exception.trivial Deadlock {-# INLINE _Deadlock #-} ---------------------------------------------------------------------------- -- NoMethodError ---------------------------------------------------------------------------- -- | A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. class AsNoMethodError t where -- | Extract a description of the missing method. -- -- @ -- '_NoMethodError' :: 'Prism'' 'NoMethodError' 'String' -- '_NoMethodError' :: 'Prism'' 'SomeException' 'String' -- @ _NoMethodError :: Prism' t String instance AsNoMethodError NoMethodError where _NoMethodError = _Wrapping NoMethodError {-# INLINE _NoMethodError #-} instance AsNoMethodError SomeException where _NoMethodError = exception._Wrapping NoMethodError {-# INLINE _NoMethodError #-} ---------------------------------------------------------------------------- -- PatternMatchFail ---------------------------------------------------------------------------- -- | A pattern match failed. class AsPatternMatchFail t where -- | Information about the source location of the pattern. -- -- @ -- '_PatternMatchFail' :: 'Prism'' 'PatternMatchFail' 'String' -- '_PatternMatchFail' :: 'Prism'' 'SomeException' 'String' -- @ _PatternMatchFail :: Prism' t String instance AsPatternMatchFail PatternMatchFail where _PatternMatchFail = _Wrapping PatternMatchFail {-# INLINE _PatternMatchFail #-} instance AsPatternMatchFail SomeException where _PatternMatchFail = exception._Wrapping PatternMatchFail {-# INLINE _PatternMatchFail #-} ---------------------------------------------------------------------------- -- RecConError ---------------------------------------------------------------------------- -- | An uninitialised record field was used. class AsRecConError t where -- | Information about the source location where the record was -- constructed. -- -- @ -- '_RecConError' :: 'Prism'' 'RecConError' 'String' -- '_RecConError' :: 'Prism'' 'SomeException' 'String' -- @ _RecConError :: Prism' t String instance AsRecConError RecConError where _RecConError = _Wrapping RecConError {-# INLINE _RecConError #-} instance AsRecConError SomeException where _RecConError = exception._Wrapping RecConError {-# INLINE _RecConError #-} ---------------------------------------------------------------------------- -- RecSelError ---------------------------------------------------------------------------- -- | A record selector was applied to a constructor without the appropriate -- field. This can only happen with a datatype with multiple constructors, -- where some fields are in one constructor but not another. class AsRecSelError t where -- | Information about the source location where the record selection occurred. _RecSelError :: Prism' t String instance AsRecSelError RecSelError where _RecSelError = _Wrapping RecSelError {-# INLINE _RecSelError #-} instance AsRecSelError SomeException where _RecSelError = exception._Wrapping RecSelError {-# INLINE _RecSelError #-} ---------------------------------------------------------------------------- -- RecUpdError ---------------------------------------------------------------------------- -- | A record update was performed on a constructor without the -- appropriate field. This can only happen with a datatype with multiple -- constructors, where some fields are in one constructor but not another. class AsRecUpdError t where -- | Information about the source location where the record was updated. _RecUpdError :: Prism' t String instance AsRecUpdError RecUpdError where _RecUpdError = _Wrapping RecUpdError {-# INLINE _RecUpdError #-} instance AsRecUpdError SomeException where _RecUpdError = exception._Wrapping RecUpdError {-# INLINE _RecUpdError #-} ---------------------------------------------------------------------------- -- ErrorCall ---------------------------------------------------------------------------- -- | This is thrown when the user calls 'Prelude.error'. class AsErrorCall t where -- | Retrieve the argument given to 'Prelude.error'. -- -- 'ErrorCall' is isomorphic to a 'String'. -- -- >>> catching _ErrorCall (error "touch down!") return -- "touch down!" _ErrorCall :: Prism' t String instance AsErrorCall ErrorCall where _ErrorCall = _Wrapping ErrorCall {-# INLINE _ErrorCall #-} instance AsErrorCall SomeException where _ErrorCall = exception._Wrapping ErrorCall {-# INLINE _ErrorCall #-} ------------------------------------------------------------------------------ -- HandlingException ------------------------------------------------------------------------------ -- | This 'Exception' is thrown by @lens@ when the user somehow manages to rethrow -- an internal 'HandlingException'. class AsHandlingException t where -- | There is no information carried in a 'HandlingException'. -- -- @ -- '_HandlingException' :: 'Prism'' 'HandlingException' () -- '_HandlingException' :: 'Prism'' 'SomeException' () -- @ _HandlingException :: Prism' t () instance AsHandlingException HandlingException where _HandlingException = trivial HandlingException {-# INLINE _HandlingException #-} instance AsHandlingException SomeException where _HandlingException = exception.trivial HandlingException {-# INLINE _HandlingException #-} ------------------------------------------------------------------------------ -- Helper Functions ------------------------------------------------------------------------------ trivial :: t -> Iso' t () trivial t = const () `iso` const t