forked from kowainik/relude
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Exception.hs
81 lines (64 loc) 路 2.38 KB
/
Exception.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ViewPatterns #-}
{- |
Copyright: (c) 2016 Stephen Diehl
(c) 2016-2018 Serokell
(c) 2018-2019 Kowainik
License: MIT
Maintainer: Kowainik <xrom.xkov@gmail.com>
Re-exports most useful functionality from 'safe-exceptions'. Also
provides some functions to work with exceptions over 'MonadError'.
-}
module Relude.Exception
( module Control.Exception
, Bug (..)
, bug
, pattern Exc
) where
import Control.Exception (Exception (..), SomeException (..))
import Data.List ((++))
import GHC.Show (Show)
import GHC.Stack (CallStack, HasCallStack, callStack, prettyCallStack)
import Relude.Function ((.))
import Relude.Monad (Maybe (..))
import qualified Control.Exception as E (displayException, throw, toException)
{- | Type that represents exceptions used in cases when a particular codepath is
not meant to be ever executed, but happens to be executed anyway.
-}
data Bug = Bug SomeException CallStack
deriving (Show)
instance Exception Bug where
displayException (Bug e cStack) = E.displayException e ++ "\n"
++ prettyCallStack cStack
-- | Generate a pure value which, when forced, will throw the given exception
impureThrow :: Exception e => e -> a
impureThrow = E.throw . E.toException
-- | Generate a pure value which, when forced, will synchronously
-- throw the exception wrapped into 'Bug' data type.
bug :: (HasCallStack, Exception e) => e -> a
bug e = impureThrow (Bug (E.toException e) callStack)
{- | Pattern synonym to easy pattern matching on exceptions. So intead of
writing something like this:
@
isNonCriticalExc :: SomeException -> Bool
isNonCriticalExc e
| Just (_ :: NodeAttackedError) <- fromException e = True
| Just DialogUnexpected{} <- fromException e = True
| otherwise = False
@
you can use 'Exc' pattern synonym:
@
isNonCriticalExc :: SomeException -> Bool
isNonCriticalExc = \case
Exc (_ :: NodeAttackedError) -> True -- matching all exceptions of type 'NodeAttackedError'
Exc DialogUnexpected{} -> True
_ -> False
@
This pattern is bidirectional. You can use @Exc e@ instead of @toException e@.
-}
pattern Exc :: Exception e => e -> SomeException
pattern Exc e <- (fromException -> Just e)
where
Exc e = toException e