git.iko.soy/text
on 3cf8564 help sign in
text/Data/Text/Encoding/Fusion.hs
205 lines 7.5 kB history raw
1{-# LANGUAGE BangPatterns, CPP, 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 : bos@serpentine.com, rtomharper@googlemail.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
34#if defined(ASSERTS)
35import Control.Exception (assert)
36#endif
37import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
38import Data.Text.Fusion (Step(..), Stream(..))
39import Data.Text.Fusion.Size
40import Data.Text.Encoding.Error
41import Data.Text.Encoding.Fusion.Common
42import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
43import Data.Text.UnsafeShift (shiftL, shiftR)
44import Data.Word (Word8, Word16, Word32)
45import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
46import Foreign.Storable (pokeByteOff)
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
52import Data.Text.Unsafe (unsafeDupablePerformIO)
54streamASCII :: ByteString -> Stream Char
55streamASCII bs = Stream next 0 (maxSize l)
56 where
57 l = B.length bs
58 {-# INLINE next #-}
59 next i
60 | i >= l = Done
61 | otherwise = Yield (unsafeChr8 x1) (i+1)
62 where
63 x1 = B.unsafeIndex bs i
64{-# DEPRECATED streamASCII "Do not use this function" #-}
65{-# INLINE [0] streamASCII #-}
67-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
68-- encoding.
69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70streamUtf8 onErr bs = Stream next 0 (maxSize l)
71 where
72 l = B.length bs
73 next i
74 | i >= l = Done
75 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
76 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
77 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
78 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
79 | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)
80 where
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) = unsafeDupablePerformIO $ 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 =
188#if defined(ASSERTS)
189 assert (srcLen <= destLen) $
190#endif
191 do
192 dest <- mallocByteString destLen
193 withForeignPtr src $ \src' ->
194 withForeignPtr dest $ \dest' ->
195 memcpy dest' src' (fromIntegral srcLen)
196 return dest
198decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
199 -> s -> Step s Char
200decodeError func kind onErr mb i =
201 case onErr desc mb of
202 Nothing -> Skip i
203 Just c -> Yield c i
204 where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
205 kind ++ " stream"