Make sure to set ioe_filename in IOException

Fixes #17

Also improves the property tests to examine more of the
IOException.

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
 

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,41 +44,44 @@ 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
 
 -- | 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)
+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.
 --
 -- The 'Handle' is not automatically closed to allow lazy IO. Use this
 -- 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)
+

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

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,26 +76,26 @@ 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
   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
-    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
   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
-    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,43 +135,39 @@ 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
   withSystemTempDirectory "test" $ \baseDir' -> 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
   withSystemTempDirectory "test" $ \baseDir' -> 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
   withSystemTempDirectory "test" $ \baseDir' -> 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
   withSystemTempDirectory "test" $ \baseDir' -> 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
+