packages feed

file-io 0.1.0.2 → 0.1.1

raw patch · 12 files changed

+722/−140 lines, 12 filesdep +deepseqdep +file-iodep +tastydep ~basedep ~bytestringdep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, file-io, tasty, tasty-hunit, temporary

Dependency ranges changed: base, bytestring, filepath

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Revision history for file-io +## 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`
System/File/OsPath.hs view
@@ -1,10 +1,38 @@-module System.File.OsPath where+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE BangPatterns #-} +module System.File.OsPath (+  openBinaryFile+, withFile+, withBinaryFile+, withFile'+, withBinaryFile'+, readFile+, readFile'+, writeFile+, writeFile'+, appendFile+, appendFile'+, openFile+, openExistingFile+) where++ import qualified System.File.Platform as P -import Control.Exception (bracket)-import System.IO (IOMode(..), Handle, hSetBinaryMode, hClose)-import System.OsPath+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@@ -22,25 +50,21 @@ -- On POSIX systems, 'openBinaryFile' is an /interruptible operation/ as -- described in "Control.Exception". openBinaryFile :: OsPath -> IOMode -> IO Handle-openBinaryFile fp iomode = do-  h <- openFile fp iomode-  hSetBinaryMode h True-  pure h+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 fp iomode action = bracket-  (openFile fp iomode)-  hClose-  action+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 fp iomode action = bracket-  (openBinaryFile fp iomode)-  hClose-  action+withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp+    $ withOpenFile' osfp iomode True False (try . act) True)+  >>= either ioError pure  -- | Run an action on a file. --@@ -48,15 +72,15 @@ -- with caution. withFile'   :: OsPath -> IOMode -> (Handle -> IO r) -> IO r-withFile' fp iomode action = do-  h <- openFile fp iomode-  action h+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' fp iomode action = do-  h <- openBinaryFile fp iomode-  action h+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.@@ -93,8 +117,55 @@  -- | Open a file and return the 'Handle'. openFile :: OsPath -> IOMode -> IO Handle-openFile (OsString fp) = P.openFile fp+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 (OsString fp) = P.openExistingFile fp+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)+
file-io.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               file-io-version:            0.1.0.2+version:            0.1.1 synopsis:           Basic file IO operations via 'OsPath' description:        Basic file IO operations like Prelude, but for 'OsPath'. homepage:           https://github.com/hasufell/file-io@@ -12,6 +12,13 @@ category:           System extra-source-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,+                GHC==8.6.5  source-repository head   type:     git@@ -35,8 +42,9 @@    hs-source-dirs: .   build-depends:-    , base        >=4.10      && <5+    , base        >=4.12      && <5     , bytestring  >=0.11.3.0+    , deepseq    if flag(os-string)     build-depends: filepath >= 1.5.0.0, os-string >= 2.0.0@@ -50,3 +58,57 @@   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, 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, tasty, tasty-hunit, file-io, filepath, temporary, Win32 >=2.13.3.0+    else+      build-depends: base+    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, 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, 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, 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, bytestring, tasty, tasty-hunit, file-io, filepath, temporary+    ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10"+
posix/System/File/Platform.hs view
@@ -1,17 +1,23 @@+{-# LANGUAGE TypeApplications #-}+ module System.File.Platform where +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,-      fdToHandle,       openFd,+      closeFd,       OpenFileFlags(noctty, nonBlock, creat, append, trunc),       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 =<< case iomode of+openFile 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 }@@ -22,7 +28,7 @@  -- | Open an existing file and return the 'Handle'. openExistingFile :: PosixPath -> IOMode -> IO Handle-openExistingFile fp iomode = fdToHandle =<< case iomode of+openExistingFile fp iomode = fdToHandle_ iomode fp =<< case iomode of   ReadMode      -> open ReadOnly  df   WriteMode     -> open WriteOnly df { trunc = True }   AppendMode    -> open WriteOnly df { append = True }@@ -30,3 +36,9 @@  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+
+ tests/CLC237.hs view
@@ -0,0 +1,25 @@+{-# 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"+
+ tests/Properties.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE CPP #-}+{-# 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)+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'+       ]+    ]++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 ""+    _ <- OSP.openFile fp ReadMode+    r <- try @IOException $ OSP.withFile fp WriteMode $ \h' -> do BS.hPut h' "test"+    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"+    _ <- OSP.openFile fp ReadMode+    r <- try @IOException $ OSP.withFile fp ReadMode BS.hGetContents+    Right "h"  @=? r++concFile3 :: Assertion+concFile3 = do+  withSystemTempDirectory "test" $ \baseDir' -> do+    baseDir <- OSP.encodeFS baseDir'+    let fp = baseDir </> [osp|foo|]+    OSP.writeFile fp ""+    _ <- OSP.openFile fp WriteMode+    r <- try @IOException $ OSP.withFile fp WriteMode (flip BS.hPut "test")+    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+        pure (c, c')+    Right ("tx", "bootx") @=? r+++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+
+ tests/T14.hs view
@@ -0,0 +1,22 @@+{-# 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'"+
+ tests/T15.hs view
@@ -0,0 +1,24 @@+{-# 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])+    ]+
+ tests/T15Win.hs view
@@ -0,0 +1,62 @@+{-# 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+
+ tests/T8.hs view
@@ -0,0 +1,26 @@+{-# 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
− windows/System/File/Platform.hs 
@@ -1,111 +0,0 @@-{-# LANGUAGE CPP #-}--module System.File.Platform where--import Control.Exception (bracketOnError)-import Data.Bits-import System.IO (IOMode(..), Handle)-import System.OsPath.Windows ( WindowsPath )--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---- | 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- where-  toHandle h = do-    when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END-    Win32.hANDLEToHandle h-  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_ALWAYS-    WriteMode     -> Win32.cREATE_ALWAYS-    AppendMode    -> Win32.oPEN_ALWAYS-    ReadWriteMode -> Win32.oPEN_ALWAYS--  shareMode = case iomode of-    ReadMode      -> maxShareMode-    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- where-  toHandle h = do-    when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END-    Win32.hANDLEToHandle h-  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      -> maxShareMode-    WriteMode     -> writeShareMode-    AppendMode    -> writeShareMode-    ReadWriteMode -> maxShareMode-
+ windows/System/File/Platform.hsc view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}++module System.File.Platform where++import Control.Exception (bracketOnError, try, SomeException, onException)+import Data.Bits+import System.IO (IOMode(..), Handle)+import System.OsPath.Windows ( WindowsPath )+import qualified System.OsPath.Windows as WS+import Foreign.C.Types+import Foreign.Ptr (ptrToIntPtr)++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+#else+import GHC.IO.Handle.FD (fdToHandle')+#include <fcntl.h>+#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+ where+#if defined(__IO_MANAGER_WINIO__)+  toHandle h = (`onException` Win32.closeHandle h) $ do+    when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END+    Win32.hANDLEToHandle h+#else+  toHandle 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+  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+ where+  toHandle h = do+    when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END+    Win32.hANDLEToHandle h+  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+