1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
6{-# LANGUAGE UnboxedTuples #-}
8-- Module : Data.Text.Encoding
9-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
10-- (c) 2009 Duncan Coutts,
11-- (c) 2008, 2009 Tom Harper
14-- Maintainer : bos@serpentine.com
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-- <http://hackage.haskell.org/package/text-icu text-icu package>.
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
58 -- * Encoding Text using ByteString Builders
60 , encodeUtf8BuilderEscaped
63#if __GLASGOW_HASKELL__ >= 702
64import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
69import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
70import Control.Monad.ST (runST)
71import Data.Bits ((.&.))
72import Data.ByteString as B
73import Data.ByteString.Internal as B hiding (c2w)
74import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
75import Data.Text.Internal (Text(..), safe, text)
76import Data.Text.Internal.Private (runText)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
80import Data.Text.Show ()
82import Data.Text.Unsafe (unsafeDupablePerformIO)
83import Data.Word (Word8, Word32)
84#if __GLASGOW_HASKELL__ >= 703
85import Foreign.C.Types (CSize(CSize))
87import Foreign.C.Types (CSize)
89import Foreign.ForeignPtr (withForeignPtr)
90import Foreign.Marshal.Utils (with)
91import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
92import Foreign.Storable (Storable, peek, poke)
93import GHC.Base (ByteArray#, MutableByteArray#)
94import qualified Data.ByteString.Builder as B
95import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
96import qualified Data.ByteString.Builder.Prim as BP
97import qualified Data.ByteString.Builder.Prim.Internal as BP
98import qualified Data.Text.Array as A
99import qualified Data.Text.Internal.Encoding.Fusion as E
100import qualified Data.Text.Internal.Encoding.Utf16 as U16
101import qualified Data.Text.Internal.Fusion as F
103#include "text_cbits.h"
105import GHC.Exts (Int(..), Int#)
106import Data.ByteString (ByteString)
108import Data.JSString (JSString)
113-- All of the single-parameter functions for decoding bytestrings
114-- encoded in one of the Unicode Transformation Formats (UTF) operate
115-- in a /strict/ mode: each will throw an exception if given invalid
118-- Each function has a variant, whose name is suffixed with -'With',
119-- that gives greater control over the handling of decoding errors.
120-- For instance, 'decodeUtf8' will throw an exception, but
121-- 'decodeUtf8With' allows the programmer to determine what to do on a
124-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
126decodeASCII :: ByteString -> Text
127decodeASCII = decodeUtf8
128{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
130-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
132-- 'decodeLatin1' is semantically equivalent to
133-- @Data.Text.pack . Data.ByteString.Char8.unpack@
134decodeLatin1 :: ByteString -> Text
135decodeLatin1 (PS fp off len) = text a 0 len
137 a = A.run (A.new len >>= unsafeIOToST . go)
138 go dest = withForeignPtr fp $ \ptr -> do
139 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
142-- | Decode a 'ByteString' containing UTF-8 encoded text.
144-- __NOTE__: The replacement character returned by 'OnDecodeError'
145-- MUST be within the BMP plane; surrogate code points will
146-- automatically be remapped to the replacement char @U+FFFD@
147-- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an
148-- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using
149-- those unsupported code points would result in undefined behavior.
150decodeUtf8With :: OnDecodeError -> ByteString -> Text
151decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
152 let go dest = withForeignPtr fp $ \ptr ->
153 with (0::CSize) $ \destOffPtr -> do
154 let end = ptr `plusPtr` (off + len)
156 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
160 unsafeSTToIO (done dest (fromIntegral n))
163 case onErr desc (Just x) of
164 Nothing -> loop $ curPtr' `plusPtr` 1
166 | c > '\xFFFF' -> throwUnsupportedReplChar
168 destOff <- peek destOffPtr
170 unsafeWrite dest (fromIntegral destOff)
172 poke destOffPtr (destOff + fromIntegral w)
173 loop $ curPtr' `plusPtr` 1
174 loop (ptr `plusPtr` off)
175 (unsafeIOToST . go) =<< A.new len
177 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
179 throwUnsupportedReplChar = throwIO $
180 ErrorCall "decodeUtf8With: non-BMP replacement characters not supported"
181 -- TODO: The code currently assumes that the transcoded UTF-16
182 -- stream is at most twice as long (in bytes) as the input UTF-8
183 -- stream. To justify this assumption one has to assume that the
184 -- error handler replacement character also satisfies this
185 -- invariant, by emitting at most one UTF16 code unit.
187 -- One easy way to support the full range of code-points for
188 -- replacement characters in the error handler is to simply change
189 -- the (over-)allocation to `A.new (2*len)` and then shrink back the
190 -- `ByteArray#` to the real size (recent GHCs have a cheap
191 -- `ByteArray#` resize-primop for that which allow the GC to reclaim
192 -- the overallocation). However, this would require 4 times as much
193 -- (temporary) storage as the original UTF-8 required.
195 -- Another strategy would be to optimistically assume that
196 -- replacement characters are within the BMP, and if the case of a
197 -- non-BMP replacement occurs reallocate the target buffer (or throw
198 -- an exception, and fallback to a pessimistic codepath, like e.g.
199 -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)
201 -- Alternatively, `OnDecodeError` could become a datastructure which
202 -- statically encodes the replacement-character range,
203 -- e.g. something isomorphic to
205 -- Either (... -> Maybe Word16) (... -> Maybe Char)
207 -- And allow to statically switch between the BMP/non-BMP
208 -- replacement-character codepaths. There's multiple ways to address
209 -- this with different tradeoffs; but ideally we should optimise for
210 -- the optimistic/error-free case.
211{- INLINE[0] decodeUtf8With #-}
215-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
216-- a 'ByteString' that represents a possibly incomplete input (e.g. a
217-- packet from a network stream) that may not end on a UTF-8 boundary.
219-- 1. The maximal prefix of 'Text' that could be decoded from the
222-- 2. The suffix of the 'ByteString' that could not be decoded due to
223-- insufficient input.
225-- 3. A function that accepts another 'ByteString'. That string will
226-- be assumed to directly follow the string that was passed as
227-- input to the original function, and it will in turn be decoded.
229-- To help understand the use of these functions, consider the Unicode
230-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
231-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
233-- Now suppose that we receive this encoded string as 3 packets that
234-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
235-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
236-- have received all three packets, but we would like to make progress
237-- as we receive each one.
240-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
242-- 'Some' \"hi \" \"\\xe2\" _
245-- We use the continuation @f0@ to decode our second packet.
248-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
250-- 'Some' \"\" \"\\xe2\\x98\"
253-- We could not give @f0@ enough input to decode anything, so it
254-- returned an empty string. Once we feed our second continuation @f1@
255-- the last byte of input, it will make progress.
258-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
260-- 'Some' \"\\x2603\" \"\" _
263-- If given invalid input, an exception will be thrown by the function
264-- or continuation where it is encountered.
266-- | A stream oriented decoding result.
269data Decoding = Some Text ByteString (ByteString -> Decoding)
271instance Show Decoding where
272 showsPrec d (Some t bs _) = showParen (d > prec) $
273 showString "Some " . showsPrec prec' t .
274 showChar ' ' . showsPrec prec' bs .
276 where prec = 10; prec' = prec + 1
278newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
279newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
281-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
282-- encoded text that is known to be valid.
284-- If the input contains any invalid UTF-8 data, an exception will be
285-- thrown (either by this function or a continuation) that cannot be
286-- caught in pure code. For more control over the handling of invalid
287-- data, use 'streamDecodeUtf8With'.
290streamDecodeUtf8 :: ByteString -> Decoding
291streamDecodeUtf8 = streamDecodeUtf8With strictDecode
293-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
297streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
298streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
300 -- We create a slightly larger than necessary buffer to accommodate a
301 -- potential surrogate pair started in the last buffer
302 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
304 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
305 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
307 decodeChunkToBuffer :: A.MArray s -> IO Decoding
308 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
309 with (0::CSize) $ \destOffPtr ->
310 with codepoint0 $ \codepointPtr ->
311 with state0 $ \statePtr ->
312 with nullPtr $ \curPtrPtr ->
313 let end = ptr `plusPtr` (off + len)
315 poke curPtrPtr curPtr
316 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
317 curPtrPtr end codepointPtr statePtr
318 state <- peek statePtr
321 -- We encountered an encoding error
324 case onErr desc (Just x) of
325 Nothing -> loop $ curPtr' `plusPtr` 1
327 destOff <- peek destOffPtr
329 unsafeWrite dest (fromIntegral destOff) (safe c)
330 poke destOffPtr (destOff + fromIntegral w)
331 loop $ curPtr' `plusPtr` 1
334 -- We encountered the end of the buffer while decoding
336 codepoint <- peek codepointPtr
337 chunkText <- unsafeSTToIO $ do
338 arr <- A.unsafeFreeze dest
339 return $! text arr 0 (fromIntegral n)
340 lastPtr <- peek curPtrPtr
341 let left = lastPtr `minusPtr` curPtr
342 !undecoded = case state of
343 UTF8_ACCEPT -> B.empty
344 _ -> B.append undecoded0 (B.drop left bs)
345 return $ Some chunkText undecoded
346 (decodeChunk undecoded codepoint state)
347 in loop (ptr `plusPtr` off)
348 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
350-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
353-- If the input contains any invalid UTF-8 data, an exception will be
354-- thrown that cannot be caught in pure code. For more control over
355-- the handling of invalid data, use 'decodeUtf8'' or
357decodeUtf8 :: ByteString -> Text
358decodeUtf8 = decodeUtf8With strictDecode
359{-# INLINE[0] decodeUtf8 #-}
360{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
361 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
363-- | Decode a 'ByteString' containing UTF-8 encoded text.
365-- If the input contains any invalid UTF-8 data, the relevant
366-- exception will be returned, otherwise the decoded text.
367decodeUtf8' :: ByteString -> Either UnicodeException Text
368decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
369{-# INLINE decodeUtf8' #-}
371-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
374encodeUtf8Builder :: Text -> B.Builder
375encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
377-- | Encode text using UTF-8 encoding and escape the ASCII characters using
378-- a 'BP.BoundedPrim'.
380-- Use this function is to implement efficient encoders for text-based formats
384{-# INLINE encodeUtf8BuilderEscaped #-}
385-- TODO: Extend documentation with references to source code in @blaze-html@
386-- or @aeson@ that uses this function.
387encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
388encodeUtf8BuilderEscaped be =
389 -- manual eta-expansion to ensure inlining works as expected
390 \txt -> B.builder (mkBuildstep txt)
392 bound = max 4 $ BP.sizeBound be
395 mkBuildstep (Text arr off len) !k =
397 mkBuildstep (Text t) !k =
403 (arr, len) = let (# ba, len' #) = js_fromString t
404 in (A.Array ba, I# len')
408 outerLoop !i0 !br@(B.BufferRange op0 ope)
410 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
411 -- TODO: Use a loop with an integrated bound's check if outRemaining
412 -- is smaller than 8, as this will save on divisions.
413 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
415 outRemaining = (ope `minusPtr` op0) `div` bound
416 inpRemaining = iend - i0
418 goPartial !iendTmp = go i0 op0
421 | i < iendTmp = case A.unsafeIndex arr i of
423 BP.runB be (fromIntegral w) op >>= go (i + 1)
425 poke8 0 $ (w `shiftR` 6) + 0xC0
426 poke8 1 $ (w .&. 0x3f) + 0x80
427 go (i + 1) (op `plusPtr` 2)
428 | 0xD800 <= w && w <= 0xDBFF -> do
429 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
430 poke8 0 $ (c `shiftR` 18) + 0xF0
431 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
432 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
433 poke8 3 $ (c .&. 0x3F) + 0x80
434 go (i + 2) (op `plusPtr` 4)
436 poke8 0 $ (w `shiftR` 12) + 0xE0
437 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
438 poke8 2 $ (w .&. 0x3F) + 0x80
439 go (i + 1) (op `plusPtr` 3)
441 outerLoop i (B.BufferRange op ope)
443 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
445-- | Encode text using UTF-8 encoding.
446encodeUtf8 :: Text -> ByteString
448encodeUtf8 (Text arr off len)
450 | otherwise = unsafeDupablePerformIO $ do
451 fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
452 withForeignPtr fp $ \ptr ->
453 with ptr $ \destPtr -> do
454 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
455 newDest <- peek destPtr
456 let utf8len = newDest `minusPtr` ptr
457 if utf8len >= len `shiftR` 1
458 then return (PS fp 0 utf8len)
460 fp' <- mallocByteString utf8len
461 withForeignPtr fp' $ \ptr' -> do
462 memcpy ptr' ptr (fromIntegral utf8len)
463 return (PS fp' 0 utf8len)
465encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf
466 where buf = js_encodeUtf8 txt
469-- | Decode text from little endian UTF-16 encoding.
470decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
471decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
472{-# INLINE decodeUtf16LEWith #-}
474-- | Decode text from little endian UTF-16 encoding.
476-- If the input contains any invalid little endian UTF-16 data, an
477-- exception will be thrown. For more control over the handling of
478-- invalid data, use 'decodeUtf16LEWith'.
479decodeUtf16LE :: ByteString -> Text
480decodeUtf16LE = decodeUtf16LEWith strictDecode
481{-# INLINE decodeUtf16LE #-}
483-- | Decode text from big endian UTF-16 encoding.
484decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
485decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
486{-# INLINE decodeUtf16BEWith #-}
488-- | Decode text from big endian UTF-16 encoding.
490-- If the input contains any invalid big endian UTF-16 data, an
491-- exception will be thrown. For more control over the handling of
492-- invalid data, use 'decodeUtf16BEWith'.
493decodeUtf16BE :: ByteString -> Text
494decodeUtf16BE = decodeUtf16BEWith strictDecode
495{-# INLINE decodeUtf16BE #-}
497-- | Encode text using little endian UTF-16 encoding.
498encodeUtf16LE :: Text -> ByteString
499encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
500{-# INLINE encodeUtf16LE #-}
502-- | Encode text using big endian UTF-16 encoding.
503encodeUtf16BE :: Text -> ByteString
504encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
505{-# INLINE encodeUtf16BE #-}
507-- | Decode text from little endian UTF-32 encoding.
508decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
509decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
510{-# INLINE decodeUtf32LEWith #-}
512-- | Decode text from little endian UTF-32 encoding.
514-- If the input contains any invalid little endian UTF-32 data, an
515-- exception will be thrown. For more control over the handling of
516-- invalid data, use 'decodeUtf32LEWith'.
517decodeUtf32LE :: ByteString -> Text
518decodeUtf32LE = decodeUtf32LEWith strictDecode
519{-# INLINE decodeUtf32LE #-}
521-- | Decode text from big endian UTF-32 encoding.
522decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
523decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
524{-# INLINE decodeUtf32BEWith #-}
526-- | Decode text from big endian UTF-32 encoding.
528-- If the input contains any invalid big endian UTF-32 data, an
529-- exception will be thrown. For more control over the handling of
530-- invalid data, use 'decodeUtf32BEWith'.
531decodeUtf32BE :: ByteString -> Text
532decodeUtf32BE = decodeUtf32BEWith strictDecode
533{-# INLINE decodeUtf32BE #-}
535-- | Encode text using little endian UTF-32 encoding.
536encodeUtf32LE :: Text -> ByteString
537encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
538{-# INLINE encodeUtf32LE #-}
540-- | Encode text using big endian UTF-32 encoding.
541encodeUtf32BE :: Text -> ByteString
542encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
543{-# INLINE encodeUtf32BE #-}
545foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
546 :: MutableByteArray# s -> Ptr CSize
547 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
549foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
550 :: MutableByteArray# s -> Ptr CSize
551 -> Ptr (Ptr Word8) -> Ptr Word8
552 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
554foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
555 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
558foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
559 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
561foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
562foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
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