Expose openFileWithCloseOnExec and openExistingFileWithCloseOnExec

Fixes #21
haskell · May 27, 2024 · 8296101 · 8296101
1 parent d2b5ed2
commit 8296101
Show file tree

Hide file tree

Showing 8 changed files with 372 additions and 222 deletions.
diff --git 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
@@ -1,6 +1,14 @@
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE BangPatterns #-}
+{- |
+Module      :  System.File.OsPath
+Copyright   :  (c) Julian Ospald 2023-2024
+License     :  BSD3
 
+Maintainer  :  [email protected]
+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 @@ module System.File.OsPath (
 ) 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
@@ -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)
+