Fix Windows Syscall module for Path/Array API changes

Cleanup Windows FFI imports
Replace unsafeJoin with appendW16CString in Win Readdir

Author: harendra-kumar

core/src/Streamly/Internal/FileSystem/Path/Common.hs

@@ -59,8 +59,7 @@ module Streamly.Internal.FileSystem.Path.Common
     , unsafeAppend
     , appendCString
     , appendCString'
-    , appendCWString
-    , appendCWString'
+    , appendCStringWith
     , unsafeJoinPaths
  -- , joinRoot -- XXX append should be enough, see joinRootBody
 
@@ -128,7 +127,7 @@ import Data.Function ((&))
 import Data.Functor.Identity (Identity(..))
 import Data.Word (Word8, Word16)
 import Foreign (castPtr)
-import Foreign.C (CString, CSize(..), CWchar, CWString)
+import Foreign.C (CString, CSize(..))
 import GHC.Base (unsafeChr, Addr#)
 import GHC.Ptr (Ptr(..))
 import Language.Haskell.TH (Q, Exp)
@@ -1541,19 +1540,6 @@ appendCString' :: OS -> Array Word8 -> CString -> IO (Array Word8)
 appendCString' os arr cstr =
     appendCStringWith MutArray.emptyOf' c_strlen_pinned os arr (castPtr cstr)
 
-foreign import ccall unsafe "wchar.h wcslen" c_wcslen_pinned
-    :: Addr# -> IO CSize
-
--- | NOTE: CWchar is 16-bit wide on Windows and 32-bit wide on Posix. wcslen is
--- available on both Posix and Windows and counts accordingly in units of
--- 2-bytes or 4-bytes.
-{-# INLINE appendCWString #-}
-appendCWString :: OS -> Array CWchar -> CWString -> IO (Array CWchar)
-appendCWString = appendCStringWith MutArray.emptyOf c_wcslen_pinned
-
-{-# INLINE appendCWString' #-}
-appendCWString' :: OS -> Array CWchar -> CWString -> IO (Array CWchar)
-appendCWString' = appendCStringWith MutArray.emptyOf' c_wcslen_pinned
 
 {-# INLINE doAppend #-}
 doAppend :: (Unbox a, Integral a) => OS -> Array a -> Array a -> Array a

core/src/Streamly/Internal/Syscall/Windows.hs

@@ -27,17 +27,24 @@ module Streamly.Internal.Syscall.Windows
 
 import Control.Monad (when)
 import Data.Word (Word16)
+import Foreign (Ptr)
+import Foreign.C (CWchar(..), CWString(..))
 import System.Win32.Types (BOOL, DWORD, LPTSTR, UINT, failIfFalse_)
 import qualified System.Win32 as Win32 (failWith)
 import Streamly.Internal.Data.Array.Type (Array(..))
 import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.Data.MutByteArray as MutByteArray
 import Streamly.Internal.Data.MutByteArray.Type
     (MutByteArray, PinnedState(..), unsafeAsPtr)
+import Streamly.Internal.FileSystem.WindowsPath (WindowsPath)
+import qualified Streamly.Internal.FileSystem.WindowsPath as Path
 import Streamly.Internal.Syscall.Common (retry)
 
-foreign import WINDOWS_CCONV unsafe "GetCurrentDirectoryW"
-  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO UINT
+-- Non-explicit import
+import Streamly.Internal.Syscall.Windows.Common
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentDirectoryW"
+  c_getCurrentDirectory :: DWORD -> LPTSTR -> IO DWORD
 
 foreign import ccall unsafe "windows.h GetLastError"
     c_GetLastError :: IO DWORD
@@ -66,10 +73,9 @@ getCwd = do
     mba <- MutByteArray.rightSizeAs Unpinned (len * 2) arr
     return (Array mba 0 (fromIntegral (len * 2)))
 
-foreign import WINDOWS_CCONV unsafe "SetCurrentDirectoryW"
-    c_setCurrentDirectory :: LPTSTR -> IO BOOL
+foreign import WINDOWS_CCONV unsafe "windows.h SetCurrentDirectoryW"
+    c_SetCurrentDirectoryW :: LPTSTR -> IO BOOL
 
-setCwd :: Array Word16 -> IO ()
-setCwd arr =
-    Array.asCWString arr (failIfFalse_ "setCwd" . c_setCurrentDirectory)
+setCwd :: WindowsPath -> IO ()
+setCwd arr = asCWString arr (failIfFalse_ "setCwd" . c_SetCurrentDirectoryW)
 #endif

core/src/Streamly/Internal/Syscall/Windows/Common.hs

@@ -0,0 +1,16 @@
+-- |
+-- Module      : Streamly.Internal.Syscall.Windows.Common
+-- Copyright   : (c) 2026 Composewell Technologies
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Portability : GHC
+
+module Streamly.Internal.Syscall.Windows.Common where
+
+import Foreign.C (CWString)
+import Foreign.Ptr (castPtr)
+import Streamly.Internal.FileSystem.WindowsPath (WindowsPath)
+import qualified Streamly.Internal.FileSystem.WindowsPath as Path
+
+asCWString :: WindowsPath -> (CWString -> IO a) -> IO a
+asCWString p act = Path.asW16CString p $ \ptr -> act (castPtr ptr)

core/src/Streamly/Internal/Syscall/Windows/File.hsc

@@ -33,8 +33,10 @@ import GHC.IO.Handle.FD (fdToHandle')
 import qualified Streamly.Internal.FileSystem.File.Common as File
 import qualified Streamly.Internal.FileSystem.WindowsPath as Path
 
+-- Non-explicit imports
 import Data.Bits
 import Foreign.Ptr
+import Streamly.Internal.Syscall.Windows.Common
 import System.Win32 as Win32 hiding (createFile, failIfWithRetry)
 
 #include <windows.h>
@@ -87,7 +89,7 @@ createFile ::
     -> Maybe Win32.HANDLE
     -> IO Win32.HANDLE
 createFile name access share mb_attr mode flag mb_h =
-  Path.asCWString name $ \c_name ->
+  asCWString name $ \c_name ->
       failIfWithRetry
         (== iNVALID_HANDLE_VALUE)
         (unwords ["CreateFile", Path.toString name])

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

@@ -6,6 +6,8 @@
 -- Maintainer  : streamly@composewell.com
 -- Portability : GHC
 
+{-# LANGUAGE UnliftedFFITypes #-}
+
 module Streamly.Internal.Syscall.Windows.ReadDir
     (
 #if defined(mingw32_HOST_OS) || defined(__MINGW32__)
@@ -29,6 +31,7 @@ import Control.Monad.Catch (MonadCatch)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Char (ord, isSpace)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import GHC.Base (Addr##)
 import Foreign.C
     ( CInt(..), CSize(..), CWchar(..), Errno(..)
     , errnoToIOError, peekCWString
@@ -44,12 +47,15 @@ import Streamly.Internal.FileSystem.WindowsPath (WindowsPath(..))
 import System.IO.Error (ioeSetErrorString)
 
 import qualified Streamly.Internal.Data.Array as Array
+import qualified Streamly.Internal.Data.MutArray as MutArray
 import qualified Streamly.Internal.Data.MutByteArray as MutByteArray
 import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)
+import qualified Streamly.Internal.FileSystem.Path.Common as PathC
 import qualified Streamly.Internal.FileSystem.WindowsPath as Path
 import qualified System.Win32 as Win32 (failWith)
 
 import Streamly.Internal.FileSystem.DirOptions
+import Streamly.Internal.Syscall.Windows.Common (asCWString)
 import Foreign hiding (void)
 
 #include <windows.h>
@@ -95,9 +101,12 @@ foreign import ccall unsafe "windows.h LocalFree"
   localFree :: Ptr a -> IO (Ptr a)
 
 ------------------------------------------------------------------------------
--- Haskell C APIs
+-- FFI imports/Haskell C APIs
 ------------------------------------------------------------------------------
 
+foreign import ccall unsafe "string.h memcpy" c_memcpy
+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
+
 foreign import ccall unsafe "maperrno_func" -- in base/cbits/Win32Utils.c
   c_maperrno_func :: ErrCode -> IO Errno
 
@@ -144,6 +153,32 @@ failIf p wh act = do
 iNVALID_HANDLE_VALUE :: HANDLE
 iNVALID_HANDLE_VALUE = castUINTPtrToPtr maxBound
 
+------------------------------------------------------------------------------
+-- Path string manipulation
+------------------------------------------------------------------------------
+
+foreign import ccall unsafe "wchar.h wcslen" c_wcslen
+    :: Ptr CWchar -> IO CSize
+
+foreign import ccall unsafe "wchar.h wcslen" c_wcslen_pinned
+    :: Addr## -> IO CSize
+
+-- This is defined here and not in Path module because wcslen is a platform
+-- specific function and uses 32-bit wide chars on posix and 16-bit wide chars
+-- on Windows. We cannot have it in WindowsPath module because that module is
+-- plaform agnostic and works on Posix as well.
+--
+{-# INLINE appendW16CString #-}
+appendW16CString :: WindowsPath -> Ptr CWchar -> IO WindowsPath
+appendW16CString (WindowsPath arr) str =
+    fmap WindowsPath
+        $ PathC.appendCStringWith
+            MutArray.emptyOf
+            c_wcslen_pinned
+            PathC.Windows
+            arr
+            (castPtr str)
+
 ------------------------------------------------------------------------------
 -- Dir stream implementation
 ------------------------------------------------------------------------------
@@ -158,14 +193,13 @@ openDirStream p = do
     fp_finddata <- mallocForeignPtrBytes (# const sizeof(WIN32_FIND_DATAW) )
     withForeignPtr fp_finddata $ \dataPtr -> do
         handle <-
-            -- XXX should it be asCWString, so we do not need to use castPtr
-            Array.asCStringUnsafe (Path.toArray path) $ \pathPtr -> do
+            asCWString path $ \pathPtr -> do
                 -- XXX Use getLastError to distinguish the case when no
                 -- matching file is found. See the doc of FindFirstFileW.
                 failIf
                     (== iNVALID_HANDLE_VALUE)
                     ("FindFirstFileW: " ++ Path.toString path)
-                    $ c_FindFirstFileW (castPtr pathPtr) dataPtr
+                    $ c_FindFirstFileW pathPtr dataPtr
         ref <- newIORef True
         return $ DirStream (handle, ref, fp_finddata)
 
@@ -358,11 +392,8 @@ readEitherChunks _confMod alldirs =
                     if isMeta
                     then return $ Skip st
                     else do
-                        arr <- liftIO $ Array.fromW16CString dname
-                        let path =
-                                Path.unsafeJoin curdir
-                                    (Path.unsafeFromArray arr)
-                            dirs1 = path : dirs
+                        path <- liftIO $ appendW16CString curdir dname
+                        let dirs1 = path : dirs
                             ndirs1 = ndirs + 1
                         if ndirs1 >= dirMax
                         then return $ Yield (Left dirs1)
@@ -371,11 +402,8 @@ readEitherChunks _confMod alldirs =
                             (ChunkStreamLoop
                                 curdir xs ds dirs1 ndirs1 files nfiles)
                 else do
-                    arr <- liftIO $ Array.fromW16CString dname
-                    let path =
-                            Path.unsafeJoin curdir
-                                (Path.unsafeFromArray arr)
-                        files1 = path : files
+                    path <- liftIO $ appendW16CString curdir dname
+                    let files1 = path : files
                         nfiles1 = nfiles + 1
                     if nfiles1 >= fileMax
                     then return $ Yield (Right files1)
@@ -392,12 +420,6 @@ readEitherChunks _confMod alldirs =
 -- Chunked byte-buffered reads
 ------------------------------------------------------------------------------
 
-foreign import ccall unsafe "string.h memcpy" c_memcpy
-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
-
-foreign import ccall unsafe "wchar.h wcslen" c_wcslen
-    :: Ptr CWchar -> IO CSize
-
 -- Split a list in half.
 splitHalf :: [a] -> ([a], [a])
 splitHalf xxs = split xxs xxs
@@ -430,8 +452,6 @@ data ChunkStreamByteState =
         MutByteArray
         Int
 
--- TODO: instead of unsafeJoin use appendCWString
---
 -- NOTE: Unlike posix on Windows the file attribute to determine whether it is
 -- a directory or not is always available so we do not need the code to handle
 -- the case when they are not available, on Posix we need to use stat
@@ -597,10 +617,8 @@ readEitherByteChunks _confMod alldirs =
 
                 {-# INLINE handleDirEnt #-}
                 handleDirEnt pos dname = do
-                    arr <- liftIO $ Array.fromW16CString dname
-                    let path =
-                            Path.unsafeJoin curdir (Path.unsafeFromArray arr)
-                        dirs1 = path : dirs
+                    path <- liftIO $ appendW16CString curdir dname
+                    let dirs1 = path : dirs
                     r <- copyToBuf mbarr pos curdir dname
                     case r of
                         Just pos1 -> goInner dirs1 pos1