Data.Text.Foreign: added peekCString

src/Data/Text/Foreign.hs

@@ -21,6 +21,7 @@ module Data.Text.Foreign
     , useAsPtr
     , asForeignPtr
     -- ** Encoding as UTF-8
+    , peekCString
     , withCString
     , peekCStringLen
     , withCStringLen
@@ -34,7 +35,7 @@ module Data.Text.Foreign
     ) where
 
 import Control.Monad.ST.Unsafe (unsafeSTToIO)
-import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)
+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafePackCString, unsafeUseAsCStringLen)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Text.Internal (Text(..), empty)
 import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)
@@ -179,6 +180,16 @@ peekCStringLen cs = do
   bs <- unsafePackCStringLen cs
   return $! decodeUtf8 bs
 
+-- | /O(n)/ Decode a null-terminated C string, which is assumed
+-- to have been encoded as UTF-8. If decoding fails, a
+-- 'UnicodeException' is thrown.
+--
+-- @since 2.1.2
+peekCString :: CString -> IO Text
+peekCString cs = do
+  bs <- unsafePackCString cs
+  return $! decodeUtf8 bs
+
 -- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary
 -- storage, with explicit length information. The encoded string may
 -- contain NUL bytes, and is not followed by a trailing NUL byte.

tests/Tests/Properties/LowLevel.hs

@@ -28,6 +28,7 @@ import Test.QuickCheck hiding ((.&.))
 import Tests.QuickCheckUtils
 import Tests.Utils
 import qualified Data.Text as T
+import qualified Data.Text.Foreign as T
 import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
@@ -72,6 +73,14 @@ t_use_from0 t = ioProperty $ do
   let t' = t `T.snoc` '\0'
   (== T.takeWhile (/= '\0') t') <$> useAsPtr t' (const . fromPtr0)
 
+t_peek_cstring t = ioProperty $ do
+  roundTrip <- T.withCString t T.peekCString
+  assertEqual "cstring" t roundTrip
+
+t_peek_cstring_len t = ioProperty $ do
+  roundTrip <- T.withCStringLen t T.peekCStringLen
+  assertEqual "cstring_len" t roundTrip
+
 t_copy t = T.copy t === t
 
 t_literal_length1 = assertEqual xs (length xs) byteLen
@@ -125,6 +134,8 @@ testLowLevel =
       testProperty "t_use_from" t_use_from,
       testProperty "t_use_from0" t_use_from0,
       testProperty "t_copy" t_copy,
+      testProperty "t_peek_cstring" t_peek_cstring,
+      testProperty "t_peek_cstring_len" t_peek_cstring_len,
       testCase "t_literal_length1" t_literal_length1,
       testCase "t_literal_length2" t_literal_length2,
       testCase "t_literal_surrogates" t_literal_surrogates
@@ -151,4 +162,3 @@ testLowLevel =
       -- testProperty "tl_put_get" tl_put_get
     ]
   ]
-