git.iko.soy/text
on bf417bc help sign in
text/Data/Text/Encoding.hs
211 lines 7.4 kB history raw
1{-# LANGUAGE BangPatterns #-}
2-- |
3-- Module : Data.Text.Encoding
4-- Copyright : (c) 2008, 2009 Tom Harper,
5-- (c) 2009, 2010 Bryan O'Sullivan,
6-- (c) 2009 Duncan Coutts
7--
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10-- duncan@haskell.org
11-- Stability : experimental
12-- Portability : portable
13--
14-- Functions for converting 'Text' values to and from 'ByteString',
15-- using several standard encodings.
16--
17-- To make use of a much larger variety of encodings, use the @text-icu@
18-- package.
20module Data.Text.Encoding
21 (
22 -- * Decoding ByteStrings to Text
23 decodeASCII
24 , decodeUtf8
25 , decodeUtf16LE
26 , decodeUtf16BE
27 , decodeUtf32LE
28 , decodeUtf32BE
29 -- ** Controllable error handling
30 , decodeUtf8With
31 , decodeUtf16LEWith
32 , decodeUtf16BEWith
33 , decodeUtf32LEWith
34 , decodeUtf32BEWith
36 -- * Encoding Text to ByteStrings
37 , encodeUtf8
38 , encodeUtf16LE
39 , encodeUtf16BE
40 , encodeUtf32LE
41 , encodeUtf32BE
42 ) where
44import Data.Bits ((.&.))
45import Data.ByteString as B
46import Data.ByteString.Internal as B
47import Data.ByteString.Unsafe as B
48import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
49import Data.Text.Internal (Text(..), textP)
50import Data.Text.UnsafeChar (ord, unsafeWrite)
51import Data.Text.UnsafeShift (shiftL, shiftR)
52import Data.Word (Word8)
53import Foreign.ForeignPtr (withForeignPtr)
54import Foreign.Ptr (plusPtr)
55import Foreign.Storable (poke)
56import System.IO.Unsafe (unsafePerformIO)
57import qualified Data.Text.Array as A
58import qualified Data.Text.Encoding.Fusion as E
59import qualified Data.Text.Encoding.Utf16 as U16
60import qualified Data.Text.Encoding.Utf8 as U8
61import qualified Data.Text.Fusion as F
63-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
64decodeASCII :: ByteString -> Text
65decodeASCII bs = F.unstream (E.streamASCII bs)
66{-# INLINE decodeASCII #-}
68decodeUtf8With :: OnDecodeError -> ByteString -> Text
69decodeUtf8With onErr bs = textP (fst a) 0 (snd a)
70 where
71 a = A.run2 (A.new len >>= outer 0 0)
72 len = B.length bs
73 outer n0 m0 arr = go n0 m0
74 where
75 go !n !m = do
76 let x1 = idx m
77 x2 = idx (m + 1)
78 x3 = idx (m + 2)
79 x4 = idx (m + 3)
80 idx = B.unsafeIndex bs
81 case undefined of
82 _| m >= len -> return (arr,n)
83 | U8.validate1 x1 -> do
84 A.unsafeWrite arr n (fromIntegral x1)
85 go (n+1) (m+1)
86 | m+1 < len && U8.validate2 x1 x2 -> do
87 w <- unsafeWrite arr n (U8.chr2 x1 x2)
88 go (n+w) (m+2)
89 | m+2 < len && U8.validate3 x1 x2 x3 -> do
90 w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
91 go (n+w) (m+3)
92 | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
93 w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
94 go (n+w) (m+4)
95 | otherwise -> case onErr desc (Just x1) of
96 Nothing -> go n (m+1)
97 Just c -> do
98 w <- unsafeWrite arr n c
99 go (n+w) (m+1)
100 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
101{-# INLINE[0] decodeUtf8With #-}
103-- | Decode a 'ByteString' containing UTF-8 encoded text.
104decodeUtf8 :: ByteString -> Text
105decodeUtf8 = decodeUtf8With strictDecode
106{-# INLINE[0] decodeUtf8 #-}
108{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
109 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
111-- | Encode text using UTF-8 encoding.
112encodeUtf8 :: Text -> ByteString
113encodeUtf8 (Text arr off len) = unsafePerformIO $ do
114 let size0 = min len 4
115 mallocByteString size0 >>= start size0 off 0
116 where
117 start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
118 where
119 loop n1 m1 ptr = go n1 m1
120 where
121 go !n !m
122 | n-off == len = return $! PS fp 0 m
123 | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do
124 let newSize = size `shiftL` 1
125 fp' <- mallocByteString newSize
126 withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
127 start newSize n m fp'
128 | otherwise = do
129 let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
130 w = A.unsafeIndex arr n
131 case undefined of
132 _| w <= 0x7F -> do
133 poke8 m w
134 go (n+1) (m+1)
135 | w <= 0x7FF -> do
136 poke8 m $ (w `shiftR` 6) + 0xC0
137 poke8 (m+1) $ (w .&. 0x3f) + 0x80
138 go (n+1) (m+2)
139 | 0xD800 <= w && w <= 0xDBFF -> do
140 let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
141 poke8 m $ (c `shiftR` 18) + 0xF0
142 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
143 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
144 poke8 (m+3) $ (c .&. 0x3F) + 0x80
145 go (n+2) (m+4)
146 | otherwise -> do
147 poke8 m $ (w `shiftR` 12) + 0xE0
148 poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
149 poke8 (m+2) $ (w .&. 0x3F) + 0x80
150 go (n+1) (m+3)
151{- INLINE encodeUtf8 #-}
153-- | Decode text from little endian UTF-16 encoding.
154decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
155decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
156{-# INLINE decodeUtf16LEWith #-}
158-- | Decode text from little endian UTF-16 encoding.
159decodeUtf16LE :: ByteString -> Text
160decodeUtf16LE = decodeUtf16LEWith strictDecode
161{-# INLINE decodeUtf16LE #-}
163-- | Decode text from big endian UTF-16 encoding.
164decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
165decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
166{-# INLINE decodeUtf16BEWith #-}
168-- | Decode text from big endian UTF-16 encoding.
169decodeUtf16BE :: ByteString -> Text
170decodeUtf16BE = decodeUtf16BEWith strictDecode
171{-# INLINE decodeUtf16BE #-}
173-- | Encode text using little endian UTF-16 encoding.
174encodeUtf16LE :: Text -> ByteString
175encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
176{-# INLINE encodeUtf16LE #-}
178-- | Encode text using big endian UTF-16 encoding.
179encodeUtf16BE :: Text -> ByteString
180encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
181{-# INLINE encodeUtf16BE #-}
183-- | Decode text from little endian UTF-32 encoding.
184decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
185decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
186{-# INLINE decodeUtf32LEWith #-}
188-- | Decode text from little endian UTF-32 encoding.
189decodeUtf32LE :: ByteString -> Text
190decodeUtf32LE = decodeUtf32LEWith strictDecode
191{-# INLINE decodeUtf32LE #-}
193-- | Decode text from big endian UTF-32 encoding.
194decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
195decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
196{-# INLINE decodeUtf32BEWith #-}
198-- | Decode text from big endian UTF-32 encoding.
199decodeUtf32BE :: ByteString -> Text
200decodeUtf32BE = decodeUtf32BEWith strictDecode
201{-# INLINE decodeUtf32BE #-}
203-- | Encode text using little endian UTF-32 encoding.
204encodeUtf32LE :: Text -> ByteString
205encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
206{-# INLINE encodeUtf32LE #-}
208-- | Encode text using big endian UTF-32 encoding.
209encodeUtf32BE :: Text -> ByteString
210encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
211{-# INLINE encodeUtf32BE #-}