Add asCWString to use WindowsPath as a c string

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

@@ -43,7 +43,8 @@ module Streamly.Internal.Data.Array
     , cast
     , asBytes
     , unsafeCast
-    , asCStringUnsafe
+    , asCStringUnsafe -- XXX asCString
+    , asCWString
 
     -- * Subarrays
     -- , sliceOffLen
@@ -114,8 +115,7 @@ import Control.Monad.IO.Class (MonadIO(..))
 import Data.Functor.Identity (Identity(..))
 import Data.Proxy (Proxy(..))
 import Data.Word (Word8)
-import Foreign.C.String (CString)
-import Foreign.Ptr (castPtr)
+import Foreign.C.String (CString, CWString)
 import GHC.Types (SPEC(..))
 import Streamly.Internal.Data.Unbox (Unbox(..))
 import Prelude hiding (length, null, last, map, (!!), read, concat)
@@ -424,9 +424,8 @@ cast arr =
         then Nothing
         else Just $ unsafeCast arr
 
--- | Convert an array of any type into a null terminated CString Ptr.  If the
--- array is unpinned it is first converted to a pinned array which requires a
--- copy.
+-- | Convert an array of any element type into a null terminated CString Ptr.
+-- The array is copied to pinned memory.
 --
 -- /Unsafe/
 --
@@ -435,10 +434,19 @@ cast arr =
 -- /Pre-release/
 --
 asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b
-asCStringUnsafe arr act = do
-    let arr1 = asBytes arr <> fromList [0]
-    -- unsafePinnedAsPtr makes sure the array is pinned
-    unsafePinnedAsPtr arr1 $ \ptr _ -> act (castPtr ptr)
+asCStringUnsafe arr = MA.asCString (unsafeThaw arr)
+
+-- | Convert an array of any element type into a null terminated CWString Ptr.
+-- The array is copied to pinned memory.
+--
+-- /Unsafe/
+--
+-- /O(n) Time: (creates a copy of the array)/
+--
+-- /Pre-release/
+--
+asCWString :: Array a -> (CWString -> IO b) -> IO b
+asCWString arr = MA.asCWString (unsafeThaw arr)
 
 -------------------------------------------------------------------------------
 -- Folds

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

@@ -44,7 +44,9 @@ module Streamly.Internal.Data.MutArray.Type
     , cast
     , unsafeCast
     , asBytes
-    , unsafeAsPtr
+    , unsafeAsPtr -- XXX asPtr
+    , asCString
+    , asCWString
 
     -- ** Construction
     , empty
@@ -466,8 +468,9 @@ import Data.Char (ord)
 import Data.Functor.Identity (Identity(..))
 import Data.Proxy (Proxy(..))
 import Data.Word (Word8, Word16)
-import Foreign.C.Types (CSize(..))
-import Foreign.Ptr (plusPtr)
+import Foreign.C.String (CString, CWString)
+import Foreign.C.Types (CSize(..), CChar, CWchar)
+import Foreign.Ptr (plusPtr, castPtr)
 import Streamly.Internal.Data.MutByteArray.Type
     ( MutByteArray(..)
     , PinnedState(..)
@@ -3569,6 +3572,28 @@ unsafeCreateWithPtr' cap pop = do
              ++ "length = " ++ show len ++ ", "
              ++ "capacity = " ++ show cap
 
+asCString :: MutArray a -> (CString -> IO b) -> IO b
+asCString arr act = do
+    let pinned = isPinned arr
+        req = byteLength arr + SIZE_OF(CChar)
+    arr1 <-
+        if byteCapacity arr < req || not pinned
+        then reallocExplicitAs Pinned 1 req arr
+        else return arr
+    arr2 :: MutArray CChar <- snocUnsafe (unsafeCast arr1) (0 :: CChar)
+    unsafeAsPtr arr2 $ \ptr _ -> act (castPtr 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)
+
 -------------------------------------------------------------------------------
 -- Equality
 -------------------------------------------------------------------------------

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

@@ -42,6 +42,7 @@ module Streamly.Internal.Data.Unbox
     ) where
 
 #include "MachDeps.h"
+#include "HsBaseConfig.h"
 #include "ArrayMacros.h"
 
 import Control.Monad (void, when)
@@ -51,6 +52,7 @@ import Data.Functor.Const (Const(..))
 import Data.Functor.Identity (Identity(..))
 import Data.Kind (Type)
 import Data.Proxy (Proxy (..))
+import Foreign.C.Types (CChar(..), CWchar(..))
 import Foreign.Ptr (IntPtr(..), WordPtr(..))
 import GHC.Base (IO(..))
 import GHC.Fingerprint.Type (Fingerprint(..))
@@ -445,6 +447,11 @@ DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)
 DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)
 #endif
 DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)
+
+-- XXX Add more CTypes
+DERIVE_WRAPPED_UNBOX(,CChar,CChar,HTYPE_CHAR)
+DERIVE_WRAPPED_UNBOX(,CWchar,CWchar,HTYPE_WCHAR_T)
+
 DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)
 DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)
 DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)

core/src/Streamly/Internal/FileSystem/Posix/File.hs

@@ -33,7 +33,6 @@ import GHC.IO.Handle.FD (fdToHandle)
 import System.Posix.Types (Fd(..), CMode(..), FileMode)
 import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfMinus1Retry)
 
-import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.FileSystem.PosixPath as Path
 -- import qualified GHC.IO.FD as FD
 
@@ -124,9 +123,6 @@ openFdAtWith_ OpenFlags{..} fdMay path how =
 
     all_flags = creat_f .|. flags .|. open_mode
 
-withFilePath :: PosixPath -> (CString -> IO a) -> IO a
-withFilePath p = Array.asCStringUnsafe (Path.toChunk p)
-
 -- | Open a file relative to an optional directory file descriptor.
 --
 -- {-# INLINE openFdAtWith #-}
@@ -137,7 +133,7 @@ openFdAtWith ::
     -> OpenMode -- ^ Read-only, read-write or write-only
     -> IO Fd
 openFdAtWith flags fdMay name how =
-   withFilePath name $ \str -> do
+   Path.asCString name $ \str -> do
      throwErrnoPathIfMinus1Retry "openFdAt" name
         $ openFdAtWith_ flags fdMay str how
 

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

@@ -76,8 +76,11 @@ module Streamly.Internal.FileSystem.OS_PATH
     , toChars
     , toChars_
     , toString
-    -- , toCString
-    -- , toW16CString
+#ifndef IS_WINDOWS
+    , asCString
+#else
+    , asCWString
+#endif
     , toString_
     , showRaw
 
@@ -128,12 +131,15 @@ import Data.Word (Word16)
 #endif
 #ifndef IS_WINDOWS
 import Foreign.C (CString)
+#else
+import Foreign.C (CWString)
 #endif
 import Language.Haskell.TH.Syntax (lift)
 import Streamly.Internal.Data.Array (Array(..))
 import Streamly.Internal.Data.Stream (Stream)
 import Streamly.Internal.FileSystem.Path.Common (mkQ, EqCfg(..), eqCfg)
 
+import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.Data.Stream as Stream
 import qualified Streamly.Internal.FileSystem.Path.Common as Common
 import qualified Streamly.Internal.Unicode.Stream as Unicode
@@ -382,6 +388,16 @@ instance Show OS_PATH where
     show (OS_PATH x) = show x
 -}
 
+#ifndef IS_WINDOWS
+{-# INLINE asCString #-}
+asCString :: OS_PATH -> (CString -> IO a) -> IO a
+asCString p = Array.asCStringUnsafe (toChunk p)
+#else
+{-# INLINE asCWString #-}
+asCWString :: OS_PATH -> (CWString -> IO a) -> IO a
+asCWString p = Array.asCWString (toChunk p)
+#endif
+
 ------------------------------------------------------------------------------
 -- Operations on Path
 ------------------------------------------------------------------------------