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-- Stability : experimental
16-- Portability : portable
18-- Functions for converting 'Text' values to and from 'ByteString',
19-- using several standard encodings.
21-- To gain access to a much larger family of encodings, use the
22-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
24module Data.Text.Encoding
26 -- * Decoding ByteStrings to Text
36 -- ** Catchable failure
39 -- ** Controllable error handling
46 -- ** Stream oriented decoding
49 , streamDecodeUtf8With
52 -- * Encoding Text to ByteStrings
59 -- * Encoding Text using ByteString Builders
61 , encodeUtf8BuilderEscaped
64#if __GLASGOW_HASKELL__ >= 702
65import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
67import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
70import Control.Exception (evaluate, try)
71import Control.Monad.ST (runST)
72import Data.Bits ((.&.))
73import Data.ByteString as B
74import Data.ByteString.Internal as B hiding (c2w)
75import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
76import Data.Text.Internal (Text(..), safe, text)
77import Data.Text.Internal.Private (runText)
78import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
79import Data.Text.Internal.Unsafe.Shift (shiftR)
81import Data.Text.Show ()
83import Data.Text.Unsafe (unsafeDupablePerformIO)
84import Data.Word (Word8, Word32)
85import Foreign.C.Types (CSize(..))
86import Foreign.ForeignPtr (withForeignPtr)
87import Foreign.Marshal.Utils (with)
88import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
89import Foreign.Storable (Storable, peek, poke)
90import GHC.Base (ByteArray#, MutableByteArray#)
91import qualified Data.ByteString.Builder as B
92import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
93import qualified Data.ByteString.Builder.Prim as BP
94import qualified Data.ByteString.Builder.Prim.Internal as BP
95import qualified Data.Text.Array as A
96import qualified Data.Text.Internal.Encoding.Fusion as E
97import qualified Data.Text.Internal.Encoding.Utf16 as U16
98import qualified Data.Text.Internal.Fusion as F
100#include "text_cbits.h"
102import GHC.Exts (Int(..), Int#)
103import Data.ByteString (ByteString)
105import Data.JSString (JSString)
110-- All of the single-parameter functions for decoding bytestrings
111-- encoded in one of the Unicode Transformation Formats (UTF) operate
112-- in a /strict/ mode: each will throw an exception if given invalid
115-- Each function has a variant, whose name is suffixed with -'With',
116-- that gives greater control over the handling of decoding errors.
117-- For instance, 'decodeUtf8' will throw an exception, but
118-- 'decodeUtf8With' allows the programmer to determine what to do on a
121-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
123decodeASCII :: ByteString -> Text
124decodeASCII = decodeUtf8
125{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
127-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
129-- 'decodeLatin1' is semantically equivalent to
130-- @Data.Text.pack . Data.ByteString.Char8.unpack@
131decodeLatin1 :: ByteString -> Text
132decodeLatin1 (PS fp off len) = text a 0 len
134 a = A.run (A.new len >>= unsafeIOToST . go)
135 go dest = withForeignPtr fp $ \ptr -> do
136 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
139-- | Decode a 'ByteString' containing UTF-8 encoded text.
140decodeUtf8With :: OnDecodeError -> ByteString -> Text
141decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
142 let go dest = withForeignPtr fp $ \ptr ->
143 with (0::CSize) $ \destOffPtr -> do
144 let end = ptr `plusPtr` (off + len)
146 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
150 unsafeSTToIO (done dest (fromIntegral n))
153 case onErr desc (Just x) of
154 Nothing -> loop $ curPtr' `plusPtr` 1
156 destOff <- peek destOffPtr
158 unsafeWrite dest (fromIntegral destOff) (safe c)
159 poke destOffPtr (destOff + fromIntegral w)
160 loop $ curPtr' `plusPtr` 1
161 loop (ptr `plusPtr` off)
162 (unsafeIOToST . go) =<< A.new len
164 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
165{- INLINE[0] decodeUtf8With #-}
169-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
170-- a 'ByteString' that represents a possibly incomplete input (e.g. a
171-- packet from a network stream) that may not end on a UTF-8 boundary.
173-- 1. The maximal prefix of 'Text' that could be decoded from the
176-- 2. The suffix of the 'ByteString' that could not be decoded due to
177-- insufficient input.
179-- 3. A function that accepts another 'ByteString'. That string will
180-- be assumed to directly follow the string that was passed as
181-- input to the original function, and it will in turn be decoded.
183-- To help understand the use of these functions, consider the Unicode
184-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
185-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
187-- Now suppose that we receive this encoded string as 3 packets that
188-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
189-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
190-- have received all three packets, but we would like to make progress
191-- as we receive each one.
194-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
196-- 'Some' \"hi \" \"\\xe2\" _
199-- We use the continuation @f0@ to decode our second packet.
202-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
204-- 'Some' \"\" \"\\xe2\\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-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
214-- 'Some' \"\\x2603\" \"\" _
217-- If given invalid input, an exception will be thrown by the function
218-- or continuation where it is encountered.
220-- | A stream oriented decoding result.
221data Decoding = Some Text ByteString (ByteString -> Decoding)
223instance Show Decoding where
224 showsPrec d (Some t bs _) = showParen (d > prec) $
225 showString "Some " . showsPrec prec' t .
226 showChar ' ' . showsPrec prec' bs .
228 where prec = 10; prec' = prec + 1
230newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
231newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
233-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
234-- encoded text that is known to be valid.
236-- If the input contains any invalid UTF-8 data, an exception will be
237-- thrown (either by this function or a continuation) that cannot be
238-- caught in pure code. For more control over the handling of invalid
239-- data, use 'streamDecodeUtf8With'.
240streamDecodeUtf8 :: ByteString -> Decoding
241streamDecodeUtf8 = streamDecodeUtf8With strictDecode
243-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
245streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
246streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
248 -- We create a slightly larger than necessary buffer to accommodate a
249 -- potential surrogate pair started in the last buffer
250 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
252 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
253 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
255 decodeChunkToBuffer :: A.MArray s -> IO Decoding
256 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
257 with (0::CSize) $ \destOffPtr ->
258 with codepoint0 $ \codepointPtr ->
259 with state0 $ \statePtr ->
260 with nullPtr $ \curPtrPtr ->
261 let end = ptr `plusPtr` (off + len)
263 poke curPtrPtr curPtr
264 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
265 curPtrPtr end codepointPtr statePtr
266 state <- peek statePtr
269 -- We encountered an encoding error
272 case onErr desc (Just x) of
273 Nothing -> loop $ curPtr' `plusPtr` 1
275 destOff <- peek destOffPtr
277 unsafeWrite dest (fromIntegral destOff) (safe c)
278 poke destOffPtr (destOff + fromIntegral w)
279 loop $ curPtr' `plusPtr` 1
282 -- We encountered the end of the buffer while decoding
284 codepoint <- peek codepointPtr
285 chunkText <- unsafeSTToIO $ do
286 arr <- A.unsafeFreeze dest
287 return $! text arr 0 (fromIntegral n)
288 lastPtr <- peek curPtrPtr
289 let left = lastPtr `minusPtr` curPtr
290 !undecoded = case state of
291 UTF8_ACCEPT -> B.empty
292 _ -> B.append undecoded0 (B.drop left bs)
293 return $ Some chunkText undecoded
294 (decodeChunk undecoded codepoint state)
295 in loop (ptr `plusPtr` off)
296 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
298-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
301-- If the input contains any invalid UTF-8 data, an exception will be
302-- thrown that cannot be caught in pure code. For more control over
303-- the handling of invalid data, use 'decodeUtf8'' or
305decodeUtf8 :: ByteString -> Text
306decodeUtf8 = decodeUtf8With strictDecode
307{-# INLINE[0] decodeUtf8 #-}
308{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
309 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
311-- | Decode a 'ByteString' containing UTF-8 encoded text.
313-- If the input contains any invalid UTF-8 data, the relevant
314-- exception will be returned, otherwise the decoded text.
315decodeUtf8' :: ByteString -> Either UnicodeException Text
316decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
317{-# INLINE decodeUtf8' #-}
319-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
320encodeUtf8Builder :: Text -> B.Builder
321encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
323-- | Encode text using UTF-8 encoding and escape the ASCII characters using
324-- a 'BP.BoundedPrim'.
326-- Use this function is to implement efficient encoders for text-based formats
328{-# INLINE encodeUtf8BuilderEscaped #-}
329-- TODO: Extend documentation with references to source code in @blaze-html@
330-- or @aeson@ that uses this function.
331encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
332encodeUtf8BuilderEscaped be =
333 -- manual eta-expansion to ensure inlining works as expected
334 \txt -> B.builder (mkBuildstep txt)
336 bound = max 4 $ BP.sizeBound be
339 mkBuildstep (Text arr off len) !k =
341 mkBuildstep (Text t) !k =
347 (arr, len) = let (# ba, len' #) = js_fromString t
348 in (A.Array ba, I# len')
352 outerLoop !i0 !br@(B.BufferRange op0 ope)
354 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
355 -- TODO: Use a loop with an integrated bound's check if outRemaining
356 -- is smaller than 8, as this will save on divisions.
357 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
359 outRemaining = (ope `minusPtr` op0) `div` bound
360 inpRemaining = iend - i0
362 goPartial !iendTmp = go i0 op0
365 | i < iendTmp = case A.unsafeIndex arr i of
367 BP.runB be (fromIntegral w) op >>= go (i + 1)
369 poke8 0 $ (w `shiftR` 6) + 0xC0
370 poke8 1 $ (w .&. 0x3f) + 0x80
371 go (i + 1) (op `plusPtr` 2)
372 | 0xD800 <= w && w <= 0xDBFF -> do
373 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
374 poke8 0 $ (c `shiftR` 18) + 0xF0
375 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
376 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
377 poke8 3 $ (c .&. 0x3F) + 0x80
378 go (i + 2) (op `plusPtr` 4)
380 poke8 0 $ (w `shiftR` 12) + 0xE0
381 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
382 poke8 2 $ (w .&. 0x3F) + 0x80
383 go (i + 1) (op `plusPtr` 3)
385 outerLoop i (B.BufferRange op ope)
387 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
389-- | Encode text using UTF-8 encoding.
390encodeUtf8 :: Text -> ByteString
392encodeUtf8 (Text arr off len)
394 | otherwise = unsafeDupablePerformIO $ do
395 fp <- mallocByteString (len*4)
396 withForeignPtr fp $ \ptr ->
397 with ptr $ \destPtr -> do
398 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
399 newDest <- peek destPtr
400 let utf8len = newDest `minusPtr` ptr
401 if utf8len >= len `shiftR` 1
402 then return (PS fp 0 utf8len)
404 fp' <- mallocByteString utf8len
405 withForeignPtr fp' $ \ptr' -> do
406 memcpy ptr' ptr (fromIntegral utf8len)
407 return (PS fp' 0 utf8len)
409encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf
410 where buf = js_encodeUtf8 txt
413-- | Decode text from little endian UTF-16 encoding.
414decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
415decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
416{-# INLINE decodeUtf16LEWith #-}
418-- | Decode text from little endian UTF-16 encoding.
420-- If the input contains any invalid little endian UTF-16 data, an
421-- exception will be thrown. For more control over the handling of
422-- invalid data, use 'decodeUtf16LEWith'.
423decodeUtf16LE :: ByteString -> Text
424decodeUtf16LE = decodeUtf16LEWith strictDecode
425{-# INLINE decodeUtf16LE #-}
427-- | Decode text from big endian UTF-16 encoding.
428decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
429decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
430{-# INLINE decodeUtf16BEWith #-}
432-- | Decode text from big endian UTF-16 encoding.
434-- If the input contains any invalid big endian UTF-16 data, an
435-- exception will be thrown. For more control over the handling of
436-- invalid data, use 'decodeUtf16BEWith'.
437decodeUtf16BE :: ByteString -> Text
438decodeUtf16BE = decodeUtf16BEWith strictDecode
439{-# INLINE decodeUtf16BE #-}
441-- | Encode text using little endian UTF-16 encoding.
442encodeUtf16LE :: Text -> ByteString
443encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
444{-# INLINE encodeUtf16LE #-}
446-- | Encode text using big endian UTF-16 encoding.
447encodeUtf16BE :: Text -> ByteString
448encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
449{-# INLINE encodeUtf16BE #-}
451-- | Decode text from little endian UTF-32 encoding.
452decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
453decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
454{-# INLINE decodeUtf32LEWith #-}
456-- | Decode text from little endian UTF-32 encoding.
458-- If the input contains any invalid little endian UTF-32 data, an
459-- exception will be thrown. For more control over the handling of
460-- invalid data, use 'decodeUtf32LEWith'.
461decodeUtf32LE :: ByteString -> Text
462decodeUtf32LE = decodeUtf32LEWith strictDecode
463{-# INLINE decodeUtf32LE #-}
465-- | Decode text from big endian UTF-32 encoding.
466decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
467decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
468{-# INLINE decodeUtf32BEWith #-}
470-- | Decode text from big endian UTF-32 encoding.
472-- If the input contains any invalid big endian UTF-32 data, an
473-- exception will be thrown. For more control over the handling of
474-- invalid data, use 'decodeUtf32BEWith'.
475decodeUtf32BE :: ByteString -> Text
476decodeUtf32BE = decodeUtf32BEWith strictDecode
477{-# INLINE decodeUtf32BE #-}
479-- | Encode text using little endian UTF-32 encoding.
480encodeUtf32LE :: Text -> ByteString
481encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
482{-# INLINE encodeUtf32LE #-}
484-- | Encode text using big endian UTF-32 encoding.
485encodeUtf32BE :: Text -> ByteString
486encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
487{-# INLINE encodeUtf32BE #-}
489foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
490 :: MutableByteArray# s -> Ptr CSize
491 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
493foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
494 :: MutableByteArray# s -> Ptr CSize
495 -> Ptr (Ptr Word8) -> Ptr Word8
496 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
498foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
499 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
502foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
503 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
505foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
506foreign 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