git.iko.soy/text
on 0b0c021 help sign in
text/Data/Text/Encoding/Fusion.hs
200 lines 7.4 kB history raw
1{-# LANGUAGE BangPatterns, Rank2Types #-}
3-- |
4-- Module : Data.Text.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 : rtharper@aftereternity.co.uk, bos@serpentine.com,
11-- duncan@haskell.org
12-- Stability : experimental
13-- Portability : portable
14--
15-- Fusible 'Stream'-oriented functions for converting between 'Text'
16-- and several common encodings.
18module Data.Text.Encoding.Fusion
19 (
20 -- * Streaming
21 streamASCII
22 , streamUtf8
23 , streamUtf16LE
24 , streamUtf16BE
25 , streamUtf32LE
26 , streamUtf32BE
28 -- * Unstreaming
29 , unstream
31 , module Data.Text.Encoding.Fusion.Common
32 ) where
34import Control.Exception (assert)
35import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
36import Data.Text.Fusion (Step(..), Stream(..))
37import Data.Text.Fusion.Size
38import Data.Text.Encoding.Error
39import Data.Text.Encoding.Fusion.Common
40import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
41import Data.Text.UnsafeShift (shiftL, shiftR)
42import Data.Word (Word8, Word16, Word32)
43import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
44import Foreign.Storable (pokeByteOff)
45import System.IO.Unsafe (unsafePerformIO)
46import qualified Data.ByteString as B
47import qualified Data.ByteString.Unsafe as B
48import qualified Data.Text.Encoding.Utf8 as U8
49import qualified Data.Text.Encoding.Utf16 as U16
50import qualified Data.Text.Encoding.Utf32 as U32
52streamASCII :: ByteString -> Stream Char
53streamASCII bs = Stream next 0 (maxSize l)
54 where
55 l = B.length bs
56 {-# INLINE next #-}
57 next i
58 | i >= l = Done
59 | otherwise = Yield (unsafeChr8 x1) (i+1)
60 where
61 x1 = B.unsafeIndex bs i
62{-# INLINE [0] streamASCII #-}
64-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
65-- encoding.
66streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
67streamUtf8 onErr bs = Stream next 0 (maxSize l)
68 where
69 l = B.length bs
70 {-# INLINE next #-}
71 next i
72 | i >= l = Done
73 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
74 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
75 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
76 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
77 | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)
78 where
79 mx = if i >= l then Nothing else Just x1
80 x1 = idx i
81 x2 = idx (i + 1)
82 x3 = idx (i + 2)
83 x4 = idx (i + 3)
84 idx = B.unsafeIndex bs
85{-# INLINE [0] streamUtf8 #-}
87-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
88-- endian UTF-16 encoding.
89streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
90streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
91 where
92 l = B.length bs
93 {-# INLINE next #-}
94 next i
95 | i >= l = Done
96 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
97 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
98 | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)
99 where
100 x1 = idx i + (idx (i + 1) `shiftL` 8)
101 x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)
102 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
103{-# INLINE [0] streamUtf16LE #-}
105-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
106-- endian UTF-16 encoding.
107streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
108streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
109 where
110 l = B.length bs
111 {-# INLINE next #-}
112 next i
113 | i >= l = Done
114 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
115 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
116 | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)
117 where
118 x1 = (idx i `shiftL` 8) + idx (i + 1)
119 x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)
120 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
121{-# INLINE [0] streamUtf16BE #-}
123-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
124-- endian UTF-32 encoding.
125streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
126streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
127 where
128 l = B.length bs
129 {-# INLINE next #-}
130 next i
131 | i >= l = Done
132 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
133 | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)
134 where
135 x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
136 x1 = idx i
137 x2 = idx (i+1)
138 x3 = idx (i+2)
139 x4 = idx (i+3)
140 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
141{-# INLINE [0] streamUtf32BE #-}
143-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
144-- endian UTF-32 encoding.
145streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
146streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
147 where
148 l = B.length bs
149 {-# INLINE next #-}
150 next i
151 | i >= l = Done
152 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
153 | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)
154 where
155 x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
156 x1 = idx i
157 x2 = idx $ i+1
158 x3 = idx $ i+2
159 x4 = idx $ i+3
160 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
161{-# INLINE [0] streamUtf32LE #-}
163-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
164unstream :: Stream Word8 -> ByteString
165unstream (Stream next s0 len) = unsafePerformIO $ do
166 let mlen = upperBound 4 len
167 mallocByteString mlen >>= loop mlen 0 s0
168 where
169 loop !n !off !s fp = case next s of
170 Done -> trimUp fp n off
171 Skip s' -> loop n off s' fp
172 Yield x s'
173 | off == n -> realloc fp n off s' x
174 | otherwise -> do
175 withForeignPtr fp $ \p -> pokeByteOff p off x
176 loop n (off+1) s' fp
177 {-# NOINLINE realloc #-}
178 realloc fp n off s x = do
179 let n' = n+n
180 fp' <- copy0 fp n n'
181 withForeignPtr fp' $ \p -> pokeByteOff p off x
182 loop n' (off+1) s fp'
183 {-# NOINLINE trimUp #-}
184 trimUp fp _ off = return $! PS fp 0 off
185 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
186 copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
187 dest <- mallocByteString destLen
188 withForeignPtr src $ \src' ->
189 withForeignPtr dest $ \dest' ->
190 memcpy dest' src' (fromIntegral srcLen)
191 return dest
193decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
194 -> s -> Step s Char
195decodeError func kind onErr mb i =
196 case onErr desc mb of
197 Nothing -> Skip i
198 Just c -> Yield c i
199 where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
200 kind ++ " stream"