1{-# LANGUAGE CPP #-}
2{-# LANGUAGE Rank2Types #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE NoMonomorphismRestriction #-}
7
8#ifdef TRUSTWORTHY
9{-# LANGUAGE Trustworthy #-}
10#endif
11
12#if __GLASGOW_HASKELL__ >= 710
13{-# LANGUAGE PatternSynonyms #-}
14{-# LANGUAGE ViewPatterns #-}
15#endif
16
17#include "lens-common.h"
18
19#if !(MIN_VERSION_exceptions(0,4,0))
20#define MonadThrow MonadCatch
21#endif
22
23-----------------------------------------------------------------------------
24-- |
25-- Module      :  Control.Exception.Lens
26-- Copyright   :  (C) 2012-16 Edward Kmett
27-- License     :  BSD-style (see the file LICENSE)
28-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
29-- Stability   :  provisional
30-- Portability :  Control.Exception
31--
32-- @Control.Exception@ provides an example of a large open hierarchy
33-- that we can model with prisms and isomorphisms.
34--
35-- Additional combinators for working with 'IOException' results can
36-- be found in "System.IO.Error.Lens".
37--
38-- The combinators in this module have been generalized to work with
39-- 'MonadCatch' instead of just 'IO'. This enables them to be used
40-- more easily in 'Monad' transformer stacks.
41----------------------------------------------------------------------------
42module Control.Exception.Lens
43  (
44  -- * Handling
45    catching, catching_
46  , handling, handling_
47  -- * Trying
48  , trying, trying_
49  -- * Throwing
50  , throwing
51  , throwing_
52  , throwingM
53  , throwingTo
54  -- * Mapping
55  , mappedException, mappedException'
56  -- * Exceptions
57  , exception
58#if __GLASGOW_HASKELL__ >= 710
59  , pattern Exception
60#endif
61  -- * Exception Handlers
62  , Handleable(..)
63  -- ** IOExceptions
64  , AsIOException(..)
65#if __GLASGOW_HASKELL__ >= 710
66  , pattern IOException_
67#endif
68  -- ** Arithmetic Exceptions
69  , AsArithException(..)
70  , _Overflow, _Underflow, _LossOfPrecision, _DivideByZero, _Denormal
71#if MIN_VERSION_base(4,6,0)
72  , _RatioZeroDenominator
73#endif
74#if __GLASGOW_HASKELL__ >= 710
75  , pattern ArithException_
76  , pattern Overflow_
77  , pattern Underflow_
78  , pattern LossOfPrecision_
79  , pattern DivideByZero_
80  , pattern Denormal_
81  , pattern RatioZeroDenominator_
82#endif
83  -- ** Array Exceptions
84  , AsArrayException(..)
85  , _IndexOutOfBounds
86  , _UndefinedElement
87#if __GLASGOW_HASKELL__ >= 710
88  , pattern ArrayException_
89  , pattern IndexOutOfBounds_
90  , pattern UndefinedElement_
91#endif
92  -- ** Assertion Failed
93  , AsAssertionFailed(..)
94#if __GLASGOW_HASKELL__ >= 710
95  , pattern AssertionFailed__
96  , pattern AssertionFailed_
97#endif
98  -- ** Async Exceptions
99  , AsAsyncException(..)
100  , _StackOverflow
101  , _HeapOverflow
102  , _ThreadKilled
103  , _UserInterrupt
104#if __GLASGOW_HASKELL__ >= 710
105  , pattern AsyncException_
106  , pattern StackOverflow_
107  , pattern HeapOverflow_
108  , pattern ThreadKilled_
109  , pattern UserInterrupt_
110#endif
111  -- ** Non-Termination
112  , AsNonTermination(..)
113#if __GLASGOW_HASKELL__ >= 710
114  , pattern NonTermination__
115  , pattern NonTermination_
116#endif
117  -- ** Nested Atomically
118  , AsNestedAtomically(..)
119#if __GLASGOW_HASKELL__ >= 710
120  , pattern NestedAtomically__
121  , pattern NestedAtomically_
122#endif
123  -- ** Blocked Indefinitely
124  -- *** on MVar
125  , AsBlockedIndefinitelyOnMVar(..)
126#if __GLASGOW_HASKELL__ >= 710
127  , pattern BlockedIndefinitelyOnMVar__
128  , pattern BlockedIndefinitelyOnMVar_
129#endif
130  -- *** on STM
131  , AsBlockedIndefinitelyOnSTM(..)
132#if __GLASGOW_HASKELL__ >= 710
133  , pattern BlockedIndefinitelyOnSTM__
134  , pattern BlockedIndefinitelyOnSTM_
135#endif
136  -- ** Deadlock
137  , AsDeadlock(..)
138#if __GLASGOW_HASKELL__ >= 710
139  , pattern Deadlock__
140  , pattern Deadlock_
141#endif
142  -- ** No Such Method
143  , AsNoMethodError(..)
144#if __GLASGOW_HASKELL__ >= 710
145  , pattern NoMethodError__
146  , pattern NoMethodError_
147#endif
148  -- ** Pattern Match Failure
149  , AsPatternMatchFail(..)
150#if __GLASGOW_HASKELL__ >= 710
151  , pattern PatternMatchFail__
152  , pattern PatternMatchFail_
153#endif
154  -- ** Record
155  , AsRecConError(..)
156  , AsRecSelError(..)
157  , AsRecUpdError(..)
158#if __GLASGOW_HASKELL__ >= 710
159  , pattern RecConError__
160  , pattern RecConError_
161  , pattern RecSelError__
162  , pattern RecSelError_
163  , pattern RecUpdError__
164  , pattern RecUpdError_
165#endif
166  -- ** Error Call
167  , AsErrorCall(..)
168#if __GLASGOW_HASKELL__ >= 710
169  , pattern ErrorCall__
170  , pattern ErrorCall_
171#endif
172#if MIN_VERSION_base(4,8,0)
173  -- ** Allocation Limit Exceeded
174  , AsAllocationLimitExceeded(..)
175  , pattern AllocationLimitExceeded__
176  , pattern AllocationLimitExceeded_
177#endif
178#if MIN_VERSION_base(4,9,0)
179  -- ** Type Error
180  , AsTypeError(..)
181  , pattern TypeError__
182  , pattern TypeError_
183#endif
184#if MIN_VERSION_base(4,10,0)
185  -- ** Compaction Failed
186  , AsCompactionFailed(..)
187  , pattern CompactionFailed__
188  , pattern CompactionFailed_
189#endif
190  -- * Handling Exceptions
191  , AsHandlingException(..)
192#if __GLASGOW_HASKELL__ >= 710
193  , pattern HandlingException__
194  , pattern HandlingException_
195#endif
196  ) where
197
198import Control.Applicative
199import Control.Monad
200import Control.Monad.IO.Class
201import Control.Monad.Catch as Catch
202import Control.Exception as Exception hiding (try, tryJust, catchJust)
203import Control.Lens
204import Control.Lens.Internal.Exception
205import Data.Monoid
206import GHC.Conc (ThreadId)
207import Prelude
208  ( const, either, flip, id
209  , (.)
210  , Maybe(..), Either(..), String
211#if __GLASGOW_HASKELL__ >= 710
212  , Bool(..)
213#endif
214  )
215
216#ifdef HLINT
217{-# ANN module "HLint: ignore Use Control.Exception.catch" #-}
218#endif
219
220-- $setup
221-- >>> :set -XNoOverloadedStrings
222-- >>> :m + Control.Exception Control.Monad Data.List Prelude
223
224------------------------------------------------------------------------------
225-- Exceptions as Prisms
226------------------------------------------------------------------------------
227
228-- | Traverse the strongly typed 'Exception' contained in 'SomeException' where the type of your function matches
229-- the desired 'Exception'.
230--
231-- @
232-- 'exception' :: ('Applicative' f, 'Exception' a)
233--           => (a -> f a) -> 'SomeException' -> f 'SomeException'
234-- @
235exception :: Exception a => Prism' SomeException a
236exception = prism' toException fromException
237{-# INLINE exception #-}
238
239#if __GLASGOW_HASKELL__ >= 710
240pattern Exception e <- (preview exception -> Just e) where
241  Exception e = review exception e
242#endif
243
244------------------------------------------------------------------------------
245-- Catching
246------------------------------------------------------------------------------
247
248-- | Catch exceptions that match a given 'Prism' (or any 'Fold', really).
249--
250-- >>> catching _AssertionFailed (assert False (return "uncaught")) $ \ _ -> return "caught"
251-- "caught"
252--
253-- @
254-- 'catching' :: 'MonadCatch' m => 'Prism'' 'SomeException' a     -> m r -> (a -> m r) -> m r
255-- 'catching' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> (a -> m r) -> m r
256-- 'catching' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> (a -> m r) -> m r
257-- 'catching' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> (a -> m r) -> m r
258-- 'catching' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> (a -> m r) -> m r
259-- 'catching' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> (a -> m r) -> m r
260-- @
261catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
262catching l = catchJust (preview l)
263{-# INLINE catching #-}
264
265-- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding
266-- the information about the match. This is particularly useful when you have
267-- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't
268-- particularly valuable, just the fact that it matches.
269--
270-- >>> catching_ _AssertionFailed (assert False (return "uncaught")) $ return "caught"
271-- "caught"
272--
273-- @
274-- 'catching_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a     -> m r -> m r -> m r
275-- 'catching_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> m r -> m r
276-- 'catching_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r
277-- 'catching_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> m r -> m r
278-- 'catching_' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r
279-- 'catching_' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r
280-- @
281catching_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r
282catching_ l a b = catchJust (preview l) a (const b)
283{-# INLINE catching_ #-}
284
285------------------------------------------------------------------------------
286-- Handling
287------------------------------------------------------------------------------
288
289-- | A version of 'catching' with the arguments swapped around; useful in
290-- situations where the code for the handler is shorter.
291--
292-- >>> handling _NonTermination (\_ -> return "caught") $ throwIO NonTermination
293-- "caught"
294--
295-- @
296-- 'handling' :: 'MonadCatch' m => 'Prism'' 'SomeException' a     -> (a -> m r) -> m r -> m r
297-- 'handling' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> (a -> m r) -> m r -> m r
298-- 'handling' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> (a -> m r) -> m r -> m r
299-- 'handling' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> (a -> m r) -> m r -> m r
300-- 'handling' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> (a -> m r) -> m r -> m r
301-- 'handling' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> (a -> m r) -> m r -> m r
302-- @
303handling :: MonadCatch m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r
304handling l = flip (catching l)
305{-# INLINE handling #-}
306
307-- | A version of 'catching_' with the arguments swapped around; useful in
308-- situations where the code for the handler is shorter.
309--
310-- >>> handling_ _NonTermination (return "caught") $ throwIO NonTermination
311-- "caught"
312--
313-- @
314-- 'handling_' :: 'MonadCatch' m => 'Prism'' 'SomeException' a     -> m r -> m r -> m r
315-- 'handling_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> m r -> m r
316-- 'handling_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r
317-- 'handling_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> m r -> m r
318-- 'handling_' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r
319-- 'handling_' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r
320-- @
321handling_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r
322handling_ l = flip (catching_ l)
323{-# INLINE handling_ #-}
324
325------------------------------------------------------------------------------
326-- Trying
327------------------------------------------------------------------------------
328
329-- | A variant of 'Control.Exception.try' that takes a 'Prism' (or any 'Fold') to select which
330-- exceptions are caught (c.f. 'Control.Exception.tryJust', 'Control.Exception.catchJust'). If the
331-- 'Exception' does not match the predicate, it is re-thrown.
332--
333-- @
334-- 'trying' :: 'MonadCatch' m => 'Prism''     'SomeException' a -> m r -> m ('Either' a r)
335-- 'trying' :: 'MonadCatch' m => 'Lens''      'SomeException' a -> m r -> m ('Either' a r)
336-- 'trying' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m ('Either' a r)
337-- 'trying' :: 'MonadCatch' m => 'Iso''       'SomeException' a -> m r -> m ('Either' a r)
338-- 'trying' :: 'MonadCatch' m => 'Getter'     'SomeException' a -> m r -> m ('Either' a r)
339-- 'trying' :: 'MonadCatch' m => 'Fold'       'SomeException' a -> m r -> m ('Either' a r)
340-- @
341trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r)
342trying l = tryJust (preview l)
343{-# INLINE trying #-}
344
345-- | A version of 'trying' that discards the specific exception thrown.
346--
347-- @
348-- 'trying_' :: 'MonadCatch' m => 'Prism''     'SomeException' a -> m r -> m (Maybe r)
349-- 'trying_' :: 'MonadCatch' m => 'Lens''      'SomeException' a -> m r -> m (Maybe r)
350-- 'trying_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m (Maybe r)
351-- 'trying_' :: 'MonadCatch' m => 'Iso''       'SomeException' a -> m r -> m (Maybe r)
352-- 'trying_' :: 'MonadCatch' m => 'Getter'     'SomeException' a -> m r -> m (Maybe r)
353-- 'trying_' :: 'MonadCatch' m => 'Fold'       'SomeException' a -> m r -> m (Maybe r)
354-- @
355trying_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Maybe r)
356trying_ l m = preview _Right `liftM` trying l m
357{-# INLINE trying_ #-}
358
359------------------------------------------------------------------------------
360-- Throwing
361------------------------------------------------------------------------------
362
363-- | Throw an 'Exception' described by a 'Prism'. Exceptions may be thrown from
364-- purely functional code, but may only be caught within the 'IO' 'Monad'.
365--
366-- @
367-- 'throwing' l ≡ 'reviews' l 'throw'
368-- @
369--
370-- @
371-- 'throwing' :: 'Prism'' 'SomeException' t -> t -> r
372-- 'throwing' :: 'Iso'' 'SomeException' t   -> t -> r
373-- @
374throwing :: AReview SomeException b -> b -> r
375throwing l = reviews l Exception.throw
376{-# INLINE throwing #-}
377
378-- | Similar to 'throwing' but specialised for the common case of
379--   error constructors with no arguments.
380--
381-- @
382-- data MyError = Foo | Bar
383-- makePrisms ''MyError
384-- 'throwing_' _Foo :: 'MonadError' MyError m => m a
385-- @
386throwing_ :: AReview SomeException () -> m x
387throwing_ l = throwing l ()
388{-# INLINE throwing_ #-}
389
390-- | A variant of 'throwing' that can only be used within the 'IO' 'Monad'
391-- (or any other 'MonadCatch' instance) to throw an 'Exception' described
392-- by a 'Prism'.
393--
394-- Although 'throwingM' has a type that is a specialization of the type of
395-- 'throwing', the two functions are subtly different:
396--
397-- @
398-- 'throwing' l e \`seq\` x  ≡ 'throwing' e
399-- 'throwingM' l e \`seq\` x ≡ x
400-- @
401--
402-- The first example will cause the 'Exception' @e@ to be raised, whereas the
403-- second one won't. In fact, 'throwingM' will only cause an 'Exception' to
404-- be raised when it is used within the 'MonadCatch' instance. The 'throwingM'
405-- variant should be used in preference to 'throwing' to raise an 'Exception'
406-- within the 'Monad' because it guarantees ordering with respect to other
407-- monadic operations, whereas 'throwing' does not.
408--
409-- @
410-- 'throwingM' l ≡ 'reviews' l 'CatchIO.throw'
411-- @
412--
413-- @
414-- 'throwingM' :: 'MonadThrow' m => 'Prism'' 'SomeException' t -> t -> m r
415-- 'throwingM' :: 'MonadThrow' m => 'Iso'' 'SomeException' t   -> t -> m r
416-- @
417throwingM :: MonadThrow m => AReview SomeException b -> b -> m r
418throwingM l = reviews l throwM
419{-# INLINE throwingM #-}
420
421-- | 'throwingTo' raises an 'Exception' specified by a 'Prism' in the target thread.
422--
423-- @
424-- 'throwingTo' thread l ≡ 'reviews' l ('throwTo' thread)
425-- @
426--
427-- @
428-- 'throwingTo' :: 'ThreadId' -> 'Prism'' 'SomeException' t -> t -> m a
429-- 'throwingTo' :: 'ThreadId' -> 'Iso'' 'SomeException' t   -> t -> m a
430-- @
431throwingTo :: MonadIO m => ThreadId -> AReview SomeException b -> b -> m ()
432throwingTo tid l = reviews l (liftIO . throwTo tid)
433{-# INLINE throwingTo #-}
434
435----------------------------------------------------------------------------
436-- Mapping
437----------------------------------------------------------------------------
438
439-- | This 'Setter' can be used to purely map over the 'Exception's an
440-- arbitrary expression might throw; it is a variant of 'mapException' in
441-- the same way that 'mapped' is a variant of 'fmap'.
442--
443-- > 'mapException' ≡ 'over' 'mappedException'
444--
445-- This view that every Haskell expression can be regarded as carrying a bag
446-- of 'Exception's is detailed in “A Semantics for Imprecise Exceptions” by
447-- Peyton Jones & al. at PLDI ’99.
448--
449-- The following maps failed assertions to arithmetic overflow:
450--
451-- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException %~ \ (AssertionFailed _) -> Overflow
452-- "caught"
453mappedException :: (Exception e, Exception e') => Setter s s e e'
454mappedException = sets mapException
455{-# INLINE mappedException #-}
456
457-- | This is a type restricted version of 'mappedException', which avoids
458-- the type ambiguity in the input 'Exception' when using 'set'.
459--
460-- The following maps any exception to arithmetic overflow:
461--
462-- >>> handling _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & mappedException' .~ Overflow
463-- "caught"
464mappedException' :: Exception e' => Setter s s SomeException e'
465mappedException' = mappedException
466{-# INLINE mappedException' #-}
467
468----------------------------------------------------------------------------
469-- IOException
470----------------------------------------------------------------------------
471
472-- | Exceptions that occur in the 'IO' 'Monad'. An 'IOException' records a
473-- more specific error type, a descriptive string and maybe the handle that was
474-- used when the error was flagged.
475--
476-- Due to their richer structure relative to other exceptions, these have
477-- a more carefully overloaded signature.
478class AsIOException t where
479  -- | Unfortunately the name 'ioException' is taken by @base@ for
480  -- throwing IOExceptions.
481  --
482  -- @
483  -- '_IOException' :: 'Prism'' 'IOException' 'IOException'
484  -- '_IOException' :: 'Prism'' 'SomeException' 'IOException'
485  -- @
486  --
487  -- Many combinators for working with an 'IOException' are available
488  -- in "System.IO.Error.Lens".
489  _IOException :: Prism' t IOException
490
491instance AsIOException IOException where
492  _IOException = id
493  {-# INLINE _IOException #-}
494
495instance AsIOException SomeException where
496  _IOException = exception
497  {-# INLINE _IOException #-}
498
499#if __GLASGOW_HASKELL__ >= 710
500pattern IOException_ a <- (preview _IOException -> Just a) where
501  IOException_ a = review _IOException a
502#endif
503
504----------------------------------------------------------------------------
505-- ArithException
506----------------------------------------------------------------------------
507
508-- | Arithmetic exceptions.
509class AsArithException t where
510  -- |
511  -- @
512  -- '_ArithException' :: 'Prism'' 'ArithException' 'ArithException'
513  -- '_ArithException' :: 'Prism'' 'SomeException'  'ArithException'
514  -- @
515  _ArithException :: Prism' t ArithException
516
517#if __GLASGOW_HASKELL__ >= 710
518pattern ArithException_ a <- (preview _ArithException -> Just a) where
519  ArithException_ a = review _ArithException a
520#endif
521
522instance AsArithException ArithException where
523  _ArithException = id
524  {-# INLINE _ArithException #-}
525
526instance AsArithException SomeException where
527  _ArithException = exception
528  {-# INLINE _ArithException #-}
529
530-- | Handle arithmetic '_Overflow'.
531--
532-- @
533-- '_Overflow' ≡ '_ArithException' '.' '_Overflow'
534-- @
535--
536-- @
537-- '_Overflow' :: 'Prism'' 'ArithException' 'ArithException'
538-- '_Overflow' :: 'Prism'' 'SomeException'  'ArithException'
539-- @
540_Overflow :: AsArithException t => Prism' t ()
541_Overflow = _ArithException . dimap seta (either id id) . right' . rmap (Overflow <$) where
542  seta Overflow = Right ()
543  seta t        = Left  (pure t)
544{-# INLINE _Overflow #-}
545
546#if __GLASGOW_HASKELL__ >= 710
547pattern Overflow_ <- (has _Overflow -> True) where
548  Overflow_ = review _Overflow ()
549#endif
550
551-- | Handle arithmetic '_Underflow'.
552--
553-- @
554-- '_Underflow' ≡ '_ArithException' '.' '_Underflow'
555-- @
556--
557-- @
558-- '_Underflow' :: 'Prism'' 'ArithException' 'ArithException'
559-- '_Underflow' :: 'Prism'' 'SomeException'  'ArithException'
560-- @
561_Underflow :: AsArithException t => Prism' t ()
562_Underflow = _ArithException . dimap seta (either id id) . right' . rmap (Underflow <$) where
563  seta Underflow = Right ()
564  seta t        = Left  (pure t)
565{-# INLINE _Underflow #-}
566
567#if __GLASGOW_HASKELL__ >= 710
568pattern Underflow_ <- (has _Underflow -> True) where
569  Underflow_ = review _Underflow ()
570#endif
571
572-- | Handle arithmetic loss of precision.
573--
574-- @
575-- '_LossOfPrecision' ≡ '_ArithException' '.' '_LossOfPrecision'
576-- @
577--
578-- @
579-- '_LossOfPrecision' :: 'Prism'' 'ArithException' 'ArithException'
580-- '_LossOfPrecision' :: 'Prism'' 'SomeException'  'ArithException'
581-- @
582_LossOfPrecision :: AsArithException t => Prism' t ()
583_LossOfPrecision = _ArithException . dimap seta (either id id) . right' . rmap (LossOfPrecision <$) where
584  seta LossOfPrecision = Right ()
585  seta t        = Left  (pure t)
586{-# INLINE _LossOfPrecision #-}
587
588#if __GLASGOW_HASKELL__ >= 710
589pattern LossOfPrecision_ <- (has _LossOfPrecision -> True) where
590  LossOfPrecision_ = review _LossOfPrecision ()
591#endif
592
593-- | Handle division by zero.
594--
595-- @
596-- '_DivideByZero' ≡ '_ArithException' '.' '_DivideByZero'
597-- @
598--
599-- @
600-- '_DivideByZero' :: 'Prism'' 'ArithException' 'ArithException'
601-- '_DivideByZero' :: 'Prism'' 'SomeException'  'ArithException'
602-- @
603_DivideByZero :: AsArithException t => Prism' t ()
604_DivideByZero = _ArithException . dimap seta (either id id) . right' . rmap (DivideByZero <$) where
605  seta DivideByZero = Right ()
606  seta t        = Left  (pure t)
607{-# INLINE _DivideByZero #-}
608
609#if __GLASGOW_HASKELL__ >= 710
610pattern DivideByZero_ <- (has _DivideByZero -> True) where
611  DivideByZero_ = review _DivideByZero ()
612#endif
613
614-- | Handle exceptional _Denormalized floating pure.
615--
616-- @
617-- '_Denormal' ≡ '_ArithException' '.' '_Denormal'
618-- @
619--
620-- @
621-- '_Denormal' :: 'Prism'' 'ArithException' 'ArithException'
622-- '_Denormal' :: 'Prism'' 'SomeException'  'ArithException'
623-- @
624_Denormal :: AsArithException t => Prism' t ()
625_Denormal = _ArithException . dimap seta (either id id) . right' . rmap (Denormal <$) where
626  seta Denormal = Right ()
627  seta t        = Left  (pure t)
628{-# INLINE _Denormal #-}
629
630#if __GLASGOW_HASKELL__ >= 710
631pattern Denormal_ <- (has _Denormal -> True) where
632  Denormal_ = review _Denormal ()
633#endif
634
635#if MIN_VERSION_base(4,6,0)
636-- | Added in @base@ 4.6 in response to this libraries discussion:
637--
638-- <http://haskell.1045720.n5.nabble.com/Data-Ratio-and-exceptions-td5711246.html>
639--
640-- @
641-- '_RatioZeroDenominator' ≡ '_ArithException' '.' '_RatioZeroDenominator'
642-- @
643--
644-- @
645-- '_RatioZeroDenominator' :: 'Prism'' 'ArithException' 'ArithException'
646-- '_RatioZeroDenominator' :: 'Prism'' 'SomeException'  'ArithException'
647-- @
648_RatioZeroDenominator :: AsArithException t => Prism' t ()
649_RatioZeroDenominator = _ArithException . dimap seta (either id id) . right' . rmap (RatioZeroDenominator <$) where
650  seta RatioZeroDenominator = Right ()
651  seta t        = Left  (pure t)
652{-# INLINE _RatioZeroDenominator #-}
653
654#if __GLASGOW_HASKELL__ >= 710
655pattern RatioZeroDenominator_ <- (has _RatioZeroDenominator -> True) where
656  RatioZeroDenominator_ = review _RatioZeroDenominator ()
657#endif
658
659#endif
660
661----------------------------------------------------------------------------
662-- ArrayException
663----------------------------------------------------------------------------
664
665-- | Exceptions generated by array operations.
666class AsArrayException t where
667  -- | Extract information about an 'ArrayException'.
668  --
669  -- @
670  -- '_ArrayException' :: 'Prism'' 'ArrayException' 'ArrayException'
671  -- '_ArrayException' :: 'Prism'' 'SomeException'  'ArrayException'
672  -- @
673  _ArrayException :: Prism' t ArrayException
674
675instance AsArrayException ArrayException where
676  _ArrayException = id
677  {-# INLINE _ArrayException #-}
678
679instance AsArrayException SomeException where
680  _ArrayException = exception
681  {-# INLINE _ArrayException #-}
682
683#if __GLASGOW_HASKELL__ >= 710
684pattern ArrayException_ e <- (preview _ArrayException -> Just e) where
685  ArrayException_ e = review _ArrayException e
686#endif
687
688-- | An attempt was made to index an array outside its declared bounds.
689--
690-- @
691-- '_IndexOutOfBounds' ≡ '_ArrayException' '.' '_IndexOutOfBounds'
692-- @
693--
694-- @
695-- '_IndexOutOfBounds' :: 'Prism'' 'ArrayException' 'String'
696-- '_IndexOutOfBounds' :: 'Prism'' 'SomeException'  'String'
697-- @
698_IndexOutOfBounds :: AsArrayException t => Prism' t String
699_IndexOutOfBounds = _ArrayException . dimap seta (either id id) . right' . rmap (fmap IndexOutOfBounds) where
700  seta (IndexOutOfBounds r) = Right r
701  seta t                    = Left  (pure t)
702{-# INLINE _IndexOutOfBounds #-}
703
704#if __GLASGOW_HASKELL__ >= 710
705pattern IndexOutOfBounds_ e <- (preview _IndexOutOfBounds -> Just e) where
706  IndexOutOfBounds_ e = review _IndexOutOfBounds e
707#endif
708
709-- | An attempt was made to evaluate an element of an array that had not been initialized.
710--
711-- @
712-- '_UndefinedElement' ≡ '_ArrayException' '.' '_UndefinedElement'
713-- @
714--
715-- @
716-- '_UndefinedElement' :: 'Prism'' 'ArrayException' 'String'
717-- '_UndefinedElement' :: 'Prism'' 'SomeException'  'String'
718-- @
719_UndefinedElement :: AsArrayException t => Prism' t String
720_UndefinedElement = _ArrayException . dimap seta (either id id) . right' . rmap (fmap UndefinedElement) where
721  seta (UndefinedElement r) = Right r
722  seta t                    = Left  (pure t)
723{-# INLINE _UndefinedElement #-}
724
725#if __GLASGOW_HASKELL__ >= 710
726pattern UndefinedElement_ e <- (preview _UndefinedElement -> Just e) where
727  UndefinedElement_ e = review _UndefinedElement e
728#endif
729
730----------------------------------------------------------------------------
731-- AssertionFailed
732----------------------------------------------------------------------------
733
734-- | 'assert' was applied to 'Prelude.False'.
735class AsAssertionFailed t where
736  -- |
737  -- @
738  -- '__AssertionFailed' :: 'Prism'' 'AssertionFailed' 'AssertionFailed'
739  -- '__AssertionFailed' :: 'Prism'' 'SomeException'   'AssertionFailed'
740  -- @
741  __AssertionFailed :: Prism' t AssertionFailed
742
743  -- | This 'Exception' contains provides information about what assertion failed in the 'String'.
744  --
745  -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("<interactive>" `isInfixOf` xs) ) $ assert False (return "uncaught")
746  -- "caught"
747  --
748  -- @
749  -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String'
750  -- '_AssertionFailed' :: 'Prism'' 'SomeException'   'String'
751  -- @
752  _AssertionFailed :: Prism' t String
753  _AssertionFailed = __AssertionFailed._AssertionFailed
754  {-# INLINE _AssertionFailed #-}
755
756instance AsAssertionFailed AssertionFailed where
757  __AssertionFailed = id
758  {-# INLINE __AssertionFailed #-}
759
760  _AssertionFailed = _Wrapping AssertionFailed
761  {-# INLINE _AssertionFailed #-}
762
763instance AsAssertionFailed SomeException where
764  __AssertionFailed = exception
765  {-# INLINE __AssertionFailed #-}
766
767#if __GLASGOW_HASKELL__ >= 710
768pattern AssertionFailed__ e <- (preview __AssertionFailed -> Just e) where
769  AssertionFailed__ e = review __AssertionFailed e
770
771pattern AssertionFailed_ e <- (preview _AssertionFailed -> Just e) where
772  AssertionFailed_ e = review _AssertionFailed e
773#endif
774
775----------------------------------------------------------------------------
776-- AsyncException
777----------------------------------------------------------------------------
778
779-- | Asynchronous exceptions.
780class AsAsyncException t where
781  -- | There are several types of 'AsyncException'.
782  --
783  -- @
784  -- '_AsyncException' :: 'Equality'' 'AsyncException' 'AsyncException'
785  -- '_AsyncException' :: 'Prism''    'SomeException'  'AsyncException'
786  -- @
787  _AsyncException :: Prism' t AsyncException
788
789instance AsAsyncException AsyncException where
790  _AsyncException = id
791  {-# INLINE _AsyncException #-}
792
793instance AsAsyncException SomeException where
794  _AsyncException = exception
795  {-# INLINE _AsyncException #-}
796
797#if __GLASGOW_HASKELL__ >= 710
798pattern AsyncException_ e <- (preview _AsyncException -> Just e) where
799  AsyncException_ e = review _AsyncException e
800#endif
801
802-- | The current thread's stack exceeded its limit. Since an 'Exception' has
803-- been raised, the thread's stack will certainly be below its limit again,
804-- but the programmer should take remedial action immediately.
805--
806-- @
807-- '_StackOverflow' :: 'Prism'' 'AsyncException' ()
808-- '_StackOverflow' :: 'Prism'' 'SomeException'  ()
809-- @
810_StackOverflow :: AsAsyncException t => Prism' t ()
811_StackOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (StackOverflow <$) where
812  seta StackOverflow = Right ()
813  seta t             = Left  (pure t)
814{-# INLINE _StackOverflow #-}
815
816#if __GLASGOW_HASKELL__ >= 710
817pattern StackOverflow_ <- (has _StackOverflow -> True) where
818  StackOverflow_ = review _StackOverflow ()
819#endif
820
821-- | The program's heap is reaching its limit, and the program should take action
822-- to reduce the amount of live data it has.
823--
824-- Notes:
825--
826-- * It is undefined which thread receives this 'Exception'.
827--
828-- * GHC currently does not throw 'HeapOverflow' exceptions.
829--
830-- @
831-- '_HeapOverflow' :: 'Prism'' 'AsyncException' ()
832-- '_HeapOverflow' :: 'Prism'' 'SomeException'  ()
833-- @
834_HeapOverflow :: AsAsyncException t => Prism' t ()
835_HeapOverflow = _AsyncException . dimap seta (either id id) . right' . rmap (HeapOverflow <$) where
836  seta HeapOverflow = Right ()
837  seta t            = Left  (pure t)
838{-# INLINE _HeapOverflow #-}
839
840#if __GLASGOW_HASKELL__ >= 710
841pattern HeapOverflow_ <- (has _HeapOverflow -> True) where
842  HeapOverflow_ = review _HeapOverflow ()
843#endif
844
845-- | This 'Exception' is raised by another thread calling
846-- 'Control.Concurrent.killThread', or by the system if it needs to terminate
847-- the thread for some reason.
848--
849-- @
850-- '_ThreadKilled' :: 'Prism'' 'AsyncException' ()
851-- '_ThreadKilled' :: 'Prism'' 'SomeException'  ()
852-- @
853_ThreadKilled :: AsAsyncException t => Prism' t ()
854_ThreadKilled = _AsyncException . dimap seta (either id id) . right' . rmap (ThreadKilled <$) where
855  seta ThreadKilled = Right ()
856  seta t            = Left  (pure t)
857{-# INLINE _ThreadKilled #-}
858
859#if __GLASGOW_HASKELL__ >= 710
860pattern ThreadKilled_ <- (has _ThreadKilled -> True) where
861  ThreadKilled_ = review _ThreadKilled ()
862#endif
863
864-- | This 'Exception' is raised by default in the main thread of the program when
865-- the user requests to terminate the program via the usual mechanism(s)
866-- (/e.g./ Control-C in the console).
867--
868-- @
869-- '_UserInterrupt' :: 'Prism'' 'AsyncException' ()
870-- '_UserInterrupt' :: 'Prism'' 'SomeException'  ()
871-- @
872_UserInterrupt :: AsAsyncException t => Prism' t ()
873_UserInterrupt = _AsyncException . dimap seta (either id id) . right' . rmap (UserInterrupt <$) where
874  seta UserInterrupt = Right ()
875  seta t             = Left  (pure t)
876{-# INLINE _UserInterrupt #-}
877
878#if __GLASGOW_HASKELL__ >= 710
879pattern UserInterrupt_ <- (has _UserInterrupt -> True) where
880  UserInterrupt_ = review _UserInterrupt ()
881#endif
882
883----------------------------------------------------------------------------
884-- AsyncException
885----------------------------------------------------------------------------
886
887-- | Thrown when the runtime system detects that the computation is guaranteed
888-- not to terminate. Note that there is no guarantee that the runtime system
889-- will notice whether any given computation is guaranteed to terminate or not.
890class AsNonTermination t where
891  -- |
892  -- @
893  -- '__NonTermination' :: 'Prism'' 'NonTermination' 'NonTermination'
894  -- '__NonTermination' :: 'Prism'' 'SomeException'  'NonTermination'
895  -- @
896  __NonTermination :: Prism' t NonTermination
897
898  -- | There is no additional information carried in a 'NonTermination' 'Exception'.
899  --
900  -- @
901  -- '_NonTermination' :: 'Prism'' 'NonTermination' ()
902  -- '_NonTermination' :: 'Prism'' 'SomeException'  ()
903  -- @
904  _NonTermination :: Prism' t ()
905  _NonTermination = __NonTermination._NonTermination
906  {-# INLINE _NonTermination #-}
907
908instance AsNonTermination NonTermination where
909  __NonTermination = id
910  {-# INLINE __NonTermination #-}
911
912  _NonTermination = trivial NonTermination
913  {-# INLINE _NonTermination #-}
914
915instance AsNonTermination SomeException where
916  __NonTermination = exception
917  {-# INLINE __NonTermination #-}
918
919#if __GLASGOW_HASKELL__ >= 710
920pattern NonTermination__ e <- (preview __NonTermination -> Just e) where
921  NonTermination__ e = review __NonTermination e
922
923pattern NonTermination_ <- (has _NonTermination -> True) where
924  NonTermination_ = review _NonTermination ()
925#endif
926
927----------------------------------------------------------------------------
928-- NestedAtomically
929----------------------------------------------------------------------------
930
931-- | Thrown when the program attempts to call atomically, from the
932-- 'Control.Monad.STM' package, inside another call to atomically.
933class AsNestedAtomically t where
934  -- |
935  -- @
936  -- '__NestedAtomically' :: 'Prism'' 'NestedAtomically' 'NestedAtomically'
937  -- '__NestedAtomically' :: 'Prism'' 'SomeException'    'NestedAtomically'
938  -- @
939  __NestedAtomically :: Prism' t NestedAtomically
940
941  -- | There is no additional information carried in a 'NestedAtomically' 'Exception'.
942  --
943  -- @
944  -- '_NestedAtomically' :: 'Prism'' 'NestedAtomically' ()
945  -- '_NestedAtomically' :: 'Prism'' 'SomeException'    ()
946  -- @
947  _NestedAtomically :: Prism' t ()
948  _NestedAtomically = __NestedAtomically._NestedAtomically
949  {-# INLINE _NestedAtomically #-}
950
951instance AsNestedAtomically NestedAtomically where
952  __NestedAtomically = id
953  {-# INLINE __NestedAtomically #-}
954
955  _NestedAtomically = trivial NestedAtomically
956  {-# INLINE _NestedAtomically #-}
957
958instance AsNestedAtomically SomeException where
959  __NestedAtomically = exception
960  {-# INLINE __NestedAtomically #-}
961
962#if __GLASGOW_HASKELL__ >= 710
963pattern NestedAtomically__ e <- (preview __NestedAtomically -> Just e) where
964  NestedAtomically__ e = review __NestedAtomically e
965
966pattern NestedAtomically_ <- (has _NestedAtomically -> True) where
967  NestedAtomically_ = review _NestedAtomically ()
968#endif
969
970----------------------------------------------------------------------------
971-- BlockedIndefinitelyOnMVar
972----------------------------------------------------------------------------
973
974-- | The thread is blocked on an 'Control.Concurrent.MVar.MVar', but there
975-- are no other references to the 'Control.Concurrent.MVar.MVar' so it can't
976-- ever continue.
977class AsBlockedIndefinitelyOnMVar t where
978  -- |
979  -- @
980  -- '__BlockedIndefinitelyOnMVar' :: 'Prism'' 'BlockedIndefinitelyOnMVar' 'BlockedIndefinitelyOnMVar'
981  -- '__BlockedIndefinitelyOnMVar' :: 'Prism'' 'SomeException'             'BlockedIndefinitelyOnMVar'
982  -- @
983  __BlockedIndefinitelyOnMVar :: Prism' t BlockedIndefinitelyOnMVar
984
985  -- | There is no additional information carried in a 'BlockedIndefinitelyOnMVar' 'Exception'.
986  --
987  -- @
988  -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'BlockedIndefinitelyOnMVar' ()
989  -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'SomeException'             ()
990  -- @
991  _BlockedIndefinitelyOnMVar :: Prism' t ()
992  _BlockedIndefinitelyOnMVar = __BlockedIndefinitelyOnMVar._BlockedIndefinitelyOnMVar
993  {-# INLINE _BlockedIndefinitelyOnMVar #-}
994
995instance AsBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar where
996  __BlockedIndefinitelyOnMVar = id
997  {-# INLINE __BlockedIndefinitelyOnMVar #-}
998
999  _BlockedIndefinitelyOnMVar = trivial BlockedIndefinitelyOnMVar
1000  {-# INLINE _BlockedIndefinitelyOnMVar #-}
1001
1002instance AsBlockedIndefinitelyOnMVar SomeException where
1003  __BlockedIndefinitelyOnMVar = exception
1004  {-# INLINE __BlockedIndefinitelyOnMVar #-}
1005
1006#if __GLASGOW_HASKELL__ >= 710
1007pattern BlockedIndefinitelyOnMVar__ e <- (preview __BlockedIndefinitelyOnMVar -> Just e) where
1008  BlockedIndefinitelyOnMVar__ e = review __BlockedIndefinitelyOnMVar e
1009
1010pattern BlockedIndefinitelyOnMVar_ <- (has _BlockedIndefinitelyOnMVar -> True) where
1011  BlockedIndefinitelyOnMVar_ = review _BlockedIndefinitelyOnMVar ()
1012#endif
1013
1014----------------------------------------------------------------------------
1015-- BlockedIndefinitelyOnSTM
1016----------------------------------------------------------------------------
1017
1018-- | The thread is waiting to retry an 'Control.Monad.STM.STM' transaction,
1019-- but there are no other references to any TVars involved, so it can't ever
1020-- continue.
1021class AsBlockedIndefinitelyOnSTM t where
1022  -- |
1023  -- @
1024  -- '__BlockedIndefinitelyOnSTM' :: 'Prism'' 'BlockedIndefinitelyOnSTM' 'BlockedIndefinitelyOnSTM'
1025  -- '__BlockedIndefinitelyOnSTM' :: 'Prism'' 'SomeException'            'BlockedIndefinitelyOnSTM'
1026  -- @
1027  __BlockedIndefinitelyOnSTM :: Prism' t BlockedIndefinitelyOnSTM
1028
1029  -- | There is no additional information carried in a 'BlockedIndefinitelyOnSTM' 'Exception'.
1030  --
1031  -- @
1032  -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'BlockedIndefinitelyOnSTM' ()
1033  -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'SomeException'            ()
1034  -- @
1035  _BlockedIndefinitelyOnSTM :: Prism' t ()
1036  _BlockedIndefinitelyOnSTM = __BlockedIndefinitelyOnSTM._BlockedIndefinitelyOnSTM
1037  {-# INLINE _BlockedIndefinitelyOnSTM #-}
1038
1039instance AsBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM where
1040  __BlockedIndefinitelyOnSTM = id
1041  {-# INLINE __BlockedIndefinitelyOnSTM #-}
1042
1043  _BlockedIndefinitelyOnSTM = trivial BlockedIndefinitelyOnSTM
1044  {-# INLINE _BlockedIndefinitelyOnSTM #-}
1045
1046instance AsBlockedIndefinitelyOnSTM SomeException where
1047  __BlockedIndefinitelyOnSTM = exception
1048  {-# INLINE __BlockedIndefinitelyOnSTM #-}
1049
1050#if __GLASGOW_HASKELL__ >= 710
1051pattern BlockedIndefinitelyOnSTM__ e <- (preview __BlockedIndefinitelyOnSTM -> Just e) where
1052  BlockedIndefinitelyOnSTM__ e = review __BlockedIndefinitelyOnSTM e
1053
1054pattern BlockedIndefinitelyOnSTM_ <- (has _BlockedIndefinitelyOnSTM -> True) where
1055  BlockedIndefinitelyOnSTM_ = review _BlockedIndefinitelyOnSTM ()
1056#endif
1057
1058----------------------------------------------------------------------------
1059-- Deadlock
1060----------------------------------------------------------------------------
1061
1062-- | There are no runnable threads, so the program is deadlocked. The
1063-- 'Deadlock' 'Exception' is raised in the main thread only.
1064class AsDeadlock t where
1065  -- |
1066  -- @
1067  -- '__Deadlock' :: 'Prism'' 'Deadlock'      'Deadlock'
1068  -- '__Deadlock' :: 'Prism'' 'SomeException' 'Deadlock'
1069  -- @
1070  __Deadlock :: Prism' t Deadlock
1071
1072  -- | There is no information carried in a 'Deadlock' 'Exception'.
1073  --
1074  -- @
1075  -- '_Deadlock' :: 'Prism'' 'Deadlock'      ()
1076  -- '_Deadlock' :: 'Prism'' 'SomeException' ()
1077  -- @
1078  _Deadlock :: Prism' t ()
1079  _Deadlock = __Deadlock._Deadlock
1080  {-# INLINE _Deadlock #-}
1081
1082instance AsDeadlock Deadlock where
1083  __Deadlock = id
1084  {-# INLINE __Deadlock #-}
1085
1086  _Deadlock = trivial Deadlock
1087  {-# INLINE _Deadlock #-}
1088
1089instance AsDeadlock SomeException where
1090  __Deadlock = exception
1091  {-# INLINE __Deadlock #-}
1092
1093#if __GLASGOW_HASKELL__ >= 710
1094pattern Deadlock__ e <- (preview __Deadlock -> Just e) where
1095  Deadlock__ e = review __Deadlock e
1096
1097pattern Deadlock_ <- (has _Deadlock -> True) where
1098  Deadlock_ = review _Deadlock ()
1099#endif
1100
1101----------------------------------------------------------------------------
1102-- NoMethodError
1103----------------------------------------------------------------------------
1104
1105-- | A class method without a definition (neither a default definition,
1106-- nor a definition in the appropriate instance) was called.
1107class AsNoMethodError t where
1108  -- |
1109  -- @
1110  -- '__NoMethodError' :: 'Prism'' 'NoMethodError' 'NoMethodError'
1111  -- '__NoMethodError' :: 'Prism'' 'SomeException' 'NoMethodError'
1112  -- @
1113  __NoMethodError :: Prism' t NoMethodError
1114
1115  -- | Extract a description of the missing method.
1116  --
1117  -- @
1118  -- '_NoMethodError' :: 'Prism'' 'NoMethodError' 'String'
1119  -- '_NoMethodError' :: 'Prism'' 'SomeException' 'String'
1120  -- @
1121  _NoMethodError :: Prism' t String
1122  _NoMethodError = __NoMethodError._NoMethodError
1123  {-# INLINE _NoMethodError #-}
1124
1125instance AsNoMethodError NoMethodError where
1126  __NoMethodError = id
1127  {-# INLINE __NoMethodError #-}
1128
1129  _NoMethodError = _Wrapping NoMethodError
1130  {-# INLINE _NoMethodError #-}
1131
1132instance AsNoMethodError SomeException where
1133  __NoMethodError = exception
1134  {-# INLINE __NoMethodError #-}
1135
1136#if __GLASGOW_HASKELL__ >= 710
1137pattern NoMethodError__ e <- (preview __NoMethodError -> Just e) where
1138  NoMethodError__ e = review __NoMethodError e
1139
1140pattern NoMethodError_ e <- (preview _NoMethodError -> Just e) where
1141  NoMethodError_ e = review _NoMethodError e
1142#endif
1143
1144----------------------------------------------------------------------------
1145-- PatternMatchFail
1146----------------------------------------------------------------------------
1147
1148-- | A pattern match failed.
1149class AsPatternMatchFail t where
1150  -- |
1151  -- @
1152  -- '__PatternMatchFail' :: 'Prism'' 'PatternMatchFail' 'PatternMatchFail'
1153  -- '__PatternMatchFail' :: 'Prism'' 'SomeException'    'PatternMatchFail'
1154  -- @
1155  __PatternMatchFail :: Prism' t PatternMatchFail
1156
1157  -- | Information about the source location of the pattern.
1158  --
1159  -- @
1160  -- '_PatternMatchFail' :: 'Prism'' 'PatternMatchFail' 'String'
1161  -- '_PatternMatchFail' :: 'Prism'' 'SomeException'    'String'
1162  -- @
1163  _PatternMatchFail :: Prism' t String
1164  _PatternMatchFail = __PatternMatchFail._PatternMatchFail
1165  {-# INLINE _PatternMatchFail #-}
1166
1167instance AsPatternMatchFail PatternMatchFail where
1168  __PatternMatchFail = id
1169  {-# INLINE __PatternMatchFail #-}
1170
1171  _PatternMatchFail = _Wrapping PatternMatchFail
1172  {-# INLINE _PatternMatchFail #-}
1173
1174instance AsPatternMatchFail SomeException where
1175  __PatternMatchFail = exception
1176  {-# INLINE __PatternMatchFail #-}
1177
1178#if __GLASGOW_HASKELL__ >= 710
1179pattern PatternMatchFail__ e <- (preview __PatternMatchFail -> Just e) where
1180  PatternMatchFail__ e = review __PatternMatchFail e
1181
1182pattern PatternMatchFail_ e <- (preview _PatternMatchFail -> Just e) where
1183  PatternMatchFail_ e = review _PatternMatchFail e
1184#endif
1185
1186----------------------------------------------------------------------------
1187-- RecConError
1188----------------------------------------------------------------------------
1189
1190-- | An uninitialised record field was used.
1191class AsRecConError t where
1192  -- |
1193  -- @
1194  -- '__RecConError' :: 'Prism'' 'RecConError'   'RecConError'
1195  -- '__RecConError' :: 'Prism'' 'SomeException' 'RecConError'
1196  -- @
1197  __RecConError :: Prism' t RecConError
1198
1199  -- | Information about the source location where the record was
1200  -- constructed.
1201  --
1202  -- @
1203  -- '_RecConError' :: 'Prism'' 'RecConError'   'String'
1204  -- '_RecConError' :: 'Prism'' 'SomeException' 'String'
1205  -- @
1206  _RecConError :: Prism' t String
1207  _RecConError = __RecConError._RecConError
1208  {-# INLINE _RecConError #-}
1209
1210instance AsRecConError RecConError where
1211  __RecConError = id
1212  {-# INLINE __RecConError #-}
1213
1214  _RecConError = _Wrapping RecConError
1215  {-# INLINE _RecConError #-}
1216
1217instance AsRecConError SomeException where
1218  __RecConError = exception
1219  {-# INLINE __RecConError #-}
1220
1221#if __GLASGOW_HASKELL__ >= 710
1222pattern RecConError__ e <- (preview __RecConError -> Just e) where
1223  RecConError__ e = review __RecConError e
1224
1225pattern RecConError_ e <- (preview _RecConError -> Just e) where
1226  RecConError_ e = review _RecConError e
1227#endif
1228
1229----------------------------------------------------------------------------
1230-- RecSelError
1231----------------------------------------------------------------------------
1232
1233-- | A record selector was applied to a constructor without the appropriate
1234-- field. This can only happen with a datatype with multiple constructors,
1235-- where some fields are in one constructor but not another.
1236class AsRecSelError t where
1237  -- |
1238  -- @
1239  -- '__RecSelError' :: 'Prism'' 'RecSelError'   'RecSelError'
1240  -- '__RecSelError' :: 'Prism'' 'SomeException' 'RecSelError'
1241  -- @
1242  __RecSelError :: Prism' t RecSelError
1243
1244  -- | Information about the source location where the record selection occurred.
1245  --
1246  -- @
1247  -- '_RecSelError' :: 'Prism'' 'RecSelError'   'String'
1248  -- '_RecSelError' :: 'Prism'' 'SomeException' 'String'
1249  -- @
1250  _RecSelError :: Prism' t String
1251  _RecSelError = __RecSelError._RecSelError
1252  {-# INLINE _RecSelError #-}
1253
1254instance AsRecSelError RecSelError where
1255  __RecSelError = id
1256  {-# INLINE __RecSelError #-}
1257
1258  _RecSelError = _Wrapping RecSelError
1259  {-# INLINE _RecSelError #-}
1260
1261instance AsRecSelError SomeException where
1262  __RecSelError = exception
1263  {-# INLINE __RecSelError #-}
1264
1265#if __GLASGOW_HASKELL__ >= 710
1266pattern RecSelError__ e <- (preview __RecSelError -> Just e) where
1267  RecSelError__ e = review __RecSelError e
1268
1269pattern RecSelError_ e <- (preview _RecSelError -> Just e) where
1270  RecSelError_ e = review _RecSelError e
1271#endif
1272
1273----------------------------------------------------------------------------
1274-- RecUpdError
1275----------------------------------------------------------------------------
1276
1277-- | A record update was performed on a constructor without the
1278-- appropriate field. This can only happen with a datatype with multiple
1279-- constructors, where some fields are in one constructor but not another.
1280class AsRecUpdError t where
1281  -- |
1282  -- @
1283  -- '__RecUpdError' :: 'Prism'' 'RecUpdError'   'RecUpdError'
1284  -- '__RecUpdError' :: 'Prism'' 'SomeException' 'RecUpdError'
1285  -- @
1286  __RecUpdError :: Prism' t RecUpdError
1287
1288  -- | Information about the source location where the record was updated.
1289  --
1290  -- @
1291  -- '_RecUpdError' :: 'Prism'' 'RecUpdError'   'String'
1292  -- '_RecUpdError' :: 'Prism'' 'SomeException' 'String'
1293  -- @
1294  _RecUpdError :: Prism' t String
1295  _RecUpdError = __RecUpdError._RecUpdError
1296  {-# INLINE _RecUpdError #-}
1297
1298instance AsRecUpdError RecUpdError where
1299  __RecUpdError = id
1300  {-# INLINE __RecUpdError #-}
1301
1302  _RecUpdError = _Wrapping RecUpdError
1303  {-# INLINE _RecUpdError #-}
1304
1305instance AsRecUpdError SomeException where
1306  __RecUpdError = exception
1307  {-# INLINE __RecUpdError #-}
1308
1309#if __GLASGOW_HASKELL__ >= 710
1310pattern RecUpdError__ e <- (preview __RecUpdError -> Just e) where
1311  RecUpdError__ e = review __RecUpdError e
1312
1313pattern RecUpdError_ e <- (preview _RecUpdError -> Just e) where
1314  RecUpdError_ e = review _RecUpdError e
1315#endif
1316
1317----------------------------------------------------------------------------
1318-- ErrorCall
1319----------------------------------------------------------------------------
1320
1321-- | This is thrown when the user calls 'Prelude.error'.
1322class AsErrorCall t where
1323  -- |
1324  -- @
1325  -- '__ErrorCall' :: 'Prism'' 'ErrorCall'     'ErrorCall'
1326  -- '__ErrorCall' :: 'Prism'' 'SomeException' 'ErrorCall'
1327  -- @
1328  __ErrorCall :: Prism' t ErrorCall
1329
1330  -- | Retrieve the argument given to 'Prelude.error'.
1331  --
1332  -- 'ErrorCall' is isomorphic to a 'String'.
1333  --
1334  -- >>> catching _ErrorCall (error "touch down!") return
1335  -- "touch down!"
1336  --
1337  -- @
1338  -- '_ErrorCall' :: 'Prism'' 'ErrorCall'     'String'
1339  -- '_ErrorCall' :: 'Prism'' 'SomeException' 'String'
1340  -- @
1341  _ErrorCall :: Prism' t String
1342  _ErrorCall = __ErrorCall._ErrorCall
1343  {-# INLINE _ErrorCall #-}
1344
1345instance AsErrorCall ErrorCall where
1346  __ErrorCall = id
1347  {-# INLINE __ErrorCall #-}
1348
1349  _ErrorCall = _Wrapping ErrorCall
1350  {-# INLINE _ErrorCall #-}
1351
1352instance AsErrorCall SomeException where
1353  __ErrorCall = exception
1354  {-# INLINE __ErrorCall #-}
1355
1356#if __GLASGOW_HASKELL__ >= 710
1357pattern ErrorCall__ e <- (preview __ErrorCall -> Just e) where
1358  ErrorCall__ e = review __ErrorCall e
1359
1360pattern ErrorCall_ e <- (preview _ErrorCall -> Just e) where
1361  ErrorCall_ e = review _ErrorCall e
1362#endif
1363
1364#if MIN_VERSION_base(4,8,0)
1365----------------------------------------------------------------------------
1366-- AllocationLimitExceeded
1367----------------------------------------------------------------------------
1368
1369-- | This thread has exceeded its allocation limit.
1370class AsAllocationLimitExceeded t where
1371  -- |
1372  -- @
1373  -- '__AllocationLimitExceeded' :: 'Prism'' 'AllocationLimitExceeded' 'AllocationLimitExceeded'
1374  -- '__AllocationLimitExceeded' :: 'Prism'' 'SomeException'           'AllocationLimitExceeded'
1375  -- @
1376  __AllocationLimitExceeded :: Prism' t AllocationLimitExceeded
1377
1378  -- | There is no additional information carried in an
1379  -- 'AllocationLimitExceeded' 'Exception'.
1380  --
1381  -- @
1382  -- '_AllocationLimitExceeded' :: 'Prism'' 'AllocationLimitExceeded' ()
1383  -- '_AllocationLimitExceeded' :: 'Prism'' 'SomeException'           ()
1384  -- @
1385  _AllocationLimitExceeded :: Prism' t ()
1386  _AllocationLimitExceeded = __AllocationLimitExceeded._AllocationLimitExceeded
1387  {-# INLINE _AllocationLimitExceeded #-}
1388
1389instance AsAllocationLimitExceeded AllocationLimitExceeded where
1390  __AllocationLimitExceeded = id
1391  {-# INLINE __AllocationLimitExceeded #-}
1392
1393  _AllocationLimitExceeded = trivial AllocationLimitExceeded
1394  {-# INLINE _AllocationLimitExceeded #-}
1395
1396instance AsAllocationLimitExceeded SomeException where
1397  __AllocationLimitExceeded = exception
1398  {-# INLINE __AllocationLimitExceeded #-}
1399
1400pattern AllocationLimitExceeded__ e <- (preview __AllocationLimitExceeded -> Just e) where
1401  AllocationLimitExceeded__ e = review __AllocationLimitExceeded e
1402
1403pattern AllocationLimitExceeded_ <- (has _AllocationLimitExceeded -> True) where
1404  AllocationLimitExceeded_ = review _AllocationLimitExceeded ()
1405#endif
1406
1407#if MIN_VERSION_base(4,9,0)
1408----------------------------------------------------------------------------
1409-- TypeError
1410----------------------------------------------------------------------------
1411
1412-- | An expression that didn't typecheck during compile time was called.
1413-- This is only possible with @-fdefer-type-errors@.
1414class AsTypeError t where
1415  -- |
1416  -- @
1417  -- '__TypeError' :: 'Prism'' 'TypeError'     'TypeError'
1418  -- '__TypeError' :: 'Prism'' 'SomeException' 'TypeError'
1419  -- @
1420  __TypeError :: Prism' t TypeError
1421
1422  -- | Details about the failed type check.
1423  --
1424  -- @
1425  -- '_TypeError' :: 'Prism'' 'TypeError'     'String'
1426  -- '_TypeError' :: 'Prism'' 'SomeException' 'String'
1427  -- @
1428  _TypeError :: Prism' t String
1429  _TypeError = __TypeError._TypeError
1430  {-# INLINE _TypeError #-}
1431
1432instance AsTypeError TypeError where
1433  __TypeError = id
1434  {-# INLINE __TypeError #-}
1435
1436  _TypeError = _Wrapping TypeError
1437  {-# INLINE _TypeError #-}
1438
1439instance AsTypeError SomeException where
1440  __TypeError = exception
1441  {-# INLINE __TypeError #-}
1442
1443pattern TypeError__ e <- (preview __TypeError -> Just e) where
1444  TypeError__ e = review __TypeError e
1445
1446pattern TypeError_ e <- (preview _TypeError -> Just e) where
1447  TypeError_ e = review _TypeError e
1448#endif
1449
1450#if MIN_VERSION_base(4,10,0)
1451----------------------------------------------------------------------------
1452-- CompactionFailed
1453----------------------------------------------------------------------------
1454
1455-- | Compaction found an object that cannot be compacted.
1456-- Functions cannot be compacted, nor can mutable objects or pinned objects.
1457class AsCompactionFailed t where
1458  -- |
1459  -- @
1460  -- '__CompactionFailed' :: 'Prism'' 'CompactionFailed' 'CompactionFailed'
1461  -- '__CompactionFailed' :: 'Prism'' 'SomeException'    'CompactionFailed'
1462  -- @
1463  __CompactionFailed :: Prism' t CompactionFailed
1464
1465  -- | Information about why a compaction failed.
1466  --
1467  -- @
1468  -- '_CompactionFailed' :: 'Prism'' 'CompactionFailed' 'String'
1469  -- '_CompactionFailed' :: 'Prism'' 'SomeException'    'String'
1470  -- @
1471  _CompactionFailed :: Prism' t String
1472  _CompactionFailed = __CompactionFailed._CompactionFailed
1473  {-# INLINE _CompactionFailed #-}
1474
1475instance AsCompactionFailed CompactionFailed where
1476  __CompactionFailed = id
1477  {-# INLINE __CompactionFailed #-}
1478
1479  _CompactionFailed = _Wrapping CompactionFailed
1480  {-# INLINE _CompactionFailed #-}
1481
1482instance AsCompactionFailed SomeException where
1483  __CompactionFailed = exception
1484  {-# INLINE __CompactionFailed #-}
1485
1486pattern CompactionFailed__ e <- (preview __CompactionFailed -> Just e) where
1487  CompactionFailed__ e = review __CompactionFailed e
1488
1489pattern CompactionFailed_ e <- (preview _CompactionFailed -> Just e) where
1490  CompactionFailed_ e = review _CompactionFailed e
1491#endif
1492
1493------------------------------------------------------------------------------
1494-- HandlingException
1495------------------------------------------------------------------------------
1496
1497-- | This 'Exception' is thrown by @lens@ when the user somehow manages to rethrow
1498-- an internal 'HandlingException'.
1499class AsHandlingException t where
1500  -- |
1501  -- @
1502  -- '__HandlingException' :: 'Prism'' 'HandlingException' 'HandlingException'
1503  -- '__HandlingException' :: 'Prism'' 'SomeException'     'HandlingException'
1504  -- @
1505  __HandlingException :: Prism' t HandlingException
1506
1507  -- | There is no information carried in a 'HandlingException'.
1508  --
1509  -- @
1510  -- '_HandlingException' :: 'Prism'' 'HandlingException' ()
1511  -- '_HandlingException' :: 'Prism'' 'SomeException'     ()
1512  -- @
1513  _HandlingException :: Prism' t ()
1514  _HandlingException = __HandlingException._HandlingException
1515  {-# INLINE _HandlingException #-}
1516
1517instance AsHandlingException HandlingException where
1518  __HandlingException = id
1519  {-# INLINE __HandlingException #-}
1520
1521  _HandlingException = trivial HandlingException
1522  {-# INLINE _HandlingException #-}
1523
1524instance AsHandlingException SomeException where
1525  __HandlingException = exception
1526  {-# INLINE __HandlingException #-}
1527
1528#if __GLASGOW_HASKELL__ >= 710
1529pattern HandlingException__ e <- (preview __HandlingException -> Just e) where
1530  HandlingException__ e = review __HandlingException e
1531
1532pattern HandlingException_ <- (has _HandlingException -> True) where
1533  HandlingException_ = review _HandlingException ()
1534#endif
1535
1536------------------------------------------------------------------------------
1537-- Helper Functions
1538------------------------------------------------------------------------------
1539
1540trivial :: t -> Iso' t ()
1541trivial t = const () `iso` const t
1542
1543