{-# LANGUAGE ScopedTypeVariables, CPP, ConstraintKinds #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}

-- | Extra functions for "Control.Exception".
--   These functions provide retrying, showing in the presence of exceptions,
--   and functions to catch\/ignore exceptions, including monomorphic (no 'Exception' context) versions.
--
--   If you want to use a safer set of exceptions see the
--   <https://hackage.haskell.org/package/safe-exceptions safe-exceptions> package.
module Control.Exception.Extra(
    module Control.Exception,
    Partial,
    retry, retryBool,
    errorWithoutStackTrace,
    showException, stringException,
    errorIO, assertIO,
    -- * Exception catching/ignoring
    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


-- | Fully evaluate an input String. If the String contains embedded exceptions it will produce @\<Exception\>@.
--
-- > stringException "test"                           == pure "test"
-- > stringException ("test" ++ undefined)            == pure "test<Exception>"
-- > stringException ("test" ++ undefined ++ "hello") == pure "test<Exception>"
-- > stringException ['t','e','s','t',undefined]      == pure "test<Exception>"
stringException :: String -> IO String
stringException :: String -> IO String
stringException String
x = do
    Either SomeException String
r <- forall a. IO a -> IO (Either SomeException a)
try_ forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> [a] -> b) -> [a] -> b
list [] (\Char
x String
xs -> Char
x seq :: forall a b. a -> b -> b
`seq` Char
xforall a. a -> [a] -> [a]
:String
xs) String
x
    case Either SomeException String
r of
        Left SomeException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"<Exception>"
        Right [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Right (Char
x:String
xs) -> (Char
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
stringException String
xs


-- | Show a value, but if the result contains exceptions, produce
--   @\<Exception\>@. Defined as @'stringException' . show@.
--   Particularly useful for printing exceptions to users, remembering that exceptions
--   can themselves contain undefined values.
showException :: Show e => e -> IO String
showException :: forall e. Show e => e -> IO String
showException = String -> IO String
stringException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


#if __GLASGOW_HASKELL__ < 800
-- | A variant of 'error' that does not produce a stack trace.
errorWithoutStackTrace :: String -> a
errorWithoutStackTrace = error
#endif


-- | Ignore any exceptions thrown by the action.
--
-- > ignore (print 1)    == print 1
-- > ignore (fail "die") == pure ()
ignore :: IO () -> IO ()
ignore :: IO () -> IO ()
ignore = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either SomeException a)
try_


-- | An 'IO' action that when evaluated calls 'error', in the 'IO' monad.
--   Note that while 'fail' in 'IO' raises an 'IOException', this function raises an 'ErrorCall' exception with a call stack.
--
-- > catch (errorIO "Hello") (\(ErrorCall x) -> pure x) == pure "Hello"
-- > seq (errorIO "foo") (print 1) == print 1
{-# NOINLINE errorIO #-} -- otherwise GHC 8.4.1 seems to get upset
errorIO :: Partial => String -> IO a
errorIO :: forall a. Partial => String -> IO a
errorIO String
x = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> a
error String
x

#if __GLASGOW_HASKELL__ < 800
withFrozenCallStack :: a -> a
withFrozenCallStack = id
#endif

-- | An 'IO' action that when evaluated calls 'assert' in the 'IO' monad, which throws an 'AssertionFailed' exception if the argument is 'False'.
--   With optimizations enabled (and @-fgnore-asserts@) this function ignores its argument and does nothing.
--
-- > catch (assertIO True  >> pure 1) (\(x :: AssertionFailed) -> pure 2) == pure 1
-- > seq (assertIO False) (print 1) == print 1
assertIO :: Partial => Bool -> IO ()
assertIO :: Partial => Bool -> IO ()
assertIO Bool
x = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. Partial => Bool -> a -> a
assert Bool
x ()

-- | Retry an operation at most /n/ times (/n/ must be positive).
--   If the operation fails the /n/th time it will throw that final exception.
--
-- > retry 1 (print "x")  == print "x"
-- > retry 3 (fail "die") == fail "die"
retry :: Int -> IO a -> IO a
retry :: forall a. Int -> IO a -> IO a
retry Int
i IO a
x | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Partial => String -> a
error String
"Control.Exception.Extra.retry: count must be 1 or more"
retry Int
i IO a
x = forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool (\(SomeException
e :: SomeException) -> Bool
True) Int
i IO a
x

-- | Retry an operation at most /n/ times (/n/ must be positive), while the exception value and type match a predicate.
--   If the operation fails the /n/th time it will throw that final exception.
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 forall a. Ord a => a -> a -> Bool
<= Int
0 = 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 <- 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
_ -> forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
retryBool e -> Bool
p (Int
iforall a. Num a => a -> a -> a
-Int
1) IO a
x
        Right a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v


-- | A version of 'catch' without the 'Exception' context, restricted to 'SomeException',
--   so catches all exceptions.
catch_ :: IO a -> (SomeException -> IO a) -> IO a
catch_ :: forall a. IO a -> (SomeException -> IO a) -> IO a
catch_ = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch

-- | Like 'catch_' but for 'catchJust'
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_ = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust

-- | Like 'catch_' but for 'handle'
handle_ :: (SomeException -> IO a) -> IO a -> IO a
handle_ :: forall a. (SomeException -> IO a) -> IO a -> IO a
handle_ = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle

-- | Like 'catch_' but for 'handleJust'
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_ = forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust

-- | Like 'catch_' but for 'try'
try_ :: IO a -> IO (Either SomeException a)
try_ :: forall a. IO a -> IO (Either SomeException a)
try_ = forall e a. Exception e => IO a -> IO (Either e a)
try

-- | Like 'catch_' but for 'tryJust'
tryJust_ :: (SomeException -> Maybe b) -> IO a -> IO (Either b a)
tryJust_ :: forall b a. (SomeException -> Maybe b) -> IO a -> IO (Either b a)
tryJust_ = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust

-- | Catch an exception if the predicate passes, then call the handler with the original exception.
--   As an example:
--
-- @
-- readFileExists x == catchBool isDoesNotExistError (readFile \"myfile\") (const $ pure \"\")
-- @
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 = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust (forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f) IO a
a e -> IO a
b

-- | Like 'catchBool' but for 'handle'.
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 = forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust (forall e. (e -> Bool) -> e -> Maybe e
bool e -> Bool
f) e -> IO a
a IO a
b

-- | Like 'catchBool' but for 'try'.
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 = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (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 forall a. a -> Maybe a
Just e
x else forall a. Maybe a
Nothing