module Darcs.Util.Exception
    ( firstJustIO
    , catchall
    , catchNonExistence
    , clarifyErrors
    , prettyException
    , prettyError
    , die
    , handleOnly
    , handleOnlyIOError
    , ifIOError
    , ifDoesNotExistError
    ) where


import Darcs.Prelude

import Control.Exception
    ( Exception(fromException)
    , SomeException
    , catch
    , handle
    , throwIO
    )
import Data.Maybe ( isJust )

import System.Exit ( exitFailure )
import System.IO ( stderr, hPutStrLn )
import System.IO.Error
    ( ioeGetErrorString
    , ioeGetFileName
    , isDoesNotExistError
    , isUserError
    )

import Darcs.Util.SignalHandler ( catchNonSignal )

catchall :: IO a
         -> IO a
         -> IO a
IO a
a catchall :: IO a -> IO a -> IO a
`catchall` IO a
b = IO a
a IO a -> (SomeException -> IO a) -> IO a
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal` (\SomeException
_ -> IO a
b)

catchNonExistence :: IO a -> a -> IO a
catchNonExistence :: IO a -> a -> IO a
catchNonExistence IO a
job a
nonexistval =
    IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
job ((IOError -> IO a) -> IO a) -> (IOError -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
nonexistval
                                   else IOError -> IO a
forall a. IOError -> IO a
ioError IOError
e

-- | The firstJustM returns the first Just entry in a list of monadic
-- operations. This is close to `listToMaybe `fmap` sequence`, but the sequence
-- operator evaluates all monadic members of the list before passing it along
-- (i.e. sequence is strict). The firstJustM is lazy in that list member monads
-- are only evaluated up to the point where the first Just entry is obtained.
firstJustM :: Monad m
           => [m (Maybe a)]
           -> m (Maybe a)
firstJustM :: [m (Maybe a)] -> m (Maybe a)
firstJustM [] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
firstJustM (m (Maybe a)
e:[m (Maybe a)]
es) = m (Maybe a)
e m (Maybe a) -> (Maybe a -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Maybe a
v -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
v then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v else [m (Maybe a)] -> m (Maybe a)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [m (Maybe a)]
es)


-- | The firstJustIO is a slight modification to firstJustM: the entries in the
-- list must be IO monad operations and the firstJustIO will silently turn any
-- monad call that throws an exception into Nothing, basically causing it to be
-- ignored.
firstJustIO :: [IO (Maybe a)]
            -> IO (Maybe a)
firstJustIO :: [IO (Maybe a)] -> IO (Maybe a)
firstJustIO = [IO (Maybe a)] -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM ([IO (Maybe a)] -> IO (Maybe a))
-> ([IO (Maybe a)] -> [IO (Maybe a)])
-> [IO (Maybe a)]
-> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (Maybe a) -> IO (Maybe a)) -> [IO (Maybe a)] -> [IO (Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a)
forall a. IO a -> IO a -> IO a
`catchall` Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)


clarifyErrors :: IO a
              -> String
              -> IO a
clarifyErrors :: IO a -> String -> IO a
clarifyErrors IO a
a String
e = IO a
a IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\SomeException
x -> String -> IO a
forall a. String -> IO a
die (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [SomeException -> String
prettyException SomeException
x,String
e])

prettyException :: SomeException
                -> String
prettyException :: SomeException -> String
prettyException SomeException
e | Just IOError
ioe <- SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e, IOError -> Bool
isUserError IOError
ioe = IOError -> String
ioeGetErrorString IOError
ioe
prettyException SomeException
e | Just IOError
ioe <- SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e, IOError -> Bool
isDoesNotExistError IOError
ioe =
  case IOError -> Maybe String
ioeGetFileName IOError
ioe of
    Just String
f  -> String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist"
    Maybe String
Nothing -> SomeException -> String
forall a. Show a => a -> String
show SomeException
e
prettyException SomeException
e = SomeException -> String
forall a. Show a => a -> String
show SomeException
e


prettyError :: IOError -> String
prettyError :: IOError -> String
prettyError IOError
e | IOError -> Bool
isUserError IOError
e = IOError -> String
ioeGetErrorString IOError
e
              | Bool
otherwise = IOError -> String
forall a. Show a => a -> String
show IOError
e

-- | Terminate the program with an error message.
die :: String -> IO a
die :: String -> IO a
die String
msg = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure

-- | Handle only actual IO exceptions i.e. not "user errors" e.g. those raised
-- by calling 'fail'.
--
-- We use 'fail' all over the place to signify erroneous conditions and we
-- normally don't want to handle such errors.
handleOnlyIOError :: IO a -> IO a -> IO a
handleOnlyIOError :: IO a -> IO a -> IO a
handleOnlyIOError = (IOError -> Bool) -> IO a -> IO a -> IO a
forall e a. Exception e => (e -> Bool) -> IO a -> IO a -> IO a
handleOnly (Bool -> Bool
not (Bool -> Bool) -> (IOError -> Bool) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isUserError)

-- | Like 'handleOnlyIOError' but restricted to returning a given value.
ifIOError :: a -> IO a -> IO a
ifIOError :: a -> IO a -> IO a
ifIOError a
use_instead = IO a -> IO a -> IO a
forall a. IO a -> IO a -> IO a
handleOnlyIOError (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
use_instead)

-- | Like 'ifIOError' but restricted to handling non-existence.
ifDoesNotExistError :: a -> IO a -> IO a
ifDoesNotExistError :: a -> IO a -> IO a
ifDoesNotExistError a
use_instead = (IOError -> Bool) -> IO a -> IO a -> IO a
forall e a. Exception e => (e -> Bool) -> IO a -> IO a -> IO a
handleOnly IOError -> Bool
isDoesNotExistError (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
use_instead)

-- | Handle only a those exceptions for which the predicate succeeds.
handleOnly :: Exception e => (e -> Bool) -> IO a -> IO a -> IO a
handleOnly :: (e -> Bool) -> IO a -> IO a -> IO a
handleOnly e -> Bool
pred IO a
handler = (e -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\e
e -> if e -> Bool
pred e
e then IO a
handler else e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
e)