git.iko.soy/text
on d651007 help sign in
text/Data/Text/Encoding.hs
280 lines 11 kB history raw
1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
2 UnliftedFFITypes #-}
3-- |
4-- Module : Data.Text.Encoding
5-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
6-- (c) 2009 Duncan Coutts,
7-- (c) 2008, 2009 Tom Harper
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, minusPtr, 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 offLen = off + len
157 go !n !m
158 | n == offLen = return (PS fp 0 m)
159 | otherwise = do
160 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
161 ensure k act
162 | size-m >= k = act
163 | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
164 let newSize = size `shiftL` 1
165 fp' <- mallocByteString newSize
166 withForeignPtr fp' $ \ptr' ->
167 memcpy ptr' ptr (fromIntegral m)
168 start newSize n m fp'
169 {-# INLINE ensure #-}
170 case A.unsafeIndex arr n of
171 w| w <= 0x7F -> ensure 1 $ do
172 poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
173 -- A single ASCII octet is likely to start a run of
174 -- them. We see better performance when we
175 -- special-case this assumption.
176 let end = ptr `plusPtr` size
177 ascii !t !u
178 | t == offLen || u == end || v >= 0x80 =
179 go t (u `minusPtr` ptr)
180 | otherwise = do
181 poke u (fromIntegral v :: Word8)
182 ascii (t+1) (u `plusPtr` 1)
183 where v = A.unsafeIndex arr t
184 ascii (n+1) (ptr `plusPtr` (m+1))
185 | w <= 0x7FF -> ensure 2 $ do
186 poke8 m $ (w `shiftR` 6) + 0xC0
187 poke8 (m+1) $ (w .&. 0x3f) + 0x80
188 go (n+1) (m+2)
189 | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
190 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
191 poke8 m $ (c `shiftR` 18) + 0xF0
192 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
193 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
194 poke8 (m+3) $ (c .&. 0x3F) + 0x80
195 go (n+2) (m+4)
196 | otherwise -> ensure 3 $ do
197 poke8 m $ (w `shiftR` 12) + 0xE0
198 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
199 poke8 (m+2) $ (w .&. 0x3F) + 0x80
200 go (n+1) (m+3)
202-- | Decode text from little endian UTF-16 encoding.
203decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
204decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
205{-# INLINE decodeUtf16LEWith #-}
207-- | Decode text from little endian UTF-16 encoding.
208--
209-- If the input contains any invalid little endian UTF-16 data, an
210-- exception will be thrown. For more control over the handling of
211-- invalid data, use 'decodeUtf16LEWith'.
212decodeUtf16LE :: ByteString -> Text
213decodeUtf16LE = decodeUtf16LEWith strictDecode
214{-# INLINE decodeUtf16LE #-}
216-- | Decode text from big endian UTF-16 encoding.
217decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
218decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
219{-# INLINE decodeUtf16BEWith #-}
221-- | Decode text from big endian UTF-16 encoding.
222--
223-- If the input contains any invalid big endian UTF-16 data, an
224-- exception will be thrown. For more control over the handling of
225-- invalid data, use 'decodeUtf16BEWith'.
226decodeUtf16BE :: ByteString -> Text
227decodeUtf16BE = decodeUtf16BEWith strictDecode
228{-# INLINE decodeUtf16BE #-}
230-- | Encode text using little endian UTF-16 encoding.
231encodeUtf16LE :: Text -> ByteString
232encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
233{-# INLINE encodeUtf16LE #-}
235-- | Encode text using big endian UTF-16 encoding.
236encodeUtf16BE :: Text -> ByteString
237encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
238{-# INLINE encodeUtf16BE #-}
240-- | Decode text from little endian UTF-32 encoding.
241decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
242decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
243{-# INLINE decodeUtf32LEWith #-}
245-- | Decode text from little endian UTF-32 encoding.
246--
247-- If the input contains any invalid little endian UTF-32 data, an
248-- exception will be thrown. For more control over the handling of
249-- invalid data, use 'decodeUtf32LEWith'.
250decodeUtf32LE :: ByteString -> Text
251decodeUtf32LE = decodeUtf32LEWith strictDecode
252{-# INLINE decodeUtf32LE #-}
254-- | Decode text from big endian UTF-32 encoding.
255decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
256decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
257{-# INLINE decodeUtf32BEWith #-}
259-- | Decode text from big endian UTF-32 encoding.
260--
261-- If the input contains any invalid big endian UTF-32 data, an
262-- exception will be thrown. For more control over the handling of
263-- invalid data, use 'decodeUtf32BEWith'.
264decodeUtf32BE :: ByteString -> Text
265decodeUtf32BE = decodeUtf32BEWith strictDecode
266{-# INLINE decodeUtf32BE #-}
268-- | Encode text using little endian UTF-32 encoding.
269encodeUtf32LE :: Text -> ByteString
270encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
271{-# INLINE encodeUtf32LE #-}
273-- | Encode text using big endian UTF-32 encoding.
274encodeUtf32BE :: Text -> ByteString
275encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
276{-# INLINE encodeUtf32BE #-}
278foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
279 :: MutableByteArray# s -> Ptr CSize
280 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)