git.iko.soy/text
on 503c396 help sign in
text/Data/Text/Internal/Encoding/Fusion.hs
210 lines 7.9 kB history raw
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
3-- |
4-- Module : Data.Text.Internal.Encoding.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
8--
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
11-- Stability : experimental
12-- Portability : portable
13--
14-- /Warning/: this is an internal module, and does not have a stable
15-- API or name. Functions in this module may not check or enforce
16-- preconditions expected by public modules. Use at your own risk!
17--
18-- Fusible 'Stream'-oriented functions for converting between 'Text'
19-- and several common encodings.
21module Data.Text.Internal.Encoding.Fusion
22 (
23 -- * Streaming
24 streamASCII
25 , streamUtf8
26 , streamUtf16LE
27 , streamUtf16BE
28 , streamUtf32LE
29 , streamUtf32BE
31 -- * Unstreaming
32 , unstream
34 , module Data.Text.Internal.Encoding.Fusion.Common
35 ) where
37#if defined(ASSERTS)
38import Control.Exception (assert)
39#endif
40import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
41import Data.Text.Internal.Fusion (Step(..), Stream(..))
42import Data.Text.Internal.Fusion.Size
43import Data.Text.Encoding.Error
44import Data.Text.Internal.Encoding.Fusion.Common
45import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
46import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
47import Data.Word (Word8, Word16, Word32)
48import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
49import Foreign.Storable (pokeByteOff)
50import qualified Data.ByteString as B
51import qualified Data.ByteString.Unsafe as B
52import qualified Data.Text.Internal.Encoding.Utf8 as U8
53import qualified Data.Text.Internal.Encoding.Utf16 as U16
54import qualified Data.Text.Internal.Encoding.Utf32 as U32
55import Data.Text.Unsafe (unsafeDupablePerformIO)
57streamASCII :: ByteString -> Stream Char
58streamASCII bs = Stream next 0 -- (maxSize l)
59 where
60 l = B.length bs
61 {-# INLINE next #-}
62 next i
63 | i >= l = Done
64 | otherwise = Yield (unsafeChr8 x1) (i+1)
65 where
66 x1 = B.unsafeIndex bs i
67{-# DEPRECATED streamASCII "Do not use this function" #-}
68{-# INLINE [0] streamASCII #-}
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
71-- encoding.
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
74 where
75 l = B.length bs
76 next i
77 | i >= l = Done
78 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
79 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
80 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
81 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
82 | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)
83 where
84 x1 = idx i
85 x2 = idx (i + 1)
86 x3 = idx (i + 2)
87 x4 = idx (i + 3)
88 idx = B.unsafeIndex bs
89{-# INLINE [0] streamUtf8 #-}
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
92-- endian UTF-16 encoding.
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
94streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
95 where
96 l = B.length bs
97 {-# INLINE next #-}
98 next i
99 | i >= l = Done
100 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
101 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
102 | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)
103 where
104 x1 = idx i + (idx (i + 1) `shiftL` 8)
105 x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)
106 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
107{-# INLINE [0] streamUtf16LE #-}
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110-- endian UTF-16 encoding.
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
112streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
113 where
114 l = B.length bs
115 {-# INLINE next #-}
116 next i
117 | i >= l = Done
118 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
119 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
120 | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)
121 where
122 x1 = (idx i `shiftL` 8) + idx (i + 1)
123 x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)
124 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
125{-# INLINE [0] streamUtf16BE #-}
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128-- endian UTF-32 encoding.
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
130streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
131 where
132 l = B.length bs
133 {-# INLINE next #-}
134 next i
135 | i >= l = Done
136 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
137 | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)
138 where
139 x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
140 x1 = idx i
141 x2 = idx (i+1)
142 x3 = idx (i+2)
143 x4 = idx (i+3)
144 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
145{-# INLINE [0] streamUtf32BE #-}
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148-- endian UTF-32 encoding.
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
150streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
151 where
152 l = B.length bs
153 {-# INLINE next #-}
154 next i
155 | i >= l = Done
156 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
157 | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)
158 where
159 x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
160 x1 = idx i
161 x2 = idx $ i+1
162 x3 = idx $ i+2
163 x4 = idx $ i+3
164 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
165{-# INLINE [0] streamUtf32LE #-}
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
169-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170unstream (Stream next s0) = unsafeDupablePerformIO $ do
171 -- let mlen = upperBound 4 len
172 let mlen = 4
173 mallocByteString mlen >>= loop mlen 0 s0
174 where
175 loop !n !off !s fp = case next s of
176 Done -> trimUp fp n off
177 Skip s' -> loop n off s' fp
178 Yield x s'
179 | off == n -> realloc fp n off s' x
180 | otherwise -> do
181 withForeignPtr fp $ \p -> pokeByteOff p off x
182 loop n (off+1) s' fp
183 {-# NOINLINE realloc #-}
184 realloc fp n off s x = do
185 let n' = n+n
186 fp' <- copy0 fp n n'
187 withForeignPtr fp' $ \p -> pokeByteOff p off x
188 loop n' (off+1) s fp'
189 {-# NOINLINE trimUp #-}
190 trimUp fp _ off = return $! PS fp 0 off
191 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
192 copy0 !src !srcLen !destLen =
193#if defined(ASSERTS)
194 assert (srcLen <= destLen) $
195#endif
196 do
197 dest <- mallocByteString destLen
198 withForeignPtr src $ \src' ->
199 withForeignPtr dest $ \dest' ->
200 memcpy dest' src' (fromIntegral srcLen)
201 return dest
203decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
204 -> s -> Step s Char
205decodeError func kind onErr mb i =
206 case onErr desc mb of
207 Nothing -> Skip i
208 Just c -> Yield c i
209 where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
210 kind ++ " stream"