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 -- * 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)
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)
79import Data.Text.Show ()
80import Data.Text.Unsafe (unsafeDupablePerformIO)
81import Data.Word (Word8, Word32)
82#if __GLASGOW_HASKELL__ >= 703
83import Foreign.C.Types (CSize(CSize))
85import Foreign.C.Types (CSize)
87import Foreign.ForeignPtr (withForeignPtr)
88import Foreign.Marshal.Utils (with)
89import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
90import Foreign.Storable (Storable, peek, poke)
91import GHC.Base (ByteArray#, MutableByteArray#)
92import qualified Data.ByteString.Builder as B
93import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
94import qualified Data.ByteString.Builder.Prim as BP
95import qualified Data.ByteString.Builder.Prim.Internal as BP
96import qualified Data.Text.Array as A
97import qualified Data.Text.Internal.Encoding.Fusion as E
98import qualified Data.Text.Internal.Encoding.Utf16 as U16
99import qualified Data.Text.Internal.Fusion as F
101#include "text_cbits.h"
105-- All of the single-parameter functions for decoding bytestrings
106-- encoded in one of the Unicode Transformation Formats (UTF) operate
107-- in a /strict/ mode: each will throw an exception if given invalid
110-- Each function has a variant, whose name is suffixed with -'With',
111-- that gives greater control over the handling of decoding errors.
112-- For instance, 'decodeUtf8' will throw an exception, but
113-- 'decodeUtf8With' allows the programmer to determine what to do on a
116-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
118decodeASCII :: ByteString -> Text
119decodeASCII = decodeUtf8
120{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
122-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
124-- 'decodeLatin1' is semantically equivalent to
125-- @Data.Text.pack . Data.ByteString.Char8.unpack@
126decodeLatin1 :: ByteString -> Text
127decodeLatin1 (PS fp off len) = text a 0 len
129 a = A.run (A.new len >>= unsafeIOToST . go)
130 go dest = withForeignPtr fp $ \ptr -> do
131 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
134-- | Decode a 'ByteString' containing UTF-8 encoded text.
135decodeUtf8With :: OnDecodeError -> ByteString -> Text
136decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
137 let go dest = withForeignPtr fp $ \ptr ->
138 with (0::CSize) $ \destOffPtr -> do
139 let end = ptr `plusPtr` (off + len)
141 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
145 unsafeSTToIO (done dest (fromIntegral n))
148 case onErr desc (Just x) of
149 Nothing -> loop $ curPtr' `plusPtr` 1
151 destOff <- peek destOffPtr
153 unsafeWrite dest (fromIntegral destOff) (safe c)
154 poke destOffPtr (destOff + fromIntegral w)
155 loop $ curPtr' `plusPtr` 1
156 loop (ptr `plusPtr` off)
157 (unsafeIOToST . go) =<< A.new len
159 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
160{- INLINE[0] decodeUtf8With #-}
164-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
165-- a 'ByteString' that represents a possibly incomplete input (e.g. a
166-- packet from a network stream) that may not end on a UTF-8 boundary.
168-- 1. The maximal prefix of 'Text' that could be decoded from the
171-- 2. The suffix of the 'ByteString' that could not be decoded due to
172-- insufficient input.
174-- 3. A function that accepts another 'ByteString'. That string will
175-- be assumed to directly follow the string that was passed as
176-- input to the original function, and it will in turn be decoded.
178-- To help understand the use of these functions, consider the Unicode
179-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
180-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
182-- Now suppose that we receive this encoded string as 3 packets that
183-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
184-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
185-- have received all three packets, but we would like to make progress
186-- as we receive each one.
189-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
191-- 'Some' \"hi \" \"\\xe2\" _
194-- We use the continuation @f0@ to decode our second packet.
197-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
199-- 'Some' \"\" \"\\xe2\\x98\"
202-- We could not give @f0@ enough input to decode anything, so it
203-- returned an empty string. Once we feed our second continuation @f1@
204-- the last byte of input, it will make progress.
207-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
209-- 'Some' \"\\x2603\" \"\" _
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.
218data Decoding = Some Text ByteString (ByteString -> Decoding)
220instance Show Decoding where
221 showsPrec d (Some t bs _) = showParen (d > prec) $
222 showString "Some " . showsPrec prec' t .
223 showChar ' ' . showsPrec prec' bs .
225 where prec = 10; prec' = prec + 1
227newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
228newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
230-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
231-- encoded text that is known to be valid.
233-- If the input contains any invalid UTF-8 data, an exception will be
234-- thrown (either by this function or a continuation) that cannot be
235-- caught in pure code. For more control over the handling of invalid
236-- data, use 'streamDecodeUtf8With'.
239streamDecodeUtf8 :: ByteString -> Decoding
240streamDecodeUtf8 = streamDecodeUtf8With strictDecode
242-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
246streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
247streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
249 -- We create a slightly larger than necessary buffer to accommodate a
250 -- potential surrogate pair started in the last buffer
251 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
253 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
254 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
256 decodeChunkToBuffer :: A.MArray s -> IO Decoding
257 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
258 with (0::CSize) $ \destOffPtr ->
259 with codepoint0 $ \codepointPtr ->
260 with state0 $ \statePtr ->
261 with nullPtr $ \curPtrPtr ->
262 let end = ptr `plusPtr` (off + len)
264 poke curPtrPtr curPtr
265 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
266 curPtrPtr end codepointPtr statePtr
267 state <- peek statePtr
270 -- We encountered an encoding error
273 case onErr desc (Just x) of
274 Nothing -> loop $ curPtr' `plusPtr` 1
276 destOff <- peek destOffPtr
278 unsafeWrite dest (fromIntegral destOff) (safe c)
279 poke destOffPtr (destOff + fromIntegral w)
280 loop $ curPtr' `plusPtr` 1
283 -- We encountered the end of the buffer while decoding
285 codepoint <- peek codepointPtr
286 chunkText <- unsafeSTToIO $ do
287 arr <- A.unsafeFreeze dest
288 return $! text arr 0 (fromIntegral n)
289 lastPtr <- peek curPtrPtr
290 let left = lastPtr `minusPtr` curPtr
291 !undecoded = case state of
292 UTF8_ACCEPT -> B.empty
293 _ -> B.append undecoded0 (B.drop left bs)
294 return $ Some chunkText undecoded
295 (decodeChunk undecoded codepoint state)
296 in loop (ptr `plusPtr` off)
297 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
299-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
302-- If the input contains any invalid UTF-8 data, an exception will be
303-- thrown that cannot be caught in pure code. For more control over
304-- the handling of invalid data, use 'decodeUtf8'' or
306decodeUtf8 :: ByteString -> Text
307decodeUtf8 = decodeUtf8With strictDecode
308{-# INLINE[0] decodeUtf8 #-}
309{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
310 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
312-- | Decode a 'ByteString' containing UTF-8 encoded text.
314-- If the input contains any invalid UTF-8 data, the relevant
315-- exception will be returned, otherwise the decoded text.
316decodeUtf8' :: ByteString -> Either UnicodeException Text
317decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
318{-# INLINE decodeUtf8' #-}
320-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
323encodeUtf8Builder :: Text -> B.Builder
324encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
326-- | Encode text using UTF-8 encoding and escape the ASCII characters using
327-- a 'BP.BoundedPrim'.
329-- Use this function is to implement efficient encoders for text-based formats
333{-# INLINE encodeUtf8BuilderEscaped #-}
334-- TODO: Extend documentation with references to source code in @blaze-html@
335-- or @aeson@ that uses this function.
336encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
337encodeUtf8BuilderEscaped be =
338 -- manual eta-expansion to ensure inlining works as expected
339 \txt -> B.builder (mkBuildstep txt)
341 bound = max 4 $ BP.sizeBound be
343 mkBuildstep (Text arr off len) !k =
348 outerLoop !i0 !br@(B.BufferRange op0 ope)
350 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
351 -- TODO: Use a loop with an integrated bound's check if outRemaining
352 -- is smaller than 8, as this will save on divisions.
353 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
355 outRemaining = (ope `minusPtr` op0) `div` bound
356 inpRemaining = iend - i0
358 goPartial !iendTmp = go i0 op0
361 | i < iendTmp = case A.unsafeIndex arr i of
363 BP.runB be (fromIntegral w) op >>= go (i + 1)
365 poke8 0 $ (w `shiftR` 6) + 0xC0
366 poke8 1 $ (w .&. 0x3f) + 0x80
367 go (i + 1) (op `plusPtr` 2)
368 | 0xD800 <= w && w <= 0xDBFF -> do
369 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
370 poke8 0 $ (c `shiftR` 18) + 0xF0
371 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
372 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
373 poke8 3 $ (c .&. 0x3F) + 0x80
374 go (i + 2) (op `plusPtr` 4)
376 poke8 0 $ (w `shiftR` 12) + 0xE0
377 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
378 poke8 2 $ (w .&. 0x3F) + 0x80
379 go (i + 1) (op `plusPtr` 3)
381 outerLoop i (B.BufferRange op ope)
383 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
385-- | Encode text using UTF-8 encoding.
386encodeUtf8 :: Text -> ByteString
387encodeUtf8 (Text arr off len)
389 | otherwise = unsafeDupablePerformIO $ do
390 fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
391 withForeignPtr fp $ \ptr ->
392 with ptr $ \destPtr -> do
393 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
394 newDest <- peek destPtr
395 let utf8len = newDest `minusPtr` ptr
396 if utf8len >= len `shiftR` 1
397 then return (PS fp 0 utf8len)
399 fp' <- mallocByteString utf8len
400 withForeignPtr fp' $ \ptr' -> do
401 memcpy ptr' ptr (fromIntegral utf8len)
402 return (PS fp' 0 utf8len)
404-- | Decode text from little endian UTF-16 encoding.
405decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
406decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
407{-# INLINE decodeUtf16LEWith #-}
409-- | Decode text from little endian UTF-16 encoding.
411-- If the input contains any invalid little endian UTF-16 data, an
412-- exception will be thrown. For more control over the handling of
413-- invalid data, use 'decodeUtf16LEWith'.
414decodeUtf16LE :: ByteString -> Text
415decodeUtf16LE = decodeUtf16LEWith strictDecode
416{-# INLINE decodeUtf16LE #-}
418-- | Decode text from big endian UTF-16 encoding.
419decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
420decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
421{-# INLINE decodeUtf16BEWith #-}
423-- | Decode text from big endian UTF-16 encoding.
425-- If the input contains any invalid big endian UTF-16 data, an
426-- exception will be thrown. For more control over the handling of
427-- invalid data, use 'decodeUtf16BEWith'.
428decodeUtf16BE :: ByteString -> Text
429decodeUtf16BE = decodeUtf16BEWith strictDecode
430{-# INLINE decodeUtf16BE #-}
432-- | Encode text using little endian UTF-16 encoding.
433encodeUtf16LE :: Text -> ByteString
434encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
435{-# INLINE encodeUtf16LE #-}
437-- | Encode text using big endian UTF-16 encoding.
438encodeUtf16BE :: Text -> ByteString
439encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
440{-# INLINE encodeUtf16BE #-}
442-- | Decode text from little endian UTF-32 encoding.
443decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
444decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
445{-# INLINE decodeUtf32LEWith #-}
447-- | Decode text from little endian UTF-32 encoding.
449-- If the input contains any invalid little endian UTF-32 data, an
450-- exception will be thrown. For more control over the handling of
451-- invalid data, use 'decodeUtf32LEWith'.
452decodeUtf32LE :: ByteString -> Text
453decodeUtf32LE = decodeUtf32LEWith strictDecode
454{-# INLINE decodeUtf32LE #-}
456-- | Decode text from big endian UTF-32 encoding.
457decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
458decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
459{-# INLINE decodeUtf32BEWith #-}
461-- | Decode text from big endian UTF-32 encoding.
463-- If the input contains any invalid big endian UTF-32 data, an
464-- exception will be thrown. For more control over the handling of
465-- invalid data, use 'decodeUtf32BEWith'.
466decodeUtf32BE :: ByteString -> Text
467decodeUtf32BE = decodeUtf32BEWith strictDecode
468{-# INLINE decodeUtf32BE #-}
470-- | Encode text using little endian UTF-32 encoding.
471encodeUtf32LE :: Text -> ByteString
472encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
473{-# INLINE encodeUtf32LE #-}
475-- | Encode text using big endian UTF-32 encoding.
476encodeUtf32BE :: Text -> ByteString
477encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
478{-# INLINE encodeUtf32BE #-}
480foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
481 :: MutableByteArray# s -> Ptr CSize
482 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
484foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
485 :: MutableByteArray# s -> Ptr CSize
486 -> Ptr (Ptr Word8) -> Ptr Word8
487 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
489foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
490 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
492foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
493 :: 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