git.iko.soy/text
on builder help sign in
text/Data/Text/Encoding.hs
260 lines 9.5 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 -- ** Catchable failure
32 , decodeUtf8'
34 -- ** Controllable error handling
35 , decodeUtf8With
36 , decodeUtf16LEWith
37 , decodeUtf16BEWith
38 , decodeUtf32LEWith
39 , decodeUtf32BEWith
41 -- * Encoding Text to ByteStrings
42 , encodeUtf8
43 , encodeUtf16LE
44 , encodeUtf16BE
45 , encodeUtf32LE
46 , encodeUtf32BE
47 ) where
49import Control.Exception (evaluate, try)
50import Data.Bits ((.&.))
51import Data.ByteString as B
52import Data.ByteString.Internal as B
53import Data.ByteString.Unsafe as B
54import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
55import Data.Text.Internal (Text(..), textP)
56import Data.Text.UnsafeChar (ord, unsafeWrite)
57import Data.Text.UnsafeShift (shiftL, shiftR)
58import Data.Word (Word8)
59import Foreign.ForeignPtr (withForeignPtr)
60import Foreign.Ptr (plusPtr)
61import Foreign.Storable (poke)
62import System.IO.Unsafe (unsafePerformIO)
63import qualified Data.Text.Array as A
64import qualified Data.Text.Encoding.Fusion as E
65import qualified Data.Text.Encoding.Utf16 as U16
66import qualified Data.Text.Encoding.Utf8 as U8
67import qualified Data.Text.Fusion as F
69-- $strict
70--
71-- All of the single-parameter functions for decoding bytestrings
72-- encoded in one of the Unicode Transformation Formats (UTF) operate
73-- in a /strict/ mode: each will throw an exception if given invalid
74-- input.
75--
76-- Each function has a variant, whose name is suffixed with -'With',
77-- that gives greater control over the handling of decoding errors.
78-- For instance, 'decodeUtf8' will throw an exception, but
79-- 'decodeUtf8With' allows the programmer to determine what to do on a
80-- decoding error.
82-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
83decodeASCII :: ByteString -> Text
84decodeASCII bs = F.unstream (E.streamASCII bs)
85{-# INLINE decodeASCII #-}
87-- | Decode a 'ByteString' containing UTF-8 encoded text.
88decodeUtf8With :: OnDecodeError -> ByteString -> Text
89decodeUtf8With onErr bs = textP (fst a) 0 (snd a)
90 where
91 a = A.run2 (A.new len >>= outer 0 0)
92 len = B.length bs
93 outer n0 m0 arr = go n0 m0
94 where
95 go !n !m = do
96 let x1 = idx m
97 x2 = idx (m + 1)
98 x3 = idx (m + 2)
99 x4 = idx (m + 3)
100 idx = B.unsafeIndex bs
101 case undefined of
102 _| m >= len -> return (arr,n)
103 | U8.validate1 x1 -> do
104 A.unsafeWrite arr n (fromIntegral x1)
105 go (n+1) (m+1)
106 | m+1 < len && U8.validate2 x1 x2 -> do
107 w <- unsafeWrite arr n (U8.chr2 x1 x2)
108 go (n+w) (m+2)
109 | m+2 < len && U8.validate3 x1 x2 x3 -> do
110 w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
111 go (n+w) (m+3)
112 | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
113 w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
114 go (n+w) (m+4)
115 | otherwise -> case onErr desc (Just x1) of
116 Nothing -> go n (m+1)
117 Just c -> do
118 w <- unsafeWrite arr n c
119 go (n+w) (m+1)
120 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
121{-# INLINE[0] decodeUtf8With #-}
123-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
124-- to be valid.
125--
126-- If the input contains any invalid UTF-8 data, an exception will be
127-- thrown that cannot be caught in pure code. For more control over
128-- the handling of invalid data, use 'decodeUtf8'' or
129-- 'decodeUtf8With'.
130decodeUtf8 :: ByteString -> Text
131decodeUtf8 = decodeUtf8With strictDecode
132{-# INLINE[0] decodeUtf8 #-}
133{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
134 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
136-- | Decode a 'ByteString' containing UTF-8 encoded text..
137--
138-- If the input contains any invalid UTF-8 data, the relevant
139-- exception will be returned, otherwise the decoded text.
140decodeUtf8' :: ByteString -> Either UnicodeException Text
141decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode
142{-# INLINE decodeUtf8' #-}
144-- | Encode text using UTF-8 encoding.
145encodeUtf8 :: Text -> ByteString
146encodeUtf8 (Text arr off len) = unsafePerformIO $ do
147 let size0 = min len 4
148 mallocByteString size0 >>= start size0 off 0
149 where
150 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
151 where
152 loop n1 m1 ptr = go n1 m1
153 where
154 go !n !m
155 | n-off == len = return $! PS fp 0 m
156 | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do
157 let newSize = size `shiftL` 1
158 fp' <- mallocByteString newSize
159 withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
160 start newSize n m fp'
161 | otherwise = do
162 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
163 w = A.unsafeIndex arr n
164 case undefined of
165 _| w <= 0x7F -> do
166 poke8 m w
167 go (n+1) (m+1)
168 | w <= 0x7FF -> do
169 poke8 m $ (w `shiftR` 6) + 0xC0
170 poke8 (m+1) $ (w .&. 0x3f) + 0x80
171 go (n+1) (m+2)
172 | 0xD800 <= w && w <= 0xDBFF -> do
173 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
174 poke8 m $ (c `shiftR` 18) + 0xF0
175 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
176 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
177 poke8 (m+3) $ (c .&. 0x3F) + 0x80
178 go (n+2) (m+4)
179 | otherwise -> do
180 poke8 m $ (w `shiftR` 12) + 0xE0
181 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
182 poke8 (m+2) $ (w .&. 0x3F) + 0x80
183 go (n+1) (m+3)
184{- INLINE encodeUtf8 #-}
186-- | Decode text from little endian UTF-16 encoding.
187decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
188decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
189{-# INLINE decodeUtf16LEWith #-}
191-- | Decode text from little endian UTF-16 encoding.
192--
193-- If the input contains any invalid little endian UTF-16 data, an
194-- exception will be thrown. For more control over the handling of
195-- invalid data, use 'decodeUtf16LEWith'.
196decodeUtf16LE :: ByteString -> Text
197decodeUtf16LE = decodeUtf16LEWith strictDecode
198{-# INLINE decodeUtf16LE #-}
200-- | Decode text from big endian UTF-16 encoding.
201decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
202decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
203{-# INLINE decodeUtf16BEWith #-}
205-- | Decode text from big endian UTF-16 encoding.
206--
207-- If the input contains any invalid big endian UTF-16 data, an
208-- exception will be thrown. For more control over the handling of
209-- invalid data, use 'decodeUtf16BEWith'.
210decodeUtf16BE :: ByteString -> Text
211decodeUtf16BE = decodeUtf16BEWith strictDecode
212{-# INLINE decodeUtf16BE #-}
214-- | Encode text using little endian UTF-16 encoding.
215encodeUtf16LE :: Text -> ByteString
216encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
217{-# INLINE encodeUtf16LE #-}
219-- | Encode text using big endian UTF-16 encoding.
220encodeUtf16BE :: Text -> ByteString
221encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
222{-# INLINE encodeUtf16BE #-}
224-- | Decode text from little endian UTF-32 encoding.
225decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
226decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
227{-# INLINE decodeUtf32LEWith #-}
229-- | Decode text from little endian UTF-32 encoding.
230--
231-- If the input contains any invalid little endian UTF-32 data, an
232-- exception will be thrown. For more control over the handling of
233-- invalid data, use 'decodeUtf32LEWith'.
234decodeUtf32LE :: ByteString -> Text
235decodeUtf32LE = decodeUtf32LEWith strictDecode
236{-# INLINE decodeUtf32LE #-}
238-- | Decode text from big endian UTF-32 encoding.
239decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
240decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
241{-# INLINE decodeUtf32BEWith #-}
243-- | Decode text from big endian UTF-32 encoding.
244--
245-- If the input contains any invalid big endian UTF-32 data, an
246-- exception will be thrown. For more control over the handling of
247-- invalid data, use 'decodeUtf32BEWith'.
248decodeUtf32BE :: ByteString -> Text
249decodeUtf32BE = decodeUtf32BEWith strictDecode
250{-# INLINE decodeUtf32BE #-}
252-- | Encode text using little endian UTF-32 encoding.
253encodeUtf32LE :: Text -> ByteString
254encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
255{-# INLINE encodeUtf32LE #-}
257-- | Encode text using big endian UTF-32 encoding.
258encodeUtf32BE :: Text -> ByteString
259encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
260{-# INLINE encodeUtf32BE #-}