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)
82import Foreign.C.Types (CSize(..))
83import Foreign.ForeignPtr (withForeignPtr)
84import Foreign.Marshal.Utils (with)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
86import Foreign.Storable (Storable, peek, poke)
87import GHC.Base (ByteArray#, MutableByteArray#)
88import qualified Data.ByteString.Builder as B
89import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
90import qualified Data.ByteString.Builder.Prim as BP
91import qualified Data.ByteString.Builder.Prim.Internal as BP
92import qualified Data.Text.Array as A
93import qualified Data.Text.Internal.Encoding.Fusion as E
94import qualified Data.Text.Internal.Encoding.Utf16 as U16
95import qualified Data.Text.Internal.Fusion as F
97#include "text_cbits.h"
101-- All of the single-parameter functions for decoding bytestrings
102-- encoded in one of the Unicode Transformation Formats (UTF) operate
103-- in a /strict/ mode: each will throw an exception if given invalid
106-- Each function has a variant, whose name is suffixed with -'With',
107-- that gives greater control over the handling of decoding errors.
108-- For instance, 'decodeUtf8' will throw an exception, but
109-- 'decodeUtf8With' allows the programmer to determine what to do on a
112-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
114decodeASCII :: ByteString -> Text
115decodeASCII = decodeUtf8
116{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
118-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.
120-- 'decodeLatin1' is semantically equivalent to
121-- @Data.Text.pack . Data.ByteString.Char8.unpack@
122decodeLatin1 :: ByteString -> Text
123decodeLatin1 (PS fp off len) = text a 0 len
125 a = A.run (A.new len >>= unsafeIOToST . go)
126 go dest = withForeignPtr fp $ \ptr -> do
127 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
133 let go dest = withForeignPtr fp $ \ptr ->
134 with (0::CSize) $ \destOffPtr -> do
135 let end = ptr `plusPtr` (off + len)
137 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
141 unsafeSTToIO (done dest (fromIntegral n))
144 case onErr desc (Just x) of
145 Nothing -> loop $ curPtr' `plusPtr` 1
147 destOff <- peek destOffPtr
149 unsafeWrite dest (fromIntegral destOff) (safe c)
150 poke destOffPtr (destOff + fromIntegral w)
151 loop $ curPtr' `plusPtr` 1
152 loop (ptr `plusPtr` off)
153 (unsafeIOToST . go) =<< A.new len
155 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
156{- INLINE[0] decodeUtf8With #-}
160-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept
161-- a 'ByteString' that represents a possibly incomplete input (e.g. a
162-- packet from a network stream) that may not end on a UTF-8 boundary.
164-- 1. The maximal prefix of 'Text' that could be decoded from the
167-- 2. The suffix of the 'ByteString' that could not be decoded due to
168-- insufficient input.
170-- 3. A function that accepts another 'ByteString'. That string will
171-- be assumed to directly follow the string that was passed as
172-- input to the original function, and it will in turn be decoded.
174-- To help understand the use of these functions, consider the Unicode
175-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi
176-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.
178-- Now suppose that we receive this encoded string as 3 packets that
179-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",
180-- \"\\x83\"]@. We cannot decode the entire Unicode string until we
181-- have received all three packets, but we would like to make progress
182-- as we receive each one.
185-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"
187-- 'Some' \"hi \" \"\\xe2\" _
190-- We use the continuation @f0@ to decode our second packet.
193-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"
195-- 'Some' \"\" \"\\xe2\\x98\"
198-- We could not give @f0@ enough input to decode anything, so it
199-- returned an empty string. Once we feed our second continuation @f1@
200-- the last byte of input, it will make progress.
203-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"
205-- 'Some' \"\\x2603\" \"\" _
208-- If given invalid input, an exception will be thrown by the function
209-- or continuation where it is encountered.
211-- | A stream oriented decoding result.
212data Decoding = Some Text ByteString (ByteString -> Decoding)
214instance Show Decoding where
215 showsPrec d (Some t bs _) = showParen (d > prec) $
216 showString "Some " . showsPrec prec' t .
217 showChar ' ' . showsPrec prec' bs .
219 where prec = 10; prec' = prec + 1
221newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
222newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
224-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
225-- encoded text that is known to be valid.
227-- If the input contains any invalid UTF-8 data, an exception will be
228-- thrown (either by this function or a continuation) that cannot be
229-- caught in pure code. For more control over the handling of invalid
230-- data, use 'streamDecodeUtf8With'.
231streamDecodeUtf8 :: ByteString -> Decoding
232streamDecodeUtf8 = streamDecodeUtf8With strictDecode
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
239 -- We create a slightly larger than necessary buffer to accommodate a
240 -- potential surrogate pair started in the last buffer
241 decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
243 decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =
244 runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
246 decodeChunkToBuffer :: A.MArray s -> IO Decoding
247 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
248 with (0::CSize) $ \destOffPtr ->
249 with codepoint0 $ \codepointPtr ->
250 with state0 $ \statePtr ->
251 with nullPtr $ \curPtrPtr ->
252 let end = ptr `plusPtr` (off + len)
254 poke curPtrPtr curPtr
255 curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
256 curPtrPtr end codepointPtr statePtr
257 state <- peek statePtr
260 -- We encountered an encoding error
263 case onErr desc (Just x) of
264 Nothing -> loop $ curPtr' `plusPtr` 1
266 destOff <- peek destOffPtr
268 unsafeWrite dest (fromIntegral destOff) (safe c)
269 poke destOffPtr (destOff + fromIntegral w)
270 loop $ curPtr' `plusPtr` 1
273 -- We encountered the end of the buffer while decoding
275 codepoint <- peek codepointPtr
276 chunkText <- unsafeSTToIO $ do
277 arr <- A.unsafeFreeze dest
278 return $! text arr 0 (fromIntegral n)
279 lastPtr <- peek curPtrPtr
280 let left = lastPtr `minusPtr` curPtr
281 !undecoded = case state of
282 UTF8_ACCEPT -> B.empty
283 _ -> B.append undecoded0 (B.drop left bs)
284 return $ Some chunkText undecoded
285 (decodeChunk undecoded codepoint state)
286 in loop (ptr `plusPtr` off)
287 desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
289-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
292-- If the input contains any invalid UTF-8 data, an exception will be
293-- thrown that cannot be caught in pure code. For more control over
294-- the handling of invalid data, use 'decodeUtf8'' or
296decodeUtf8 :: ByteString -> Text
297decodeUtf8 = decodeUtf8With strictDecode
298{-# INLINE[0] decodeUtf8 #-}
299{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
300 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
302-- | Decode a 'ByteString' containing UTF-8 encoded text.
304-- If the input contains any invalid UTF-8 data, the relevant
305-- exception will be returned, otherwise the decoded text.
306decodeUtf8' :: ByteString -> Either UnicodeException Text
307decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode
308{-# INLINE decodeUtf8' #-}
310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
311encodeUtf8Builder :: Text -> B.Builder
312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
314-- | Encode text using UTF-8 encoding and escape the ASCII characters using
315-- a 'BP.BoundedPrim'.
317-- Use this function is to implement efficient encoders for text-based formats
319{-# INLINE encodeUtf8BuilderEscaped #-}
320-- TODO: Extend documentation with references to source code in @blaze-html@
321-- or @aeson@ that uses this function.
322encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
323encodeUtf8BuilderEscaped be =
324 -- manual eta-expansion to ensure inlining works as expected
325 \txt -> B.builder (mkBuildstep txt)
327 bound = max 4 $ BP.sizeBound be
329 mkBuildstep (Text arr off len) !k =
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
336 | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
337 -- TODO: Use a loop with an integrated bound's check if outRemaining
338 -- is smaller than 8, as this will save on divisions.
339 | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
341 outRemaining = (ope `minusPtr` op0) `div` bound
342 inpRemaining = iend - i0
344 goPartial !iendTmp = go i0 op0
347 | i < iendTmp = case A.unsafeIndex arr i of
349 BP.runB be (fromIntegral w) op >>= go (i + 1)
351 poke8 0 $ (w `shiftR` 6) + 0xC0
352 poke8 1 $ (w .&. 0x3f) + 0x80
353 go (i + 1) (op `plusPtr` 2)
354 | 0xD800 <= w && w <= 0xDBFF -> do
355 let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
356 poke8 0 $ (c `shiftR` 18) + 0xF0
357 poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
358 poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
359 poke8 3 $ (c .&. 0x3F) + 0x80
360 go (i + 2) (op `plusPtr` 4)
362 poke8 0 $ (w `shiftR` 12) + 0xE0
363 poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
364 poke8 2 $ (w .&. 0x3F) + 0x80
365 go (i + 1) (op `plusPtr` 3)
367 outerLoop i (B.BufferRange op ope)
369 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
371-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
373encodeUtf8 (Text arr off len)
375 | otherwise = unsafeDupablePerformIO $ do
376 fp <- mallocByteString (len*4)
377 withForeignPtr fp $ \ptr ->
378 with ptr $ \destPtr -> do
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
380 newDest <- peek destPtr
381 let utf8len = newDest `minusPtr` ptr
382 if utf8len >= len `shiftR` 1
383 then return (PS fp 0 utf8len)
385 fp' <- mallocByteString utf8len
386 withForeignPtr fp' $ \ptr' -> do
387 memcpy ptr' ptr (fromIntegral utf8len)
388 return (PS fp' 0 utf8len)
390-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
392decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
393{-# INLINE decodeUtf16LEWith #-}
395-- | Decode text from little endian UTF-16 encoding.
397-- If the input contains any invalid little endian UTF-16 data, an
398-- exception will be thrown. For more control over the handling of
399-- invalid data, use 'decodeUtf16LEWith'.
400decodeUtf16LE :: ByteString -> Text
401decodeUtf16LE = decodeUtf16LEWith strictDecode
402{-# INLINE decodeUtf16LE #-}
404-- | Decode text from big endian UTF-16 encoding.
405decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
406decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
407{-# INLINE decodeUtf16BEWith #-}
409-- | Decode text from big endian UTF-16 encoding.
411-- If the input contains any invalid big endian UTF-16 data, an
412-- exception will be thrown. For more control over the handling of
413-- invalid data, use 'decodeUtf16BEWith'.
414decodeUtf16BE :: ByteString -> Text
415decodeUtf16BE = decodeUtf16BEWith strictDecode
416{-# INLINE decodeUtf16BE #-}
418-- | Encode text using little endian UTF-16 encoding.
419encodeUtf16LE :: Text -> ByteString
420encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
421{-# INLINE encodeUtf16LE #-}
423-- | Encode text using big endian UTF-16 encoding.
424encodeUtf16BE :: Text -> ByteString
425encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
426{-# INLINE encodeUtf16BE #-}
428-- | Decode text from little endian UTF-32 encoding.
429decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
430decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
431{-# INLINE decodeUtf32LEWith #-}
433-- | Decode text from little endian UTF-32 encoding.
435-- If the input contains any invalid little endian UTF-32 data, an
436-- exception will be thrown. For more control over the handling of
437-- invalid data, use 'decodeUtf32LEWith'.
438decodeUtf32LE :: ByteString -> Text
439decodeUtf32LE = decodeUtf32LEWith strictDecode
440{-# INLINE decodeUtf32LE #-}
442-- | Decode text from big endian UTF-32 encoding.
443decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
444decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
445{-# INLINE decodeUtf32BEWith #-}
447-- | Decode text from big endian UTF-32 encoding.
449-- If the input contains any invalid big endian UTF-32 data, an
450-- exception will be thrown. For more control over the handling of
451-- invalid data, use 'decodeUtf32BEWith'.
452decodeUtf32BE :: ByteString -> Text
453decodeUtf32BE = decodeUtf32BEWith strictDecode
454{-# INLINE decodeUtf32BE #-}
456-- | Encode text using little endian UTF-32 encoding.
457encodeUtf32LE :: Text -> ByteString
458encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
459{-# INLINE encodeUtf32LE #-}
461-- | Encode text using big endian UTF-32 encoding.
462encodeUtf32BE :: Text -> ByteString
463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
464{-# INLINE encodeUtf32BE #-}
466foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
467 :: MutableByteArray# s -> Ptr CSize
468 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
470foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
471 :: MutableByteArray# s -> Ptr CSize
472 -> Ptr (Ptr Word8) -> Ptr Word8
473 -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479 :: 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