Update Windows, Posix Readdir API, Path/Array ops

bench-test-lib/src/BenchTestLib/DirIO.hs

@@ -60,9 +60,6 @@ import qualified Streamly.Data.Unfold as Unfold
 import qualified Streamly.Internal.Data.Unfold as Unfold
 import qualified Streamly.Internal.FileSystem.DirIO as Dir
 import qualified Streamly.FileSystem.Path as Path
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-import qualified Streamly.Internal.FileSystem.Posix.ReadDir as Dir
-#endif
 
 --------------------------------------------------------------------------------
 -- Helpers

core/src/Streamly/Internal/Data/Array.hs

@@ -43,8 +43,9 @@ module Streamly.Internal.Data.Array
     , cast
     , asBytes
     , unsafeCast
-    , asCStringUnsafe -- XXX asCString
-    , asCWString
+    , asCString -- XXX can remove
+    , asCWString -- XXX can remove
+    , asNullTerminatedPtr
 
     -- * Subarrays
     -- , sliceOffLen
@@ -107,6 +108,7 @@ module Streamly.Internal.Data.Array
     , splitOn
     , fold
     , foldBreakChunksK
+    , asCStringUnsafe
     )
 where
 
@@ -121,7 +123,9 @@ import Control.Monad.IO.Class (MonadIO(..))
 import Data.Functor.Identity (Identity(..))
 import Data.Proxy (Proxy(..))
 import Data.Word (Word8)
+import Foreign (Ptr, castPtr)
 import Foreign.C.String (CString, CWString)
+import Foreign.C.Types (CWchar)
 import GHC.Types (SPEC(..))
 import Streamly.Internal.Data.Unbox (Unbox(..))
 import Prelude hiding (length, null, last, map, (!!), read, concat)
@@ -396,12 +400,20 @@ streamTransform f arr =
 -- Casts
 -------------------------------------------------------------------------------
 
--- | Cast an array having elements of type @a@ into an array having elements of
--- type @b@. The array size must be a multiple of the size of type @b@
--- otherwise accessing the last element of the array may result into a crash or
--- a random value.
+-- | Unsafely reinterpret an array of @a@ as an array of @b@.
 --
--- /Pre-release/
+-- The 'byteLength' of the array must be a multiple of the size of @b@.
+-- Additionally, the start offset of the array must satisfy the alignment
+-- requirements of @b@ whenever the target platform or element access
+-- operations require aligned memory accesses.
+--
+-- Violating these requirements results in undefined behavior, including
+-- possible crashes or invalid values.
+--
+-- If @a@ and @b@ have the same runtime representation, prefer using
+-- 'coerce', which is safe:
+--
+-- >> unsafeCast = coerce
 --
 unsafeCast, castUnsafe :: Array a -> Array b
 unsafeCast (Array contents start end) =
@@ -414,11 +426,14 @@ RENAME(castUnsafe,unsafeCast)
 asBytes :: Array a -> Array Word8
 asBytes = unsafeCast
 
--- | Cast an array having elements of type @a@ into an array having elements of
--- type @b@. The length of the array should be a multiple of the size of the
--- target element otherwise 'Nothing' is returned.
+-- | Attempt to reinterpret an array as containing elements of type @b@.
 --
+-- Returns 'Nothing' if the byte length of the array is not a multiple
+-- of the size of @b@.
 --
+-- This function does not validate alignment requirements for @b@.
+-- If stricter alignment is required, copy the array into a properly
+-- aligned buffer before casting.
 cast :: forall a b. (Unbox b) => Array a -> Maybe (Array b)
 cast arr =
     let len = byteLength arr
@@ -436,21 +451,37 @@ cast arr =
 --
 -- /Pre-release/
 --
+{-# DEPRECATED asCStringUnsafe "Please use asCString instead." #-}
 asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b
-asCStringUnsafe arr = MA.asCString (unsafeThaw arr)
+asCStringUnsafe arr act =
+    MA.asCString (unsafeThaw (unsafeCast arr)) $ \ptr -> act (castPtr ptr)
 
--- | Convert an array of any element type into a null terminated CWString Ptr.
--- The array is copied to pinned memory.
+-- | Use an array of CChar as a null terminated CString Ptr in pinned memory.
+--
+-- /Unsafe/
+--
+-- /O(n) Time: (creates a copy of the array)/
+--
+-- /Pre-release/
+--
+asCString :: Array Word8 -> (Ptr Word8 -> IO b) -> IO b
+asCString arr = MA.asCString (unsafeThaw arr)
+
+-- | Use an array of CWchar as a null terminated CWString Ptr in pinned memory.
 --
 -- /Unsafe/
 --
 -- /O(n) Time: (creates a copy of the array)/
 --
 -- /Pre-release/
 --
-asCWString :: Array a -> (CWString -> IO b) -> IO b
+asCWString :: Array CWchar -> (CWString -> IO b) -> IO b
 asCWString arr = MA.asCWString (unsafeThaw arr)
 
+{-# INLINE asNullTerminatedPtr #-}
+asNullTerminatedPtr :: (Unbox a, Num a) => Array a -> (Ptr a -> IO b) -> IO b
+asNullTerminatedPtr arr = MA.asNullTerminatedPtr (unsafeThaw arr)
+
 -------------------------------------------------------------------------------
 -- Folds
 -------------------------------------------------------------------------------

core/src/Streamly/Internal/Data/MutArray/Type.hs

@@ -46,8 +46,9 @@ module Streamly.Internal.Data.MutArray.Type
     , unsafeCast
     , asBytes
     , unsafeAsPtr -- XXX asPtr
-    , asCString
-    , asCWString
+    , asCString -- XXX can remove
+    , asCWString -- XXX can remove
+    , asNullTerminatedPtr
 
     -- ** Construction
     , empty
@@ -519,8 +520,8 @@ import Data.Char (ord)
 import Data.Functor.Identity (Identity(..))
 import Data.Proxy (Proxy(..))
 import Data.Word (Word8, Word16)
-import Foreign.C.String (CString, CWString)
-import Foreign.C.Types (CSize(..), CChar, CWchar)
+import Foreign.C.String (CWString)
+import Foreign.C.Types (CSize(..), CWchar)
 import Foreign.Ptr (plusPtr, castPtr)
 import Streamly.Internal.Data.MutByteArray.Type
     ( MutByteArray(..)
@@ -3263,7 +3264,7 @@ unsafeSplice dst src = do
          (arrContents src) startSrc (arrContents dst) endDst srcLen
      return $ dst {arrEnd = endDst + srcLen}
 
--- | Append specified number of bytes from a given pointer to the MutArray.
+-- | Append specified number of Ptr items from a given pointer to the MutArray.
 --
 -- /Unsafe:/
 --
@@ -3274,20 +3275,22 @@ unsafeSplice dst src = do
 -- 3. the pointer passed is valid up to the given length.
 --
 {-# INLINE unsafeAppendPtrN #-}
-unsafeAppendPtrN :: MonadIO m =>
-    MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)
-unsafeAppendPtrN arr ptr ptrLen = do
-    let newEnd = arrEnd arr + ptrLen
+unsafeAppendPtrN :: forall m a. (MonadIO m, Unbox a) =>
+    MutArray a -> Ptr a -> Int -> m (MutArray a)
+unsafeAppendPtrN arr ptr count = do
+    let byteCount = count * SIZE_OF(a)
+    let newEnd = arrEnd arr + byteCount
     assertM(newEnd <= arrBound arr)
-    Unboxed.unsafePutPtrN ptr (arrContents arr) (arrEnd arr) ptrLen
+    Unboxed.unsafePutPtrN
+        (castPtr ptr) (arrContents arr) (arrEnd arr) byteCount
     return $ arr {arrEnd = newEnd}
 
 {-# INLINE appendPtrN #-}
-appendPtrN :: MonadIO m =>
-    MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)
-appendPtrN arr ptr ptrLen = do
-    arr1 <- growBy ptrLen arr
-    unsafeAppendPtrN arr1 ptr ptrLen
+appendPtrN :: (Unbox a, MonadIO m) =>
+    MutArray a -> Ptr a -> Int -> m (MutArray a)
+appendPtrN arr ptr count = do
+    arr1 <- growBy count arr
+    unsafeAppendPtrN arr1 ptr count
 
 -- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
 -- reserved space available in @dst@ it is reallocated to a size determined by
@@ -3662,27 +3665,27 @@ unsafeCreateWithPtr' cap pop = do
              ++ "length = " ++ show len ++ ", "
              ++ "capacity = " ++ show cap
 
-asCString :: MutArray a -> (CString -> IO b) -> IO b
-asCString arr act = do
+{-# INLINE asNullTerminatedPtr #-}
+asNullTerminatedPtr :: forall a b. (Unbox a, Num a) =>
+    MutArray a -> (Ptr a -> IO b) -> IO b
+asNullTerminatedPtr arr act = do
     let pinned = isPinned arr
-        req = byteLength arr + SIZE_OF(CChar)
+        req = byteLength arr + SIZE_OF(a)
     arr1 <-
         if byteCapacity arr < req || not pinned
-        then reallocExplicitAs Pinned 1 req arr
+        then reallocExplicitAs Pinned (SIZE_OF(a)) req arr
         else return arr
-    arr2 :: MutArray CChar <- snocUnsafe (unsafeCast arr1) (0 :: CChar)
-    unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr)
+    arr2 <- snocUnsafe arr1 (0 :: a)
+    unsafeAsPtr arr2 $ \ptr _ -> act ptr
 
-asCWString :: MutArray a -> (CWString -> IO b) -> IO b
-asCWString arr act = do
-    let pinned = isPinned arr
-        req = byteLength arr + SIZE_OF(CWchar)
-    arr1 <-
-        if byteCapacity arr < req || not pinned
-        then reallocExplicitAs Pinned 1 req arr
-        else return arr
-    arr2 :: MutArray CWchar <- snocUnsafe (unsafeCast arr1) (0 :: CWchar)
-    unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr)
+-- | Provides a pinned, null terminated CString pointer (Ptr Word8).
+asCString :: MutArray Word8 -> (Ptr Word8 -> IO b) -> IO b
+asCString = asNullTerminatedPtr
+
+-- | Provides a pinned, null terminated CWString pointer (Ptr CWchar).
+-- Note CWchar is 16-bit wide on Windows and 32-bit wide on Posix.
+asCWString :: MutArray CWchar -> (CWString -> IO b) -> IO b
+asCWString = asNullTerminatedPtr
 
 -------------------------------------------------------------------------------
 -- Equality

core/src/Streamly/Internal/FileSystem/DirIO.hs

@@ -127,7 +127,9 @@ module Streamly.Internal.FileSystem.DirIO
     , readDirs
     , readEither
     , readEitherPaths
-    , readEitherChunks
+    , OS.readEitherChunks
+    , OS.readEitherByteChunks
+    , readEitherChunksPortable
 
     -- We can implement this in terms of readAttrsRecursive without losing
     -- perf.
@@ -137,10 +139,10 @@ module Streamly.Internal.FileSystem.DirIO
 
     -- * Unfolds
     -- | Use the more convenient stream APIs instead of unfolds where possible.
-    , reader
+    , OS.reader
     , fileReader
     , dirReader
-    , eitherReader
+    , OS.eitherReader
     , eitherReaderPaths
 
       {-
@@ -178,12 +180,11 @@ import Data.Either (isRight, isLeft, fromLeft, fromRight)
 import Streamly.Data.Stream (Stream)
 import Streamly.Internal.Data.Unfold.Type (Unfold(..))
 import Streamly.Internal.FileSystem.Path (Path)
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
 import qualified Streamly.Internal.Data.Fold as Fold
-import Streamly.Internal.FileSystem.Windows.ReadDir (eitherReader, reader)
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+import qualified Streamly.Internal.Syscall.Windows.ReadDir as OS
 #else
-import Streamly.Internal.FileSystem.Posix.ReadDir
-    ( readEitherChunks, eitherReader, reader)
+import qualified Streamly.Internal.Syscall.Posix.ReadDir as OS
 #endif
 import qualified Streamly.Internal.Data.Stream as S
 import qualified Streamly.Data.Unfold as UF
@@ -337,7 +338,7 @@ eitherReaderPaths ::(MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
 eitherReaderPaths f =
     let (</>) = Path.join
      in fmap (\(dir, x) -> bimap (dir </>) (dir </>) x)
-            $ UF.carry (eitherReader f)
+            $ UF.carry (OS.eitherReader f)
 
 --
 -- | Read files only.
@@ -347,7 +348,7 @@ eitherReaderPaths f =
 {-# INLINE fileReader #-}
 fileReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
     Unfold m Path Path
-fileReader f = fmap (fromRight undefined) $ UF.filter isRight (eitherReader f)
+fileReader f = fmap (fromRight undefined) $ UF.filter isRight (OS.eitherReader f)
 
 -- | Read directories only. Filter out "." and ".." entries.
 --
@@ -356,15 +357,15 @@ fileReader f = fmap (fromRight undefined) $ UF.filter isRight (eitherReader f)
 {-# INLINE dirReader #-}
 dirReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
     Unfold m Path Path
-dirReader f = fmap (fromLeft undefined) $ UF.filter isLeft (eitherReader f)
+dirReader f = fmap (fromLeft undefined) $ UF.filter isLeft (OS.eitherReader f)
 
 -- | Raw read of a directory.
 --
 -- /Pre-release/
 {-# INLINE read #-}
 read :: (MonadIO m, MonadCatch m) =>
     Path -> Stream m Path
-read = S.unfold reader
+read = S.unfold OS.reader
 
 -- | Read directories as Left and files as Right. Filter out "." and ".."
 -- entries. The output contains the names of the directories and files.
@@ -373,7 +374,7 @@ read = S.unfold reader
 {-# INLINE readEither #-}
 readEither :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
     Path -> Stream m (Either Path Path)
-readEither f = S.unfold (eitherReader f)
+readEither f = S.unfold (OS.eitherReader f)
 
 -- | Like 'readEither' but prefix the names of the files and directories with
 -- the supplied directory path.
@@ -384,20 +385,12 @@ readEitherPaths f dir =
     let (</>) = Path.join
      in fmap (bimap (dir </>) (dir </>)) $ readEither f dir
 
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
--- XXX Implement a custom version of readEitherChunks (like for Posix) for
--- windows as well. Also implement readEitherByteChunks.
---
--- XXX For a fast custom implementation of traversal, the Right could be the
--- final array chunk including all files and dirs to be written to IO. The Left
--- could be list of dirs to be traversed.
---
--- This is a generic (but slower?) version of readEitherChunks using
--- eitherReaderPaths.
-{-# INLINE readEitherChunks #-}
-readEitherChunks :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
+-- | A generic (but slower) version of 'readEitherChunks' using
+-- 'eitherReaderPaths'.
+{-# INLINE readEitherChunksPortable #-}
+readEitherChunksPortable :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->
     [Path] -> Stream m (Either [Path] [Path])
-readEitherChunks f dirs =
+readEitherChunksPortable f dirs =
     -- XXX Need to use a take to limit the group size. There will be separate
     -- limits for dir and files groups.
      S.groupsWhile grouper collector
@@ -422,7 +415,6 @@ readEitherChunks f dirs =
                     Right _ -> Left [x1] -- initial
                     _ -> either (\xs -> Left (x1:xs)) Right b
             Right x1 -> fmap (x1:) b
-#endif
 
 -- | Read files only.
 --

core/src/Streamly/Internal/FileSystem/FileIO.hs

@@ -96,9 +96,9 @@ import qualified Streamly.Internal.Data.Fold.Type as FL
     (Step(..), snoc, reduce)
 import qualified Streamly.Internal.FileSystem.Handle as FH
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-import qualified Streamly.Internal.FileSystem.Posix.File as File
+import qualified Streamly.Internal.Syscall.Posix.File as File
 #else
-import qualified Streamly.Internal.FileSystem.Windows.File as File
+import qualified Streamly.Internal.Syscall.Windows.File as File
 #endif
 
 #include "inline.hs"