{-# LANGUAGE ScopedTypeVariables, CPP, ConstraintKinds #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
module Control.Exception.Extra(
module Control.Exception,
Partial,
retry, retryBool,
errorWithoutStackTrace,
showException, stringException,
errorIO, assertIO,
ignore,
catch_, handle_, try_,
catchJust_, handleJust_, tryJust_,
catchBool, handleBool, tryBool
) where
#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack
#endif
import Control.Exception
import Control.Monad
import Data.List.Extra
import Data.Functor
import Partial
import Prelude
stringException :: String -> IO String
stringException :: String -> IO String
stringException String
x = do
Either SomeException String
r <- IO String -> IO (Either SomeException String)
forall a. IO a -> IO (Either SomeException a)
try_ (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> (Char -> String -> String) -> String -> String
forall b a. b -> (a -> [a] -> b) -> [a] -> b
list [] (\Char
x String
xs -> Char
x Char -> String -> String
forall a b. a -> b -> b
`seq` Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) String
x
case Either SomeException String
r of
Left SomeException
e -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"<Exception>"
Right [] -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Right (Char
x:String
xs) -> (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
stringException String
xs
showException :: Show e => e -> IO String
showException :: forall e. Show e => e -> IO String
showException = String -> IO String
stringException (String -> IO String) -> (e -> String) -> e -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show
#if __GLASGOW_HASKELL__ < 800
errorWithoutStackTrace :: String -> a
errorWithoutStackTrace = error
#endif
ignore :: IO () -> IO ()
ignore :: IO () -> IO ()
ignore = IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> (IO () -> IO (Either SomeException ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
try_
{-# NOINLINE errorIO #-}
errorIO :: Partial => String -> IO a
errorIO :: forall a. Partial => String -> IO a
errorIO String
x = (Partial => IO a) -> IO a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => IO a) -> IO a) -> (Partial => IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall a. a -> IO a
evaluate (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Partial => String -> a
error String
x
#if __GLASGOW_HASKELL__ < 800
withFrozenCallStack :: a -> a
withFrozenCallStack = id
#endif
assertIO :: Partial => Bool -> IO ()
assertIO :: Partial => Bool -> IO ()
assertIO Bool
x = (Partial => IO ()) -> IO ()
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => IO ()) -> IO ()) -> (Partial => IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> () -> ()
forall a. Partial => Bool -> a -> a
assert Bool
x ()
retry :: Int -> IO a -> IO a
retry :: forall a. Int -> IO a -> IO a
retry Int
i IO a
x | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> IO a
forall a. Partial => String -> a
error String
"Control.Exception.Extra.retry: count must be 1 or more"
retry Int
i IO a
x = (SomeException -> Bool) -> Int -> IO a -> IO a
forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool (\(SomeException
e :: SomeException) -> Bool
True) Int
i IO a
x
retryBool :: Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool :: forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool e -> Bool
p Int
i IO a
x | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> IO a
forall a. Partial => String -> a
error String
"Control.Exception.Extra.retryBool: count must be 1 or more"
retryBool e -> Bool
p Int
1 IO a
x = IO a
x
retryBool e -> Bool
p Int
i IO a
x = do
Either e a
res <- (e -> Bool) -> IO a -> IO (Either e a)
forall e a. Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryBool e -> Bool
p IO a
x
case Either e a
res of
Left e
_ -> (e -> Bool) -> Int -> IO a -> IO a
forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool e -> Bool
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) IO a
x
Right a
v -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
catch_ :: IO a -> (SomeException -> IO a) -> IO a
catch_ :: forall a. IO a -> (SomeException -> IO a) -> IO a
catch_ = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch
catchJust_ :: (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust_ :: forall b a.
(SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust_ = (SomeException -> Maybe b) -> IO a -> (b -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust
handle_ :: (SomeException -> IO a) -> IO a -> IO a
handle_ :: forall a. (SomeException -> IO a) -> IO a -> IO a
handle_ = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
handleJust_ :: (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust_ :: forall b a.
(SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust_ = (SomeException -> Maybe b) -> (b -> IO a) -> IO a -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust
try_ :: IO a -> IO (Either SomeException a)
try_ :: forall a. IO a -> IO (Either SomeException a)
try_ = IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try
tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a)
tryJust_ :: forall b a. (SomeException -> Maybe b) -> IO a -> IO (Either b a)
tryJust_ = (SomeException -> Maybe b) -> IO a -> IO (Either b a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust
catchBool :: Exception e => (e -> Bool) -> IO a -> (e -> IO a) -> IO a
catchBool :: forall e a.
Exception e =>
(e -> Bool) -> IO a -> (e -> IO a) -> IO a
catchBool e -> Bool
f IO a
a e -> IO a
b = (e -> Maybe e) -> IO a -> (e -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust ((e -> Bool) -> e -> Maybe e
forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f) IO a
a e -> IO a
b
handleBool :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO a
handleBool :: forall e a.
Exception e =>
(e -> Bool) -> (e -> IO a) -> IO a -> IO a
handleBool e -> Bool
f e -> IO a
a IO a
b = (e -> Maybe e) -> (e -> IO a) -> IO a -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust ((e -> Bool) -> e -> Maybe e
forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f) e -> IO a
a IO a
b
tryBool :: Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryBool :: forall e a. Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryBool e -> Bool
f IO a
a = (e -> Maybe e) -> IO a -> IO (Either e a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust ((e -> Bool) -> e -> Maybe e
forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f) IO a
a
bool :: (e -> Bool) -> (e -> Maybe e)
bool :: forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f e
x = if e -> Bool
f e
x then e -> Maybe e
forall a. a -> Maybe a
Just e
x else Maybe e
forall a. Maybe a
Nothing