@@ -54,6 +54,14 @@ module Data.Text.Encoding
5454 , encodeUtf16BE
5555 , encodeUtf32LE
5656 , encodeUtf32BE
57+
58+#if MIN_VERSION_bytestring(0,10,4)
59+ -- * Generic encoding of Text
60+ -- , encodeStreamWithB
61+ -- , encodeTextWithB
62+ -- , encodeUtf8Builder
63+ , encodeUtf8Escaped
64+#endif
5765 ) where
5866
5967import Control.Exception (evaluate, try)
@@ -66,6 +74,13 @@ import Control.Monad.ST (runST)
6674import Data.Bits ((.&.))
6775import Data.ByteString as B
6876import Data.ByteString.Internal as B
77+#if MIN_VERSION_bytestring(0,10,4)
78+import qualified Data.ByteString.Builder as B
79+import qualified Data.ByteString.Builder.Internal as B
80+import qualified Data.ByteString.Builder.Prim as BP
81+import qualified Data.ByteString.Builder.Prim.Internal as BP
82+import qualified Data.ByteString.Lazy as BL
83+#endif
6984import Data.Text ()
7085import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
7186import Data.Text.Internal (Text(..), safe, textP)
@@ -291,6 +306,61 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDec
291306
292307-- | Encode text using UTF-8 encoding.
293308encodeUtf8 :: Text -> ByteString
309+#if MIN_VERSION_bytestring(0,10,4)
310+
311+encodeUtf8 =
312+ BL.toStrict . B.toLazyByteString
313+ . encodeUtf8Escaped (BP.liftFixedToBounded BP.word8)
314+
315+-- | Encode text using UTF-8 encoding and escape the ASCII characters using
316+-- a 'BP.PrimBounded'.
317+encodeUtf8Escaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
318+encodeUtf8Escaped be (Text arr off len) =
319+ B.builder step
320+ where
321+ bound = max 4 $ BP.sizeBound be
322+ iend = off + len
323+ step !k =
324+ outerLoop off
325+ where
326+ outerLoop !i0 !br@(B.BufferRange op0 ope)
327+ | i0 >= iend = k br
328+ | op0 `plusPtr` bound < ope =
329+ goPartial (i0 + min outRemaining inpRemaining)
330+ | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
331+ where
332+ outRemaining = (ope `minusPtr` op0) `div` bound
333+ inpRemaining = iend - i0
334+
335+ goPartial !iendTmp = go i0 op0
336+ where
337+ go !i !op
338+ | i < iendTmp = case A.unsafeIndex arr i of
339+ w | w <= 0x7F -> do
340+ BP.runB be (fromIntegral w) op >>= go (i + 1)
341+ | w <= 0x7FF -> do
342+ poke8 0 $ (w `shiftR` 6) + 0xC0
343+ poke8 1 $ (w .&. 0x3f) + 0x80
344+ go (i + 1) (op `plusPtr` 2)
345+ | 0xD800 <= w && w <= 0xDBFF -> do
346+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
347+ poke8 0 $ (c `shiftR` 18) + 0xF0
348+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
349+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
350+ poke8 3 $ (c .&. 0x3F) + 0x80
351+ go (i + 2) (op `plusPtr` 4)
352+ | otherwise -> do
353+ poke8 0 $ (w `shiftR` 12) + 0xE0
354+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
355+ poke8 2 $ (w .&. 0x3F) + 0x80
356+ go (i + 1) (op `plusPtr` 3)
357+ | otherwise =
358+ outerLoop i (B.BufferRange op ope)
359+ where
360+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
361+
362+#else
363+
294364encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
295365 let size0 = max len 4
296366 mallocByteString size0 >>= start size0 off 0
@@ -344,6 +414,7 @@ encodeUtf8 (Text arr off len) = unsafeDupablePerformIO $ do
344414 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
345415 poke8 (m+2) $ (w .&. 0x3F) + 0x80
346416 go (n+1) (m+3)
417+#endif
347418
348419-- | Decode text from little endian UTF-16 encoding.
349420decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -432,3 +503,36 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
432503
433504foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
434505 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
506+
507+
508+{-
509+-- | Encode all elements of a 'F.Stream' using a 'B.BoundedEncoding'.
510+{-# INLINE encodeStreamWithB #-}
511+encodeStreamWithB :: B.BoundedEncoding a -> F.Stream a -> B.Builder
512+encodeStreamWithB be =
513+ \(F.Stream next s0 _) -> B.builder $ step next s0
514+ where
515+ bound = B.sizeBound be
516+ step next s0 k (B.BufferRange op0 ope0) =
517+ go s0 op0
518+ where
519+ go s !op = case next s of
520+ F.Done -> k (B.BufferRange op ope0)
521+ F.Skip s' -> go s' op
522+ F.Yield x s'
523+ | op `plusPtr` bound <= ope0 -> B.runB be x op >>= go s'
524+ | otherwise ->
525+ return $ B.bufferFull bound op (step next s k)
526+
527+
528+-- |
529+-- | /Subject to fusion./
530+-- Encode all 'Char's of a 'T.Text' using a 'B.BoundedEncoding'.
531+{-# INLINE encodeTextWithB #-}
532+encodeTextWithB :: B.BoundedEncoding Char -> Text -> B.Builder
533+encodeTextWithB be = encodeStreamWithB be . F.stream
534+
535+-- | Encode text using UTF-8 encoding.
536+encodeUtf8Builder :: Text -> B.Builder
537+encodeUtf8Builder = encodeUtf8Escaped (B.fromF B.word8)
538+-}