-- |
-- Module      :  System.Posix.RawFilePath.Directory.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 System.Posix.RawFilePath.Directory.Errors
  (
  -- * Types
    HPathIOException(..)
  , RecursiveFailureHint(..)

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

  -- * Path based functions
  , throwFileDoesExist
  , throwDirDoesExist
  , throwSameFile
  , sameFile
  , throwDestinationInSource

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


import Control.Applicative
  (
    (<$>)
  )
import Control.Exception.Safe hiding (handleIOError)
import Control.Monad
  (
    forM
  , when
  )
import Control.Monad.IfElse
  (
    whenM
  )
import Data.ByteString
  (
    ByteString
  )
import qualified Data.ByteString as BS
import Data.ByteString.UTF8
  (
    toString
  )
import Data.Typeable
  (
    Typeable
  )
import Foreign.C.Error
  (
    getErrno
  , Errno
  )
import GHC.IO.Exception
  (
    IOErrorType
  )
import {-# SOURCE #-} System.Posix.RawFilePath.Directory
  (
    canonicalizePath
  , toAbs
  , doesFileExist
  , doesDirectoryExist
  , isWritable
  , canOpenDirectory
  )
import System.IO.Error
  (
    alreadyExistsErrorType
  , ioeGetErrorType
  , mkIOError
  )
import System.Posix.FilePath
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 {}            = String
"SameFile"
toConstr DestinationInSource {} = String
"DestinationInSource"
toConstr RecursiveFailure {}    = String
"RecursiveFailure"





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


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


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





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


-- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: RawFilePath -> IO ()
throwFileDoesExist :: ByteString -> IO ()
throwFileDoesExist ByteString
bs =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (ByteString -> IO Bool
doesFileExist ByteString
bs)
        (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
                     String
"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 :: RawFilePath -> IO ()
throwDirDoesExist :: ByteString -> IO ()
throwDirDoesExist ByteString
bs =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (ByteString -> IO Bool
doesDirectoryExist ByteString
bs)
        (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
                     String
"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 :: RawFilePath
              -> RawFilePath
              -> IO ()
throwSameFile :: ByteString -> ByteString -> IO ()
throwSameFile ByteString
bs1 ByteString
bs2 =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (ByteString -> ByteString -> IO Bool
sameFile ByteString
bs1 ByteString
bs2)
        (HPathIOException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m 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 :: RawFilePath -> RawFilePath -> IO Bool
sameFile :: ByteString -> ByteString -> IO Bool
sameFile ByteString
fp1 ByteString
fp2 =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIOError (\IOException
_ -> 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 :: RawFilePath -- ^ source dir
                         -> RawFilePath -- ^ full destination, @dirname dest@
                                        --   must exist
                         -> IO ()
throwDestinationInSource :: ByteString -> ByteString -> IO ()
throwDestinationInSource ByteString
sbs ByteString
dbs = do
  ByteString
destAbs <- ByteString -> IO ByteString
toAbs ByteString
dbs
  ByteString
dest'   <- (\ByteString
x -> ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
x (\ByteString
y -> ByteString
x ByteString -> ByteString -> ByteString
</> ByteString
y) (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
basename ByteString
dbs)
             (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> IO ByteString
canonicalizePath (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
takeDirectory ByteString
destAbs)
  [(DeviceID, FileID)]
dids <- [ByteString]
-> (ByteString -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ByteString -> [ByteString]
takeAllParents ByteString
dest') ((ByteString -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)])
-> (ByteString -> IO (DeviceID, FileID)) -> IO [(DeviceID, FileID)]
forall a b. (a -> b) -> a -> b
$ \ByteString
p -> do
          FileStatus
fs <- ByteString -> IO FileStatus
PF.getSymbolicLinkStatus ByteString
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 (\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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (HPathIOException -> IO ()) -> HPathIOException -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> HPathIOException
DestinationInSource ByteString
dbs ByteString
sbs)
  where
    basename :: ByteString -> Maybe ByteString
basename ByteString
x = let b :: ByteString
b = ByteString -> ByteString
takeBaseName ByteString
x
                 in if ByteString -> Bool
BS.null ByteString
b then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b



    --------------------------------
    --[ 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 [Errno]
en IO a
a1 IO a
a2 =
  IO a -> (IOException -> IO a) -> IO a
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
catchIOError IO a
a1 ((IOException -> IO a) -> IO a) -> (IOException -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \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 [Errno]
en e
fmex 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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m 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 (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
catchIOError


hideError :: IOErrorType -> IO () -> IO ()
hideError :: IOErrorType -> IO () -> IO ()
hideError IOErrorType
err = (IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOErrorType
err IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOException -> IOErrorType
ioeGetErrorType IOException
e then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)


-- |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 IO a
before a -> IO b
after a -> IO b
afterEx a -> IO c
thing =
  ((forall a. IO a -> IO a) -> IO c) -> IO c
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m 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
$ \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 (m :: * -> *) a b. MonadMask m => m a -> m b -> m 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 IO a
a [(IOErrorType, IO a)]
ios [(HPathIOException, IO a)]
fmios =
  IO a
a IO a -> [Handler IO a] -> IO a
forall (m :: * -> *) a.
(MonadCatch m, MonadThrow m) =>
m a -> [Handler m a] -> m a
`catches` [Handler IO a
iohandler, Handler IO a
fmiohandler]
  where
    iohandler :: Handler IO a
iohandler = (IOException -> IO a) -> Handler IO a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((IOException -> IO a) -> Handler IO a)
-> (IOException -> IO a) -> Handler IO 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 (\(IOErrorType
t, IO a
a') 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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
ex)
               [(IOErrorType, IO a)]
ios
    fmiohandler :: Handler IO a
fmiohandler = (HPathIOException -> IO a) -> Handler IO a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((HPathIOException -> IO a) -> Handler IO a)
-> (HPathIOException -> IO a) -> Handler IO 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 (\(HPathIOException
t, IO a
a') 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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO HPathIOException
ex)
               [(HPathIOException, IO a)]
fmios