1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
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
13-- Maintainer : bos@serpentine.com
14-- Stability : experimental
15-- Portability : portable
17-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
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
25 -- * Decoding ByteStrings to Text
35 -- ** Catchable failure
38 -- ** Controllable error handling
45 -- ** Stream oriented decoding
48 , streamDecodeUtf8With
51 -- * Encoding Text to ByteStrings
60#if MIN_VERSION_bytestring(0,10,4)
61 -- * Encoding Text using ByteString Builders
62 -- | /Note/ that these functions are only available if built against
63 -- @bytestring >= 0.10.4.0@.
65 , encodeUtf8BuilderEscaped
69import Control.Exception (evaluate, try)
71#if __GLASGOW_HASKELL__ >= 702
72import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
74import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
77import Control.Monad.ST (runST)
78import Data.Bits ((.&.))
79import Data.ByteString as B
80import Data.ByteString.Internal as B hiding (c2w)
82#if MIN_VERSION_bytestring(0,10,4)
83import qualified Data.ByteString.Builder as B
84import qualified Data.ByteString.Builder.Extra as B
85import qualified Data.ByteString.Builder.Internal as B hiding (empty)
86import qualified Data.ByteString.Builder.Prim as BP
87import qualified Data.ByteString.Builder.Prim.Internal as BP
88import qualified Data.ByteString.Lazy as BL
92import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
93import Data.Text.Internal (Text(..), safe, textP)
94import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
95import Data.Text.Internal.Private (runText)
96import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
97import Data.Word (Word8, Word32)
98import Foreign.C.Types (CSize(..))
99import Foreign.ForeignPtr (withForeignPtr)
100import Foreign.Marshal.Utils (with)
101import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
102import Foreign.Storable (Storable, peek, poke)
103import GHC.Base (ByteArray#, MutableByteArray#)
104import qualified Data.Text.Array as A
105import qualified Data.Text.Internal.Encoding.Fusion as E
106import qualified Data.Text.Internal.Encoding.Utf16 as U16
107import qualified Data.Text.Internal.Fusion as F
108import Data.Text.Unsafe (unsafeDupablePerformIO)
110#include "text_cbits.h"
114-- All of the single-parameter functions for decoding bytestrings
115-- encoded in one of the Unicode Transformation Formats (UTF) operate
116-- in a /strict/ mode: each will throw an exception if given invalid
119-- Each function has a variant, whose name is suffixed with -'With',
120-- that gives greater control over the handling of decoding errors.
121-- For instance, 'decodeUtf8' will throw an exception, but
122-- 'decodeUtf8With' allows the programmer to determine what to do on a
125-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
128-- This function is deprecated. Use 'decodeLatin1' instead.
129decodeASCII :: ByteString -> Text
130decodeASCII = decodeUtf8
131{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
133-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
135-- 'decodeLatin1' is semantically equivalent to
136-- @Data.Text.pack . Data.ByteString.Char8.unpack@
137decodeLatin1 :: ByteString -> Text
138decodeLatin1 (PS fp off len) = textP a 0 len
140 a = A.run (A.new len >>= unsafeIOToST . go)
141 go dest = withForeignPtr fp $ \ptr -> do
142 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
145-- | Decode a 'ByteString' containing UTF-8 encoded text.
146decodeUtf8With :: OnDecodeError -> ByteString -> Text
147decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
148 let go dest = withForeignPtr fp $ \ptr ->
149 with (0::CSize) $ \destOffPtr -> do
150 let end = ptr `plusPtr` (off + len)
152 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
156 unsafeSTToIO (done dest (fromIntegral n))
159 case onErr desc (Just x) of
160 Nothing -> loop $ curPtr' `plusPtr` 1
162 destOff <- peek destOffPtr
164 unsafeWrite dest (fromIntegral destOff) (safe c)
165 poke destOffPtr (destOff + fromIntegral w)
166 loop $ curPtr' `plusPtr` 1
167 loop (ptr `plusPtr` off)
168 (unsafeIOToST . go) =<< A.new len
170 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
171{- INLINE[0] decodeUtf8With #-}
175-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
176-- a 'ByteString' that represents a possibly incomplete input (e.g. a
177-- packet from a network stream) that may not end on a UTF-8 boundary.
179-- The first element of the result is the maximal chunk of 'Text' that
180-- can be decoded from the given input. The second is a function which
181-- accepts another 'ByteString'. That string will be assumed to
182-- directly follow the string that was passed as input to the original
183-- function, and it will in turn be decoded.
185-- To help understand the use of these functions, consider the Unicode
186-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
187-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
189-- Now suppose that we receive this encoded string as 3 packets that
190-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
191-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
192-- have received all three packets, but we would like to make progress
193-- as we receive each one.
196-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"
197-- t0 == \"hi \" :: 'Text'
200-- We use the continuation @f0@ to decode our second packet.
203-- let 'Some' t1 f1 = f0 \"\\x98\"
207-- We could not give @f0@ enough input to decode anything, so it
208-- returned an empty string. Once we feed our second continuation @f1@
209-- the last byte of input, it will make progress.
212-- let 'Some' t2 f2 = f1 \"\\x83\"
216-- If given invalid input, an exception will be thrown by the function
217-- or continuation where it is encountered.
219-- | A stream oriented decoding result.
220data Decoding = Some Text ByteString (ByteString -> Decoding)
222instance Show Decoding where
223 showsPrec d (Some t bs _) = showParen (d > prec) $
224 showString "Some " . showsPrec prec' t .
225 showChar ' ' . showsPrec prec' bs .
227 where prec = 10; prec' = prec + 1
229newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
230newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
232-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
233-- encoded text that is known to be valid.
235-- If the input contains any invalid UTF-8 data, an exception will be
236-- thrown (either by this function or a continuation) that cannot be
237-- caught in pure code. For more control over the handling of invalid
238-- data, use 'streamDecodeUtf8With'.
239streamDecodeUtf8 :: ByteString -> Decoding
240streamDecodeUtf8 = streamDecodeUtf8With strictDecode
242-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
244streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
245streamDecodeUtf8With onErr = decodeChunk 0 0
247 -- We create a slightly larger than necessary buffer to accommodate a
248 -- potential surrogate pair started in the last buffer
249 decodeChunk :: CodePoint -> DecoderState -> ByteString -> Decoding
250 decodeChunk codepoint0 state0 bs@(PS fp off len) =
251 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
253 decodeChunkToBuffer :: A.MArray s -> IO Decoding
254 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
255 with (0::CSize) $ \destOffPtr ->
256 with codepoint0 $ \codepointPtr ->
257 with state0 $ \statePtr ->
258 with nullPtr $ \curPtrPtr ->
259 let end = ptr `plusPtr` (off + len)
261 poke curPtrPtr curPtr
262 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
263 curPtrPtr end codepointPtr statePtr
264 state <- peek statePtr
267 -- We encountered an encoding error
269 case onErr desc (Just x) of
270 Nothing -> loop $ curPtr' `plusPtr` 1
272 destOff <- peek destOffPtr
274 unsafeWrite dest (fromIntegral destOff) (safe c)
275 poke destOffPtr (destOff + fromIntegral w)
277 loop $ curPtr' `plusPtr` 1
280 -- We encountered the end of the buffer while decoding
282 codepoint <- peek codepointPtr
283 chunkText <- unsafeSTToIO $ do
284 arr <- A.unsafeFreeze dest
285 return $! textP arr 0 (fromIntegral n)
286 lastPtr <- peek curPtrPtr
287 let left = lastPtr `minusPtr` curPtr
288 return $ Some chunkText (B.drop left bs)
289 (decodeChunk codepoint state)
290 in loop (ptr `plusPtr` off)
291 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
293-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
296-- If the input contains any invalid UTF-8 data, an exception will be
297-- thrown that cannot be caught in pure code. For more control over
298-- the handling of invalid data, use 'decodeUtf8'' or
300decodeUtf8 :: ByteString -> Text
301decodeUtf8 = decodeUtf8With strictDecode
302{-# INLINE[0] decodeUtf8 #-}
303{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
304 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
306-- | Decode a 'ByteString' containing UTF-8 encoded text.
308-- If the input contains any invalid UTF-8 data, the relevant
309-- exception will be returned, otherwise the decoded text.
310decodeUtf8' :: ByteString -> Either UnicodeException Text
311decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
312{-# INLINE decodeUtf8' #-}
314-- | Encode text using UTF-8 encoding.
315encodeUtf8 :: Text -> ByteString
316#if MIN_VERSION_bytestring(0,10,4)
318encodeUtf8 t@(Text _arr _off len) =
319 B.copy -- copy to trim and avoid wasting memory
321 $ B.toLazyByteStringWith strategy BL.empty
322 $ encodeUtf8Builder t
324 -- We use a strategy that allocates a buffer that is guaranteed to be
325 -- large enough for the whole result. This ensures that we always stay in
326 -- the fast 'goPartial' loop in the 'encodeUtf8BuilderEscaped' function.
327 strategy = B.untrimmedStrategy (4 * (len + 1)) B.defaultChunkSize
330-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
331encodeUtf8Builder :: Text -> B.Builder
332encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
334-- | Encode text using UTF-8 encoding and escape the ASCII characters using
335-- a 'BP.BoundedPrim'.
337-- Use this function is to implement efficient encoders for text-based formats
339{-# INLINE encodeUtf8BuilderEscaped #-}
340-- TODO: Extend documentation with references to source code in @blaze-html@
341-- or @aeson@ that uses this function.
342encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
343encodeUtf8BuilderEscaped be =
344 -- manual eta-expansion to ensure inlining works as expected
345 \txt -> B.builder (mkBuildstep txt)
347 bound = max 4 $ BP.sizeBound be
349 mkBuildstep (Text arr off len) !k =
354 outerLoop !i0 !br@(B.BufferRange op0 ope)
356 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
357 -- TODO: Use a loop with an integrated bound's check if outRemaining
358 -- is smaller than 8, as this will save on divisions.
359 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
361 outRemaining = (ope `minusPtr` op0) `div` bound
362 inpRemaining = iend - i0
364 goPartial !iendTmp = go i0 op0
367 | i < iendTmp = case A.unsafeIndex arr i of
369 BP.runB be (fromIntegral w) op >>= go (i + 1)
371 poke8 0 $ (w `shiftR` 6) + 0xC0
372 poke8 1 $ (w .&. 0x3f) + 0x80
373 go (i + 1) (op `plusPtr` 2)
374 | 0xD800 <= w && w <= 0xDBFF -> do
375 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
376 poke8 0 $ (c `shiftR` 18) + 0xF0
377 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
378 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
379 poke8 3 $ (c .&. 0x3F) + 0x80
380 go (i + 2) (op `plusPtr` 4)
382 poke8 0 $ (w `shiftR` 12) + 0xE0
383 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
384 poke8 2 $ (w .&. 0x3F) + 0x80
385 go (i + 1) (op `plusPtr` 3)
387 outerLoop i (B.BufferRange op ope)
389 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
393encodeUtf8 = encodeUtf8_0
397encodeUtf8_0 :: Text -> ByteString
398encodeUtf8_0 (Text arr off len) = unsafeDupablePerformIO $ do
399 let size0 = max len 4
400 mallocByteString size0 >>= start size0 off 0
402 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
404 loop n1 m1 ptr = go n1 m1
408 | n == offLen = return (PS fp 0 m)
410 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
413 | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
414 let newSize = size `shiftL` 1
415 fp' <- mallocByteString newSize
416 withForeignPtr fp' $ \ptr' ->
417 memcpy ptr' ptr (fromIntegral m)
418 start newSize n m fp'
419 {-# INLINE ensure #-}
420 case A.unsafeIndex arr n of
421 w| w <= 0x7F -> ensure 1 $ do
422 poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
424 | w <= 0x7FF -> ensure 2 $ do
425 poke8 m $ (w `shiftR` 6) + 0xC0
426 poke8 (m+1) $ (w .&. 0x3f) + 0x80
428 | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
429 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
430 poke8 m $ (c `shiftR` 18) + 0xF0
431 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
432 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
433 poke8 (m+3) $ (c .&. 0x3F) + 0x80
435 | otherwise -> ensure 3 $ do
436 poke8 m $ (w `shiftR` 12) + 0xE0
437 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
438 poke8 (m+2) $ (w .&. 0x3F) + 0x80
441encodeUtf8_2 :: Text -> ByteString
442encodeUtf8_2 (Text arr off len)
444 | otherwise = unsafeDupablePerformIO $ do
445 fp <- mallocByteString (len*4)
446 withForeignPtr fp $ \ptr ->
447 with ptr $ \destPtr -> do
448 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
449 newDest <- peek destPtr
450 let utf8len = newDest `minusPtr` ptr
451 if utf8len >= len `shiftR` 1
452 then return (PS fp 0 utf8len)
454 fp' <- mallocByteString utf8len
455 withForeignPtr fp' $ \ptr' -> do
456 memcpy ptr' ptr (fromIntegral utf8len)
457 return (PS fp' 0 utf8len)
459-- | Decode text from little endian UTF-16 encoding.
460decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
461decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
462{-# INLINE decodeUtf16LEWith #-}
464-- | Decode text from little endian UTF-16 encoding.
466-- If the input contains any invalid little endian UTF-16 data, an
467-- exception will be thrown. For more control over the handling of
468-- invalid data, use 'decodeUtf16LEWith'.
469decodeUtf16LE :: ByteString -> Text
470decodeUtf16LE = decodeUtf16LEWith strictDecode
471{-# INLINE decodeUtf16LE #-}
473-- | Decode text from big endian UTF-16 encoding.
474decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
475decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
476{-# INLINE decodeUtf16BEWith #-}
478-- | Decode text from big endian UTF-16 encoding.
480-- If the input contains any invalid big endian UTF-16 data, an
481-- exception will be thrown. For more control over the handling of
482-- invalid data, use 'decodeUtf16BEWith'.
483decodeUtf16BE :: ByteString -> Text
484decodeUtf16BE = decodeUtf16BEWith strictDecode
485{-# INLINE decodeUtf16BE #-}
487-- | Encode text using little endian UTF-16 encoding.
488encodeUtf16LE :: Text -> ByteString
489encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
490{-# INLINE encodeUtf16LE #-}
492-- | Encode text using big endian UTF-16 encoding.
493encodeUtf16BE :: Text -> ByteString
494encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
495{-# INLINE encodeUtf16BE #-}
497-- | Decode text from little endian UTF-32 encoding.
498decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
499decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
500{-# INLINE decodeUtf32LEWith #-}
502-- | Decode text from little endian UTF-32 encoding.
504-- If the input contains any invalid little endian UTF-32 data, an
505-- exception will be thrown. For more control over the handling of
506-- invalid data, use 'decodeUtf32LEWith'.
507decodeUtf32LE :: ByteString -> Text
508decodeUtf32LE = decodeUtf32LEWith strictDecode
509{-# INLINE decodeUtf32LE #-}
511-- | Decode text from big endian UTF-32 encoding.
512decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
513decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
514{-# INLINE decodeUtf32BEWith #-}
516-- | Decode text from big endian UTF-32 encoding.
518-- If the input contains any invalid big endian UTF-32 data, an
519-- exception will be thrown. For more control over the handling of
520-- invalid data, use 'decodeUtf32BEWith'.
521decodeUtf32BE :: ByteString -> Text
522decodeUtf32BE = decodeUtf32BEWith strictDecode
523{-# INLINE decodeUtf32BE #-}
525-- | Encode text using little endian UTF-32 encoding.
526encodeUtf32LE :: Text -> ByteString
527encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
528{-# INLINE encodeUtf32LE #-}
530-- | Encode text using big endian UTF-32 encoding.
531encodeUtf32BE :: Text -> ByteString
532encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
533{-# INLINE encodeUtf32BE #-}
535foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
536 :: MutableByteArray# s -> Ptr CSize
537 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
539foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
540 :: MutableByteArray# s -> Ptr CSize
541 -> Ptr (Ptr Word8) -> Ptr Word8
542 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
544foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
545 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
547foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
548 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list