Replace Win32 functions with local impls

core/src/Streamly/Internal/FileSystem/Windows/ReadDir.hsc

@@ -19,21 +19,22 @@ where
 
 #if defined(mingw32_HOST_OS) || defined(__MINGW32__)
 
+import Control.Exception (throwIO)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..))
-import Data.Bits ((.&.))
-import Data.Char (ord)
+import Data.Char (ord, isSpace)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Foreign
-    ( Ptr, Word8, Word32, mallocForeignPtrBytes, withForeignPtr, peek
-    , peekByteOff , castPtr, ForeignPtr, plusPtr)
-import Foreign.C (CWchar(..))
+import Foreign.C (CInt(..), CWchar(..), Errno(..), errnoToIOError, peekCWString)
+import Numeric (showHex)
 import Streamly.Internal.Data.Array (Array(..))
 import Streamly.Internal.FileSystem.WindowsPath (WindowsPath(..))
+import System.IO.Error (ioeSetErrorString)
 
 import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.FileSystem.WindowsPath as Path
-import qualified System.Win32 as Win32
+import qualified System.Win32 as Win32 (failWith)
+
+import Foreign hiding (void)
 
 #include <windows.h>
 
@@ -43,22 +44,97 @@ import qualified System.Win32 as Win32
 -- _UNICODE preprocessor macros) is enabled in your project. To ensure
 -- consistent Unicode support, explicitly use CreateFileW.
 
+------------------------------------------------------------------------------
+-- Types
+------------------------------------------------------------------------------
+
+type BOOL = Bool
+type DWORD = Word32
+
+type UINT_PTR = Word
+type ErrCode = DWORD
+type LPCTSTR = Ptr CWchar
 type WIN32_FIND_DATA = ()
+type HANDLE = Ptr ()
 
--- XXX Define this as data and unpack three fields?
-newtype DirStream =
-    DirStream (Win32.HANDLE, IORef Bool, ForeignPtr WIN32_FIND_DATA)
+------------------------------------------------------------------------------
+-- Windows C APIs
+------------------------------------------------------------------------------
 
 -- XXX Note for i386, stdcall is needed instead of ccall, see Win32
 -- package/windows_cconv.h. We support only x86_64 for now.
 foreign import ccall unsafe "windows.h FindFirstFileW"
-  c_FindFirstFileW :: Win32.LPCTSTR -> Ptr WIN32_FIND_DATA -> IO Win32.HANDLE
+  c_FindFirstFileW :: LPCTSTR -> Ptr WIN32_FIND_DATA -> IO HANDLE
 
 foreign import ccall unsafe "windows.h FindNextFileW"
-  c_FindNextFileW :: Win32.HANDLE -> Ptr WIN32_FIND_DATA -> IO Win32.BOOL
+  c_FindNextFileW :: HANDLE -> Ptr WIN32_FIND_DATA -> IO BOOL
 
 foreign import ccall unsafe "windows.h FindClose"
-  c_FindClose :: Win32.HANDLE -> IO Win32.BOOL
+  c_FindClose :: HANDLE -> IO BOOL
+
+foreign import ccall unsafe "windows.h GetLastError"
+  getLastError :: IO ErrCode
+
+foreign import ccall unsafe "windows.h LocalFree"
+  localFree :: Ptr a -> IO (Ptr a)
+
+------------------------------------------------------------------------------
+-- Haskell C APIs
+------------------------------------------------------------------------------
+
+foreign import ccall unsafe "maperrno_func" -- in base/cbits/Win32Utils.c
+  c_maperrno_func :: ErrCode -> IO Errno
+
+------------------------------------------------------------------------------
+-- Error Handling
+------------------------------------------------------------------------------
+
+-- XXX getErrorMessage and castUINTPtrToPtr require c code, so left out for
+-- now. Once we replace these we can remove dependency on Win32. We can
+-- possibly implement these in Haskell by directly calling the Windows API.
+
+foreign import ccall unsafe "getErrorMessage"
+  getErrorMessage :: DWORD -> IO (Ptr CWchar)
+
+foreign import ccall unsafe "castUINTPtrToPtr"
+  castUINTPtrToPtr :: UINT_PTR -> Ptr a
+
+failWith :: String -> ErrCode -> IO a
+failWith fn_name err_code = do
+  c_msg <- getErrorMessage err_code
+  msg <- if c_msg == nullPtr
+         then return $ "Error 0x" ++ Numeric.showHex err_code ""
+         else do 
+             msg <- peekCWString c_msg
+             -- We ignore failure of freeing c_msg, given we're already failing
+             _ <- localFree c_msg
+             return msg
+  errno <- c_maperrno_func err_code
+  let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n
+      ioerror = errnoToIOError fn_name errno Nothing Nothing
+                  `ioeSetErrorString` msg'
+  throwIO ioerror
+
+errorWin :: String -> IO a
+errorWin fn_name = do
+  err_code <- getLastError
+  failWith fn_name err_code
+
+failIf :: (a -> Bool) -> String -> IO a -> IO a
+failIf p wh act = do
+  v <- act
+  if p v then errorWin wh else return v
+
+iNVALID_HANDLE_VALUE :: HANDLE
+iNVALID_HANDLE_VALUE = castUINTPtrToPtr maxBound
+
+------------------------------------------------------------------------------
+-- Dir stream implementation
+------------------------------------------------------------------------------
+
+-- XXX Define this as data and unpack three fields?
+newtype DirStream =
+    DirStream (HANDLE, IORef Bool, ForeignPtr WIN32_FIND_DATA)
 
 openDirStream :: WindowsPath -> IO DirStream
 openDirStream p = do
@@ -67,10 +143,11 @@ openDirStream p = do
     withForeignPtr fp_finddata $ \dataPtr -> do
         handle <-
             Array.asCStringUnsafe (Path.toChunk path) $ \pathPtr -> do
-                -- XXX print the path in the error message
                 -- XXX Use getLastError to distinguish the case when no
-                -- matching file is found.
-                Win32.failIf (== Win32.iNVALID_HANDLE_VALUE) "FindFirstFileW"
+                -- matching file is found. See the doc of FindFirstFileW.
+                failIf 
+                    (== iNVALID_HANDLE_VALUE) 
+                    ("FindFirstFileW: " ++ Path.toString path)
                     $ c_FindFirstFileW (castPtr pathPtr) dataPtr
         ref <- newIORef True
         return $ DirStream (handle, ref, fp_finddata)
@@ -130,7 +207,7 @@ readDirStreamEither (DirStream (h, ref, fdata)) =
         if (retval)
         then processEntry ptr
         else do
-            err <- Win32.getLastError
+            err <- getLastError
             if err == (# const ERROR_NO_MORE_FILES )
             then return Nothing
             -- XXX Print the path in the error message