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)
80-- import Data.Text.Show ()
81import Data.Text.Unsafe (unsafeDupablePerformIO)
82import Data.Word (Word8, Word32)
83import Foreign.C.Types (CSize(..))
84import Foreign.ForeignPtr (withForeignPtr)
85import Foreign.Marshal.Utils (with)
86import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
87import Foreign.Storable (Storable, peek, poke)
88import GHC.Base (ByteArray#, MutableByteArray#)
89import qualified Data.ByteString.Builder as B
90import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
91import qualified Data.ByteString.Builder.Prim as BP
92import qualified Data.ByteString.Builder.Prim.Internal as BP
93import qualified Data.Text.Array as A
94import qualified Data.Text.Internal.Encoding.Fusion as E
95import qualified Data.Text.Internal.Encoding.Utf16 as U16
96import qualified Data.Text.Internal.Fusion as F
98import GHC.Exts (ByteArray#, Int(..), Int#, Any, Addr#, Ptr(..))
100#include "text_cbits.h"
103import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
104import Data.ByteString (ByteString)
105import Data.Text.Internal (Text)
107-------------------------------------
111import Data.JSString (JSString)
113import System.IO.Unsafe
114-------------------------------------
119-- All of the single-parameter functions for decoding bytestrings
120-- encoded in one of the Unicode Transformation Formats (UTF) operate
121-- in a /strict/ mode: each will throw an exception if given invalid
124-- Each function has a variant, whose name is suffixed with -'With',
125-- that gives greater control over the handling of decoding errors.
126-- For instance, 'decodeUtf8' will throw an exception, but
127-- 'decodeUtf8With' allows the programmer to determine what to do on a
130-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
132decodeASCII :: ByteString -> Text
133decodeASCII = decodeUtf8
134{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
136-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
138-- 'decodeLatin1' is semantically equivalent to
139-- @Data.Text.pack . Data.ByteString.Char8.unpack@
140decodeLatin1 :: ByteString -> Text
141decodeLatin1 (PS fp off len) = text a 0 len
143 a = A.run (A.new len >>= unsafeIOToST . go)
144 go dest = withForeignPtr fp $ \ptr -> do
145 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
148-- foreign import javascript unsafe "h$textToString" js_toString :: JSVal -> Text
150foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
151foreign import javascript unsafe "String['fromCharCode']['apply'](null, $1['u8'])" js_decodeBytes :: JSVal -> JSString
152foreign import javascript unsafe "h$decodeUtf8z($1, $2)" js_fromByteStringBuffer :: Buffer -> Int -> JSString
153foreign import javascript unsafe "h$decodeUtf8z($1, $2)" js_fromByteStringBufferz :: Addr# -> Int -> JSString
154foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
156foreign import javascript unsafe "String['fromCharCode']['apply'](null, $1['u8'])" js_decodeUtf8Hack :: Addr# -> JSString
158foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8Mut :: JSString -> MutableBuffer
159foreign import javascript unsafe "h$encodeUtf16($1)" js_encodeUtf16 :: JSString -> Buffer
160foreign import javascript unsafe "$1['length']" js_length :: JSString -> Int
161foreign import javascript unsafe "h$jsstringTake" js_take :: Int -> JSString -> JSString
162foreign import javascript unsafe "$3.substring($1,$2)" js_substring :: Int# -> Int# -> JSString -> JSString
164-- | Decode a 'ByteString' containing UTF-8 encoded text.
165decodeUtf8With :: OnDecodeError -> ByteString -> Text
166decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
167 let go dest = withForeignPtr fp $ \ptr ->
168 with (0::CSize) $ \destOffPtr -> do
169 let end = ptr `plusPtr` (off + len)
171 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
175 unsafeSTToIO (done dest (fromIntegral n))
178 case onErr desc (Just x) of
179 Nothing -> loop $ curPtr' `plusPtr` 1
181 destOff <- peek destOffPtr
183 unsafeWrite dest (fromIntegral destOff) (safe c)
184 poke destOffPtr (destOff + fromIntegral w)
185 loop $ curPtr' `plusPtr` 1
186 loop (ptr `plusPtr` off)
187 (unsafeIOToST . go) =<< A.new len
189 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
190{- INLINE[0] decodeUtf8With #-}
194-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
195-- a 'ByteString' that represents a possibly incomplete input (e.g. a
196-- packet from a network stream) that may not end on a UTF-8 boundary.
198-- 1. The maximal prefix of 'Text' that could be decoded from the
201-- 2. The suffix of the 'ByteString' that could not be decoded due to
202-- insufficient input.
204-- 3. A function that accepts another 'ByteString'. That string will
205-- be assumed to directly follow the string that was passed as
206-- input to the original function, and it will in turn be decoded.
208-- To help understand the use of these functions, consider the Unicode
209-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
210-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
212-- Now suppose that we receive this encoded string as 3 packets that
213-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
214-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
215-- have received all three packets, but we would like to make progress
216-- as we receive each one.
219-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
221-- 'Some' \"hi \" \"\\xe2\" _
224-- We use the continuation @f0@ to decode our second packet.
227-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
229-- 'Some' \"\" \"\\xe2\\x98\"
232-- We could not give @f0@ enough input to decode anything, so it
233-- returned an empty string. Once we feed our second continuation @f1@
234-- the last byte of input, it will make progress.
237-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
239-- 'Some' \"\\x2603\" \"\" _
242-- If given invalid input, an exception will be thrown by the function
243-- or continuation where it is encountered.
245-- | A stream oriented decoding result.
246data Decoding = Some Text ByteString (ByteString -> Decoding)
248instance Show Decoding where
249 showsPrec d (Some t bs _) = showParen (d > prec) $
250 showString "Some " . showsPrec prec' t .
251 showChar ' ' . showsPrec prec' bs .
253 where prec = 10; prec' = prec + 1
255newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
256newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
258-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
259-- encoded text that is known to be valid.
261-- If the input contains any invalid UTF-8 data, an exception will be
262-- thrown (either by this function or a continuation) that cannot be
263-- caught in pure code. For more control over the handling of invalid
264-- data, use 'streamDecodeUtf8With'.
265streamDecodeUtf8 :: ByteString -> Decoding
266streamDecodeUtf8 = streamDecodeUtf8With strictDecode
268-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
270streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
271streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
273 -- We create a slightly larger than necessary buffer to accommodate a
274 -- potential surrogate pair started in the last buffer
275 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
277 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
278 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
280 decodeChunkToBuffer :: A.MArray s -> IO Decoding
281 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
282 with (0::CSize) $ \destOffPtr ->
283 with codepoint0 $ \codepointPtr ->
284 with state0 $ \statePtr ->
285 with nullPtr $ \curPtrPtr ->
286 let end = ptr `plusPtr` (off + len)
288 poke curPtrPtr curPtr
289 curPtr' <- error "c_decode_utf8_with_state: needs to be implemented"
290 -- curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
291 -- curPtrPtr end codepointPtr statePtr
292 state <- peek statePtr
295 -- We encountered an encoding error
298 case onErr desc (Just x) of
299 Nothing -> loop $ curPtr' `plusPtr` 1
301 destOff <- peek destOffPtr
303 unsafeWrite dest (fromIntegral destOff) (safe c)
304 poke destOffPtr (destOff + fromIntegral w)
305 loop $ curPtr' `plusPtr` 1
308 -- We encountered the end of the buffer while decoding
310 codepoint <- peek codepointPtr
311 chunkText <- unsafeSTToIO $ do
312 arr <- A.unsafeFreeze dest
313 return $! text arr 0 (fromIntegral n)
314 lastPtr <- peek curPtrPtr
315 let left = lastPtr `minusPtr` curPtr
316 !undecoded = case state of
317 UTF8_ACCEPT -> B.empty
318 _ -> B.append undecoded0 (B.drop left bs)
319 return $ Some chunkText undecoded
320 (decodeChunk undecoded codepoint state)
321 in loop (ptr `plusPtr` off)
322 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
324-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
327-- If the input contains any invalid UTF-8 data, an exception will be
328-- thrown that cannot be caught in pure code. For more control over
329-- the handling of invalid data, use 'decodeUtf8'' or
331decodeUtf8 :: ByteString -> Text
332decodeUtf8 = decodeUtf8With strictDecode
333{-# INLINE[0] decodeUtf8 #-}
334-- {-# RULES "STREAM stream/decodeUtf8 fusion" [1]
335-- forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
337-- | Decode a 'ByteString' containing UTF-8 encoded text.
339-- If the input contains any invalid UTF-8 data, the relevant
340-- exception will be returned, otherwise the decoded text.
341decodeUtf8' :: ByteString -> Either UnicodeException Text
342decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
343{-# INLINE decodeUtf8' #-}
345-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
346encodeUtf8Builder :: Text -> B.Builder
347encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
349-- | Encode text using UTF-8 encoding and escape the ASCII characters using
350-- a 'BP.BoundedPrim'.
352-- Use this function is to implement efficient encoders for text-based formats
354{-# INLINE encodeUtf8BuilderEscaped #-}
355-- TODO: Extend documentation with references to source code in @blaze-html@
356-- or @aeson@ that uses this function.
357encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
358encodeUtf8BuilderEscaped be =
359 -- manual eta-expansion to ensure inlining works as expected
360 \txt -> B.builder (mkBuildstep txt)
362 bound = max 4 $ BP.sizeBound be
364 mkBuildstep (Text t) !k =
365 -- mkBuildstep (Text arr off len) !k =
369 (arr, len) = let (# ba, len' #) = js_fromString t
370 in (A.Array ba, I# len')
373 outerLoop !i0 !br@(B.BufferRange op0 ope)
375 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
376 -- TODO: Use a loop with an integrated bound's check if outRemaining
377 -- is smaller than 8, as this will save on divisions.
378 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
380 outRemaining = (ope `minusPtr` op0) `div` bound
381 inpRemaining = iend - i0
383 goPartial !iendTmp = go i0 op0
386 | i < iendTmp = case A.unsafeIndex arr i of
388 BP.runB be (fromIntegral w) op >>= go (i + 1)
390 poke8 0 $ (w `shiftR` 6) + 0xC0
391 poke8 1 $ (w .&. 0x3f) + 0x80
392 go (i + 1) (op `plusPtr` 2)
393 | 0xD800 <= w && w <= 0xDBFF -> do
394 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
395 poke8 0 $ (c `shiftR` 18) + 0xF0
396 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
397 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
398 poke8 3 $ (c .&. 0x3F) + 0x80
399 go (i + 2) (op `plusPtr` 4)
401 poke8 0 $ (w `shiftR` 12) + 0xE0
402 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
403 poke8 2 $ (w .&. 0x3F) + 0x80
404 go (i + 1) (op `plusPtr` 3)
406 outerLoop i (B.BufferRange op ope)
408 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
412-- | Encode text using UTF-8 encoding.
413encodeUtf8 :: Text -> ByteString
414encodeUtf8 (Text txt) = toByteString 0 (Just (js_length txt)) $ js_encodeUtf8 txt
415-- encodeUtf8 (Text arr off len)
416-- | len == 0 = B.empty
417-- | otherwise = unsafeDupablePerformIO $ do
418-- fp <- mallocByteString (len*4)
419-- withForeignPtr fp $ \ptr ->
420-- with ptr $ \destPtr -> do
421-- c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
422-- newDest <- peek destPtr
423-- let utf8len = newDest `minusPtr` ptr
424-- if utf8len >= len `shiftR` 1
425-- then return (PS fp 0 utf8len)
427-- fp' <- mallocByteString utf8len
428-- withForeignPtr fp' $ \ptr' -> do
429-- memcpy ptr' ptr (fromIntegral utf8len)
430-- return (PS fp' 0 utf8len)
432-- | Decode text from little endian UTF-16 encoding.
433decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
434decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
435{-# INLINE decodeUtf16LEWith #-}
437-- | Decode text from little endian UTF-16 encoding.
439-- If the input contains any invalid little endian UTF-16 data, an
440-- exception will be thrown. For more control over the handling of
441-- invalid data, use 'decodeUtf16LEWith'.
442decodeUtf16LE :: ByteString -> Text
443decodeUtf16LE = decodeUtf16LEWith strictDecode
444{-# INLINE decodeUtf16LE #-}
446-- | Decode text from big endian UTF-16 encoding.
447decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
448decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
449{-# INLINE decodeUtf16BEWith #-}
451-- | Decode text from big endian UTF-16 encoding.
453-- If the input contains any invalid big endian UTF-16 data, an
454-- exception will be thrown. For more control over the handling of
455-- invalid data, use 'decodeUtf16BEWith'.
456decodeUtf16BE :: ByteString -> Text
457decodeUtf16BE = decodeUtf16BEWith strictDecode
458{-# INLINE decodeUtf16BE #-}
460-- | Encode text using little endian UTF-16 encoding.
461encodeUtf16LE :: Text -> ByteString
462encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
463{-# INLINE encodeUtf16LE #-}
465-- | Encode text using big endian UTF-16 encoding.
466encodeUtf16BE :: Text -> ByteString
467encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
468{-# INLINE encodeUtf16BE #-}
470-- | Decode text from little endian UTF-32 encoding.
471decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
472decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
473{-# INLINE decodeUtf32LEWith #-}
475-- | Decode text from little endian UTF-32 encoding.
477-- If the input contains any invalid little endian UTF-32 data, an
478-- exception will be thrown. For more control over the handling of
479-- invalid data, use 'decodeUtf32LEWith'.
480decodeUtf32LE :: ByteString -> Text
481decodeUtf32LE = decodeUtf32LEWith strictDecode
482{-# INLINE decodeUtf32LE #-}
484-- | Decode text from big endian UTF-32 encoding.
485decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
486decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
487{-# INLINE decodeUtf32BEWith #-}
489-- | Decode text from big endian UTF-32 encoding.
491-- If the input contains any invalid big endian UTF-32 data, an
492-- exception will be thrown. For more control over the handling of
493-- invalid data, use 'decodeUtf32BEWith'.
494decodeUtf32BE :: ByteString -> Text
495decodeUtf32BE = decodeUtf32BEWith strictDecode
496{-# INLINE decodeUtf32BE #-}
498-- | Encode text using little endian UTF-32 encoding.
499encodeUtf32LE :: Text -> ByteString
500encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
501{-# INLINE encodeUtf32LE #-}
503-- | Encode text using big endian UTF-32 encoding.
504encodeUtf32BE :: Text -> ByteString
505encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
506{-# INLINE encodeUtf32BE #-}
508foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
509 :: MutableByteArray# s -> Ptr CSize
510 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
512foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
513 :: MutableByteArray# s -> Ptr CSize
514 -> Ptr (Ptr Word8) -> Ptr Word8
515 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
517foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
518 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
520foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
521 :: 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