git.iko.soy/text
on 1cd4e39 help sign in
text/Data/Text/Encoding.hs
247 lines 9.0 kB history raw
1{-# LANGUAGE BangPatterns #-}
2-- |
3-- Module : Data.Text.Encoding
4-- Copyright : (c) 2008, 2009 Tom Harper,
5-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009 Duncan Coutts
7--
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10-- duncan@haskell.org
11-- Stability : experimental
12-- Portability : portable
13--
14-- Functions for converting 'Text' values to and from 'ByteString',
15-- using several standard encodings.
16--
17-- To gain access to a much larger family of encodings, use the
18-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
20module Data.Text.Encoding
21 (
22 -- * Decoding ByteStrings to Text
23 -- $strict
24 decodeASCII
25 , decodeUtf8
26 , decodeUtf16LE
27 , decodeUtf16BE
28 , decodeUtf32LE
29 , decodeUtf32BE
31 -- ** Controllable error handling
32 , decodeUtf8With
33 , decodeUtf16LEWith
34 , decodeUtf16BEWith
35 , decodeUtf32LEWith
36 , decodeUtf32BEWith
38 -- * Encoding Text to ByteStrings
39 , encodeUtf8
40 , encodeUtf16LE
41 , encodeUtf16BE
42 , encodeUtf32LE
43 , encodeUtf32BE
44 ) where
46import Data.Bits ((.&.))
47import Data.ByteString as B
48import Data.ByteString.Internal as B
49import Data.ByteString.Unsafe as B
50import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
51import Data.Text.Internal (Text(..), textP)
52import Data.Text.UnsafeChar (ord, unsafeWrite)
53import Data.Text.UnsafeShift (shiftL, shiftR)
54import Data.Word (Word8)
55import Foreign.ForeignPtr (withForeignPtr)
56import Foreign.Ptr (plusPtr)
57import Foreign.Storable (poke)
58import System.IO.Unsafe (unsafePerformIO)
59import qualified Data.Text.Array as A
60import qualified Data.Text.Encoding.Fusion as E
61import qualified Data.Text.Encoding.Utf16 as U16
62import qualified Data.Text.Encoding.Utf8 as U8
63import qualified Data.Text.Fusion as F
65-- $strict
66--
67-- All of the single-parameter functions for decoding bytestrings
68-- encoded in one of the Unicode Transformation Formats (UTF) operate
69-- in a /strict/ mode: each will throw an exception if given invalid
70-- input.
71--
72-- Each function has a variant, whose name is suffixed with -'With',
73-- that gives greater control over the handling of decoding errors.
74-- For instance, 'decodeUtf8' will throw an exception, but
75-- 'decodeUtf8With' allows the programmer to determine what to do on a
76-- decoding error.
78-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
79decodeASCII :: ByteString -> Text
80decodeASCII bs = F.unstream (E.streamASCII bs)
81{-# INLINE decodeASCII #-}
83-- | Decode a 'ByteString' containing UTF-8 encoded text.
84decodeUtf8With :: OnDecodeError -> ByteString -> Text
85decodeUtf8With onErr bs = textP (fst a) 0 (snd a)
86 where
87 a = A.run2 (A.new len >>= outer 0 0)
88 len = B.length bs
89 outer n0 m0 arr = go n0 m0
90 where
91 go !n !m = do
92 let x1 = idx m
93 x2 = idx (m + 1)
94 x3 = idx (m + 2)
95 x4 = idx (m + 3)
96 idx = B.unsafeIndex bs
97 case undefined of
98 _| m >= len -> return (arr,n)
99 | U8.validate1 x1 -> do
100 A.unsafeWrite arr n (fromIntegral x1)
101 go (n+1) (m+1)
102 | m+1 < len && U8.validate2 x1 x2 -> do
103 w <- unsafeWrite arr n (U8.chr2 x1 x2)
104 go (n+w) (m+2)
105 | m+2 < len && U8.validate3 x1 x2 x3 -> do
106 w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
107 go (n+w) (m+3)
108 | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
109 w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
110 go (n+w) (m+4)
111 | otherwise -> case onErr desc (Just x1) of
112 Nothing -> go n (m+1)
113 Just c -> do
114 w <- unsafeWrite arr n c
115 go (n+w) (m+1)
116 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
117{-# INLINE[0] decodeUtf8With #-}
119-- | Decode a 'ByteString' containing UTF-8 encoded text.
120--
121-- If the input contains any invalid UTF-8 data, an exception will be
122-- thrown. For more control over the handling of invalid data, use
123-- 'decodeUtf8With'.
124decodeUtf8 :: ByteString -> Text
125decodeUtf8 = decodeUtf8With strictDecode
126{-# INLINE[0] decodeUtf8 #-}
128{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
129 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
131-- | Encode text using UTF-8 encoding.
132encodeUtf8 :: Text -> ByteString
133encodeUtf8 (Text arr off len) = unsafePerformIO $ do
134 let size0 = min len 4
135 mallocByteString size0 >>= start size0 off 0
136 where
137 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
138 where
139 loop n1 m1 ptr = go n1 m1
140 where
141 go !n !m
142 | n-off == len = return $! PS fp 0 m
143 | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do
144 let newSize = size `shiftL` 1
145 fp' <- mallocByteString newSize
146 withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
147 start newSize n m fp'
148 | otherwise = do
149 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
150 w = A.unsafeIndex arr n
151 case undefined of
152 _| w <= 0x7F -> do
153 poke8 m w
154 go (n+1) (m+1)
155 | w <= 0x7FF -> do
156 poke8 m $ (w `shiftR` 6) + 0xC0
157 poke8 (m+1) $ (w .&. 0x3f) + 0x80
158 go (n+1) (m+2)
159 | 0xD800 <= w && w <= 0xDBFF -> do
160 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
161 poke8 m $ (c `shiftR` 18) + 0xF0
162 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
163 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
164 poke8 (m+3) $ (c .&. 0x3F) + 0x80
165 go (n+2) (m+4)
166 | otherwise -> do
167 poke8 m $ (w `shiftR` 12) + 0xE0
168 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
169 poke8 (m+2) $ (w .&. 0x3F) + 0x80
170 go (n+1) (m+3)
171{- INLINE encodeUtf8 #-}
173-- | Decode text from little endian UTF-16 encoding.
174decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
175decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
176{-# INLINE decodeUtf16LEWith #-}
178-- | Decode text from little endian UTF-16 encoding.
179--
180-- If the input contains any invalid little endian UTF-16 data, an
181-- exception will be thrown. For more control over the handling of
182-- invalid data, use 'decodeUtf16LEWith'.
183decodeUtf16LE :: ByteString -> Text
184decodeUtf16LE = decodeUtf16LEWith strictDecode
185{-# INLINE decodeUtf16LE #-}
187-- | Decode text from big endian UTF-16 encoding.
188decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
189decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
190{-# INLINE decodeUtf16BEWith #-}
192-- | Decode text from big endian UTF-16 encoding.
193--
194-- If the input contains any invalid big endian UTF-16 data, an
195-- exception will be thrown. For more control over the handling of
196-- invalid data, use 'decodeUtf16BEWith'.
197decodeUtf16BE :: ByteString -> Text
198decodeUtf16BE = decodeUtf16BEWith strictDecode
199{-# INLINE decodeUtf16BE #-}
201-- | Encode text using little endian UTF-16 encoding.
202encodeUtf16LE :: Text -> ByteString
203encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
204{-# INLINE encodeUtf16LE #-}
206-- | Encode text using big endian UTF-16 encoding.
207encodeUtf16BE :: Text -> ByteString
208encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
209{-# INLINE encodeUtf16BE #-}
211-- | Decode text from little endian UTF-32 encoding.
212decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
213decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
214{-# INLINE decodeUtf32LEWith #-}
216-- | Decode text from little endian UTF-32 encoding.
217--
218-- If the input contains any invalid little endian UTF-32 data, an
219-- exception will be thrown. For more control over the handling of
220-- invalid data, use 'decodeUtf32LEWith'.
221decodeUtf32LE :: ByteString -> Text
222decodeUtf32LE = decodeUtf32LEWith strictDecode
223{-# INLINE decodeUtf32LE #-}
225-- | Decode text from big endian UTF-32 encoding.
226decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
227decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
228{-# INLINE decodeUtf32BEWith #-}
230-- | Decode text from big endian UTF-32 encoding.
231--
232-- If the input contains any invalid big endian UTF-32 data, an
233-- exception will be thrown. For more control over the handling of
234-- invalid data, use 'decodeUtf32BEWith'.
235decodeUtf32BE :: ByteString -> Text
236decodeUtf32BE = decodeUtf32BEWith strictDecode
237{-# INLINE decodeUtf32BE #-}
239-- | Encode text using little endian UTF-32 encoding.
240encodeUtf32LE :: Text -> ByteString
241encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
242{-# INLINE encodeUtf32LE #-}
244-- | Encode text using big endian UTF-32 encoding.
245encodeUtf32BE :: Text -> ByteString
246encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
247{-# INLINE encodeUtf32BE #-}