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