git.iko.soy/text
on 2fc429e help sign in
text/Data/Text/Encoding.hs
281 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(..))
61import Data.Text.Private (runText)
62import Data.Text.UnsafeChar (ord, unsafeWrite)
63import Data.Text.UnsafeShift (shiftL, shiftR)
64import Data.Word (Word8)
65import Foreign.C.Types (CSize)
66import Foreign.ForeignPtr (withForeignPtr)
67import Foreign.Marshal.Utils (with)
68import Foreign.Ptr (Ptr, minusPtr, plusPtr)
69import Foreign.Storable (peek, poke)
70import GHC.Base (MutableByteArray#)
71import System.IO.Unsafe (unsafePerformIO)
72import qualified Data.Text.Array as A
73import qualified Data.Text.Encoding.Fusion as E
74import qualified Data.Text.Encoding.Utf16 as U16
75import qualified Data.Text.Fusion as F
77-- $strict
78--
79-- All of the single-parameter functions for decoding bytestrings
80-- encoded in one of the Unicode Transformation Formats (UTF) operate
81-- in a /strict/ mode: each will throw an exception if given invalid
82-- input.
83--
84-- Each function has a variant, whose name is suffixed with -'With',
85-- that gives greater control over the handling of decoding errors.
86-- For instance, 'decodeUtf8' will throw an exception, but
87-- 'decodeUtf8With' allows the programmer to determine what to do on a
88-- decoding error.
90-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII
91-- encoded text.
92--
93-- This function is deprecated. Use 'decodeUtf8' instead.
94decodeASCII :: ByteString -> Text
95decodeASCII = decodeUtf8
96{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
98-- | Decode a 'ByteString' containing UTF-8 encoded text.
99decodeUtf8With :: OnDecodeError -> ByteString -> Text
100decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
101 let go dest = withForeignPtr fp $ \ptr ->
102 with (0::CSize) $ \destOffPtr -> do
103 let end = ptr `plusPtr` (off + len)
104 loop curPtr = do
105 curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
106 if curPtr' == end
107 then do
108 n <- peek destOffPtr
109 unsafeSTToIO (done dest (fromIntegral n))
110 else do
111 x <- peek curPtr'
112 case onErr desc (Just x) of
113 Nothing -> loop $ curPtr' `plusPtr` 1
114 Just c -> do
115 destOff <- peek destOffPtr
116 w <- unsafeSTToIO $
117 unsafeWrite dest (fromIntegral destOff) c
118 poke destOffPtr (destOff + fromIntegral w)
119 loop $ curPtr' `plusPtr` 1
120 loop (ptr `plusPtr` off)
121 (unsafeIOToST . go) =<< A.new len
122 where
123 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
124{- INLINE[0] decodeUtf8With #-}
126-- | Decode a 'ByteString' containing UTF-8 encoded text that is known
127-- to be valid.
128--
129-- If the input contains any invalid UTF-8 data, an exception will be
130-- thrown that cannot be caught in pure code. For more control over
131-- the handling of invalid data, use 'decodeUtf8'' or
132-- 'decodeUtf8With'.
133decodeUtf8 :: ByteString -> Text
134decodeUtf8 = decodeUtf8With strictDecode
135{-# INLINE[0] decodeUtf8 #-}
136{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
137 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
139-- | Decode a 'ByteString' containing UTF-8 encoded text..
140--
141-- If the input contains any invalid UTF-8 data, the relevant
142-- exception will be returned, otherwise the decoded text.
143decodeUtf8' :: ByteString -> Either UnicodeException Text
144decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode
145{-# INLINE decodeUtf8' #-}
147-- | Encode text using UTF-8 encoding.
148encodeUtf8 :: Text -> ByteString
149encodeUtf8 (Text arr off len) = unsafePerformIO $ do
150 let size0 = max len 4
151 mallocByteString size0 >>= start size0 off 0
152 where
153 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
154 where
155 loop n1 m1 ptr = go n1 m1
156 where
157 offLen = off + len
158 go !n !m
159 | n == offLen = return (PS fp 0 m)
160 | otherwise = do
161 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
162 ensure k act
163 | size-m >= k = act
164 | otherwise = {-# SCC "resizeUtf8/ensure" #-} do
165 let newSize = size `shiftL` 1
166 fp' <- mallocByteString newSize
167 withForeignPtr fp' $ \ptr' ->
168 memcpy ptr' ptr (fromIntegral m)
169 start newSize n m fp'
170 {-# INLINE ensure #-}
171 case A.unsafeIndex arr n of
172 w| w <= 0x7F -> ensure 1 $ do
173 poke (ptr `plusPtr` m) (fromIntegral w :: Word8)
174 -- A single ASCII octet is likely to start a run of
175 -- them. We see better performance when we
176 -- special-case this assumption.
177 let end = ptr `plusPtr` size
178 ascii !t !u
179 | t == offLen || u == end || v >= 0x80 =
180 go t (u `minusPtr` ptr)
181 | otherwise = do
182 poke u (fromIntegral v :: Word8)
183 ascii (t+1) (u `plusPtr` 1)
184 where v = A.unsafeIndex arr t
185 ascii (n+1) (ptr `plusPtr` (m+1))
186 | w <= 0x7FF -> ensure 2 $ do
187 poke8 m $ (w `shiftR` 6) + 0xC0
188 poke8 (m+1) $ (w .&. 0x3f) + 0x80
189 go (n+1) (m+2)
190 | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do
191 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
192 poke8 m $ (c `shiftR` 18) + 0xF0
193 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
194 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
195 poke8 (m+3) $ (c .&. 0x3F) + 0x80
196 go (n+2) (m+4)
197 | otherwise -> ensure 3 $ do
198 poke8 m $ (w `shiftR` 12) + 0xE0
199 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
200 poke8 (m+2) $ (w .&. 0x3F) + 0x80
201 go (n+1) (m+3)
203-- | Decode text from little endian UTF-16 encoding.
204decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
205decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
206{-# INLINE decodeUtf16LEWith #-}
208-- | Decode text from little endian UTF-16 encoding.
209--
210-- If the input contains any invalid little endian UTF-16 data, an
211-- exception will be thrown. For more control over the handling of
212-- invalid data, use 'decodeUtf16LEWith'.
213decodeUtf16LE :: ByteString -> Text
214decodeUtf16LE = decodeUtf16LEWith strictDecode
215{-# INLINE decodeUtf16LE #-}
217-- | Decode text from big endian UTF-16 encoding.
218decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
219decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
220{-# INLINE decodeUtf16BEWith #-}
222-- | Decode text from big endian UTF-16 encoding.
223--
224-- If the input contains any invalid big endian UTF-16 data, an
225-- exception will be thrown. For more control over the handling of
226-- invalid data, use 'decodeUtf16BEWith'.
227decodeUtf16BE :: ByteString -> Text
228decodeUtf16BE = decodeUtf16BEWith strictDecode
229{-# INLINE decodeUtf16BE #-}
231-- | Encode text using little endian UTF-16 encoding.
232encodeUtf16LE :: Text -> ByteString
233encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
234{-# INLINE encodeUtf16LE #-}
236-- | Encode text using big endian UTF-16 encoding.
237encodeUtf16BE :: Text -> ByteString
238encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
239{-# INLINE encodeUtf16BE #-}
241-- | Decode text from little endian UTF-32 encoding.
242decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
243decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
244{-# INLINE decodeUtf32LEWith #-}
246-- | Decode text from little endian UTF-32 encoding.
247--
248-- If the input contains any invalid little endian UTF-32 data, an
249-- exception will be thrown. For more control over the handling of
250-- invalid data, use 'decodeUtf32LEWith'.
251decodeUtf32LE :: ByteString -> Text
252decodeUtf32LE = decodeUtf32LEWith strictDecode
253{-# INLINE decodeUtf32LE #-}
255-- | Decode text from big endian UTF-32 encoding.
256decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
257decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
258{-# INLINE decodeUtf32BEWith #-}
260-- | Decode text from big endian UTF-32 encoding.
261--
262-- If the input contains any invalid big endian UTF-32 data, an
263-- exception will be thrown. For more control over the handling of
264-- invalid data, use 'decodeUtf32BEWith'.
265decodeUtf32BE :: ByteString -> Text
266decodeUtf32BE = decodeUtf32BEWith strictDecode
267{-# INLINE decodeUtf32BE #-}
269-- | Encode text using little endian UTF-32 encoding.
270encodeUtf32LE :: Text -> ByteString
271encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
272{-# INLINE encodeUtf32LE #-}
274-- | Encode text using big endian UTF-32 encoding.
275encodeUtf32BE :: Text -> ByteString
276encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
277{-# INLINE encodeUtf32BE #-}
279foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
280 :: MutableByteArray# s -> Ptr CSize
281 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)