@@ -1,3 +1,5 @@
1+{-# LANGUAGE BangPatterns #-}
2-- Module : Data.Text.Lazy.Encoding.Fusion
4-- Module : Data.Text.Lazy.Encoding.Fusion
3-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
@@ -22,46 +24,107 @@ module Data.Text.Lazy.Encoding.Fusion
22 --, streamUtf32BE
24 --, streamUtf32BE
24 -- * Unstreaming
26 -- * Unstreaming
25− --, unstream
27+ , unstream
27 , module Data.Text.Encoding.Fusion.Common
29 , module Data.Text.Encoding.Fusion.Common
30−import Data.ByteString.Lazy.Internal (ByteString(..))
32+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
31import qualified Data.ByteString as B
33import qualified Data.ByteString as B
32import qualified Data.ByteString.Unsafe as B
34import qualified Data.ByteString.Unsafe as B
33import Data.Text.Encoding.Fusion.Common
35import Data.Text.Encoding.Fusion.Common
34import Data.Text.Fusion (Step(..), Stream(..))
36import Data.Text.Fusion (Step(..), Stream(..))
35−import Data.Text.Fusion.Internal (PairS(..))
37+import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))
36import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
38import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
39+import Data.Word (Word8)
37import qualified Data.Text.Encoding.Utf8 as U8
40import qualified Data.Text.Encoding.Utf8 as U8
41+import System.IO.Unsafe (unsafePerformIO)
42+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
43+import Foreign.Storable (pokeByteOff)
44+import Data.ByteString.Internal (mallocByteString, memcpy)
45+import Control.Exception (assert)
46+import qualified Data.ByteString.Internal as B
39unknownLength :: Int
48unknownLength :: Int
40unknownLength = 4
49unknownLength = 4
42−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
51+-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
43−-- encoding.
52+-- UTF-8 encoding.
44streamUtf8 :: ByteString -> Stream Char
53streamUtf8 :: ByteString -> Stream Char
45−streamUtf8 bs0 = Stream next (bs0 :!: 0) unknownLength
54+streamUtf8 bs0 = Stream next (bs0 :!: S N N N N :!: 0) unknownLength
47 {-# INLINE next #-}
56 {-# INLINE next #-}
48− next (c@(Chunk bs rest) :!: i)
57+ next st@(bs :!: s :!: i) =
49− | i >= l = next (rest :!: 0)
58+ case s of
59+ S (J a) N N N | U8.validate1 a ->
50− | U8.validate1 x1 = Yield (unsafeChr8 x1) (c :!: i+1)
60+ Yield (unsafeChr8 a) es
61+ S (J a) (J b) N N | U8.validate2 a b ->
51− | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (c :!: i+2)
62+ Yield (U8.chr2 a b) es
52− | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (c :!: i+3)
63+ S (J a) (J b) (J c) N | U8.validate3 a b c ->
53− | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (c :!: i+4)
64+ Yield (U8.chr3 a b c) es
65+ S (J a) (J b) (J c) (J d) | U8.validate4 a b c d ->
66+ Yield (U8.chr4 a b c d) es
68+ where es = bs :!: S N N N N :!: i
69+ {-# INLINE consume #-}
70+ consume (c@(Chunk bs rest) :!: s :!: i)
71+ | i >= len = consume (rest :!: s :!: 0)
54− | otherwise = encodingError "UTF-8"
72+ | otherwise = next (c :!: s' :!: i+1)
55− where
73+ where s' = case s of
56− x1 = idx i
74+ S N _ _ _ -> S x N N N
57− x2 = idx (i + 1)
75+ S a N _ _ -> S a x N N
58− x3 = idx (i + 2)
76+ S a b N _ -> S a b x N
59− x4 = idx (i + 3)
77+ S a b c N -> S a b c x
78+ _ -> encodingError "streamUtf8" "UTF-8"
60− idx = B.unsafeIndex bs
79+ x = J (B.unsafeIndex bs i)
61− l = B.length bs
80+ len = B.length bs
62− next (Empty :!: _) = Done
81+ consume (Empty :!: S N _ _ _ :!: _) = Done
82+ consume _ = encodingError "streamUtf8" "UTF-8"
63{-# INLINE [0] streamUtf8 #-}
83{-# INLINE [0] streamUtf8 #-}
85+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
86+unstreamChunks :: Int -> Stream Word8 -> ByteString
87+unstreamChunks chunkSize (Stream next s0 len) = chunk s0 len
88+ where chunk s0 len = unsafePerformIO $ do
89+ let safeLen = min (max len unknownLength) chunkSize
90+ fp0 <- mallocByteString safeLen
91+ loop fp0 safeLen 0 s0
93+ loop !fp !n !off !s = case next s of
94+ Done | off == 0 -> return Empty
97+ return $! Chunk bs Empty
98+ Skip s' -> loop fp n off s'
100+ | off == chunkSize -> do
102+ return (Chunk bs (chunk s (len - B.length bs)))
103+ | off == n -> realloc fp n off s' x
105+ withForeignPtr fp $ \p -> pokeByteOff p off x
106+ loop fp n (off+1) s'
107+ {-# NOINLINE realloc #-}
108+ realloc fp n off s x = do
109+ let n' = min (n+n) chunkSize
110+ fp' <- copy0 fp n n'
111+ withForeignPtr fp' $ \p -> pokeByteOff p off x
112+ loop fp' n' (off+1) s
113+ {-# NOINLINE trimUp #-}
114+ trimUp fp off = return $! B.PS fp 0 off
115+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
116+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
117+ dest <- mallocByteString destLen
118+ withForeignPtr src $ \src' ->
119+ withForeignPtr dest $ \dest' ->
120+ memcpy dest' src' (fromIntegral srcLen)
123+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
124+unstream :: Stream Word8 -> ByteString
125+unstream = unstreamChunks 64
65−encodingError :: String -> a
127+encodingError :: String -> String -> a
66−encodingError encoding =
128+encodingError func encoding =
67− error $ "Data.Text.Lazy.Encoding.Fusion: Bad " ++ encoding ++ " stream"
129+ error $ "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Bad " ++
130+ encoding ++ " stream"