    {- Simple IO exception handling (and some more)
     -
     - Copyright 2011-2016 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_GHC -fno-warn-tabs #-}

    module Utility.Exception (
    	module X,
    	giveup,
    	catchBoolIO,
    	catchMaybeIO,
    	catchDefaultIO,
    	catchMsgIO,
    	catchIO,
    	tryIO,
    	bracketIO,
    	catchNonAsync,
    	tryNonAsync,
    	tryWhenExists,
    	catchIOErrorType,
    	IOErrorType(..),
    	catchPermissionDenied,
    ) where

    import Control.Monad.Catch as X hiding (Handler)
    import qualified Control.Monad.Catch as M
    import Control.Exception (IOException, AsyncException)
    import Control.Exception (SomeAsyncException)
    import Control.Monad
    import Control.Monad.IO.Class (liftIO, MonadIO)
    import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
    import GHC.IO.Exception (IOErrorType(..))

    import Utility.Data

    {- Like error, this throws an exception. Unlike error, if this exception
     - is not caught, it won't generate a backtrace. So use this for situations
     - where there's a problem that the user is excpected to see in some
     - circumstances. -}
    giveup :: [Char] -> a
    giveup :: forall a. [Char] -> a
    giveup = [Char] -> a
    forall a. [Char] -> a
    errorWithoutStackTrace

    {- Catches IO errors and returns a Bool -}
    catchBoolIO :: MonadCatch m => m Bool -> m Bool
    catchBoolIO :: forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
    catchBoolIO = Bool -> m Bool -> m Bool
    forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO Bool
    False

    {- Catches IO errors and returns a Maybe -}
    catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)
    catchMaybeIO :: forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
    catchMaybeIO m a
    a = Maybe a -> m (Maybe a) -> m (Maybe a)
    forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO Maybe a
    forall a. Maybe a
    Nothing (m (Maybe a) -> m (Maybe a)) -> m (Maybe a) -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ m a
    a m a -> (a -> m (Maybe a)) -> m (Maybe a)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Maybe a -> m (Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    Just)

    {- Catches IO errors and returns a default value. -}
    catchDefaultIO :: MonadCatch m => a -> m a -> m a
    catchDefaultIO :: forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO a
    def m a
    a = m a -> (IOException -> m a) -> m a
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (IOException -> m a) -> m a
    catchIO m a
    a (m a -> IOException -> m a
    forall a b. a -> b -> a
    const (m a -> IOException -> m a) -> m a -> IOException -> m a
    forall a b. (a -> b) -> a -> b
    $ a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    def)

    {- Catches IO errors and returns the error message. -}
    catchMsgIO :: MonadCatch m => m a -> m (Either String a)
    catchMsgIO :: forall (m :: * -> *) a. MonadCatch m => m a -> m (Either [Char] a)
    catchMsgIO m a
    a = do
    	v <- m a -> m (Either IOException a)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either IOException a)
    tryIO m a
    a
    	return $ either (Left . show) Right v

    {- catch specialized for IO errors only -}
    catchIO :: MonadCatch m => m a -> (IOException -> m a) -> m a
    catchIO :: forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (IOException -> m a) -> m a
    catchIO = m a -> (IOException -> m a) -> m a
    forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    m a -> (e -> m a) -> m a
    M.catch

    {- try specialized for IO errors only -}
    tryIO :: MonadCatch m => m a -> m (Either IOException a)
    tryIO :: forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either IOException a)
    tryIO = m a -> m (Either IOException a)
    forall (m :: * -> *) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    M.try

    {- bracket with setup and cleanup actions lifted to IO.
     -
     - Note that unlike catchIO and tryIO, this catches all exceptions. -}
    bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a
    bracketIO :: forall (m :: * -> *) v b a.
    (MonadMask m, MonadIO m) =>
    IO v -> (v -> IO b) -> (v -> m a) -> m a
    bracketIO IO v
    setup v -> IO b
    cleanup = m v -> (v -> m b) -> (v -> m a) -> m a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket (IO v -> m v
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO v
    setup) (IO b -> m b
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO b -> m b) -> (v -> IO b) -> v -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> IO b
    cleanup)

    {- Catches all exceptions except for async exceptions.
     - This is often better to use than catching them all, so that
     - ThreadKilled and UserInterrupt get through.
     -}
    catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
    catchNonAsync :: forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (SomeException -> m a) -> m a
    catchNonAsync m a
    a SomeException -> m a
    onerr = m a
    a m a -> [Handler m a] -> m a
    forall (f :: * -> *) (m :: * -> *) a.
    (HasCallStack, Foldable f, MonadCatch m) =>
    m a -> f (Handler m a) -> m a
    `catches`
    	[ (AsyncException -> m a) -> Handler m a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    M.Handler (\ (AsyncException
    e :: AsyncException) -> AsyncException -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM AsyncException
    e)
    	, (SomeAsyncException -> m a) -> Handler m a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    M.Handler (\ (SomeAsyncException
    e :: SomeAsyncException) -> SomeAsyncException -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM SomeAsyncException
    e)
    	, (SomeException -> m a) -> Handler m a
    forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
    M.Handler (\ (SomeException
    e :: SomeException) -> SomeException -> m a
    onerr SomeException
    e)
    	]

    tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
    tryNonAsync :: forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either SomeException a)
    tryNonAsync m a
    a = m (Either SomeException a)
    forall {a}. m (Either a a)
    go m (Either SomeException a)
    -> (SomeException -> m (Either SomeException a))
    -> m (Either SomeException a)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (SomeException -> m a) -> m a
    `catchNonAsync` (Either SomeException a -> m (Either SomeException a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either SomeException a -> m (Either SomeException a))
    -> (SomeException -> Either SomeException a)
    -> SomeException
    -> m (Either SomeException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> Either SomeException a
    forall a b. a -> Either a b
    Left)
      where
    	go :: m (Either a a)
    go = do
    		v <- m a
    a
    		return (Right v)

    {- Catches only DoesNotExist exceptions, and lets all others through. -}
    tryWhenExists :: MonadCatch m => m a -> m (Maybe a)
    tryWhenExists :: forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
    tryWhenExists m a
    a = do
    	v <- (IOException -> Maybe ()) -> m a -> m (Either () a)
    forall (m :: * -> *) e b a.
    (HasCallStack, MonadCatch m, Exception e) =>
    (e -> Maybe b) -> m a -> m (Either b a)
    tryJust (Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ())
    -> (IOException -> Bool) -> IOException -> Maybe ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOException -> Bool
    isDoesNotExistError) m a
    a
    	return (eitherToMaybe v)

    {- Catches only IO exceptions of a particular type.
     - Ie, use HardwareFault to catch disk IO errors. -}
    catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
    catchIOErrorType :: forall (m :: * -> *) a.
    MonadCatch m =>
    IOErrorType -> (IOException -> m a) -> m a -> m a
    catchIOErrorType IOErrorType
    errtype IOException -> m a
    onmatchingerr m a
    a = m a -> (IOException -> m a) -> m a
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (IOException -> m a) -> m a
    catchIO m a
    a IOException -> m a
    onlymatching
      where
    	onlymatching :: IOException -> m a
    onlymatching IOException
    e
    		| IOException -> IOErrorType
    ioeGetErrorType IOException
    e IOErrorType -> IOErrorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOErrorType
    errtype = IOException -> m a
    onmatchingerr IOException
    e
    		| Bool
    otherwise = IOException -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM IOException
    e

    catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a
    catchPermissionDenied :: forall (m :: * -> *) a.
    MonadCatch m =>
    (IOException -> m a) -> m a -> m a
    catchPermissionDenied = IOErrorType -> (IOException -> m a) -> m a -> m a
    forall (m :: * -> *) a.
    MonadCatch m =>
    IOErrorType -> (IOException -> m a) -> m a -> m a
    catchIOErrorType IOErrorType
    PermissionDenied