{-# Language MultiParamTypeClasses #-}
module Darcs.Util.Exception
( firstJustIO
, catchall
, clarifyErrors
, prettyException
, prettyError
, die
) where
import Prelude ()
import Darcs.Prelude
import Control.Exception ( SomeException, Exception(fromException), catch )
import Data.Maybe ( isJust )
import System.Exit ( exitFailure )
import System.IO ( stderr, hPutStrLn )
import System.IO.Error ( isUserError, ioeGetErrorString
, isDoesNotExistError, ioeGetFileName )
import Darcs.Util.SignalHandler ( catchNonSignal )
catchall :: IO a
-> IO a
-> IO a
a :: IO a
a catchall :: IO a -> IO a -> IO a
`catchall` b :: IO a
b = IO a
a IO a -> (SomeException -> IO a) -> IO a
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchNonSignal` (\_ -> IO a
b)
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 (e :: m (Maybe a)
e:es :: [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
>>= (\v :: 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)
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 a :: IO a
a e :: 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` (\x :: 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 e :: SomeException
e | Just ioe :: 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 e :: SomeException
e | Just ioe :: 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 f :: String
f -> String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ " does not exist"
Nothing -> SomeException -> String
forall a. Show a => a -> String
show SomeException
e
prettyException e :: SomeException
e = SomeException -> String
forall a. Show a => a -> String
show SomeException
e
prettyError :: IOError -> String
prettyError :: IOError -> String
prettyError e :: 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
die :: String -> IO a
die :: String -> IO a
die msg :: 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