-- Copyright 2021 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE ScopedTypeVariables #-}
-- | Utilities for exceptions.
module Util.Exceptions where
import qualified Control.Exception as Exception
import           Control.Monad (guard, void)
import qualified System.IO.Error as IO.Error


-- | If @op@ raised ENOENT, return Nothing.
ignoreEnoent :: IO a -> IO (Maybe a)
ignoreEnoent :: forall a. IO a -> IO (Maybe a)
ignoreEnoent = forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError IOError -> Bool
IO.Error.isDoesNotExistError

ignoreEnoent_ :: IO a -> IO ()
ignoreEnoent_ :: forall a. IO a -> IO ()
ignoreEnoent_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Maybe a)
ignoreEnoent

ignoreEOF :: IO a -> IO (Maybe a)
ignoreEOF :: forall a. IO a -> IO (Maybe a)
ignoreEOF = forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError IOError -> Bool
IO.Error.isEOFError

-- | Ignore all IO errors.  This is useful when you want to see if a file
-- exists, because some-file/x will not give ENOENT, but ENOTDIR, which is
-- probably isIllegalOperation.
ignoreIOError :: IO a -> IO (Maybe a)
ignoreIOError :: forall a. IO a -> IO (Maybe a)
ignoreIOError = forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError (\(IOError
_ :: IO.Error.IOError) -> Bool
True)

ignoreError :: Exception.Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError :: forall e a. Exception e => (e -> Bool) -> IO a -> IO (Maybe a)
ignoreError e -> Bool
ignore IO a
action = forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Exception.handleJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Bool
ignore)
    (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO a
action)

-- | 'Exception.try' specialized to IOError.
tryIO :: IO a -> IO (Either IO.Error.IOError a)
tryIO :: forall a. IO a -> IO (Either IOError a)
tryIO = forall e a. Exception e => IO a -> IO (Either e a)
Exception.try