git.iko.soy/text
on 0fdeebd help sign in
text/Data/Text/Internal/Encoding/Fusion.hs
208 lines 7.8 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
169unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170 let mlen = upperBound 4 len
171 mallocByteString mlen >>= loop mlen 0 s0
172 where
173 loop !n !off !s fp = case next s of
174 Done -> trimUp fp n off
175 Skip s' -> loop n off s' fp
176 Yield x s'
177 | off == n -> realloc fp n off s' x
178 | otherwise -> do
179 withForeignPtr fp $ \p -> pokeByteOff p off x
180 loop n (off+1) s' fp
181 {-# NOINLINE realloc #-}
182 realloc fp n off s x = do
183 let n' = n+n
184 fp' <- copy0 fp n n'
185 withForeignPtr fp' $ \p -> pokeByteOff p off x
186 loop n' (off+1) s fp'
187 {-# NOINLINE trimUp #-}
188 trimUp fp _ off = return $! PS fp 0 off
189 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
190 copy0 !src !srcLen !destLen =
191#if defined(ASSERTS)
192 assert (srcLen <= destLen) $
193#endif
194 do
195 dest <- mallocByteString destLen
196 withForeignPtr src $ \src' ->
197 withForeignPtr dest $ \dest' ->
198 memcpy dest' src' (fromIntegral srcLen)
199 return dest
201decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
202 -> s -> Step s Char
203decodeError func kind onErr mb i =
204 case onErr desc mb of
205 Nothing -> Skip i
206 Just c -> Yield c i
207 where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++
208 kind ++ " stream"