-- |
-- Module      :  HPath.IO.Errors
-- Copyright   :  © 2016 Julian Ospald
-- License     :  BSD3
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- Provides error handling.

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

module HPath.IO.Errors
  (
  -- * Types
    HPathIOException(..)
  , RecursiveFailureHint(..)

  -- * Exception identifiers
  , isSameFile
  , isDestinationInSource
  , isRecursiveFailure
  , isReadContentsFailed
  , isCreateDirFailed
  , isCopyFileFailed
  , isRecreateSymlinkFailed

  -- * Path based functions
  , throwFileDoesExist
  , throwDirDoesExist
  , throwSameFile
  , sameFile
  , throwDestinationInSource
  , doesFileExist
  , doesDirectoryExist
  , isWritable
  , canOpenDirectory

  -- * Error handling functions
  , catchErrno
  , rethrowErrnoAs
  , handleIOError
  , bracketeer
  , reactOnError
  )
  where


import Control.Applicative
  (
    (<$>)
  )
import Control.Exception
import Control.Monad
  (
    forM
  , when
  )
import Control.Monad.IfElse
  (
    whenM
  )
import Data.ByteString
  (
    ByteString
  )
import Data.ByteString.UTF8
  (
    toString
  )
import Data.Typeable
  (
    Typeable
  )
import Foreign.C.Error
  (
    getErrno
  , Errno
  )
import GHC.IO.Exception
  (
    IOErrorType
  )
import HPath
import HPath.Internal
  (
    Path(..)
  )
import {-# SOURCE #-} HPath.IO
  (
    canonicalizePath
  , toAbs
  )
import System.IO.Error
  (
    alreadyExistsErrorType
  , catchIOError
  , ioeGetErrorType
  , mkIOError
  )

import qualified System.Posix.Directory.ByteString as PFD
import System.Posix.Files.ByteString
  (
    fileAccess
  , getFileStatus
  )
import qualified System.Posix.Files.ByteString as PF


-- |Additional generic IO exceptions that the posix functions
-- do not provide.
data HPathIOException = SameFile ByteString ByteString
                      | DestinationInSource ByteString ByteString
                      | RecursiveFailure [(RecursiveFailureHint, IOException)]
  deriving (HPathIOException -> HPathIOException -> Bool
(HPathIOException -> HPathIOException -> Bool)
-> (HPathIOException -> HPathIOException -> Bool)
-> Eq HPathIOException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HPathIOException -> HPathIOException -> Bool
$c/= :: HPathIOException -> HPathIOException -> Bool
== :: HPathIOException -> HPathIOException -> Bool
$c== :: HPathIOException -> HPathIOException -> Bool
Eq, Int -> HPathIOException -> ShowS
[HPathIOException] -> ShowS
HPathIOException -> String
(Int -> HPathIOException -> ShowS)
-> (HPathIOException -> String)
-> ([HPathIOException] -> ShowS)
-> Show HPathIOException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HPathIOException] -> ShowS
$cshowList :: [HPathIOException] -> ShowS
show :: HPathIOException -> String
$cshow :: HPathIOException -> String
showsPrec :: Int -> HPathIOException -> ShowS
$cshowsPrec :: Int -> HPathIOException -> ShowS
Show, Typeable)


-- |A type for giving failure hints on recursive failure, which allows
-- to programmatically make choices without examining
-- the weakly typed I/O error attributes (like `ioeGetFileName`).
--
-- The first argument to the data constructor is always the
-- source and the second the destination.
data RecursiveFailureHint = ReadContentsFailed    ByteString ByteString
                          | CreateDirFailed       ByteString ByteString
                          | CopyFileFailed        ByteString ByteString
                          | RecreateSymlinkFailed ByteString ByteString
  deriving (RecursiveFailureHint -> RecursiveFailureHint -> Bool
(RecursiveFailureHint -> RecursiveFailureHint -> Bool)
-> (RecursiveFailureHint -> RecursiveFailureHint -> Bool)
-> Eq RecursiveFailureHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecursiveFailureHint -> RecursiveFailureHint -> Bool
$c/= :: RecursiveFailureHint -> RecursiveFailureHint -> Bool
== :: RecursiveFailureHint -> RecursiveFailureHint -> Bool
$c== :: RecursiveFailureHint -> RecursiveFailureHint -> Bool
Eq, Int -> RecursiveFailureHint -> ShowS
[RecursiveFailureHint] -> ShowS
RecursiveFailureHint -> String
(Int -> RecursiveFailureHint -> ShowS)
-> (RecursiveFailureHint -> String)
-> ([RecursiveFailureHint] -> ShowS)
-> Show RecursiveFailureHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecursiveFailureHint] -> ShowS
$cshowList :: [RecursiveFailureHint] -> ShowS
show :: RecursiveFailureHint -> String
$cshow :: RecursiveFailureHint -> String
showsPrec :: Int -> RecursiveFailureHint -> ShowS
$cshowsPrec :: Int -> RecursiveFailureHint -> ShowS
Show)


instance Exception HPathIOException


toConstr :: HPathIOException -> String
toConstr :: HPathIOException -> String
toConstr SameFile {}            = "SameFile"
toConstr DestinationInSource {} = "DestinationInSource"
toConstr RecursiveFailure {}    = "RecursiveFailure"





    -----------------------------
    --[ Exception identifiers ]--
    -----------------------------


isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool
isSameFile :: HPathIOException -> Bool
isSameFile ex :: HPathIOException
ex = HPathIOException -> String
toConstr (HPathIOException
ex :: HPathIOException) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HPathIOException -> String
toConstr SameFile :: ByteString -> ByteString -> HPathIOException
SameFile{}
isDestinationInSource :: HPathIOException -> Bool
isDestinationInSource ex :: HPathIOException
ex = HPathIOException -> String
toConstr (HPathIOException
ex :: HPathIOException) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HPathIOException -> String
toConstr DestinationInSource :: ByteString -> ByteString -> HPathIOException
DestinationInSource{}
isRecursiveFailure :: HPathIOException -> Bool
isRecursiveFailure ex :: HPathIOException
ex = HPathIOException -> String
toConstr (HPathIOException
ex :: HPathIOException) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HPathIOException -> String
toConstr RecursiveFailure :: [(RecursiveFailureHint, IOException)] -> HPathIOException
RecursiveFailure{}


isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool
isReadContentsFailed :: RecursiveFailureHint -> Bool
isReadContentsFailed ReadContentsFailed{} = Bool
True
isReadContentsFailed _ = Bool
False
isCreateDirFailed :: RecursiveFailureHint -> Bool
isCreateDirFailed CreateDirFailed{} = Bool
True
isCreateDirFailed _ = Bool
False
isCopyFileFailed :: RecursiveFailureHint -> Bool
isCopyFileFailed CopyFileFailed{} = Bool
True
isCopyFileFailed _ = Bool
False
isRecreateSymlinkFailed :: RecursiveFailureHint -> Bool
isRecreateSymlinkFailed RecreateSymlinkFailed{} = Bool
True
isRecreateSymlinkFailed _ = Bool
False





    ----------------------------
    --[ Path based functions ]--
    ----------------------------


-- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: Path b -> IO ()
throwFileDoesExist :: Path b -> IO ()
throwFileDoesExist fp :: Path b
fp@(MkPath bs :: ByteString
bs) =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path b -> IO Bool
forall b. Path b -> IO Bool
doesFileExist Path b
fp)
        (IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException -> IO ())
-> (Maybe String -> IOException) -> Maybe String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError
                     IOErrorType
alreadyExistsErrorType
                     "File already exists"
                     Maybe Handle
forall a. Maybe a
Nothing
                   (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bs))
        )


-- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: Path b -> IO ()
throwDirDoesExist :: Path b -> IO ()
throwDirDoesExist fp :: Path b
fp@(MkPath bs :: ByteString
bs) =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path b -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path b
fp)
        (IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException -> IO ())
-> (Maybe String -> IOException) -> Maybe String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError
                     IOErrorType
alreadyExistsErrorType
                     "Directory already exists"
                     Maybe Handle
forall a. Maybe a
Nothing
                   (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bs))
        )


-- |Uses `isSameFile` and throws `SameFile` if it returns True.
throwSameFile :: Path b1
              -> Path b2
              -> IO ()
throwSameFile :: Path b1 -> Path b2 -> IO ()
throwSameFile fp1 :: Path b1
fp1@(MkPath bs1 :: ByteString
bs1) fp2 :: Path b2
fp2@(MkPath bs2 :: ByteString
bs2) =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path b1 -> Path b2 -> IO Bool
forall b1 b2. Path b1 -> Path b2 -> IO Bool
sameFile Path b1
fp1 Path b2
fp2)
        (HPathIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HPathIOException -> IO ()) -> HPathIOException -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> HPathIOException
SameFile ByteString
bs1 ByteString
bs2)


-- |Check if the files are the same by examining device and file id.
-- This follows symbolic links.
sameFile :: Path b1 -> Path b2 -> IO Bool
sameFile :: Path b1 -> Path b2 -> IO Bool
sameFile (MkPath fp1 :: ByteString
fp1) (MkPath fp2 :: ByteString
fp2) =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    FileStatus
fs1 <- ByteString -> IO FileStatus
getFileStatus ByteString
fp1
    FileStatus
fs2 <- ByteString -> IO FileStatus
getFileStatus ByteString
fp2

    if ((FileStatus -> DeviceID
PF.deviceID FileStatus
fs1, FileStatus -> FileID
PF.fileID FileStatus
fs1) (DeviceID, FileID) -> (DeviceID, FileID) -> Bool
forall a. Eq a => a -> a -> Bool
==
        (FileStatus -> DeviceID
PF.deviceID FileStatus
fs2, FileStatus -> FileID
PF.fileID FileStatus
fs2))
      then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False


-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories
-- of the destination.
throwDestinationInSource :: Path b1 -- ^ source dir
                         -> Path b2 -- ^ full destination, @dirname dest@
                                    --   must exist
                         -> IO ()
throwDestinationInSource :: Path b1 -> Path b2 -> IO ()
throwDestinationInSource (MkPath sbs :: ByteString
sbs) dest :: Path b2
dest@(MkPath dbs :: ByteString
dbs) = do
  Path Abs
destAbs <- Path b2 -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
toAbs Path b2
dest
  Path Abs
dest'   <- (\x :: Path Abs
x -> Path Abs -> (Path Fn -> Path Abs) -> Maybe (Path Fn) -> Path Abs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Path Abs
x (\y :: Path Fn
y -> Path Abs
x Path Abs -> Path Fn -> Path Abs
forall r b. RelC r => Path b -> Path r -> Path b
</> Path Fn
y) (Maybe (Path Fn) -> Path Abs) -> Maybe (Path Fn) -> Path Abs
forall a b. (a -> b) -> a -> b
$ Path b2 -> Maybe (Path Fn)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Fn)
basename Path b2
dest)
             (Path Abs -> Path Abs) -> IO (Path Abs) -> IO (Path Abs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Abs -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
canonicalizePath (Path Abs -> IO (Path Abs)) -> Path Abs -> IO (Path Abs)
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs
dirname Path Abs
destAbs)
  [(DeviceID, FileID)]
dids <- [Path Abs]
-> (Path Abs -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Path Abs -> [Path Abs]
getAllParents Path Abs
dest') ((Path Abs -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)])
-> (Path Abs -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)]
forall a b. (a -> b) -> a -> b
$ \p :: Path Abs
p -> do
          FileStatus
fs <- ByteString -> IO FileStatus
PF.getSymbolicLinkStatus (Path Abs -> ByteString
fromAbs Path Abs
p)
          (DeviceID, FileID) -> IO (DeviceID, FileID)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> DeviceID
PF.deviceID FileStatus
fs, FileStatus -> FileID
PF.fileID FileStatus
fs)
  (DeviceID, FileID)
sid <- (FileStatus -> (DeviceID, FileID))
-> IO FileStatus -> IO (DeviceID, FileID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: FileStatus
x -> (FileStatus -> DeviceID
PF.deviceID FileStatus
x, FileStatus -> FileID
PF.fileID FileStatus
x))
              (IO FileStatus -> IO (DeviceID, FileID))
-> IO FileStatus -> IO (DeviceID, FileID)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO FileStatus
PF.getFileStatus ByteString
sbs
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((DeviceID, FileID) -> [(DeviceID, FileID)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (DeviceID, FileID)
sid [(DeviceID, FileID)]
dids)
       (HPathIOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HPathIOException -> IO ()) -> HPathIOException -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> HPathIOException
DestinationInSource ByteString
dbs ByteString
sbs)


-- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks.
doesFileExist :: Path b -> IO Bool
doesFileExist :: Path b -> IO Bool
doesFileExist (MkPath bs :: ByteString
bs) =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    FileStatus
fs  <- ByteString -> IO FileStatus
PF.getSymbolicLinkStatus ByteString
bs
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (FileStatus -> Bool) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
PF.isDirectory (FileStatus -> Bool) -> FileStatus -> Bool
forall a b. (a -> b) -> a -> b
$ FileStatus
fs


-- |Checks if the given file exists and is a directory.
-- Does not follow symlinks.
doesDirectoryExist :: Path b -> IO Bool
doesDirectoryExist :: Path b -> IO Bool
doesDirectoryExist (MkPath bs :: ByteString
bs) =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    FileStatus
fs  <- ByteString -> IO FileStatus
PF.getSymbolicLinkStatus ByteString
bs
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
PF.isDirectory FileStatus
fs


-- |Checks whether a file or folder is writable.
isWritable :: Path b -> IO Bool
isWritable :: Path b -> IO Bool
isWritable (MkPath bs :: ByteString
bs) =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
    ByteString -> Bool -> Bool -> Bool -> IO Bool
fileAccess ByteString
bs Bool
False Bool
True Bool
False


-- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: Path b -> IO Bool
canOpenDirectory :: Path b -> IO Bool
canOpenDirectory (MkPath bs :: ByteString
bs) =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    IO DirStream
-> (DirStream -> IO ()) -> (DirStream -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO DirStream
PFD.openDirStream ByteString
bs)
            DirStream -> IO ()
PFD.closeDirStream
            (\_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True




    --------------------------------
    --[ Error handling functions ]--
    --------------------------------


-- |Carries out an action, then checks if there is an IOException and
-- a specific errno. If so, then it carries out another action, otherwise
-- it rethrows the error.
catchErrno :: [Errno] -- ^ errno to catch
           -> IO a    -- ^ action to try, which can raise an IOException
           -> IO a    -- ^ action to carry out in case of an IOException and
                      --   if errno matches
           -> IO a
catchErrno :: [Errno] -> IO a -> IO a -> IO a
catchErrno en :: [Errno]
en a1 :: IO a
a1 a2 :: IO a
a2 =
  IO a -> (IOException -> IO a) -> IO a
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError IO a
a1 ((IOException -> IO a) -> IO a) -> (IOException -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \e :: IOException
e -> do
    Errno
errno <- IO Errno
getErrno
    if Errno
errno Errno -> [Errno] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Errno]
en
      then IO a
a2
      else IOException -> IO a
forall a. IOException -> IO a
ioError IOException
e


-- |Execute the given action and retrow IO exceptions as a new Exception
-- that have the given errno. If errno does not match the exception is rethrown
-- as is.
rethrowErrnoAs :: Exception e
               => [Errno]       -- ^ errno to catch
               -> e             -- ^ rethrow as if errno matches
               -> IO a          -- ^ action to try
               -> IO a
rethrowErrnoAs :: [Errno] -> e -> IO a -> IO a
rethrowErrnoAs en :: [Errno]
en fmex :: e
fmex action :: IO a
action = [Errno] -> IO a -> IO a -> IO a
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno]
en IO a
action (e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
fmex)



-- |Like `catchIOError`, with arguments swapped.
handleIOError :: (IOError -> IO a) -> IO a -> IO a
handleIOError :: (IOException -> IO a) -> IO a -> IO a
handleIOError = (IO a -> (IOException -> IO a) -> IO a)
-> (IOException -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (IOException -> IO a) -> IO a
forall a. IO a -> (IOException -> IO a) -> IO a
catchIOError


-- |Like `bracket`, but allows to have different clean-up
-- actions depending on whether the in-between computation
-- has raised an exception or not. 
bracketeer :: IO a        -- ^ computation to run first
           -> (a -> IO b) -- ^ computation to run last, when
                          --   no exception was raised
           -> (a -> IO b) -- ^ computation to run last,
                          --   when an exception was raised
           -> (a -> IO c) -- ^ computation to run in-between
           -> IO c
bracketeer :: IO a -> (a -> IO b) -> (a -> IO b) -> (a -> IO c) -> IO c
bracketeer before :: IO a
before after :: a -> IO b
after afterEx :: a -> IO b
afterEx thing :: a -> IO c
thing =
  ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
    a
a <- IO a
before
    c
r <- IO c -> IO c
forall a. IO a -> IO a
restore (a -> IO c
thing a
a) IO c -> IO b -> IO c
forall a b. IO a -> IO b -> IO a
`onException` a -> IO b
afterEx a
a
    b
_ <- a -> IO b
after a
a
    c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
r


reactOnError :: IO a
             -> [(IOErrorType, IO a)]      -- ^ reaction on IO errors
             -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
             -> IO a
reactOnError :: IO a -> [(IOErrorType, IO a)] -> [(HPathIOException, IO a)] -> IO a
reactOnError a :: IO a
a ios :: [(IOErrorType, IO a)]
ios fmios :: [(HPathIOException, IO a)]
fmios =
  IO a
a IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
`catches` [Handler a
iohandler, Handler a
fmiohandler]
  where
    iohandler :: Handler a
iohandler = (IOException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((IOException -> IO a) -> Handler a)
-> (IOException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$
      \(IOException
ex :: IOException) ->
         ((IOErrorType, IO a) -> IO a -> IO a)
-> IO a -> [(IOErrorType, IO a)] -> IO a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(t :: IOErrorType
t, a' :: IO a
a') y :: IO a
y -> if IOException -> IOErrorType
ioeGetErrorType IOException
ex IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
t
                                then IO a
a'
                                else IO a
y)
               (IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO IOException
ex)
               [(IOErrorType, IO a)]
ios
    fmiohandler :: Handler a
fmiohandler = (HPathIOException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((HPathIOException -> IO a) -> Handler a)
-> (HPathIOException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$
      \(HPathIOException
ex :: HPathIOException) ->
         ((HPathIOException, IO a) -> IO a -> IO a)
-> IO a -> [(HPathIOException, IO a)] -> IO a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(t :: HPathIOException
t, a' :: IO a
a') y :: IO a
y -> if HPathIOException -> String
toConstr HPathIOException
ex String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HPathIOException -> String
toConstr HPathIOException
t
                                then IO a
a'
                                else IO a
y)
               (HPathIOException -> IO a
forall e a. Exception e => e -> IO a
throwIO HPathIOException
ex)
               [(HPathIOException, IO a)]
fmios