file-io-0.1.5/0000755000000000000000000000000007346545000011232 5ustar0000000000000000file-io-0.1.5/CHANGELOG.md0000644000000000000000000000241307346545000013043 0ustar0000000000000000# Revision history for file-io ## 0.1.5 -- 2024-11-26 * Don't use QuasiQotes * Remove redundant imports ## 0.1.4 -- 2024-08-10 * fix build on GHC <= 8.10 ## 0.1.3 -- 2024-08-08 * add `openTempFile` , `openBinaryTempFile` , `openTempFileWithDefaultPermissions` and `openBinaryTempFileWithDefaultPermissions` wrt [#2](https://github.com/hasufell/file-io/issues/2) ## 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) * fix a concurrency bug on windows with `readFile`, wrt [#15](https://github.com/hasufell/file-io/issues/15) * make sure to set `ioe_filename` in `IOException` wrt [#17](https://github.com/hasufell/file-io/issues/17) * Make `openFile` and friends exception safe wrt [#8](https://github.com/hasufell/file-io/issues/8) ## 0.1.0.2 -- 2023-12-11 * support `os-string` package and newer `filepath` ## 0.1.0.1 -- YYYY-mm-dd * Don't use creat flag when only reading files ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. file-io-0.1.5/LICENSE0000644000000000000000000000275707346545000012252 0ustar0000000000000000Copyright Julian Ospald 2024. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Neil Mitchell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. file-io-0.1.5/System/File/0000755000000000000000000000000007346545000013375 5ustar0000000000000000file-io-0.1.5/System/File/OsPath.hs0000644000000000000000000000117407346545000015132 0ustar0000000000000000{- | 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 , withBinaryFile , withFile' , withBinaryFile' , readFile , readFile' , writeFile , writeFile' , appendFile , appendFile' , openFile , openExistingFile , openTempFile , openBinaryTempFile , openTempFileWithDefaultPermissions , openBinaryTempFileWithDefaultPermissions ) where import System.File.OsPath.Internal import Prelude () file-io-0.1.5/System/File/OsPath/0000755000000000000000000000000007346545000014573 5ustar0000000000000000file-io-0.1.5/System/File/OsPath/Internal.hs0000644000000000000000000002520007346545000016702 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} 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, (>>=), (==), otherwise, userError) 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, throwIO) 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 import System.Posix.Types (CMode) #if MIN_VERSION_filepath(1, 5, 0) import qualified System.OsString as OSS #else import Data.Coerce #endif -- | 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 -- | The function creates a temporary file in ReadWrite mode. -- The created file isn\'t deleted automatically, so you need to delete it manually. -- -- The file is created with permissions such that only the current -- user can read\/write it. -- -- With some exceptions (see below), the file will be created securely -- in the sense that an attacker should not be able to cause -- openTempFile to overwrite another file on the filesystem using your -- credentials, by putting symbolic links (on Unix) in the place where -- the temporary file is to be created. On Unix the @O_CREAT@ and -- @O_EXCL@ flags are used to prevent this attack, but note that -- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you -- rely on this behaviour it is best to use local filesystems only. -- -- @since 0.1.3 openTempFile :: OsPath -- ^ Directory in which to create the file -> OsString -- ^ File name template. If the template is \"foo.ext\" then -- the created file will be \"fooXXX.ext\" where XXX is some -- random number. Note that this should not contain any path -- separator characters. On Windows, the template prefix may -- be truncated to 3 chars, e.g. \"foobar.ext\" will be -- \"fooXXX.ext\". -> IO (OsPath, Handle) openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False 0o600 -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. -- -- @since 0.1.3 openBinaryTempFile :: OsPath -> OsString -> IO (OsPath, Handle) openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600 -- | Like 'openTempFile', but uses the default file permissions -- -- @since 0.1.3 openTempFileWithDefaultPermissions :: OsPath -> OsString -> IO (OsPath, Handle) openTempFileWithDefaultPermissions tmp_dir template = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666 -- | Like 'openBinaryTempFile', but uses the default file permissions -- -- @since 0.1.3 openBinaryTempFileWithDefaultPermissions :: OsPath -> OsString -> IO (OsPath, Handle) openBinaryTempFileWithDefaultPermissions tmp_dir template = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666 -- --------------------------------------------------------------------------- -- 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) openTempFile' :: String -> OsPath -> OsString -> Bool -> CMode -> IO (OsPath, Handle) openTempFile' loc (OsString tmp_dir) template@(OsString tmpl) binary mode | any_ (== OSP.pathSeparator) template = throwIO $ userError $ "openTempFile': Template string must not contain path separator characters: " ++ P.lenientDecode tmpl | otherwise = do (fp, hdl) <- P.findTempName (prefix, suffix) loc tmp_dir mode when binary $ hSetBinaryMode hdl True pure (OsString fp, hdl) where -- We split off the last extension, so we can use .foo.ext files -- for temporary files (hidden on Unix OSes). Unfortunately we're -- below filepath in the hierarchy here. (OsString prefix, OsString suffix) = OSP.splitExtension template #if MIN_VERSION_filepath(1, 5, 0) any_ :: (OsChar -> Bool) -> OsString -> Bool any_ = OSS.any #else any_ :: (OsChar -> Bool) -> OsString -> Bool any_ = coerce P.any_ #endif file-io-0.1.5/System/File/PlatformPath.hs0000644000000000000000000000115107346545000016330 0ustar0000000000000000{- | Module : System.File.PlatformPath Copyright : (c) Julian Ospald 2023-2024 License : BSD3 Maintainer : hasufell@posteo.de Stability : stable Portability : portable This module is only interesting when you are implementing low-level libraries based on 'OsPath' API. Usually you want "System.File.OsPath". -} module System.File.PlatformPath ( openBinaryFile , withFile , withBinaryFile , withFile' , withBinaryFile' , readFile , readFile' , writeFile , writeFile' , appendFile , appendFile' , openFile , openExistingFile ) where import System.File.PlatformPath.Internal import Prelude () file-io-0.1.5/System/File/PlatformPath/0000755000000000000000000000000007346545000015776 5ustar0000000000000000file-io-0.1.5/System/File/PlatformPath/Internal.hs0000644000000000000000000001010507346545000020103 0ustar0000000000000000module 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 file-io-0.1.5/file-io.cabal0000644000000000000000000000635507346545000013553 0ustar0000000000000000cabal-version: 2.4 name: file-io version: 0.1.5 synopsis: Basic file IO operations via 'OsPath' description: Basic file IO operations like Prelude, but for 'OsPath'. homepage: https://github.com/hasufell/file-io bug-reports: https://github.com/hasufell/file-io/issues license: BSD-3-Clause license-file: LICENSE author: Julian Ospald maintainer: hasufell@posteo.de copyright: Julian Ospald 2022 category: System extra-doc-files: CHANGELOG.md tested-with: GHC==9.8.1, GHC==9.4.8, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4 source-repository head type: git location: https://github.com/hasufell/file-io.git flag os-string description: Use the new os-string package default: False manual: False library default-language: Haskell2010 if os(windows) hs-source-dirs: windows build-depends: Win32 >=2.13.3.0 else hs-source-dirs: posix build-depends: unix >=2.8.0.0 && <3 hs-source-dirs: . build-depends: , base >=4.13.0.0 && <5 , bytestring >=0.11.3.0 && <1 , deepseq >=1 && <2 if flag(os-string) build-depends: filepath >= 1.5.0.0, os-string >= 2.0.0 else build-depends: filepath >= 1.4.100.0 && < 1.5.0.0 exposed-modules: System.File.OsPath System.File.OsPath.Internal System.File.PlatformPath System.File.PlatformPath.Internal other-modules: System.File.Platform ghc-options: -Wall test-suite T15 hs-source-dirs: tests main-is: T15.hs type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath, temporary ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10" if os(windows) build-depends: Win32 >=2.13.3.0 test-suite T15Win hs-source-dirs: tests main-is: T15Win.hs type: exitcode-stdio-1.0 default-language: Haskell2010 if os(windows) build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath, temporary, Win32 >=2.13.3.0 else build-depends: base >=4.13.0.0 && <5 ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10" test-suite T14 hs-source-dirs: tests main-is: T14.hs type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base >=4.13.0.0 && <5, file-io, filepath, temporary ghc-options: -Wall test-suite T8 hs-source-dirs: tests main-is: T8.hs type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base >=4.13.0.0 && <5, bytestring, file-io, filepath, temporary ghc-options: -Wall -threaded test-suite CLC237 hs-source-dirs: tests main-is: CLC237.hs type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base >=4.13.0.0 && <5, file-io, filepath, temporary ghc-options: -Wall test-suite Properties hs-source-dirs: tests main-is: Properties.hs type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends: base >=4.13.0.0 && <5, bytestring, tasty, tasty-hunit, file-io, filepath, temporary ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10" file-io-0.1.5/posix/System/File/0000755000000000000000000000000007346545000014537 5ustar0000000000000000file-io-0.1.5/posix/System/File/Platform.hs0000644000000000000000000001141507346545000016661 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE PackageImports #-} module System.File.Platform where import Data.Either (fromRight) import Control.Exception (try, onException, SomeException) import GHC.IO.Handle.FD (fdToHandle') import System.IO (IOMode(..), Handle) import System.Posix.Types (Fd(..)) import System.Posix.IO.PosixString ( defaultFileFlags, openFd, closeFd, OpenFileFlags(noctty, nonBlock, creat, append, trunc, cloexec, exclusive), OpenMode(ReadWrite, ReadOnly, WriteOnly) ) import System.OsPath.Posix ( PosixPath, PosixString, () ) import qualified System.OsPath.Posix as PS import Data.IORef (IORef, newIORef) import System.Posix (CMode) import System.IO (utf8, latin1) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Internals (c_getpid) import GHC.IORef (atomicModifyIORef'_) import Foreign.C (getErrno, eEXIST, errnoToIOError) #if !MIN_VERSION_filepath(1, 5, 0) import Data.Coerce (coerce) import "filepath" System.OsString.Internal.Types (PosixString(..), PosixChar(..)) import qualified "filepath" System.OsPath.Data.ByteString.Short as BC #endif import System.CPUTime (cpuTimePrecision, getCPUTime) import Text.Printf (printf) -- | Open a file and return the 'Handle'. openFile :: PosixPath -> IOMode -> IO Handle 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 -- | Open an existing file and return the 'Handle'. openExistingFile :: PosixPath -> IOMode -> IO Handle 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 fdToHandle_ :: IOMode -> PosixPath -> Fd -> IO Handle fdToHandle_ iomode fp (Fd fd) = (`onException` closeFd (Fd fd)) $ do fp' <- fromRight (fmap PS.toChar . PS.unpack $ fp) <$> 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 } findTempName :: (PosixString, PosixString) -> String -> PosixPath -> CMode -> IO (PosixPath, Handle) findTempName (prefix, suffix) loc tmp_dir mode = go where go = do rs <- rand_string let filename = prefix <> rs <> suffix filepath = tmp_dir filename fd <- openTempFile_ filepath mode if fd < 0 then do errno <- getErrno case errno of _ | errno == eEXIST -> go _ -> do let tmp_dir' = lenientDecode tmp_dir ioError (errnoToIOError loc errno Nothing (Just tmp_dir')) else fmap (filepath,) $ fdToHandle_ ReadWriteMode filepath fd openTempFile_ :: PosixPath -> CMode -> IO Fd openTempFile_ fp cmode = openFd fp ReadWrite defaultFileFlags' { creat = Just cmode, nonBlock = True, noctty = True, exclusive = True } tempCounter :: IORef Int tempCounter = unsafePerformIO $ newIORef 0 {-# NOINLINE tempCounter #-} -- build large digit-alike number rand_string :: IO PosixString rand_string = do r1 <- fromIntegral @_ @Int <$> c_getpid (r2, _) <- atomicModifyIORef'_ tempCounter (+1) r3 <- (`quot` cpuTimePrecision) <$> getCPUTime return $ PS.pack $ fmap (PS.unsafeFromChar) (printf "%x-%x-%x" r1 r2 r3) lenientDecode :: PosixString -> String lenientDecode ps = let utf8' = PS.decodeWith utf8 ps latin1' = PS.decodeWith latin1 ps in case (utf8', latin1') of (Right s, ~_) -> s (_, Right s) -> s (Left _, Left _) -> error "lenientDecode: failed to decode" #if !MIN_VERSION_filepath(1, 5, 0) any_ :: (PosixChar -> Bool) -> PosixString -> Bool any_ = coerce BC.any #endif file-io-0.1.5/tests/0000755000000000000000000000000007346545000012374 5ustar0000000000000000file-io-0.1.5/tests/CLC237.hs0000644000000000000000000000157207346545000013572 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Main where import Control.Exception import System.OsPath ((), osp) import qualified System.OsPath as OSP import qualified System.File.OsPath as OSP import GHC.IO.Exception (IOErrorType(..), IOException(..)) import System.IO import System.IO.Temp -- Test that the action in 'withFile' does not inherit the filepath annotation -- See https://github.com/haskell/core-libraries-committee/issues/237 main :: IO () main = withSystemTempDirectory "tar-test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' res <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) WriteMode $ \_ -> fail "test" case res of Left (IOError Nothing UserError "" "test" Nothing Nothing) -> pure () Left e -> print e >> fail "Unexpected error" Right _ -> fail "Unexpected success" file-io-0.1.5/tests/Properties.hs0000644000000000000000000003004207346545000015063 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Control.Exception import qualified System.FilePath as FP import Test.Tasty import Test.Tasty.HUnit import System.OsPath ((), osp, OsPath, OsString) import qualified System.OsPath as OSP import qualified System.File.OsPath as OSP import GHC.IO.Exception (IOErrorType(..), IOException(..)) import System.IO import System.IO.Temp import qualified Data.ByteString as BS main :: IO () main = defaultMain $ testGroup "All" [ testGroup "System.File.OsPath" [ testCase "readFile . writeFile" writeFileReadFile , testCase "readFile . writeFile . writeFile" writeWriteFileReadFile , testCase "readFile . appendFile . writeFile" appendFileReadFile , testCase "iomode: ReadFile does not allow write" iomodeReadFile , testCase "iomode: WriteFile does not allow read" iomodeWriteFile , testCase "iomode: AppendMode does not allow read" iomodeAppendFile , testCase "iomode: ReadWriteMode does allow everything" iomodeAppendFile , testCase "concurrency: open multiple handles (read and write)" concFile , testCase "concurrency: open multiple handles (read and read)" concFile2 , testCase "concurrency: open multiple handles (write and write)" concFile3 , testCase "openExistingFile no (Read)" existingFile , testCase "openExistingFile no (Write)" existingFile2 , testCase "openExistingFile no (Append)" existingFile3 , testCase "openExistingFile no (ReadWrite)" existingFile4 , testCase "openExistingFile yes (Read)" existingFile' , testCase "openExistingFile yes (Write)" existingFile2' , testCase "openExistingFile yes (Append)" existingFile3' , testCase "openExistingFile yes (ReadWrite)" existingFile4' , testCase "openTempFile" (openTempFile2 OSP.openTempFile) , testCase "openTempFile (reopen file)" (openTempFile1 OSP.openTempFile) , testCase "openTempFile (filepaths different)" (openTempFile3 OSP.openTempFile) , testCase "openBinaryTempFile" (openTempFile2 OSP.openBinaryTempFile) , testCase "openBinaryTempFile (reopen file)" (openTempFile1 OSP.openBinaryTempFile) , testCase "openBinaryTempFile (filepaths different)" (openTempFile3 OSP.openBinaryTempFile) , testCase "openTempFileWithDefaultPermissions" (openTempFile2 OSP.openTempFileWithDefaultPermissions) , testCase "openTempFileWithDefaultPermissions (reopen file)" (openTempFile1 OSP.openTempFileWithDefaultPermissions) , testCase "openTempFileWithDefaultPermissions (filepaths different)" (openTempFile3 OSP.openTempFileWithDefaultPermissions) , testCase "openBinaryTempFileWithDefaultPermissions" (openTempFile2 OSP.openBinaryTempFileWithDefaultPermissions) , testCase "openBinaryTempFileWithDefaultPermissions (reopen file)" (openTempFile1 OSP.openBinaryTempFileWithDefaultPermissions) , testCase "openBinaryTempFileWithDefaultPermissions (filepaths different)" (openTempFile3 OSP.openBinaryTempFileWithDefaultPermissions) ] ] writeFileReadFile :: Assertion writeFileReadFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "test" contents <- OSP.readFile (baseDir [osp|foo|]) "test" @=? contents writeWriteFileReadFile :: Assertion writeWriteFileReadFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "lol" OSP.writeFile (baseDir [osp|foo|]) "test" contents <- OSP.readFile (baseDir [osp|foo|]) "test" @=? contents appendFileReadFile :: Assertion appendFileReadFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "test" OSP.appendFile (baseDir [osp|foo|]) "test" contents <- OSP.readFile (baseDir [osp|foo|]) "testtest" @=? contents iomodeReadFile :: Assertion iomodeReadFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) ReadMode $ \h -> BS.hPut h "test" IOError Nothing IllegalOperation "hPutBuf" "handle is not open for writing" Nothing (Just $ baseDir' FP. "foo") @==? r iomodeWriteFile :: Assertion iomodeWriteFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) WriteMode $ \h -> BS.hGetContents h IOError Nothing IllegalOperation "hGetBuf" "handle is not open for reading" Nothing (Just $ baseDir' FP. "foo") @==? r iomodeAppendFile :: Assertion iomodeAppendFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) AppendMode $ \h -> BS.hGetContents h IOError Nothing IllegalOperation "hGetBuf" "handle is not open for reading" Nothing (Just $ baseDir' FP. "foo") @==? r iomodeReadWriteFile :: Assertion iomodeReadWriteFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) ReadWriteMode $ \h -> do BS.hPut h "test" BS.hGetContents h Right "testtest" @=? r concFile :: Assertion concFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "" !h <- OSP.openFile fp ReadMode r <- try @IOException $ OSP.withFile fp WriteMode $ \h' -> do BS.hPut h' "test" _ <- try @IOException $ BS.hPut h "" IOError Nothing fileLockedType "withFile" fileLockedMsg Nothing (Just $ baseDir' FP. "foo") @==? r concFile2 :: Assertion concFile2 = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "h" !h <- OSP.openFile fp ReadMode r <- try @IOException $ OSP.withFile fp ReadMode BS.hGetContents _ <- try @IOException $ BS.hPut h "" Right "h" @=? r concFile3 :: Assertion concFile3 = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "" !h <- OSP.openFile fp ReadMode r <- try @IOException $ OSP.withFile fp WriteMode (flip BS.hPut "test") _ <- try @IOException $ BS.hPut h "" IOError Nothing fileLockedType "withFile" fileLockedMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile :: Assertion existingFile = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp ReadMode IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile2 :: Assertion existingFile2 = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp WriteMode IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile3 :: Assertion existingFile3 = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp AppendMode IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile4 :: Assertion existingFile4 = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp AppendMode IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile' :: Assertion existingFile' = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "test" r <- try @IOException $ (OSP.openExistingFile fp ReadMode >>= BS.hGetContents) Right "test" @=? r existingFile2' :: Assertion existingFile2' = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "test" r <- try @IOException $ do OSP.openExistingFile fp WriteMode >>= \h -> BS.hPut h "boo" >> hClose h OSP.readFile (baseDir [osp|foo|]) Right "boo" @=? r existingFile3' :: Assertion existingFile3' = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "test" r <- try @IOException $ do OSP.openExistingFile fp AppendMode >>= \h -> BS.hPut h "boo" >> hClose h OSP.readFile (baseDir [osp|foo|]) Right "testboo" @=? r existingFile4' :: Assertion existingFile4' = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] OSP.writeFile fp "testx" r <- try @IOException $ OSP.openExistingFile fp ReadWriteMode >>= \h -> do hSetBuffering h NoBuffering BS.hPut h "boo" !c <- BS.hGetSome h 5 hSeek h AbsoluteSeek 0 !c' <- BS.hGetSome h 5 hClose h pure (c, c') Right ("tx", "bootx") @=? r openTempFile1 :: (OsPath -> OsString -> IO (OsPath, Handle)) -> Assertion openTempFile1 open = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let file = [osp|foo.ext|] (!fp, h') <- open baseDir file hClose h' r <- try @IOException $ do OSP.openExistingFile fp ReadWriteMode >>= \h -> BS.hPut h "boo" >> hClose h OSP.readFile fp Right "boo" @=? r openTempFile2 :: (OsPath -> OsString -> IO (OsPath, Handle)) -> Assertion openTempFile2 open = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let file = [osp|foo.ext|] (fp, h) <- open baseDir file r <- try @IOException $ do BS.hPut h "boo" >> hClose h OSP.readFile fp Right "boo" @=? r openTempFile3 :: (OsPath -> OsString -> IO (OsPath, Handle)) -> Assertion openTempFile3 open = do withSystemTempDirectory "test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' let file = [osp|foo.ext|] (!fp, h) <- open baseDir file (!fp', h') <- open baseDir file hClose h hClose h' (fp /= fp') @? "Filepaths are different" compareIOError :: forall a . (Eq a, Show a, HasCallStack) => IOException -> Either IOException a -> Assertion compareIOError el (Left lel) = lel { ioe_handle = Nothing , ioe_errno = Nothing } @?= el { ioe_handle = Nothing , ioe_errno = Nothing } compareIOError el (Right rel) = Right rel @?= (Left el :: Either IOException a) (@==?) :: forall a . (Eq a, Show a, HasCallStack) => IOException -> Either IOException a -> Assertion (@==?) = compareIOError noSuchFileMsg :: String #if defined(mingw32_HOST_OS) || defined(__MINGW32__) noSuchFileMsg = "The system cannot find the file specified." #else noSuchFileMsg = "No such file or directory" #endif fileLockedMsg :: String #if defined(mingw32_HOST_OS) || defined(__MINGW32__) fileLockedMsg = "The process cannot access the file because it is being used by another process." #else fileLockedMsg = "file is locked" #endif fileLockedType :: IOErrorType #if defined(mingw32_HOST_OS) || defined(__MINGW32__) fileLockedType = PermissionDenied #else fileLockedType = ResourceBusy #endif file-io-0.1.5/tests/T14.hs0000644000000000000000000000122007346545000013273 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Main where import Control.Exception import System.OsPath ((), osp) import qualified System.OsPath as OSP import qualified System.File.OsPath as OSP import System.IO.Temp -- Test that 'readFile' does not create a file -- https://github.com/hasufell/file-io/issues/14 main :: IO () main = withSystemTempDirectory "tar-test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' res <- try @SomeException $ OSP.readFile (baseDir [osp|foo|]) case res of Left e -> print e >> return () Right _ -> fail "Unexpectedly found file 'foo'" file-io-0.1.5/tests/T15.hs0000644000000000000000000000134407346545000013303 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} module Main where import Test.Tasty import Test.Tasty.HUnit import System.OsPath ((), osp) import qualified System.OsPath as OSP import qualified System.File.OsPath as OSP import System.IO import System.IO.Temp -- Test that we can read concurrently without file lock -- https://github.com/hasufell/file-io/issues/15 main :: IO () main = withSystemTempDirectory "tar-test" $ \baseDir' -> do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" defaultMain $ testGroup "All" [ testGroup "System.File.OsPath" $ map (\i -> testCase ("foo " <> show i) (OSP.openFile (baseDir [osp|foo|]) ReadMode >>= hClose)) ([0..99] :: [Int]) ] file-io-0.1.5/tests/T15Win.hs0000644000000000000000000000320507346545000013757 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} module Main where #if defined(mingw32_HOST_OS) || defined(__MINGW32__) import Test.Tasty import Test.Tasty.HUnit import qualified System.File.PlatformPath as PFP import System.IO import System.IO.Temp import Control.Exception (bracketOnError) import Data.Bits import System.OsPath.Windows ( WindowsPath, pstr ) import qualified System.OsPath.Windows as WS import qualified System.Win32 as Win32 import qualified System.Win32.WindowsString.File as WS import Control.Monad (when, void) #if defined(__IO_MANAGER_WINIO__) import GHC.IO.SubSystem #endif -- Test that we can read concurrently without file lock -- https://github.com/hasufell/file-io/issues/15 main :: IO () main = withSystemTempDirectory "tar-test" $ \baseDir' -> do baseDir <- WS.encodeFS baseDir' PFP.writeFile (baseDir WS. [pstr|foo|]) "" defaultMain $ testGroup "All" [ testGroup "System.File.OsPath (Windows)" $ (map (\i -> testCase ("foo (Win32 API) " <> show i) (openFile32 (baseDir WS. [pstr|foo|]) ReadMode >>= Win32.closeHandle)) ([0..99] :: [Int])) ] openFile32 :: WindowsPath -> IOMode -> IO Win32.HANDLE openFile32 fp iomode = WS.createFile fp Win32.gENERIC_READ Win32.fILE_SHARE_READ Nothing Win32.oPEN_EXISTING #if defined(__IO_MANAGER_WINIO__) (case ioSubSystem of IoPOSIX -> Win32.fILE_ATTRIBUTE_NORMAL IoNative -> Win32.fILE_ATTRIBUTE_NORMAL .|. Win32.fILE_FLAG_OVERLAPPED ) #else Win32.fILE_ATTRIBUTE_NORMAL #endif Nothing #else main :: IO () main = putStrLn "Skipping test on windows" #endif file-io-0.1.5/tests/T8.hs0000644000000000000000000000122707346545000013225 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Main where import Control.Concurrent import Control.Monad import System.File.OsPath import System.OsPath import System.IO.Temp import qualified Data.ByteString.Lazy as BL import qualified System.OsPath as OSP import qualified System.File.OsPath as OSP main :: IO () main = withSystemTempDirectory "test" $ \baseDir' -> do let fn = [osp|test.txt|] baseDir <- OSP.encodeFS baseDir' let fp = baseDir OSP. fn OSP.writeFile fp "" replicateM_ 100000 $ do thr <- forkIO (System.File.OsPath.readFile fp >>= BL.putStr) threadDelay 1 void $ killThread thr file-io-0.1.5/windows/System/File/0000755000000000000000000000000007346545000015067 5ustar0000000000000000file-io-0.1.5/windows/System/File/Platform.hsc0000644000000000000000000002062007346545000017352 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE PackageImports #-} module System.File.Platform where import Control.Exception (bracketOnError, try, SomeException, onException) import Data.Bits import Data.Maybe (fromJust) import System.IO (IOMode(..), Handle) import System.OsPath.Windows ( WindowsPath ) import qualified System.OsPath.Windows as WS import Foreign.C.Types import qualified System.OsString.Windows as WS hiding (decodeFS) import System.OsString.Windows ( encodeUtf, WindowsString ) import qualified System.Win32 as Win32 import qualified System.Win32.WindowsString.File as WS import System.Win32.WindowsString.Types (withTString, peekTString) #if MIN_VERSION_Win32(2, 14, 0) import System.Win32.WindowsString.Types (withFilePath) #endif import Control.Monad (when, void) #if defined(__IO_MANAGER_WINIO__) import GHC.IO.SubSystem #else import GHC.IO.Handle.FD (fdToHandle') #include #endif import GHC.IORef (atomicModifyIORef'_) import Foreign.C (getErrno, errnoToIOError) import Data.IORef (IORef, newIORef) import Foreign.C.String import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Utils (with) import Foreign.Storable import System.CPUTime (cpuTimePrecision, getCPUTime) import System.Posix.Types (CMode) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Internals (c_getpid, o_EXCL) import Text.Printf (printf) #if MIN_VERSION_filepath(1, 5, 0) import System.OsString.Encoding import "os-string" System.OsString.Internal.Types (WindowsString(..), WindowsChar(..)) import qualified "os-string" System.OsString.Data.ByteString.Short as BC #else import Data.Coerce (coerce) import System.OsPath.Encoding import "filepath" System.OsString.Internal.Types (WindowsString(..), WindowsChar(..)) import qualified "filepath" System.OsPath.Data.ByteString.Short.Word16 as BC #endif -- | Open a file and return the 'Handle'. openFile :: WindowsPath -> IOMode -> IO Handle openFile fp iomode = bracketOnError (WS.createFile fp accessMode shareMode Nothing createMode #if defined(__IO_MANAGER_WINIO__) (case ioSubSystem of IoPOSIX -> Win32.fILE_ATTRIBUTE_NORMAL IoNative -> Win32.fILE_ATTRIBUTE_NORMAL .|. Win32.fILE_FLAG_OVERLAPPED ) #else Win32.fILE_ATTRIBUTE_NORMAL #endif Nothing) Win32.closeHandle (toHandle fp iomode) where accessMode = case iomode of ReadMode -> Win32.gENERIC_READ WriteMode -> Win32.gENERIC_WRITE AppendMode -> Win32.gENERIC_WRITE .|. Win32.fILE_APPEND_DATA ReadWriteMode -> Win32.gENERIC_READ .|. Win32.gENERIC_WRITE createMode = case iomode of ReadMode -> Win32.oPEN_EXISTING WriteMode -> Win32.cREATE_ALWAYS AppendMode -> Win32.oPEN_ALWAYS ReadWriteMode -> Win32.oPEN_ALWAYS shareMode = case iomode of ReadMode -> Win32.fILE_SHARE_READ WriteMode -> writeShareMode AppendMode -> writeShareMode ReadWriteMode -> maxShareMode maxShareMode :: Win32.ShareMode maxShareMode = Win32.fILE_SHARE_DELETE .|. Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE writeShareMode :: Win32.ShareMode writeShareMode = Win32.fILE_SHARE_DELETE .|. Win32.fILE_SHARE_READ -- | Open an existing file and return the 'Handle'. openExistingFile :: WindowsPath -> IOMode -> IO Handle openExistingFile fp iomode = bracketOnError (WS.createFile fp accessMode shareMode Nothing createMode #if defined(__IO_MANAGER_WINIO__) (case ioSubSystem of IoPOSIX -> Win32.fILE_ATTRIBUTE_NORMAL IoNative -> Win32.fILE_ATTRIBUTE_NORMAL .|. Win32.fILE_FLAG_OVERLAPPED ) #else Win32.fILE_ATTRIBUTE_NORMAL #endif Nothing) Win32.closeHandle (toHandle fp iomode) where accessMode = case iomode of ReadMode -> Win32.gENERIC_READ WriteMode -> Win32.gENERIC_WRITE AppendMode -> Win32.gENERIC_WRITE .|. Win32.fILE_APPEND_DATA ReadWriteMode -> Win32.gENERIC_READ .|. Win32.gENERIC_WRITE createMode = case iomode of ReadMode -> Win32.oPEN_EXISTING WriteMode -> Win32.tRUNCATE_EXISTING AppendMode -> Win32.oPEN_EXISTING ReadWriteMode -> Win32.oPEN_EXISTING shareMode = case iomode of ReadMode -> Win32.fILE_SHARE_READ WriteMode -> writeShareMode AppendMode -> writeShareMode ReadWriteMode -> maxShareMode #if !defined(__IO_MANAGER_WINIO__) foreign import ccall "_open_osfhandle" _open_osfhandle :: CIntPtr -> CInt -> IO CInt #endif openFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle openFileWithCloseOnExec = openFile openExistingFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle openExistingFileWithCloseOnExec = openExistingFile findTempName :: (WindowsString, WindowsString) -> String -> WindowsPath -> CMode -> IO (WindowsPath, Handle) findTempName (prefix, suffix) loc tmp_dir mode = go where go = do let label = if prefix == mempty then fromJust (encodeUtf "ghc") else prefix #if MIN_VERSION_Win32(2, 14, 0) withFilePath tmp_dir $ \c_tmp_dir -> #else withTString tmp_dir $ \c_tmp_dir -> #endif withTString label $ \c_template -> withTString suffix $ \c_suffix -> #if MIN_VERSION_base(4, 15, 0) with nullPtr $ \c_ptr -> do res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr if not res then do errno <- getErrno ioError (errnoToIOError loc errno Nothing (Just $ lenientDecode tmp_dir)) else do c_p <- peek c_ptr filename <- peekTString c_p free c_p let flags = fromIntegral mode .&. o_EXCL handleResultsWinIO filename (flags == o_EXCL) #else -- NOTE: revisit this when new I/O manager in place and use a UUID -- based one when we are no longer MAX_PATH bound. allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0 c_str if not res then do errno <- getErrno ioError (errnoToIOError loc errno Nothing (Just $ lenientDecode tmp_dir)) else do filename <- peekTString c_str let flags = fromIntegral mode .&. o_EXCL handleResultsWinIO filename (flags == o_EXCL) #endif handleResultsWinIO filename excl = do h <- (if excl then openExistingFile else openFile) filename ReadWriteMode return (filename, h) #if MIN_VERSION_base(4, 15, 0) foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool #else foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool #endif tempCounter :: IORef Int tempCounter = unsafePerformIO $ newIORef 0 {-# NOINLINE tempCounter #-} -- build large digit-alike number rand_string :: IO WindowsPath rand_string = do r1 <- fromIntegral @_ @Int <$> c_getpid (r2, _) <- atomicModifyIORef'_ tempCounter (+1) r3 <- (`quot` cpuTimePrecision) <$> getCPUTime return $ WS.pack $ fmap (WS.unsafeFromChar) (printf "%x-%x-%x" r1 r2 r3) lenientDecode :: WindowsString -> String lenientDecode ws = let utf16le' = WS.decodeWith utf16le_b ws ucs2' = WS.decodeWith ucs2le ws in case (utf16le', ucs2') of (Right s, ~_) -> s (_, Right s) -> s (Left _, Left _) -> error "lenientDecode: failed to decode" toHandle :: WindowsPath -> IOMode -> Win32.HANDLE -> IO Handle #if defined(__IO_MANAGER_WINIO__) toHandle _ iomode h = (`onException` Win32.closeHandle h) $ do when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END Win32.hANDLEToHandle h #else toHandle fp iomode h = (`onException` Win32.closeHandle h) $ do when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END fd <- _open_osfhandle (fromIntegral (ptrToIntPtr h)) (#const _O_BINARY) fp' <- either (const (fmap WS.toChar . WS.unpack $ fp)) id <$> try @SomeException (WS.decodeFS fp) fdToHandle' fd Nothing False fp' iomode True #endif #if !MIN_VERSION_filepath(1, 5, 0) any_ :: (WindowsChar -> Bool) -> WindowsString -> Bool any_ = coerce BC.any #endif