From 5f49a63e175c03685088450f3680fb3ef87b90ed Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 13 Jan 2024 16:27:08 +0800 Subject: [PATCH] Make sure to set ioe_filename in IOException Fixes #17 Also improves the property tests to examine more of the IOException. --- CHANGELOG.md | 1 + System/File/OsPath.hs | 75 +++++++++++++++++++++++++++++++------------ file-io.cabal | 1 + tests/Properties.hs | 68 +++++++++++++++++++++++++++------------ 4 files changed, 105 insertions(+), 40 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9616344..dcf4169 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ * 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) ## 0.1.0.2 -- 2023-12-11 diff --git a/System/File/OsPath.hs b/System/File/OsPath.hs index 5fef19e..56a4e16 100644 --- a/System/File/OsPath.hs +++ b/System/File/OsPath.hs @@ -1,10 +1,32 @@ -module System.File.OsPath where +{-# LANGUAGE TypeApplications #-} + +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, pure, either, const, flip, Maybe(..), fmap, (<$>), id, ioError, (=<<), Bool(..)) +import GHC.IO (catchException) +import GHC.IO.Exception (IOException(..)) +import Control.DeepSeq (force) +import Control.Exception (SomeException, try, evaluate, bracket) +import System.IO (IOMode(..), Handle) +import System.IO.Unsafe (unsafePerformIO) +import System.IO (hSetBinaryMode, hClose) +import System.OsPath as OSP import System.OsString.Internal.Types import qualified Data.ByteString as BS @@ -22,8 +44,11 @@ import qualified Data.ByteString.Lazy as BSL -- 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 +openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $ openBinaryFile' osfp iomode + +openBinaryFile' :: OsPath -> IOMode -> IO Handle +openBinaryFile' (OsString fp) iomode =do + h <- P.openFile fp iomode hSetBinaryMode h True pure h @@ -31,16 +56,16 @@ openBinaryFile fp iomode = do -- -- The 'Handle' is automatically closed afther the action. withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withFile fp iomode action = bracket - (openFile fp iomode) +withFile osfp@(OsString fp) iomode action = either ioError pure =<< (augmentError "withFile" osfp $ bracket + (P.openFile fp iomode) hClose - action + (try . action)) withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile fp iomode action = bracket - (openBinaryFile fp iomode) +withBinaryFile osfp iomode action = either ioError pure =<< (augmentError "withBinaryFile" osfp $ bracket + (openBinaryFile' osfp iomode) hClose - action + (try . action)) -- | Run an action on a file. -- @@ -48,15 +73,15 @@ withBinaryFile fp iomode action = bracket -- with caution. withFile' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withFile' fp iomode action = do - h <- openFile fp iomode - action h +withFile' osfp@(OsString fp) iomode action = either ioError pure =<< (augmentError "withFile'" osfp $ do + h <- P.openFile fp iomode + try . action $ h) withBinaryFile' :: OsPath -> IOMode -> (Handle -> IO r) -> IO r -withBinaryFile' fp iomode action = do - h <- openBinaryFile fp iomode - action h +withBinaryFile' fp iomode action = either ioError pure =<< (augmentError "withBinaryFile'" fp $ do + h <- openBinaryFile' fp iomode + try . action $ h) -- | 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 +118,18 @@ appendFile' fp contents = withFile fp AppendMode (`BS.hPut` contents) -- | Open a file and return the 'Handle'. openFile :: OsPath -> IOMode -> IO Handle -openFile (OsString fp) = P.openFile fp +openFile osfp@(OsString fp) = augmentError "openFile" osfp . P.openFile fp -- | Open an existing file and return the 'Handle'. openExistingFile :: OsPath -> IOMode -> IO Handle -openExistingFile (OsString fp) = P.openExistingFile fp +openExistingFile osfp@(OsString fp) = augmentError "openExistingFile" osfp . P.openExistingFile fp + +addFilePathToIOError :: String -> OsPath -> IOException -> IOException +addFilePathToIOError fun fp ioe = unsafePerformIO $ do + fp' <- either (const (fmap OSP.toChar . OSP.unpack $ fp)) id <$> try @SomeException (OSP.decodeFS fp) + fp'' <- evaluate $ force fp' + pure $ ioe{ ioe_location = fun, ioe_filename = Just fp'' } + +augmentError :: String -> OsPath -> IO a -> IO a +augmentError str osfp = flip catchException (ioError . addFilePathToIOError str osfp) + diff --git a/file-io.cabal b/file-io.cabal index 0285b0d..9d20621 100644 --- a/file-io.cabal +++ b/file-io.cabal @@ -44,6 +44,7 @@ library build-depends: , 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 diff --git a/tests/Properties.hs b/tests/Properties.hs index c278049..5ae577d 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -2,11 +2,13 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module Main where import Control.Exception import Data.Bifunctor (first) +import qualified System.FilePath as FP import Test.Tasty import Test.Tasty.HUnit import System.OsPath ((), osp) @@ -74,8 +76,8 @@ iomodeReadFile = do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) ReadMode $ \h -> BS.hPut h "test" - Left IllegalOperation - @=? first ioe_type r + IOError Nothing IllegalOperation "hPutBuf" "handle is not open for writing" Nothing Nothing + @==? first (\e -> e { ioe_filename = Nothing }) r iomodeWriteFile :: Assertion iomodeWriteFile = do @@ -83,8 +85,8 @@ iomodeWriteFile = do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) WriteMode $ \h -> BS.hGetContents h - Left IllegalOperation - @=? first ioe_type r + IOError Nothing IllegalOperation "hGetBuf" "handle is not open for reading" Nothing Nothing + @==? first (\e -> e { ioe_filename = Nothing }) r iomodeAppendFile :: Assertion iomodeAppendFile = do @@ -92,8 +94,8 @@ iomodeAppendFile = do baseDir <- OSP.encodeFS baseDir' OSP.writeFile (baseDir [osp|foo|]) "" r <- try @IOException $ OSP.withFile (baseDir [osp|foo|]) AppendMode $ \h -> BS.hGetContents h - Left IllegalOperation - @=? first ioe_type r + IOError Nothing IllegalOperation "hGetBuf" "handle is not open for reading" Nothing Nothing + @==? first (\e -> e { ioe_filename = Nothing }) r iomodeReadWriteFile :: Assertion iomodeReadWriteFile = do @@ -113,11 +115,7 @@ concFile = do OSP.writeFile fp "" _ <- OSP.openFile fp ReadMode r <- try @IOException $ OSP.withFile fp WriteMode $ \h' -> do BS.hPut h' "test" -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) - Left PermissionDenied @=? first ioe_type r -#else - Left ResourceBusy @=? first ioe_type r -#endif + IOError Nothing fileLockedType "withFile" fileLockedMsg Nothing (Just $ baseDir' FP. "foo") @==? r concFile2 :: Assertion concFile2 = do @@ -137,11 +135,7 @@ concFile3 = do OSP.writeFile fp "" _ <- OSP.openFile fp WriteMode r <- try @IOException $ OSP.withFile fp WriteMode (flip BS.hPut "test") -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) - Left PermissionDenied @=? first ioe_type r -#else - Left ResourceBusy @=? first ioe_type r -#endif + IOError Nothing fileLockedType "withFile" fileLockedMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile :: Assertion existingFile = do @@ -149,7 +143,7 @@ existingFile = do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp ReadMode - Left NoSuchThing @=? first ioe_type r + IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile2 :: Assertion existingFile2 = do @@ -157,7 +151,7 @@ existingFile2 = do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp WriteMode - Left NoSuchThing @=? first ioe_type r + IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile3 :: Assertion existingFile3 = do @@ -165,7 +159,7 @@ existingFile3 = do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp AppendMode - Left NoSuchThing @=? first ioe_type r + IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile4 :: Assertion existingFile4 = do @@ -173,7 +167,7 @@ existingFile4 = do baseDir <- OSP.encodeFS baseDir' let fp = baseDir [osp|foo|] r <- try @IOException $ OSP.openExistingFile fp AppendMode - Left NoSuchThing @=? first ioe_type r + IOError Nothing NoSuchThing "openExistingFile" noSuchFileMsg Nothing (Just $ baseDir' FP. "foo") @==? r existingFile' :: Assertion existingFile' = do @@ -222,3 +216,37 @@ existingFile4' = do 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 +