aboutsummaryrefslogtreecommitdiffhomepage
path: root/Pipes/Text
diff options
context:
space:
mode:
Diffstat (limited to 'Pipes/Text')
-rw-r--r--Pipes/Text/Codec.hs215
1 files changed, 0 insertions, 215 deletions
diff --git a/Pipes/Text/Codec.hs b/Pipes/Text/Codec.hs
deleted file mode 100644
index 070b0d9..0000000
--- a/Pipes/Text/Codec.hs
+++ /dev/null
@@ -1,215 +0,0 @@
1
2{-# LANGUAGE DeriveDataTypeable, RankNTypes, BangPatterns #-}
3-- |
4-- Copyright: 2014 Michael Thompson, 2011 Michael Snoyman, 2010-2011 John Millikin
5-- License: MIT
6--
7-- Parts of this code were taken from enumerator and conduits, and adapted for pipes.
8
9module Pipes.Text.Codec
10 ( Decoding(..)
11 , streamDecodeUtf8
12 , decodeSomeUtf8
13 , Codec(..)
14 , TextException(..)
15 , utf8
16 , utf16_le
17 , utf16_be
18 , utf32_le
19 , utf32_be
20 ) where
21
22import Data.Bits ((.&.))
23import Data.Char (ord)
24import Data.ByteString as B
25import Data.ByteString (ByteString)
26import Data.ByteString.Internal as B
27import Data.ByteString.Char8 as B8
28import Data.Text (Text)
29import qualified Data.Text as T
30import qualified Data.Text.Encoding as TE
31import Data.Text.Encoding.Error ()
32import GHC.Word (Word8, Word32)
33import qualified Data.Text.Array as A
34import Data.Word (Word8, Word16)
35import System.IO.Unsafe (unsafePerformIO)
36import qualified Control.Exception as Exc
37import Data.Bits ((.&.), (.|.), shiftL)
38import Data.Typeable
39import Control.Arrow (first)
40import Data.Maybe (catMaybes)
41import Pipes.Text.Internal
42import Pipes
43-- | A specific character encoding.
44--
45-- Since 0.3.0
46data Codec = Codec
47 { codecName :: Text
48 , codecEncode :: Text -> (ByteString, Maybe (TextException, Text))
49 , codecDecode :: ByteString -> Decoding -- (Text, Either (TextException, ByteString) ByteString)
50 }
51
52instance Show Codec where
53 showsPrec d c = showParen (d > 10) $
54 showString "Codec " . shows (codecName c)
55
56data TextException = DecodeException Codec Word8
57 | EncodeException Codec Char
58 | LengthExceeded Int
59 | TextException Exc.SomeException
60 deriving (Show, Typeable)
61instance Exc.Exception TextException
62
63
64toDecoding :: (ByteString -> (Text, Either (TextException, ByteString) ByteString))
65 -> (ByteString -> Decoding)
66toDecoding op = loop B.empty where
67 loop !extra bs0 = case op (B.append extra bs0) of
68 (txt, Right bs) -> Some txt bs (loop bs)
69 (txt, Left (_,bs)) -> Other txt bs
70-- To do: toDecoding should be inlined in each of the 'Codec' definitions
71-- or else Codec changed to the conduit/enumerator definition. We have
72-- altered it to use 'streamDecodeUtf8'
73
74splitSlowly :: (ByteString -> Text)
75 -> ByteString
76 -> (Text, Either (TextException, ByteString) ByteString)
77splitSlowly dec bytes = valid where
78 valid:_ = catMaybes $ Prelude.map decFirst $ splits (B.length bytes)
79 splits 0 = [(B.empty, bytes)]
80 splits n = B.splitAt n bytes : splits (n - 1)
81 decFirst (a, b) = case tryEvaluate (dec a) of
82 Left _ -> Nothing
83 Right text -> let trouble = case tryEvaluate (dec b) of
84 Left exc -> Left (TextException exc, b)
85 Right _ -> Right B.empty
86 in Just (text, trouble) -- this case shouldn't occur,
87 -- since splitSlowly is only called
88 -- when parsing failed somewhere
89
90utf8 :: Codec
91utf8 = Codec name enc (toDecoding dec) where
92 name = T.pack "UTF-8"
93 enc text = (TE.encodeUtf8 text, Nothing)
94 dec bytes = case decodeSomeUtf8 bytes of (t,b) -> (t, Right b)
95
96-- -- Whether the given byte is a continuation byte.
97-- isContinuation byte = byte .&. 0xC0 == 0x80
98--
99-- -- The number of continuation bytes needed by the given
100-- -- non-continuation byte. Returns -1 for an illegal UTF-8
101-- -- non-continuation byte and the whole split quickly must fail so
102-- -- as the input is passed to TE.decodeUtf8, which will issue a
103-- -- suitable error.
104-- required x0
105-- | x0 .&. 0x80 == 0x00 = 0
106-- | x0 .&. 0xE0 == 0xC0 = 1
107-- | x0 .&. 0xF0 == 0xE0 = 2
108-- | x0 .&. 0xF8 == 0xF0 = 3
109-- | otherwise = -1
110--
111-- splitQuickly bytes
112-- | B.null l || req == -1 = Nothing
113-- | req == B.length r = Just (TE.decodeUtf8 bytes, B.empty)
114-- | otherwise = Just (TE.decodeUtf8 l', r')
115-- where
116-- (l, r) = B.spanEnd isContinuation bytes
117-- req = required (B.last l)
118-- l' = B.init l
119-- r' = B.cons (B.last l) r
120
121
122utf16_le :: Codec
123utf16_le = Codec name enc (toDecoding dec) where
124 name = T.pack "UTF-16-LE"
125 enc text = (TE.encodeUtf16LE text, Nothing)
126 dec bytes = case splitQuickly bytes of
127 Just (text, extra) -> (text, Right extra)
128 Nothing -> splitSlowly TE.decodeUtf16LE bytes
129
130 splitQuickly bytes = maybeDecode (loop 0) where
131 maxN = B.length bytes
132
133 loop n | n == maxN = decodeAll
134 | (n + 1) == maxN = decodeTo n
135 loop n = let
136 req = utf16Required
137 (B.index bytes n)
138 (B.index bytes (n + 1))
139 decodeMore = loop $! n + req
140 in if n + req > maxN
141 then decodeTo n
142 else decodeMore
143
144 decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes)
145 decodeAll = (TE.decodeUtf16LE bytes, B.empty)
146
147utf16_be :: Codec
148utf16_be = Codec name enc (toDecoding dec) where
149 name = T.pack "UTF-16-BE"
150 enc text = (TE.encodeUtf16BE text, Nothing)
151 dec bytes = case splitQuickly bytes of
152 Just (text, extra) -> (text, Right extra)
153 Nothing -> splitSlowly TE.decodeUtf16BE bytes
154
155 splitQuickly bytes = maybeDecode (loop 0) where
156 maxN = B.length bytes
157
158 loop n | n == maxN = decodeAll
159 | (n + 1) == maxN = decodeTo n
160 loop n = let
161 req = utf16Required
162 (B.index bytes (n + 1))
163 (B.index bytes n)
164 decodeMore = loop $! n + req
165 in if n + req > maxN
166 then decodeTo n
167 else decodeMore
168
169 decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes)
170 decodeAll = (TE.decodeUtf16BE bytes, B.empty)
171
172utf16Required :: Word8 -> Word8 -> Int
173utf16Required x0 x1 = if x >= 0xD800 && x <= 0xDBFF then 4 else 2 where
174 x :: Word16
175 x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0
176
177
178utf32_le :: Codec
179utf32_le = Codec name enc (toDecoding dec) where
180 name = T.pack "UTF-32-LE"
181 enc text = (TE.encodeUtf32LE text, Nothing)
182 dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of
183 Just (text, extra) -> (text, Right extra)
184 Nothing -> splitSlowly TE.decodeUtf32LE bs
185
186
187utf32_be :: Codec
188utf32_be = Codec name enc (toDecoding dec) where
189 name = T.pack "UTF-32-BE"
190 enc text = (TE.encodeUtf32BE text, Nothing)
191 dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of
192 Just (text, extra) -> (text, Right extra)
193 Nothing -> splitSlowly TE.decodeUtf32BE bs
194
195utf32SplitBytes :: (ByteString -> Text)
196 -> ByteString
197 -> Maybe (Text, ByteString)
198utf32SplitBytes dec bytes = split where
199 split = maybeDecode (dec toDecode, extra)
200 len = B.length bytes
201 lenExtra = mod len 4
202
203 lenToDecode = len - lenExtra
204 (toDecode, extra) = if lenExtra == 0
205 then (bytes, B.empty)
206 else B.splitAt lenToDecode bytes
207
208
209tryEvaluate :: a -> Either Exc.SomeException a
210tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate
211
212maybeDecode :: (a, b) -> Maybe (a, b)
213maybeDecode (a, b) = case tryEvaluate a of
214 Left _ -> Nothing
215 Right _ -> Just (a, b)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 18:32:44 +0000