git.iko.soy/text
on 7679113 help sign in
text/Data/Text/Encoding.hs
266 lines 10.0 kB history raw
1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
2 UnliftedFFITypes #-}
3-- |
4-- Module : Data.Text.Encoding
5-- Copyright : (c) 2008, 2009 Tom Harper,
6-- (c) 2009, 2010 Bryan O'Sullivan,
7-- (c) 2009 Duncan Coutts
8--
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11-- duncan@haskell.org
12-- Stability : experimental
13-- Portability : portable
14--
15-- Functions for converting 'Text' values to and from 'ByteString',
16-- using several standard encodings.
17--
18-- To gain access to a much larger family of encodings, use the
19-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
21module Data.Text.Encoding
22 (
23 -- * Decoding ByteStrings to Text
24 -- $strict
25 decodeASCII
26 , decodeUtf8
27 , decodeUtf16LE
28 , decodeUtf16BE
29 , decodeUtf32LE
30 , decodeUtf32BE
32 -- ** Catchable failure
33 , decodeUtf8'
35 -- ** Controllable error handling
36 , decodeUtf8With
37 , decodeUtf16LEWith
38 , decodeUtf16BEWith
39 , decodeUtf32LEWith
40 , decodeUtf32BEWith
42 -- * Encoding Text to ByteStrings
43 , encodeUtf8
44 , encodeUtf16LE
45 , encodeUtf16BE
46 , encodeUtf32LE
47 , encodeUtf32BE
48 ) where
50import Control.Exception (evaluate, try)
51#if __GLASGOW_HASKELL__ >= 702
52import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
53#else
54import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
55#endif
56import Data.Bits ((.&.))
57import Data.ByteString as B
58import Data.ByteString.Internal as B
59import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
60import Data.Text.Internal (Text(..), textP)
61import Data.Text.UnsafeChar (ord, unsafeWrite)
62import Data.Text.UnsafeShift (shiftL, shiftR)
63import Data.Word (Word8)
64import Foreign.C.Types (CSize)
65import Foreign.ForeignPtr (withForeignPtr)
66import Foreign.Marshal.Utils (with)
67import Foreign.Ptr (Ptr, plusPtr)
68import Foreign.Storable (peek, poke)
69import GHC.Base (MutableByteArray#)
70import System.IO.Unsafe (unsafePerformIO)
71import qualified Data.Text.Array as A
72import qualified Data.Text.Encoding.Fusion as E
73import qualified Data.Text.Encoding.Utf16 as U16
74import qualified Data.Text.Fusion as F
76-- $strict
77--
78-- All of the single-parameter functions for decoding bytestrings
79-- encoded in one of the Unicode Transformation Formats (UTF) operate
80-- in a /strict/ mode: each will throw an exception if given invalid
81-- input.
82--
83-- Each function has a variant, whose name is suffixed with -'With',
84-- that gives greater control over the handling of decoding errors.
85-- For instance, 'decodeUtf8' will throw an exception, but
86-- 'decodeUtf8With' allows the programmer to determine what to do on a
87-- decoding error.
89-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
90-- encoded text.
91--
92-- This function is deprecated. Use 'decodeUtf8' instead.
93decodeASCII :: ByteString -> Text
94decodeASCII = decodeUtf8
95{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
97-- | Decode a 'ByteString' containing UTF-8 encoded text.
98decodeUtf8With :: OnDecodeError -> ByteString -> Text
99decodeUtf8With onErr (PS fp off len) = textP (fst a) 0 (snd a)
100 where
101 a = A.run2 (A.new len >>= unsafeIOToST . go)
102 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
103 go dest = withForeignPtr fp $ \ptr ->
104 with (0::CSize) $ \destOffPtr -> do
105 let end = ptr `plusPtr` (off + len)
106 loop curPtr = do
107 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
108 if curPtr' == end
109 then do
110 n <- peek destOffPtr
111 return (dest,fromIntegral n)
112 else do
113 x <- peek curPtr'
114 case onErr desc (Just x) of
115 Nothing -> loop $ curPtr' `plusPtr` 1
116 Just c -> do
117 destOff <- peek destOffPtr
118 w <- unsafeSTToIO $
119 unsafeWrite dest (fromIntegral destOff) c
120 poke destOffPtr (destOff + fromIntegral w)
121 loop $ curPtr' `plusPtr` 1
122 loop (ptr `plusPtr` off)
123{- INLINE[0] decodeUtf8With #-}
125-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
126-- to be valid.
127--
128-- If the input contains any invalid UTF-8 data, an exception will be
129-- thrown that cannot be caught in pure code. For more control over
130-- the handling of invalid data, use 'decodeUtf8'' or
131-- 'decodeUtf8With'.
132decodeUtf8 :: ByteString -> Text
133decodeUtf8 = decodeUtf8With strictDecode
134{-# INLINE[0] decodeUtf8 #-}
135{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
136 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
138-- | Decode a 'ByteString' containing UTF-8 encoded text..
139--
140-- If the input contains any invalid UTF-8 data, the relevant
141-- exception will be returned, otherwise the decoded text.
142decodeUtf8' :: ByteString -> Either UnicodeException Text
143decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode
144{-# INLINE decodeUtf8' #-}
146-- | Encode text using UTF-8 encoding.
147encodeUtf8 :: Text -> ByteString
148encodeUtf8 (Text arr off len) = unsafePerformIO $ do
149 let size0 = max len 4
150 mallocByteString size0 >>= start size0 off 0
151 where
152 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
153 where
154 loop n1 m1 ptr = go n1 m1
155 where
156 go !n !m
157 | n == off+len = return (PS fp 0 m)
158 | otherwise = do
159 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
160 ensure k act
161 | size-m >= k = act
162 | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
163 let newSize = size `shiftL` 1
164 fp' <- mallocByteString newSize
165 withForeignPtr fp' $ \ptr' ->
166 memcpy ptr' ptr (fromIntegral m)
167 start newSize n m fp'
168 {-# INLINE ensure #-}
169 case A.unsafeIndex arr n of
170 w| w <= 0x7F -> poke8 m w >> go (n+1) (m+1)
171 | w <= 0x7FF -> ensure 2 $ do
172 poke8 m $ (w `shiftR` 6) + 0xC0
173 poke8 (m+1) $ (w .&. 0x3f) + 0x80
174 go (n+1) (m+2)
175 | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
176 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
177 poke8 m $ (c `shiftR` 18) + 0xF0
178 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
179 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
180 poke8 (m+3) $ (c .&. 0x3F) + 0x80
181 go (n+2) (m+4)
182 | otherwise -> ensure 3 $ do
183 poke8 m $ (w `shiftR` 12) + 0xE0
184 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
185 poke8 (m+2) $ (w .&. 0x3F) + 0x80
186 go (n+1) (m+3)
188-- | Decode text from little endian UTF-16 encoding.
189decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
190decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
191{-# INLINE decodeUtf16LEWith #-}
193-- | Decode text from little endian UTF-16 encoding.
194--
195-- If the input contains any invalid little endian UTF-16 data, an
196-- exception will be thrown. For more control over the handling of
197-- invalid data, use 'decodeUtf16LEWith'.
198decodeUtf16LE :: ByteString -> Text
199decodeUtf16LE = decodeUtf16LEWith strictDecode
200{-# INLINE decodeUtf16LE #-}
202-- | Decode text from big endian UTF-16 encoding.
203decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
204decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
205{-# INLINE decodeUtf16BEWith #-}
207-- | Decode text from big endian UTF-16 encoding.
208--
209-- If the input contains any invalid big endian UTF-16 data, an
210-- exception will be thrown. For more control over the handling of
211-- invalid data, use 'decodeUtf16BEWith'.
212decodeUtf16BE :: ByteString -> Text
213decodeUtf16BE = decodeUtf16BEWith strictDecode
214{-# INLINE decodeUtf16BE #-}
216-- | Encode text using little endian UTF-16 encoding.
217encodeUtf16LE :: Text -> ByteString
218encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
219{-# INLINE encodeUtf16LE #-}
221-- | Encode text using big endian UTF-16 encoding.
222encodeUtf16BE :: Text -> ByteString
223encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
224{-# INLINE encodeUtf16BE #-}
226-- | Decode text from little endian UTF-32 encoding.
227decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
228decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
229{-# INLINE decodeUtf32LEWith #-}
231-- | Decode text from little endian UTF-32 encoding.
232--
233-- If the input contains any invalid little endian UTF-32 data, an
234-- exception will be thrown. For more control over the handling of
235-- invalid data, use 'decodeUtf32LEWith'.
236decodeUtf32LE :: ByteString -> Text
237decodeUtf32LE = decodeUtf32LEWith strictDecode
238{-# INLINE decodeUtf32LE #-}
240-- | Decode text from big endian UTF-32 encoding.
241decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
242decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
243{-# INLINE decodeUtf32BEWith #-}
245-- | Decode text from big endian UTF-32 encoding.
246--
247-- If the input contains any invalid big endian UTF-32 data, an
248-- exception will be thrown. For more control over the handling of
249-- invalid data, use 'decodeUtf32BEWith'.
250decodeUtf32BE :: ByteString -> Text
251decodeUtf32BE = decodeUtf32BEWith strictDecode
252{-# INLINE decodeUtf32BE #-}
254-- | Encode text using little endian UTF-32 encoding.
255encodeUtf32LE :: Text -> ByteString
256encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
257{-# INLINE encodeUtf32LE #-}
259-- | Encode text using big endian UTF-32 encoding.
260encodeUtf32BE :: Text -> ByteString
261encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
262{-# INLINE encodeUtf32BE #-}
264foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
265 :: MutableByteArray# s -> Ptr CSize
266 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)