on 1.1 help sign in
text/Data/Text/Encoding.hs
492 lines 19 kB history raw
1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
2 UnliftedFFITypes #-}
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
5#endif
6-- |
7-- Module : Data.Text.Encoding
8-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
9-- (c) 2009 Duncan Coutts,
10-- (c) 2008, 2009 Tom Harper
11--
12-- License : BSD-style
13-- Maintainer : bos@serpentine.com
14-- Stability : experimental
15-- Portability : portable
16--
17-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
19--
20-- To gain access to a much larger family of encodings, use the
21-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
23module Data.Text.Encoding
24 (
25 -- * Decoding ByteStrings to Text
26 -- $strict
27 decodeASCII
28 , decodeLatin1
29 , decodeUtf8
30 , decodeUtf16LE
31 , decodeUtf16BE
32 , decodeUtf32LE
33 , decodeUtf32BE
35 -- ** Catchable failure
36 , decodeUtf8'
38 -- ** Controllable error handling
39 , decodeUtf8With
40 , decodeUtf16LEWith
41 , decodeUtf16BEWith
42 , decodeUtf32LEWith
43 , decodeUtf32BEWith
45 -- ** Stream oriented decoding
46 -- $stream
47 , streamDecodeUtf8
48 , streamDecodeUtf8With
49 , Decoding(..)
51 -- * Encoding Text to ByteStrings
52 , encodeUtf8
53 , encodeUtf16LE
54 , encodeUtf16BE
55 , encodeUtf32LE
56 , encodeUtf32BE
58#if MIN_VERSION_bytestring(0,10,4)
59 -- * Encoding Text using ByteString Builders
60 -- | /Note/ that these functions are only available if built against
61 -- @bytestring >= 0.10.4.0@.
62 , encodeUtf8Builder
63 , encodeUtf8BuilderEscaped
64#endif
65 ) where
67#if __GLASGOW_HASKELL__ >= 702
68import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
69#else
70import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
71#endif
73#if MIN_VERSION_bytestring(0,10,4)
74import Data.Bits ((.&.))
75import Data.Text.Internal.Unsafe.Char (ord)
76import qualified Data.ByteString.Builder as B
77import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
78import qualified Data.ByteString.Builder.Prim as BP
79import qualified Data.ByteString.Builder.Prim.Internal as BP
80import qualified Data.Text.Internal.Encoding.Utf16 as U16
81#endif
83import Control.Exception (evaluate, try)
84import Control.Monad.ST (runST)
85import Data.ByteString as B
86import Data.ByteString.Internal as B hiding (c2w)
87import Data.Text ()
88import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
89import Data.Text.Internal (Text(..), safe, text)
90import Data.Text.Internal.Private (runText)
91import Data.Text.Internal.Unsafe.Char (unsafeWrite)
92import Data.Text.Internal.Unsafe.Shift (shiftR)
93import Data.Text.Unsafe (unsafeDupablePerformIO)
94import Data.Word (Word8, Word32)
95import Foreign.C.Types (CSize(..))
96import Foreign.ForeignPtr (withForeignPtr)
97import Foreign.Marshal.Utils (with)
98import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
99import Foreign.Storable (Storable, peek, poke)
100import GHC.Base (ByteArray#, MutableByteArray#)
101import qualified Data.Text.Array as A
102import qualified Data.Text.Internal.Encoding.Fusion as E
103import qualified Data.Text.Internal.Fusion as F
105#include "text_cbits.h"
107-- $strict
108--
109-- All of the single-parameter functions for decoding bytestrings
110-- encoded in one of the Unicode Transformation Formats (UTF) operate
111-- in a /strict/ mode: each will throw an exception if given invalid
112-- input.
113--
114-- Each function has a variant, whose name is suffixed with -'With',
115-- that gives greater control over the handling of decoding errors.
116-- For instance, 'decodeUtf8' will throw an exception, but
117-- 'decodeUtf8With' allows the programmer to determine what to do on a
118-- decoding error.
120-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
121-- encoded text.
122--
123-- This function is deprecated. Use 'decodeLatin1' instead.
124decodeASCII :: ByteString -> Text
125decodeASCII = decodeUtf8
126{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
128-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
129--
130-- 'decodeLatin1' is semantically equivalent to
131-- @Data.Text.pack . Data.ByteString.Char8.unpack@
132decodeLatin1 :: ByteString -> Text
133decodeLatin1 (PS fp off len) = text a 0 len
134 where
135 a = A.run (A.new len >>= unsafeIOToST . go)
136 go dest = withForeignPtr fp $ \ptr -> do
137 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
138 return dest
140-- | Decode a 'ByteString' containing UTF-8 encoded text.
141decodeUtf8With :: OnDecodeError -> ByteString -> Text
142decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
143 let go dest = withForeignPtr fp $ \ptr ->
144 with (0::CSize) $ \destOffPtr -> do
145 let end = ptr `plusPtr` (off + len)
146 loop curPtr = do
147 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
148 if curPtr' == end
149 then do
150 n <- peek destOffPtr
151 unsafeSTToIO (done dest (fromIntegral n))
152 else do
153 x <- peek curPtr'
154 case onErr desc (Just x) of
155 Nothing -> loop $ curPtr' `plusPtr` 1
156 Just c -> do
157 destOff <- peek destOffPtr
158 w <- unsafeSTToIO $
159 unsafeWrite dest (fromIntegral destOff) (safe c)
160 poke destOffPtr (destOff + fromIntegral w)
161 loop $ curPtr' `plusPtr` 1
162 loop (ptr `plusPtr` off)
163 (unsafeIOToST . go) =<< A.new len
164 where
165 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
166{- INLINE[0] decodeUtf8With #-}
168-- $stream
169--
170-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
171-- a 'ByteString' that represents a possibly incomplete input (e.g. a
172-- packet from a network stream) that may not end on a UTF-8 boundary.
173--
174-- 1. The maximal prefix of 'Text' that could be decoded from the
175-- given input.
176--
177-- 2. The suffix of the 'ByteString' that could not be decoded due to
178-- insufficient input.
179--
180-- 3. A function that accepts another 'ByteString'. That string will
181-- be assumed to directly follow the string that was passed as
182-- input to the original function, and it will in turn be decoded.
183--
184-- To help understand the use of these functions, consider the Unicode
185-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi
186-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.
187--
188-- Now suppose that we receive this encoded string as 3 packets that
189-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
190-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
191-- have received all three packets, but we would like to make progress
192-- as we receive each one.
193--
194-- @
195-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
196-- ghci> s0
197-- 'Some' \"hi \" \"\\xe2\" _
198-- @
199--
200-- We use the continuation @f0@ to decode our second packet.
201--
202-- @
203-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
204-- ghci> s1
205-- 'Some' \"\" \"\\xe2\\x98\"
206-- @
207--
208-- We could not give @f0@ enough input to decode anything, so it
209-- returned an empty string. Once we feed our second continuation @f1@
210-- the last byte of input, it will make progress.
211--
212-- @
213-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
214-- ghci> s2
215-- 'Some' \"\\x2603\" \"\" _
216-- @
217--
218-- If given invalid input, an exception will be thrown by the function
219-- or continuation where it is encountered.
221-- | A stream oriented decoding result.
222data Decoding = Some Text ByteString (ByteString -> Decoding)
224instance Show Decoding where
225 showsPrec d (Some t bs _) = showParen (d > prec) $
226 showString "Some " . showsPrec prec' t .
227 showChar ' ' . showsPrec prec' bs .
228 showString " _"
229 where prec = 10; prec' = prec + 1
231newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
232newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235-- encoded text that is known to be valid.
236--
237-- If the input contains any invalid UTF-8 data, an exception will be
238-- thrown (either by this function or a continuation) that cannot be
239-- caught in pure code. For more control over the handling of invalid
240-- data, use 'streamDecodeUtf8With'.
241streamDecodeUtf8 :: ByteString -> Decoding
242streamDecodeUtf8 = streamDecodeUtf8With strictDecode
244-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
245-- encoded text.
246streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
247streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
248 where
249 -- We create a slightly larger than necessary buffer to accommodate a
250 -- potential surrogate pair started in the last buffer
251 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
252 -> Decoding
253 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
254 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
255 where
256 decodeChunkToBuffer :: A.MArray s -> IO Decoding
257 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
258 with (0::CSize) $ \destOffPtr ->
259 with codepoint0 $ \codepointPtr ->
260 with state0 $ \statePtr ->
261 with nullPtr $ \curPtrPtr ->
262 let end = ptr `plusPtr` (off + len)
263 loop curPtr = do
264 poke curPtrPtr curPtr
265 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
266 curPtrPtr end codepointPtr statePtr
267 state <- peek statePtr
268 case state of
269 UTF8_REJECT -> do
270 -- We encountered an encoding error
271 x <- peek curPtr'
272 case onErr desc (Just x) of
273 Nothing -> loop $ curPtr' `plusPtr` 1
274 Just c -> do
275 destOff <- peek destOffPtr
276 w <- unsafeSTToIO $
277 unsafeWrite dest (fromIntegral destOff) (safe c)
278 poke destOffPtr (destOff + fromIntegral w)
279 poke statePtr 0
280 loop $ curPtr' `plusPtr` 1
282 _ -> do
283 -- We encountered the end of the buffer while decoding
284 n <- peek destOffPtr
285 codepoint <- peek codepointPtr
286 chunkText <- unsafeSTToIO $ do
287 arr <- A.unsafeFreeze dest
288 return $! text arr 0 (fromIntegral n)
289 lastPtr <- peek curPtrPtr
290 let left = lastPtr `minusPtr` curPtr
291 undecoded = case state of
292 UTF8_ACCEPT -> B.empty
293 _ -> B.append undecoded0 (B.drop left bs)
294 return $ Some chunkText undecoded
295 (decodeChunk undecoded codepoint state)
296 in loop (ptr `plusPtr` off)
297 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
299-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
300-- to be valid.
301--
302-- If the input contains any invalid UTF-8 data, an exception will be
303-- thrown that cannot be caught in pure code. For more control over
304-- the handling of invalid data, use 'decodeUtf8'' or
305-- 'decodeUtf8With'.
306decodeUtf8 :: ByteString -> Text
307decodeUtf8 = decodeUtf8With strictDecode
308{-# INLINE[0] decodeUtf8 #-}
309{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
310 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
312-- | Decode a 'ByteString' containing UTF-8 encoded text.
313--
314-- If the input contains any invalid UTF-8 data, the relevant
315-- exception will be returned, otherwise the decoded text.
316decodeUtf8' :: ByteString -> Either UnicodeException Text
317decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
318{-# INLINE decodeUtf8' #-}
320#if MIN_VERSION_bytestring(0,10,4)
322-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
323encodeUtf8Builder :: Text -> B.Builder
324encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
326-- | Encode text using UTF-8 encoding and escape the ASCII characters using
327-- a 'BP.BoundedPrim'.
328--
329-- Use this function is to implement efficient encoders for text-based formats
330-- like JSON or HTML.
331{-# INLINE encodeUtf8BuilderEscaped #-}
332-- TODO: Extend documentation with references to source code in @blaze-html@
333-- or @aeson@ that uses this function.
334encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
335encodeUtf8BuilderEscaped be =
336 -- manual eta-expansion to ensure inlining works as expected
337 \txt -> B.builder (mkBuildstep txt)
338 where
339 bound = max 4 $ BP.sizeBound be
341 mkBuildstep (Text arr off len) !k =
342 outerLoop off
343 where
344 iend = off + len
346 outerLoop !i0 !br@(B.BufferRange op0 ope)
347 | i0 >= iend = k br
348 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
349 -- TODO: Use a loop with an integrated bound's check if outRemaining
350 -- is smaller than 8, as this will save on divisions.
351 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
352 where
353 outRemaining = (ope `minusPtr` op0) `div` bound
354 inpRemaining = iend - i0
356 goPartial !iendTmp = go i0 op0
357 where
358 go !i !op
359 | i < iendTmp = case A.unsafeIndex arr i of
360 w | w <= 0x7F -> do
361 BP.runB be (fromIntegral w) op >>= go (i + 1)
362 | w <= 0x7FF -> do
363 poke8 0 $ (w `shiftR` 6) + 0xC0
364 poke8 1 $ (w .&. 0x3f) + 0x80
365 go (i + 1) (op `plusPtr` 2)
366 | 0xD800 <= w && w <= 0xDBFF -> do
367 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
368 poke8 0 $ (c `shiftR` 18) + 0xF0
369 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
370 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
371 poke8 3 $ (c .&. 0x3F) + 0x80
372 go (i + 2) (op `plusPtr` 4)
373 | otherwise -> do
374 poke8 0 $ (w `shiftR` 12) + 0xE0
375 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
376 poke8 2 $ (w .&. 0x3F) + 0x80
377 go (i + 1) (op `plusPtr` 3)
378 | otherwise =
379 outerLoop i (B.BufferRange op ope)
380 where
381 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
382#endif
384-- | Encode text using UTF-8 encoding.
385encodeUtf8 :: Text -> ByteString
386encodeUtf8 (Text arr off len)
387 | len == 0 = B.empty
388 | otherwise = unsafeDupablePerformIO $ do
389 fp <- mallocByteString (len*4)
390 withForeignPtr fp $ \ptr ->
391 with ptr $ \destPtr -> do
392 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
393 newDest <- peek destPtr
394 let utf8len = newDest `minusPtr` ptr
395 if utf8len >= len `shiftR` 1
396 then return (PS fp 0 utf8len)
397 else do
398 fp' <- mallocByteString utf8len
399 withForeignPtr fp' $ \ptr' -> do
400 memcpy ptr' ptr (fromIntegral utf8len)
401 return (PS fp' 0 utf8len)
403-- | Decode text from little endian UTF-16 encoding.
404decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
405decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
406{-# INLINE decodeUtf16LEWith #-}
408-- | Decode text from little endian UTF-16 encoding.
409--
410-- If the input contains any invalid little endian UTF-16 data, an
411-- exception will be thrown. For more control over the handling of
412-- invalid data, use 'decodeUtf16LEWith'.
413decodeUtf16LE :: ByteString -> Text
414decodeUtf16LE = decodeUtf16LEWith strictDecode
415{-# INLINE decodeUtf16LE #-}
417-- | Decode text from big endian UTF-16 encoding.
418decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
419decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
420{-# INLINE decodeUtf16BEWith #-}
422-- | Decode text from big endian UTF-16 encoding.
423--
424-- If the input contains any invalid big endian UTF-16 data, an
425-- exception will be thrown. For more control over the handling of
426-- invalid data, use 'decodeUtf16BEWith'.
427decodeUtf16BE :: ByteString -> Text
428decodeUtf16BE = decodeUtf16BEWith strictDecode
429{-# INLINE decodeUtf16BE #-}
431-- | Encode text using little endian UTF-16 encoding.
432encodeUtf16LE :: Text -> ByteString
433encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
434{-# INLINE encodeUtf16LE #-}
436-- | Encode text using big endian UTF-16 encoding.
437encodeUtf16BE :: Text -> ByteString
438encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
439{-# INLINE encodeUtf16BE #-}
441-- | Decode text from little endian UTF-32 encoding.
442decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
443decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
444{-# INLINE decodeUtf32LEWith #-}
446-- | Decode text from little endian UTF-32 encoding.
447--
448-- If the input contains any invalid little endian UTF-32 data, an
449-- exception will be thrown. For more control over the handling of
450-- invalid data, use 'decodeUtf32LEWith'.
451decodeUtf32LE :: ByteString -> Text
452decodeUtf32LE = decodeUtf32LEWith strictDecode
453{-# INLINE decodeUtf32LE #-}
455-- | Decode text from big endian UTF-32 encoding.
456decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
457decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
458{-# INLINE decodeUtf32BEWith #-}
460-- | Decode text from big endian UTF-32 encoding.
461--
462-- If the input contains any invalid big endian UTF-32 data, an
463-- exception will be thrown. For more control over the handling of
464-- invalid data, use 'decodeUtf32BEWith'.
465decodeUtf32BE :: ByteString -> Text
466decodeUtf32BE = decodeUtf32BEWith strictDecode
467{-# INLINE decodeUtf32BE #-}
469-- | Encode text using little endian UTF-32 encoding.
470encodeUtf32LE :: Text -> ByteString
471encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
472{-# INLINE encodeUtf32LE #-}
474-- | Encode text using big endian UTF-32 encoding.
475encodeUtf32BE :: Text -> ByteString
476encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
477{-# INLINE encodeUtf32BE #-}
479foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
480 :: MutableByteArray# s -> Ptr CSize
481 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
483foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
484 :: MutableByteArray# s -> Ptr CSize
485 -> Ptr (Ptr Word8) -> Ptr Word8
486 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
488foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
489 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
491foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
492 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()