1module Darcs.Util.Exception 2 ( firstJustIO 3 , catchall 4 , catchNonExistence 5 , clarifyErrors 6 , prettyException 7 , prettyError 8 , die 9 , handleOnly 10 , handleOnlyIOError 11 , ifIOError 12 , ifDoesNotExistError 13 ) where 14 15 16import Darcs.Prelude 17 18import Control.Exception 19 ( Exception(fromException) 20 , SomeException 21 , catch 22 , handle 23 , throwIO 24 ) 25import Data.Maybe ( isJust ) 26 27import System.Exit ( exitFailure ) 28import System.IO ( stderr, hPutStrLn ) 29import System.IO.Error 30 ( ioeGetErrorString 31 , ioeGetFileName 32 , isDoesNotExistError 33 , isUserError 34 ) 35 36import Darcs.Util.SignalHandler ( catchNonSignal ) 37 38catchall :: IO a 39 -> IO a 40 -> IO a 41a `catchall` b = a `catchNonSignal` (\_ -> b) 42 43catchNonExistence :: IO a -> a -> IO a 44catchNonExistence job nonexistval = 45 catch job $ 46 \e -> if isDoesNotExistError e then return nonexistval 47 else ioError e 48 49-- | The firstJustM returns the first Just entry in a list of monadic 50-- operations. This is close to `listToMaybe `fmap` sequence`, but the sequence 51-- operator evaluates all monadic members of the list before passing it along 52-- (i.e. sequence is strict). The firstJustM is lazy in that list member monads 53-- are only evaluated up to the point where the first Just entry is obtained. 54firstJustM :: Monad m 55 => [m (Maybe a)] 56 -> m (Maybe a) 57firstJustM [] = return Nothing 58firstJustM (e:es) = e >>= (\v -> if isJust v then return v else firstJustM es) 59 60 61-- | The firstJustIO is a slight modification to firstJustM: the entries in the 62-- list must be IO monad operations and the firstJustIO will silently turn any 63-- monad call that throws an exception into Nothing, basically causing it to be 64-- ignored. 65firstJustIO :: [IO (Maybe a)] 66 -> IO (Maybe a) 67firstJustIO = firstJustM . map (`catchall` return Nothing) 68 69 70clarifyErrors :: IO a 71 -> String 72 -> IO a 73clarifyErrors a e = a `catch` (\x -> die $ unlines [prettyException x,e]) 74 75prettyException :: SomeException 76 -> String 77prettyException e | Just ioe <- fromException e, isUserError ioe = ioeGetErrorString ioe 78prettyException e | Just ioe <- fromException e, isDoesNotExistError ioe = 79 case ioeGetFileName ioe of 80 Just f -> f ++ " does not exist" 81 Nothing -> show e 82prettyException e = show e 83 84 85prettyError :: IOError -> String 86prettyError e | isUserError e = ioeGetErrorString e 87 | otherwise = show e 88 89-- | Terminate the program with an error message. 90die :: String -> IO a 91die msg = hPutStrLn stderr msg >> exitFailure 92 93-- | Handle only actual IO exceptions i.e. not "user errors" e.g. those raised 94-- by calling 'fail'. 95-- 96-- We use 'fail' all over the place to signify erroneous conditions and we 97-- normally don't want to handle such errors. 98handleOnlyIOError :: IO a -> IO a -> IO a 99handleOnlyIOError = handleOnly (not . isUserError) 100 101-- | Like 'handleOnlyIOError' but restricted to returning a given value. 102ifIOError :: a -> IO a -> IO a 103ifIOError use_instead = handleOnlyIOError (return use_instead) 104 105-- | Like 'ifIOError' but restricted to handling non-existence. 106ifDoesNotExistError :: a -> IO a -> IO a 107ifDoesNotExistError use_instead = handleOnly isDoesNotExistError (return use_instead) 108 109-- | Handle only a those exceptions for which the predicate succeeds. 110handleOnly :: Exception e => (e -> Bool) -> IO a -> IO a -> IO a 111handleOnly pred handler = handle (\e -> if pred e then handler else throwIO e) 112