Add asCWStringUnsafe

Author: harendra-kumar

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)