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
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@.
63 , encodeUtf8BuilderEscaped
67#if __GLASGOW_HASKELL__ >= 702
68import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
70import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
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.Extra as B
78import qualified Data.ByteString.Builder.Internal as B hiding (empty)
79import qualified Data.ByteString.Builder.Prim as BP
80import qualified Data.ByteString.Builder.Prim.Internal as BP
81import qualified Data.Text.Internal.Encoding.Utf16 as U16
84import Control.Exception (evaluate, try)
85import Control.Monad.ST (runST)
86import Data.ByteString as B
87import Data.ByteString.Internal as B hiding (c2w)
89import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
90import Data.Text.Internal (Text(..), safe, textP)
91import Data.Text.Internal.Private (runText)
92import Data.Text.Internal.Unsafe.Char (unsafeWrite)
93import Data.Text.Internal.Unsafe.Shift (shiftR)
94import Data.Text.Unsafe (unsafeDupablePerformIO)
95import Data.Word (Word8, Word32)
96import Foreign.C.Types (CSize(..))
97import Foreign.ForeignPtr (withForeignPtr)
98import Foreign.Marshal.Utils (with)
99import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
100import Foreign.Storable (Storable, peek, poke)
101import GHC.Base (ByteArray#, MutableByteArray#)
102import qualified Data.Text.Array as A
103import qualified Data.Text.Internal.Encoding.Fusion as E
104import qualified Data.Text.Internal.Fusion as F
106#include "text_cbits.h"
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
124-- This function is deprecated. Use 'decodeLatin1' instead.
125decodeASCII :: ByteString -> Text
126decodeASCII = decodeUtf8
127{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
129-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
131-- 'decodeLatin1' is semantically equivalent to
132-- @Data.Text.pack . Data.ByteString.Char8.unpack@
133decodeLatin1 :: ByteString -> Text
134decodeLatin1 (PS fp off len) = textP a 0 len
136 a = A.run (A.new len >>= unsafeIOToST . go)
137 go dest = withForeignPtr fp $ \ptr -> do
138 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
141-- | Decode a 'ByteString' containing UTF-8 encoded text.
142decodeUtf8With :: OnDecodeError -> ByteString -> Text
143decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
144 let go dest = withForeignPtr fp $ \ptr ->
145 with (0::CSize) $ \destOffPtr -> do
146 let end = ptr `plusPtr` (off + len)
148 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
152 unsafeSTToIO (done dest (fromIntegral n))
155 case onErr desc (Just x) of
156 Nothing -> loop $ curPtr' `plusPtr` 1
158 destOff <- peek destOffPtr
160 unsafeWrite dest (fromIntegral destOff) (safe c)
161 poke destOffPtr (destOff + fromIntegral w)
162 loop $ curPtr' `plusPtr` 1
163 loop (ptr `plusPtr` off)
164 (unsafeIOToST . go) =<< A.new len
166 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
167{- INLINE[0] decodeUtf8With #-}
171-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
172-- a 'ByteString' that represents a possibly incomplete input (e.g. a
173-- packet from a network stream) that may not end on a UTF-8 boundary.
175-- The first element of the result is the maximal chunk of 'Text' that
176-- can be decoded from the given input. The second is a function which
177-- accepts another 'ByteString'. That string will be assumed to
178-- directly follow the string that was passed as input to the original
179-- function, and it will in turn be decoded.
181-- To help understand the use of these functions, consider the Unicode
182-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
183-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
185-- Now suppose that we receive this encoded string as 3 packets that
186-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
187-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
188-- have received all three packets, but we would like to make progress
189-- as we receive each one.
192-- let 'Some' t0 f0 = 'streamDecodeUtf8' \"hi \\xe2\"
193-- t0 == \"hi \" :: 'Text'
196-- We use the continuation @f0@ to decode our second packet.
199-- let 'Some' t1 f1 = f0 \"\\x98\"
203-- We could not give @f0@ enough input to decode anything, so it
204-- returned an empty string. Once we feed our second continuation @f1@
205-- the last byte of input, it will make progress.
208-- let 'Some' t2 f2 = f1 \"\\x83\"
212-- If given invalid input, an exception will be thrown by the function
213-- or continuation where it is encountered.
215-- | A stream oriented decoding result.
216data Decoding = Some Text ByteString (ByteString -> Decoding)
218instance Show Decoding where
219 showsPrec d (Some t bs _) = showParen (d > prec) $
220 showString "Some " . showsPrec prec' t .
221 showChar ' ' . showsPrec prec' bs .
223 where prec = 10; prec' = prec + 1
225newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
226newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
228-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
229-- encoded text that is known to be valid.
231-- If the input contains any invalid UTF-8 data, an exception will be
232-- thrown (either by this function or a continuation) that cannot be
233-- caught in pure code. For more control over the handling of invalid
234-- data, use 'streamDecodeUtf8With'.
235streamDecodeUtf8 :: ByteString -> Decoding
236streamDecodeUtf8 = streamDecodeUtf8With strictDecode
238-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
240streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
241streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
243 -- We create a slightly larger than necessary buffer to accommodate a
244 -- potential surrogate pair started in the last buffer
245 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
247 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
248 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
250 decodeChunkToBuffer :: A.MArray s -> IO Decoding
251 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
252 with (0::CSize) $ \destOffPtr ->
253 with codepoint0 $ \codepointPtr ->
254 with state0 $ \statePtr ->
255 with nullPtr $ \curPtrPtr ->
256 let end = ptr `plusPtr` (off + len)
258 poke curPtrPtr curPtr
259 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
260 curPtrPtr end codepointPtr statePtr
261 state <- peek statePtr
264 -- We encountered an encoding error
266 case onErr desc (Just x) of
267 Nothing -> loop $ curPtr' `plusPtr` 1
269 destOff <- peek destOffPtr
271 unsafeWrite dest (fromIntegral destOff) (safe c)
272 poke destOffPtr (destOff + fromIntegral w)
274 loop $ curPtr' `plusPtr` 1
277 -- We encountered the end of the buffer while decoding
279 codepoint <- peek codepointPtr
280 chunkText <- unsafeSTToIO $ do
281 arr <- A.unsafeFreeze dest
282 return $! textP arr 0 (fromIntegral n)
283 lastPtr <- peek curPtrPtr
284 let left = lastPtr `minusPtr` curPtr
285 undecoded = case state of
286 UTF8_ACCEPT -> B.empty
287 _ -> B.append undecoded0 (B.drop left bs)
288 return $ Some chunkText undecoded
289 (decodeChunk undecoded 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#if MIN_VERSION_bytestring(0,10,4)
316-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
317encodeUtf8Builder :: Text -> B.Builder
318encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
320-- | Encode text using UTF-8 encoding and escape the ASCII characters using
321-- a 'BP.BoundedPrim'.
323-- Use this function is to implement efficient encoders for text-based formats
325{-# INLINE encodeUtf8BuilderEscaped #-}
326-- TODO: Extend documentation with references to source code in @blaze-html@
327-- or @aeson@ that uses this function.
328encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
329encodeUtf8BuilderEscaped be =
330 -- manual eta-expansion to ensure inlining works as expected
331 \txt -> B.builder (mkBuildstep txt)
333 bound = max 4 $ BP.sizeBound be
335 mkBuildstep (Text arr off len) !k =
340 outerLoop !i0 !br@(B.BufferRange op0 ope)
342 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
343 -- TODO: Use a loop with an integrated bound's check if outRemaining
344 -- is smaller than 8, as this will save on divisions.
345 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
347 outRemaining = (ope `minusPtr` op0) `div` bound
348 inpRemaining = iend - i0
350 goPartial !iendTmp = go i0 op0
353 | i < iendTmp = case A.unsafeIndex arr i of
355 BP.runB be (fromIntegral w) op >>= go (i + 1)
357 poke8 0 $ (w `shiftR` 6) + 0xC0
358 poke8 1 $ (w .&. 0x3f) + 0x80
359 go (i + 1) (op `plusPtr` 2)
360 | 0xD800 <= w && w <= 0xDBFF -> do
361 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
362 poke8 0 $ (c `shiftR` 18) + 0xF0
363 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
364 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
365 poke8 3 $ (c .&. 0x3F) + 0x80
366 go (i + 2) (op `plusPtr` 4)
368 poke8 0 $ (w `shiftR` 12) + 0xE0
369 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
370 poke8 2 $ (w .&. 0x3F) + 0x80
371 go (i + 1) (op `plusPtr` 3)
373 outerLoop i (B.BufferRange op ope)
375 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
378-- | Encode text using UTF-8 encoding.
379encodeUtf8 :: Text -> ByteString
380encodeUtf8 (Text arr off len)
382 | otherwise = unsafeDupablePerformIO $ do
383 fp <- mallocByteString (len*4)
384 withForeignPtr fp $ \ptr ->
385 with ptr $ \destPtr -> do
386 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
387 newDest <- peek destPtr
388 let utf8len = newDest `minusPtr` ptr
389 if utf8len >= len `shiftR` 1
390 then return (PS fp 0 utf8len)
392 fp' <- mallocByteString utf8len
393 withForeignPtr fp' $ \ptr' -> do
394 memcpy ptr' ptr (fromIntegral utf8len)
395 return (PS fp' 0 utf8len)
397-- | Decode text from little endian UTF-16 encoding.
398decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
399decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
400{-# INLINE decodeUtf16LEWith #-}
402-- | Decode text from little endian UTF-16 encoding.
404-- If the input contains any invalid little endian UTF-16 data, an
405-- exception will be thrown. For more control over the handling of
406-- invalid data, use 'decodeUtf16LEWith'.
407decodeUtf16LE :: ByteString -> Text
408decodeUtf16LE = decodeUtf16LEWith strictDecode
409{-# INLINE decodeUtf16LE #-}
411-- | Decode text from big endian UTF-16 encoding.
412decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
413decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
414{-# INLINE decodeUtf16BEWith #-}
416-- | Decode text from big endian UTF-16 encoding.
418-- If the input contains any invalid big endian UTF-16 data, an
419-- exception will be thrown. For more control over the handling of
420-- invalid data, use 'decodeUtf16BEWith'.
421decodeUtf16BE :: ByteString -> Text
422decodeUtf16BE = decodeUtf16BEWith strictDecode
423{-# INLINE decodeUtf16BE #-}
425-- | Encode text using little endian UTF-16 encoding.
426encodeUtf16LE :: Text -> ByteString
427encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
428{-# INLINE encodeUtf16LE #-}
430-- | Encode text using big endian UTF-16 encoding.
431encodeUtf16BE :: Text -> ByteString
432encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
433{-# INLINE encodeUtf16BE #-}
435-- | Decode text from little endian UTF-32 encoding.
436decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
437decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
438{-# INLINE decodeUtf32LEWith #-}
440-- | Decode text from little endian UTF-32 encoding.
442-- If the input contains any invalid little endian UTF-32 data, an
443-- exception will be thrown. For more control over the handling of
444-- invalid data, use 'decodeUtf32LEWith'.
445decodeUtf32LE :: ByteString -> Text
446decodeUtf32LE = decodeUtf32LEWith strictDecode
447{-# INLINE decodeUtf32LE #-}
449-- | Decode text from big endian UTF-32 encoding.
450decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
451decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
452{-# INLINE decodeUtf32BEWith #-}
454-- | Decode text from big endian UTF-32 encoding.
456-- If the input contains any invalid big endian UTF-32 data, an
457-- exception will be thrown. For more control over the handling of
458-- invalid data, use 'decodeUtf32BEWith'.
459decodeUtf32BE :: ByteString -> Text
460decodeUtf32BE = decodeUtf32BEWith strictDecode
461{-# INLINE decodeUtf32BE #-}
463-- | Encode text using little endian UTF-32 encoding.
464encodeUtf32LE :: Text -> ByteString
465encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
466{-# INLINE encodeUtf32LE #-}
468-- | Encode text using big endian UTF-32 encoding.
469encodeUtf32BE :: Text -> ByteString
470encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
471{-# INLINE encodeUtf32BE #-}
473foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
474 :: MutableByteArray# s -> Ptr CSize
475 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
477foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
478 :: MutableByteArray# s -> Ptr CSize
479 -> Ptr (Ptr Word8) -> Ptr Word8
480 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
482foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
483 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
485foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
486 :: 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