module System.IO.SaferFileHandles.Internal where
import Control.Applicative ( (<$>) )
import Data.Function ( ($) )
import Data.Tuple ( uncurry )
import Data.Bool ( Bool(False, True) )
import Data.Char ( String )
import Data.Maybe ( Maybe(Nothing, Just) )
import System.IO.Error ( modifyIOError )
import GHC.IO.Exception ( ioe_handle )
import Data.Function.Unicode ( (∘) )
import Control.Monad.Trans ( MonadIO, liftIO )
import Control.Resource ( Resource, openResource, closeResource )
import qualified Control.Resource as R ( Handle )
import Control.Monad.Trans.Region ( RegionalHandle )
import Control.Monad.Trans.Region.Unsafe ( internalHandle )
import System.IO.ExplicitIOModes ( IOMode(..), RW, IO, FilePath )
import qualified System.IO.ExplicitIOModes as E
( Handle
, openFile
, openBinaryFile
, openTempFile
, openBinaryTempFile
#if MIN_VERSION_base(4,2,0)
, openTempFileWithDefaultPermissions
, openBinaryTempFileWithDefaultPermissions
#endif
, hClose
)
data File ioMode where
File ∷ Binary → FilePath → IOMode ioMode → File ioMode
TempFile ∷ Binary
→ FilePath
→ Template
#if MIN_VERSION_base(4,2,0)
→ DefaultPermissions
#endif
→ File RW
type Binary = Bool
type Template = String
#if MIN_VERSION_base(4,2,0)
type DefaultPermissions = Bool
#endif
instance Resource (File ioMode) where
data R.Handle (File ioMode) =
FileHandle { mbFilePath ∷ Maybe FilePath
, handle ∷ E.Handle ioMode
}
openResource (File isBinary filePath ioMode) =
FileHandle Nothing <$>
(if isBinary then E.openBinaryFile else E.openFile)
filePath ioMode
#if MIN_VERSION_base(4,2,0)
openResource (TempFile isBinary filePath template defaultPerms) = do
uncurry (FileHandle ∘ Just) <$>
(case (isBinary, defaultPerms) of
(False, False) → E.openTempFile
(True, False) → E.openBinaryTempFile
(False, True) → E.openTempFileWithDefaultPermissions
(True, True) → E.openBinaryTempFileWithDefaultPermissions
) filePath template
#else
openResource (TempFile isBinary filePath template) = do
uncurry (FileHandle ∘ Just) <$>
(if isBinary then E.openBinaryTempFile else E.openTempFile)
filePath template
#endif
closeResource = sanitizeIOError ∘ E.hClose ∘ handle
type RegionalFileHandle ioMode r = RegionalHandle (File ioMode) r
regularHandle ∷ RegionalFileHandle ioMode r → E.Handle ioMode
regularHandle = handle ∘ internalHandle
wrap ∷ MonadIO m
⇒ (E.Handle ioMode → IO α)
→ (RegionalFileHandle ioMode r → m α)
wrap f = \h → liftIO $ sanitizeIOError $ f (regularHandle h)
wrap2 ∷ MonadIO m
⇒ (E.Handle ioMode → β → IO α)
→ (RegionalFileHandle ioMode r → β → m α)
wrap2 f = \h y → liftIO $ sanitizeIOError $ f (regularHandle h) y
wrap3 ∷ MonadIO m
⇒ (E.Handle ioMode → γ → β → IO α)
→ (RegionalFileHandle ioMode r → γ → β → m α)
wrap3 f = \h z y → liftIO $ sanitizeIOError $ f (regularHandle h) z y
sanitizeIOError ∷ IO α → IO α
sanitizeIOError = modifyIOError $ \e -> e { ioe_handle = Nothing }