diff --git a/src/Data/Text/Foreign.hs b/src/Data/Text/Foreign.hs index ad44ea6a0..c41036772 100644 --- a/src/Data/Text/Foreign.hs +++ b/src/Data/Text/Foreign.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, MagicHash #-} -- | -- Module : Data.Text.Foreign -- Copyright : (c) 2009, 2010 Bryan O'Sullivan @@ -17,6 +17,7 @@ module Data.Text.Foreign I8 -- * Safe conversion functions , fromPtr + , fromPtr0 , useAsPtr , asForeignPtr -- ** Encoding as UTF-8 @@ -36,12 +37,14 @@ import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Internal (Text(..), empty) import Data.Text.Internal.Unsafe (unsafeWithForeignPtr) +import Data.Text.Show (addrLen) import Data.Text.Unsafe (lengthWord8) import Data.Word (Word8) import Foreign.C.String (CStringLen) import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (Ptr, castPtr) +import GHC.Exts (Ptr(..)) import qualified Data.Text.Array as A -- $interop @@ -72,6 +75,12 @@ fromPtr ptr (I8 len) = unsafeSTToIO $ do arr <- A.unsafeFreeze dst return $! Text arr 0 len +-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word8' by copying the +-- contents of the NUL-terminated array. +fromPtr0 :: Ptr Word8 -- ^ source array + -> IO Text +fromPtr0 ptr@(Ptr addr#) = fromPtr ptr (fromIntegral (addrLen addr#)) + -- $lowlevel -- -- Foreign functions that use UTF-8 internally may return indices in diff --git a/src/Data/Text/Show.hs b/src/Data/Text/Show.hs index d19b36899..2fd2c961d 100644 --- a/src/Data/Text/Show.hs +++ b/src/Data/Text/Show.hs @@ -16,7 +16,8 @@ module Data.Text.Show ( - singleton + addrLen + , singleton , unpack , unpackCString# , unpackCStringAscii# diff --git a/tests/Tests/Properties/LowLevel.hs b/tests/Tests/Properties/LowLevel.hs index bd1bee300..336b57da3 100644 --- a/tests/Tests/Properties/LowLevel.hs +++ b/tests/Tests/Properties/LowLevel.hs @@ -66,6 +66,9 @@ t_dropWord8 m t = dropWord8 m t `T.isSuffixOf` t t_takeWord8 m t = takeWord8 m t `T.isPrefixOf` t t_take_drop_8 (Small n) t = T.append (takeWord8 n t) (dropWord8 n t) === t t_use_from t = ioProperty $ (==t) <$> useAsPtr t fromPtr +t_use_from0 t = ioProperty $ do + let t' = t `T.snoc` '\0' + (== T.takeWhile (/= '\0') t') <$> useAsPtr t' (const . fromPtr0) t_copy t = T.copy t === t @@ -118,6 +121,7 @@ testLowLevel = testProperty "t_takeWord8" t_takeWord8, testProperty "t_take_drop_8" t_take_drop_8, testProperty "t_use_from" t_use_from, + testProperty "t_use_from0" t_use_from0, testProperty "t_copy" t_copy, testCase "t_literal_length1" t_literal_length1, testCase "t_literal_length2" t_literal_length2,