diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for file-io +## 0.1.2 -- 2024-05-27 + +* expose internals via `.Internal` modules +* add `openFileWithCloseOnExec` and `openExistingFileWithCloseOnExec` to `.Internal` modules wrt [#21](https://github.com/hasufell/file-io/issues/21) + ## 0.1.1 -- 2024-01-20 * fix a severe bug on windows, where `readFile` may create a missing file, wrt [#14](https://github.com/hasufell/file-io/issues/14) diff --git a/System/File/OsPath.hs b/System/File/OsPath.hs --- a/System/File/OsPath.hs +++ b/System/File/OsPath.hs @@ -1,6 +1,14 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE BangPatterns #-} +{- | +Module : System.File.OsPath +Copyright : (c) Julian Ospald 2023-2024 +License : BSD3 +Maintainer : hasufell@posteo.de +Stability : stable +Portability : portable + +This module mimics base API wrt file IO, but using 'OsPath'. +-} module System.File.OsPath ( openBinaryFile , withFile @@ -18,154 +26,6 @@ ) where -import qualified System.File.Platform as P - -import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=)) -import GHC.IO (catchException) -import GHC.IO.Exception (IOException(..)) -import GHC.IO.Handle (hClose_help) -import GHC.IO.Handle.Internals (debugIO) -import GHC.IO.Handle.Types (Handle__, Handle(..)) -import Control.Concurrent.MVar -import Control.Monad (void, when) -import Control.DeepSeq (force) -import Control.Exception (SomeException, try, evaluate, mask, onException) -import System.IO (IOMode(..), hSetBinaryMode, hClose) -import System.IO.Unsafe (unsafePerformIO) -import System.OsPath as OSP -import System.OsString.Internal.Types - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL - --- | Like 'openFile', but open the file in binary mode. --- On Windows, reading a file in text mode (which is the default) --- will translate CRLF to LF, and writing will translate LF to CRLF. --- This is usually what you want with text files. With binary files --- this is undesirable; also, as usual under Microsoft operating systems, --- text mode treats control-Z as EOF. Binary mode turns off all special --- treatment of end-of-line and end-of-file characters. --- (See also 'System.IO.hSetBinaryMode'.) - --- On POSIX systems, 'openBinaryFile' is an /interruptible operation/ as --- described in "Control.Exception". -openBinaryFile :: OsPath -> IOMode -> IO Handle -openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $ withOpenFile' osfp iomode True False pure False - - --- | Run an action on a file. --- --- The 'Handle' is automatically closed afther the action. -withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withFile osfp iomode act = (augmentError "withFile" osfp - $ withOpenFile' osfp iomode False False (try . act) True) - >>= either ioError pure - -withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp - $ withOpenFile' osfp iomode True False (try . act) True) - >>= either ioError pure - --- | Run an action on a file. --- --- The 'Handle' is not automatically closed to allow lazy IO. Use this --- with caution. -withFile' - :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withFile' osfp iomode act = (augmentError "withFile'" osfp - $ withOpenFile' osfp iomode False False (try . act) False) - >>= either ioError pure - -withBinaryFile' - :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile' osfp iomode act = (augmentError "withBinaryFile'" osfp - $ withOpenFile' osfp iomode True False (try . act) False) - >>= either ioError pure - --- | The 'readFile' function reads a file and returns the contents of the file --- as a 'ByteString'. The file is read lazily, on demand. -readFile :: OsPath -> IO BSL.ByteString -readFile fp = withFile' fp ReadMode BSL.hGetContents - --- | The 'readFile'' function reads a file and returns the contents of the file --- as a 'ByteString'. The file is fully read before being returned. -readFile' - :: OsPath -> IO BS.ByteString -readFile' fp = withFile fp ReadMode BS.hGetContents - --- | The computation 'writeFile' @file str@ function writes the lazy 'ByteString' @str@, --- to the file @file@. -writeFile :: OsPath -> BSL.ByteString -> IO () -writeFile fp contents = withFile fp WriteMode (`BSL.hPut` contents) - --- | The computation 'writeFile' @file str@ function writes the strict 'ByteString' @str@, --- to the file @file@. -writeFile' - :: OsPath -> BS.ByteString -> IO () -writeFile' fp contents = withFile fp WriteMode (`BS.hPut` contents) - --- | The computation 'appendFile' @file str@ function appends the lazy 'ByteString' @str@, --- to the file @file@. -appendFile :: OsPath -> BSL.ByteString -> IO () -appendFile fp contents = withFile fp AppendMode (`BSL.hPut` contents) - --- | The computation 'appendFile' @file str@ function appends the strict 'ByteString' @str@, --- to the file @file@. -appendFile' - :: OsPath -> BS.ByteString -> IO () -appendFile' fp contents = withFile fp AppendMode (`BS.hPut` contents) - --- | Open a file and return the 'Handle'. -openFile :: OsPath -> IOMode -> IO Handle -openFile osfp iomode = augmentError "openFile" osfp $ withOpenFile' osfp iomode False False pure False - - --- | Open an existing file and return the 'Handle'. -openExistingFile :: OsPath -> IOMode -> IO Handle -openExistingFile osfp iomode = augmentError "openExistingFile" osfp $ withOpenFile' osfp iomode False True pure False - - --- --------------------------------------------------------------------------- --- Internals - -handleFinalizer :: FilePath -> MVar Handle__ -> IO () -handleFinalizer _fp m = do - handle_ <- takeMVar m - (handle_', _) <- hClose_help handle_ - putMVar m handle_' - return () - -type HandleFinalizer = FilePath -> MVar Handle__ -> IO () - --- | Add a finalizer to a 'Handle'. Specifically, the finalizer --- will be added to the 'MVar' of a file handle or the write-side --- 'MVar' of a duplex handle. See Handle Finalizers for details. -addHandleFinalizer :: Handle -> HandleFinalizer -> IO () -addHandleFinalizer hndl finalizer = do - debugIO $ "Registering finalizer: " ++ show filepath - void $ mkWeakMVar mv (finalizer filepath mv) - where - !(filepath, !mv) = case hndl of - FileHandle fp m -> (fp, m) - DuplexHandle fp _ write_m -> (fp, write_m) - -withOpenFile' :: OsPath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r -withOpenFile' (OsString fp) iomode binary existing action close_finally = mask $ \restore -> do - hndl <- if existing - then P.openExistingFile fp iomode - else P.openFile fp iomode - addHandleFinalizer hndl handleFinalizer - when binary $ hSetBinaryMode hndl True - r <- restore (action hndl) `onException` hClose hndl - when close_finally $ hClose hndl - pure r - -addFilePathToIOError :: String -> OsPath -> IOException -> IOException -addFilePathToIOError fun fp ioe = unsafePerformIO $ do - fp' <- either (const (fmap OSP.toChar . OSP.unpack $ fp)) id <$> try @SomeException (OSP.decodeFS fp) - fp'' <- evaluate $ force fp' - pure $ ioe{ ioe_location = fun, ioe_filename = Just fp'' } - -augmentError :: String -> OsPath -> IO a -> IO a -augmentError str osfp = flip catchException (ioError . addFilePathToIOError str osfp) +import System.File.OsPath.Internal +import Prelude () diff --git a/System/File/OsPath/Internal.hs b/System/File/OsPath/Internal.hs new file mode 100644 --- /dev/null +++ b/System/File/OsPath/Internal.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BangPatterns #-} + +module System.File.OsPath.Internal where + + +import qualified System.File.Platform as P + +import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=)) +import GHC.IO (catchException) +import GHC.IO.Exception (IOException(..)) +import GHC.IO.Handle (hClose_help) +import GHC.IO.Handle.Internals (debugIO) +import GHC.IO.Handle.Types (Handle__, Handle(..)) +import Control.Concurrent.MVar +import Control.Monad (void, when) +import Control.DeepSeq (force) +import Control.Exception (SomeException, try, evaluate, mask, onException) +import System.IO (IOMode(..), hSetBinaryMode, hClose) +import System.IO.Unsafe (unsafePerformIO) +import System.OsPath as OSP +import System.OsString.Internal.Types + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL + +-- | Like 'openFile', but open the file in binary mode. +-- On Windows, reading a file in text mode (which is the default) +-- will translate CRLF to LF, and writing will translate LF to CRLF. +-- This is usually what you want with text files. With binary files +-- this is undesirable; also, as usual under Microsoft operating systems, +-- text mode treats control-Z as EOF. Binary mode turns off all special +-- treatment of end-of-line and end-of-file characters. +-- (See also 'System.IO.hSetBinaryMode'.) + +-- On POSIX systems, 'openBinaryFile' is an /interruptible operation/ as +-- described in "Control.Exception". +openBinaryFile :: OsPath -> IOMode -> IO Handle +openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $ withOpenFile' osfp iomode True False False pure False + + +-- | Run an action on a file. +-- +-- The 'Handle' is automatically closed afther the action. +withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile osfp iomode act = (augmentError "withFile" osfp + $ withOpenFile' osfp iomode False False False (try . act) True) + >>= either ioError pure + +withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp + $ withOpenFile' osfp iomode True False False (try . act) True) + >>= either ioError pure + +-- | Run an action on a file. +-- +-- The 'Handle' is not automatically closed to allow lazy IO. Use this +-- with caution. +withFile' + :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile' osfp iomode act = (augmentError "withFile'" osfp + $ withOpenFile' osfp iomode False False False (try . act) False) + >>= either ioError pure + +withBinaryFile' + :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile' osfp iomode act = (augmentError "withBinaryFile'" osfp + $ withOpenFile' osfp iomode True False False (try . act) False) + >>= either ioError pure + +-- | The 'readFile' function reads a file and returns the contents of the file +-- as a 'ByteString'. The file is read lazily, on demand. +readFile :: OsPath -> IO BSL.ByteString +readFile fp = withFile' fp ReadMode BSL.hGetContents + +-- | The 'readFile'' function reads a file and returns the contents of the file +-- as a 'ByteString'. The file is fully read before being returned. +readFile' + :: OsPath -> IO BS.ByteString +readFile' fp = withFile fp ReadMode BS.hGetContents + +-- | The computation 'writeFile' @file str@ function writes the lazy 'ByteString' @str@, +-- to the file @file@. +writeFile :: OsPath -> BSL.ByteString -> IO () +writeFile fp contents = withFile fp WriteMode (`BSL.hPut` contents) + +-- | The computation 'writeFile' @file str@ function writes the strict 'ByteString' @str@, +-- to the file @file@. +writeFile' + :: OsPath -> BS.ByteString -> IO () +writeFile' fp contents = withFile fp WriteMode (`BS.hPut` contents) + +-- | The computation 'appendFile' @file str@ function appends the lazy 'ByteString' @str@, +-- to the file @file@. +appendFile :: OsPath -> BSL.ByteString -> IO () +appendFile fp contents = withFile fp AppendMode (`BSL.hPut` contents) + +-- | The computation 'appendFile' @file str@ function appends the strict 'ByteString' @str@, +-- to the file @file@. +appendFile' + :: OsPath -> BS.ByteString -> IO () +appendFile' fp contents = withFile fp AppendMode (`BS.hPut` contents) + +-- | Open a file and return the 'Handle'. +openFile :: OsPath -> IOMode -> IO Handle +openFile osfp iomode = augmentError "openFile" osfp $ withOpenFile' osfp iomode False False False pure False + + +-- | Open an existing file and return the 'Handle'. +openExistingFile :: OsPath -> IOMode -> IO Handle +openExistingFile osfp iomode = augmentError "openExistingFile" osfp $ withOpenFile' osfp iomode False True False pure False + +-- | Open a file and return the 'Handle'. +-- +-- Sets @O_CLOEXEC@ on posix. +-- +-- @since 0.1.2 +openFileWithCloseOnExec :: OsPath -> IOMode -> IO Handle +openFileWithCloseOnExec osfp iomode = augmentError "openFileWithCloseOnExec" osfp $ withOpenFile' osfp iomode False False True pure False + + +-- | Open an existing file and return the 'Handle'. +-- +-- Sets @O_CLOEXEC@ on posix. +-- +-- @since 0.1.2 +openExistingFileWithCloseOnExec :: OsPath -> IOMode -> IO Handle +openExistingFileWithCloseOnExec osfp iomode = augmentError "openExistingFileWithCloseOnExec" osfp $ withOpenFile' osfp iomode False True True pure False + +-- --------------------------------------------------------------------------- +-- Internals + +handleFinalizer :: FilePath -> MVar Handle__ -> IO () +handleFinalizer _fp m = do + handle_ <- takeMVar m + (handle_', _) <- hClose_help handle_ + putMVar m handle_' + return () + +type HandleFinalizer = FilePath -> MVar Handle__ -> IO () + +-- | Add a finalizer to a 'Handle'. Specifically, the finalizer +-- will be added to the 'MVar' of a file handle or the write-side +-- 'MVar' of a duplex handle. See Handle Finalizers for details. +addHandleFinalizer :: Handle -> HandleFinalizer -> IO () +addHandleFinalizer hndl finalizer = do + debugIO $ "Registering finalizer: " ++ show filepath + void $ mkWeakMVar mv (finalizer filepath mv) + where + !(filepath, !mv) = case hndl of + FileHandle fp m -> (fp, m) + DuplexHandle fp _ write_m -> (fp, write_m) + +withOpenFile' :: OsPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r +withOpenFile' (OsString fp) iomode binary existing cloExec action close_finally = mask $ \restore -> do + hndl <- case (existing, cloExec) of + (True, False) -> P.openExistingFile fp iomode + (False, False) -> P.openFile fp iomode + (True, True) -> P.openExistingFileWithCloseOnExec fp iomode + (False, True) -> P.openFileWithCloseOnExec fp iomode + addHandleFinalizer hndl handleFinalizer + when binary $ hSetBinaryMode hndl True + r <- restore (action hndl) `onException` hClose hndl + when close_finally $ hClose hndl + pure r + +addFilePathToIOError :: String -> OsPath -> IOException -> IOException +addFilePathToIOError fun fp ioe = unsafePerformIO $ do + fp' <- either (const (fmap OSP.toChar . OSP.unpack $ fp)) id <$> try @SomeException (OSP.decodeFS fp) + fp'' <- evaluate $ force fp' + pure $ ioe{ ioe_location = fun, ioe_filename = Just fp'' } + +augmentError :: String -> OsPath -> IO a -> IO a +augmentError str osfp = flip catchException (ioError . addFilePathToIOError str osfp) + diff --git a/System/File/PlatformPath.hs b/System/File/PlatformPath.hs --- a/System/File/PlatformPath.hs +++ b/System/File/PlatformPath.hs @@ -1,65 +1,33 @@ -module System.File.PlatformPath where - - -import System.IO (IOMode(..), Handle) -import System.OsPath.Types - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BSL - -import qualified System.File.OsPath as OsPath -import System.OsString.Internal.Types - -import Data.Coerce (coerce) - --- | Like `OsPath.openBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`. -openBinaryFile :: PlatformPath -> IOMode -> IO Handle -openBinaryFile = OsPath.openBinaryFile . coerce - --- | Like `OsPath.withFile`, but takes a `PlatformPath` instead of an `OsPath`. -withFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r -withFile = OsPath.withFile . coerce - --- | Like `OsPath.withBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`. -withBinaryFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile = OsPath.withBinaryFile . coerce - --- | Like `OsPath.withFile'`, but takes a `PlatformPath` instead of an `OsPath`. -withFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r -withFile' = OsPath.withFile' . coerce - --- | Like `OsPath.withBinaryFile'`, but takes a `PlatformPath` instead of an `OsPath`. -withBinaryFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile' = OsPath.withBinaryFile' . coerce - --- | Like `OsPath.readFile`, but takes a `PlatformPath` instead of an `OsPath`. -readFile :: PlatformPath -> IO BSL.ByteString -readFile = OsPath.readFile . coerce - --- | Like `OsPath.readFile'`, but takes a `PlatformPath` instead of an `OsPath`. -readFile' :: PlatformPath -> IO BS.ByteString -readFile' = OsPath.readFile' . coerce - --- | Like `OsPath.writeFile`, but takes a `PlatformPath` instead of an `OsPath`. -writeFile :: PlatformPath -> BSL.ByteString -> IO () -writeFile = OsPath.writeFile . coerce +{- | +Module : System.File.PlatformPath +Copyright : (c) Julian Ospald 2023-2024 +License : BSD3 --- | Like `OsPath.writeFile'`, but takes a `PlatformPath` instead of an `OsPath`. -writeFile' :: PlatformPath -> BS.ByteString -> IO () -writeFile' = OsPath.writeFile' . coerce +Maintainer : hasufell@posteo.de +Stability : stable +Portability : portable --- | Like `OsPath.appendFile`, but takes a `PlatformPath` instead of an `OsPath`. -appendFile :: PlatformPath -> BSL.ByteString -> IO () -appendFile = OsPath.appendFile . coerce +This module is only interesting when you are implementing low-level libraries +based on 'OsPath' API. --- | Like `OsPath.appendFile'`, but takes a `PlatformPath` instead of an `OsPath`. -appendFile' :: PlatformPath -> BS.ByteString -> IO () -appendFile' = OsPath.appendFile' . coerce +Usually you want "System.File.OsPath". +-} +module System.File.PlatformPath ( + openBinaryFile +, withFile +, withBinaryFile +, withFile' +, withBinaryFile' +, readFile +, readFile' +, writeFile +, writeFile' +, appendFile +, appendFile' +, openFile +, openExistingFile +) where --- | Like `OsPath.openFile`, but takes a `PlatformPath` instead of an `OsPath`. -openFile :: PlatformPath -> IOMode -> IO Handle -openFile = OsPath.openFile . coerce +import System.File.PlatformPath.Internal +import Prelude () --- | Like `OsPath.openExistingFile`, but takes a `PlatformPath` instead of an `OsPath`. -openExistingFile :: PlatformPath -> IOMode -> IO Handle -openExistingFile = OsPath.openExistingFile . coerce diff --git a/System/File/PlatformPath/Internal.hs b/System/File/PlatformPath/Internal.hs new file mode 100644 --- /dev/null +++ b/System/File/PlatformPath/Internal.hs @@ -0,0 +1,118 @@ +module System.File.PlatformPath.Internal ( + openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' + , readFile + , readFile' + , writeFile + , writeFile' + , appendFile + , appendFile' + , openFile + , openExistingFile + , openFileWithCloseOnExec + , openExistingFileWithCloseOnExec + , OsPath.handleFinalizer + , OsPath.HandleFinalizer + , OsPath.addHandleFinalizer + , withOpenFile' + , addFilePathToIOError + , augmentError +) where + + +import System.IO (IOMode(..), Handle) +import System.OsPath.Types +import GHC.IO.Exception (IOException(..)) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL + +import qualified System.File.OsPath.Internal as OsPath +import System.OsString.Internal.Types + +import Data.Coerce (coerce) +import Prelude hiding (readFile, writeFile, appendFile) + +-- | Like `OsPath.openBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`. +openBinaryFile :: PlatformPath -> IOMode -> IO Handle +openBinaryFile = OsPath.openBinaryFile . coerce + +-- | Like `OsPath.withFile`, but takes a `PlatformPath` instead of an `OsPath`. +withFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r +withFile = OsPath.withFile . coerce + +-- | Like `OsPath.withBinaryFile`, but takes a `PlatformPath` instead of an `OsPath`. +withBinaryFile :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile = OsPath.withBinaryFile . coerce + +-- | Like `OsPath.withFile'`, but takes a `PlatformPath` instead of an `OsPath`. +withFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r +withFile' = OsPath.withFile' . coerce + +-- | Like `OsPath.withBinaryFile'`, but takes a `PlatformPath` instead of an `OsPath`. +withBinaryFile' :: PlatformPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile' = OsPath.withBinaryFile' . coerce + +-- | Like `OsPath.readFile`, but takes a `PlatformPath` instead of an `OsPath`. +readFile :: PlatformPath -> IO BSL.ByteString +readFile = OsPath.readFile . coerce + +-- | Like `OsPath.readFile'`, but takes a `PlatformPath` instead of an `OsPath`. +readFile' :: PlatformPath -> IO BS.ByteString +readFile' = OsPath.readFile' . coerce + +-- | Like `OsPath.writeFile`, but takes a `PlatformPath` instead of an `OsPath`. +writeFile :: PlatformPath -> BSL.ByteString -> IO () +writeFile = OsPath.writeFile . coerce + +-- | Like `OsPath.writeFile'`, but takes a `PlatformPath` instead of an `OsPath`. +writeFile' :: PlatformPath -> BS.ByteString -> IO () +writeFile' = OsPath.writeFile' . coerce + +-- | Like `OsPath.appendFile`, but takes a `PlatformPath` instead of an `OsPath`. +appendFile :: PlatformPath -> BSL.ByteString -> IO () +appendFile = OsPath.appendFile . coerce + +-- | Like `OsPath.appendFile'`, but takes a `PlatformPath` instead of an `OsPath`. +appendFile' :: PlatformPath -> BS.ByteString -> IO () +appendFile' = OsPath.appendFile' . coerce + +-- | Like `OsPath.openFile`, but takes a `PlatformPath` instead of an `OsPath`. +openFile :: PlatformPath -> IOMode -> IO Handle +openFile = OsPath.openFile . coerce + +-- | Like `OsPath.openExistingFile`, but takes a `PlatformPath` instead of an `OsPath`. +openExistingFile :: PlatformPath -> IOMode -> IO Handle +openExistingFile = OsPath.openExistingFile . coerce + +-- | Open a file and return the 'Handle'. +-- +-- Sets @O_CLOEXEC@ on posix. +-- +-- @since 0.1.2 +openFileWithCloseOnExec :: PlatformPath -> IOMode -> IO Handle +openFileWithCloseOnExec = OsPath.openFileWithCloseOnExec . coerce + +-- | Open an existing file and return the 'Handle'. +-- +-- Sets @O_CLOEXEC@ on posix. +-- +-- @since 0.1.2 +openExistingFileWithCloseOnExec :: PlatformPath -> IOMode -> IO Handle +openExistingFileWithCloseOnExec = OsPath.openExistingFileWithCloseOnExec . coerce + +-- --------------------------------------------------------------------------- +-- Internals + +withOpenFile' :: PlatformPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r +withOpenFile' = OsPath.withOpenFile' . coerce + +addFilePathToIOError :: String -> PlatformPath -> IOException -> IOException +addFilePathToIOError = coerce OsPath.addFilePathToIOError + +augmentError :: String -> PlatformPath -> IO a -> IO a +augmentError fp = OsPath.augmentError fp . coerce + diff --git a/file-io.cabal b/file-io.cabal --- a/file-io.cabal +++ b/file-io.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: file-io -version: 0.1.1 +version: 0.1.2 synopsis: Basic file IO operations via 'OsPath' description: Basic file IO operations like Prelude, but for 'OsPath'. homepage: https://github.com/hasufell/file-io @@ -53,7 +53,9 @@ exposed-modules: System.File.OsPath + System.File.OsPath.Internal System.File.PlatformPath + System.File.PlatformPath.Internal other-modules: System.File.Platform diff --git a/posix/System/File/Platform.hs b/posix/System/File/Platform.hs --- a/posix/System/File/Platform.hs +++ b/posix/System/File/Platform.hs @@ -10,35 +10,51 @@ ( defaultFileFlags, openFd, closeFd, - OpenFileFlags(noctty, nonBlock, creat, append, trunc), + OpenFileFlags(noctty, nonBlock, creat, append, trunc, cloexec), OpenMode(ReadWrite, ReadOnly, WriteOnly) ) import System.OsPath.Posix ( PosixPath ) import qualified System.OsPath.Posix as PS -- | Open a file and return the 'Handle'. openFile :: PosixPath -> IOMode -> IO Handle -openFile fp iomode = fdToHandle_ iomode fp =<< case iomode of +openFile = openFile_ defaultFileFlags' + +openFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle +openFile_ df fp iomode = fdToHandle_ iomode fp =<< case iomode of ReadMode -> open ReadOnly df WriteMode -> open WriteOnly df { trunc = True, creat = Just 0o666 } AppendMode -> open WriteOnly df { append = True, creat = Just 0o666 } ReadWriteMode -> open ReadWrite df { creat = Just 0o666 } where open = openFd fp - df = defaultFileFlags { noctty = True, nonBlock = True } -- | Open an existing file and return the 'Handle'. openExistingFile :: PosixPath -> IOMode -> IO Handle -openExistingFile fp iomode = fdToHandle_ iomode fp =<< case iomode of +openExistingFile = openExistingFile_ defaultExistingFileFlags + +openExistingFile_ :: OpenFileFlags -> PosixPath -> IOMode -> IO Handle +openExistingFile_ df fp iomode = fdToHandle_ iomode fp =<< case iomode of ReadMode -> open ReadOnly df WriteMode -> open WriteOnly df { trunc = True } AppendMode -> open WriteOnly df { append = True } ReadWriteMode -> open ReadWrite df where open = openFd fp - df = defaultFileFlags { noctty = True, nonBlock = True, creat = Nothing } fdToHandle_ :: IOMode -> PosixPath -> Fd -> IO Handle fdToHandle_ iomode fp (Fd fd) = (`onException` closeFd (Fd fd)) $ do fp' <- either (const (fmap PS.toChar . PS.unpack $ fp)) id <$> try @SomeException (PS.decodeFS fp) fdToHandle' fd Nothing False fp' iomode True + +openFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle +openFileWithCloseOnExec = openFile_ defaultFileFlags' { cloexec = True } + +openExistingFileWithCloseOnExec :: PosixPath -> IOMode -> IO Handle +openExistingFileWithCloseOnExec = openExistingFile_ defaultExistingFileFlags { cloexec = True } + +defaultFileFlags' :: OpenFileFlags +defaultFileFlags' = defaultFileFlags { noctty = True, nonBlock = True } + +defaultExistingFileFlags :: OpenFileFlags +defaultExistingFileFlags = defaultFileFlags { noctty = True, nonBlock = True, creat = Nothing } diff --git a/windows/System/File/Platform.hsc b/windows/System/File/Platform.hsc --- a/windows/System/File/Platform.hsc +++ b/windows/System/File/Platform.hsc @@ -129,3 +129,9 @@ _open_osfhandle :: CIntPtr -> CInt -> IO CInt #endif +openFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle +openFileWithCloseOnExec = openFile + +openExistingFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle +openExistingFileWithCloseOnExec = openExistingFile +