8766bac · text · git.iko.soy

git.iko.soy/text

Add controllable error handling and recovery code.

--HG-- extra : convert_revision : 3795901067732c91b235f9281f8e3691756dc5d3

commit8766bacfca7a17c97b43d942f87685fcdae6f976 authorBryan O'Sullivan <bos@serpentine.com> dateSat 6 Jun 2009, 04:21 (17 years ago) parent62aa968

6 files changed+203−43

compare with master

unifiedsplit

Data/Text/Encoding.hs+37−5 Data/Text/Encoding/Error.hs+108 Data/Text/Encoding/Fusion.hs+26−19 Data/Text/Lazy/Encoding.hs+8−1 Data/Text/Lazy/Encoding/Fusion.hs+23−18 text.cabal+1

Data/Text/Encoding.hs+37−5

@@ -25,6 +25,12 @@ module Data.Text.Encoding

2525 , decodeUtf16BE

2626 , decodeUtf32LE

2727 , decodeUtf32BE

28+ -- ** Controllable error handling

29+ , decodeUtf8With

30+ , decodeUtf16LEWith

31+ , decodeUtf16BEWith

32+ , decodeUtf32LEWith

33+ , decodeUtf32BEWith

2834

2935 -- * Encoding Text to ByteStrings

3036 , encodeUtf8

@@ -36,6 +42,7 @@ module Data.Text.Encoding

3642

3743import Data.ByteString (ByteString)

3844import qualified Data.Text.Fusion as F

45+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)

3946import qualified Data.Text.Encoding.Fusion as E

4047import Data.Text.Internal (Text)

4148

@@ -44,9 +51,14 @@ decodeASCII :: ByteString -> Text

4451decodeASCII bs = F.unstream (E.streamASCII bs)

4552{-# INLINE decodeASCII #-}

4653

54+-- | Decode a 'ByteString' containing UTF-8 encoded text.

55+decodeUtf8With :: OnDecodeError -> ByteString -> Text

56+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

57+{-# INLINE decodeUtf8With #-}

58+

4759-- | Decode a 'ByteString' containing UTF-8 encoded text.

4860decodeUtf8 :: ByteString -> Text

49−decodeUtf8 bs = F.unstream (E.streamUtf8 bs)

61+decodeUtf8 = decodeUtf8With strictDecode

5062{-# INLINE decodeUtf8 #-}

5163

5264-- | Encode text using UTF-8 encoding.

@@ -54,14 +66,24 @@ encodeUtf8 :: Text -> ByteString

5466encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))

5567{-# INLINE encodeUtf8 #-}

5668

69+-- | Decode text from little endian UTF-16 encoding.

70+decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

71+decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

72+{-# INLINE decodeUtf16LEWith #-}

73+

5774-- | Decode text from little endian UTF-16 encoding.

5875decodeUtf16LE :: ByteString -> Text

59−decodeUtf16LE bs = F.unstream (E.streamUtf16LE bs)

76+decodeUtf16LE = decodeUtf16LEWith strictDecode

6077{-# INLINE decodeUtf16LE #-}

6178

79+-- | Decode text from big endian UTF-16 encoding.

80+decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text

81+decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)

82+{-# INLINE decodeUtf16BEWith #-}

83+

6284-- | Decode text from big endian UTF-16 encoding.

6385decodeUtf16BE :: ByteString -> Text

64−decodeUtf16BE bs = F.unstream (E.streamUtf16BE bs)

86+decodeUtf16BE = decodeUtf16BEWith strictDecode

6587{-# INLINE decodeUtf16BE #-}

6688

6789-- | Encode text using little endian UTF-16 encoding.

@@ -74,14 +96,24 @@ encodeUtf16BE :: Text -> ByteString

7496encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))

7597{-# INLINE encodeUtf16BE #-}

7698

99+-- | Decode text from little endian UTF-32 encoding.

100+decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text

101+decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)

102+{-# INLINE decodeUtf32LEWith #-}

103+

77104-- | Decode text from little endian UTF-32 encoding.

78105decodeUtf32LE :: ByteString -> Text

79−decodeUtf32LE bs = F.unstream (E.streamUtf32LE bs)

106+decodeUtf32LE = decodeUtf32LEWith strictDecode

80107{-# INLINE decodeUtf32LE #-}

81108

109+-- | Decode text from big endian UTF-32 encoding.

110+decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text

111+decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)

112+{-# INLINE decodeUtf32BEWith #-}

113+

82114-- | Decode text from big endian UTF-32 encoding.

83115decodeUtf32BE :: ByteString -> Text

84−decodeUtf32BE bs = F.unstream (E.streamUtf32BE bs)

116+decodeUtf32BE = decodeUtf32BEWith strictDecode

85117{-# INLINE decodeUtf32BE #-}

86118

87119-- | Encode text using little endian UTF-32 encoding.

Data/Text/Encoding/Error.hsnew file+108

@@ -0,0 +1,108 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+-- |

3+-- Module : Data.Text.Encoding.Error

4+-- Copyright : (c) Bryan O'Sullivan 2009

5+--

6+-- License : BSD-style

7+-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

8+-- duncan@haskell.org

9+-- Stability : experimental

10+-- Portability : GHC

11+--

12+-- Types and functions for dealing with encoding and decoding errors

13+-- in Unicode text.

14+--

15+-- The standard functions for encoding and decoding text are strict,

16+-- which is to say that they throw exceptions on invalid input. This

17+-- is often unhelpful on real world input, so alternative functions

18+-- exist that accept custom handlers for dealing with invalid inputs.

19+-- These 'OnError' handlers are normal Haskell functions. You can use

20+-- one of the presupplied functions in this module, or you can write a

21+-- custom handler of your own.

22+

23+module Data.Text.Encoding.Error

24+ (

25+ -- * Error handling types

26+ UnicodeException(..)

27+ , OnError

28+ , OnDecodeError

29+ , OnEncodeError

30+ -- * Useful error handling functions

31+ , lenientDecode

32+ , strictDecode

33+ , strictEncode

34+ , ignore

35+ , replace

36+ ) where

37+

38+import Control.Exception (Exception, throw)

39+import Data.Typeable (Typeable)

40+import Data.Word (Word8)

41+import Numeric (showHex)

42+

43+-- | Function type for handling a coding error. It is supplied with

44+-- two inputs:

45+--

46+-- * A 'String' that describes the error.

47+--

48+-- * The input value that caused the error. If the error arose

49+-- because the end of input was reached or could not be identified

50+-- precisely, this value will be 'Nothing'.

51+--

52+-- If the handler returns a value wrapped with 'Just', that value will

53+-- be used in the output as the replacement for the invalid input. If

54+-- it returns 'Nothing', no value will be used in the output.

55+--

56+-- Should the handler need to abort processing, it should use 'error'

57+-- or 'throw' an exception (preferably a 'UnicodeException'). It may

58+-- use the description provided to construct a more helpful error

59+-- report.

60+type OnError a b = String -> Maybe a -> Maybe b

61+type OnDecodeError = OnError Word8 Char

62+type OnEncodeError = OnError Char Word8

63+

64+-- | An exception type for representing Unicode encoding errors.

65+data UnicodeException =

66+ DecodeError String (Maybe Word8)

67+ -- ^ Could not decode a byte sequence because it was invalid under

68+ -- the given encoding, or ran out of input in mid-decode.

69+ | EncodeError String (Maybe Char)

70+ -- ^ Tried to encode a character that could not be represented

71+ -- under the given encoding, or ran out of input in mid-encode.

72+ deriving (Typeable)

73+

74+showUnicodeException :: UnicodeException -> String

75+showUnicodeException (DecodeError desc (Just w))

76+ = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)

77+showUnicodeException (DecodeError desc Nothing)

78+ = "Cannot decode input: " ++ desc

79+showUnicodeException (EncodeError desc (Just c))

80+ = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)

81+showUnicodeException (EncodeError desc Nothing)

82+ = "Cannot encode input: " ++ desc

83+

84+instance Show UnicodeException where

85+ show = showUnicodeException

86+

87+instance Exception UnicodeException

88+

89+-- | Throw a 'UnicodeException' if decoding fails.

90+strictDecode :: OnError Word8 Char

91+strictDecode desc c = throw (DecodeError desc c)

92+

93+-- | Replace an invalid input byte with the Unicode replacement

94+-- character U+FFFD.

95+lenientDecode :: OnError Word8 Char

96+lenientDecode _ _ = Just '\xfffd'

97+

98+-- | Throw a 'UnicodeException' if encoding fails.

99+strictEncode :: OnError Char Word8

100+strictEncode desc c = throw (EncodeError desc c)

101+

102+-- | Ignore an invalid input, substituting nothing in the output.

103+ignore :: OnError a b

104+ignore _ _ = Nothing

105+

106+-- | Replace an invalid input with a valid output.

107+replace :: b -> OnError a b

108+replace c _ _ = Just c

Data/Text/Encoding/Fusion.hs+26−19

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns #-}

1+{-# LANGUAGE BangPatterns, Rank2Types #-}

33-- |

44-- Module : Data.Text.Encoding.Fusion

@@ -35,6 +35,7 @@ import Control.Exception (assert)

3535import Data.ByteString as B

3636import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)

3737import Data.Text.Fusion (Step(..), Stream(..))

38+import Data.Text.Encoding.Error

3839import Data.Text.Encoding.Fusion.Common

3940import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

4041import Data.Text.UnsafeShift (shiftL)

@@ -62,8 +63,8 @@ streamASCII bs = Stream next 0 l

6263

6364-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8

6465-- encoding.

65−streamUtf8 :: ByteString -> Stream Char

66−streamUtf8 bs = Stream next 0 l

66+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

67+streamUtf8 onErr bs = Stream next 0 l

6768 where

6869 l = B.length bs

6970 {-# INLINE next #-}

@@ -73,8 +74,9 @@ streamUtf8 bs = Stream next 0 l

7374 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)

7475 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)

7576 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)

76− | otherwise = encodingError "UTF-8"

77+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)

7778 where

79+ mx = if i >= l then Nothing else Just x1

7880 x1 = idx i

7981 x2 = idx (i + 1)

8082 x3 = idx (i + 2)

@@ -84,8 +86,8 @@ streamUtf8 bs = Stream next 0 l

8486

8587-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

8688-- endian UTF-16 encoding.

87−streamUtf16LE :: ByteString -> Stream Char

88−streamUtf16LE bs = Stream next 0 l

89+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

90+streamUtf16LE onErr bs = Stream next 0 l

8991 where

9092 l = B.length bs

9193 {-# INLINE next #-}

@@ -93,7 +95,7 @@ streamUtf16LE bs = Stream next 0 l

9395 | i >= l = Done

9496 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)

9597 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

96− | otherwise = encodingError "UTF-16LE"

98+ | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)

9799 where

98100 x1 = idx i + (idx (i + 1) `shiftL` 8)

99101 x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)

@@ -102,8 +104,8 @@ streamUtf16LE bs = Stream next 0 l

102104

103105-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

104106-- endian UTF-16 encoding.

105−streamUtf16BE :: ByteString -> Stream Char

106−streamUtf16BE bs = Stream next 0 l

107+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

108+streamUtf16BE onErr bs = Stream next 0 l

107109 where

108110 l = B.length bs

109111 {-# INLINE next #-}

@@ -111,7 +113,7 @@ streamUtf16BE bs = Stream next 0 l

111113 | i >= l = Done

112114 | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)

113115 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

114− | otherwise = encodingError "UTF16-BE"

116+ | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)

115117 where

116118 x1 = (idx i `shiftL` 8) + idx (i + 1)

117119 x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)

@@ -120,15 +122,15 @@ streamUtf16BE bs = Stream next 0 l

120122

121123-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

122124-- endian UTF-32 encoding.

123−streamUtf32BE :: ByteString -> Stream Char

124−streamUtf32BE bs = Stream next 0 l

125+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

126+streamUtf32BE onErr bs = Stream next 0 l

125127 where

126128 l = B.length bs

127129 {-# INLINE next #-}

128130 next i

129131 | i >= l = Done

130132 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)

131− | otherwise = encodingError "UTF-32BE"

133+ | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)

132134 where

133135 x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4

134136 x1 = idx i

@@ -140,15 +142,15 @@ streamUtf32BE bs = Stream next 0 l

140142

141143-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

142144-- endian UTF-32 encoding.

143−streamUtf32LE :: ByteString -> Stream Char

144−streamUtf32LE bs = Stream next 0 l

145+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

146+streamUtf32LE onErr bs = Stream next 0 l

145147 where

146148 l = B.length bs

147149 {-# INLINE next #-}

148150 next i

149151 | i >= l = Done

150152 | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)

151− | otherwise = encodingError "UTF-32LE"

153+ | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)

152154 where

153155 x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1

154156 x1 = idx i

@@ -187,6 +189,11 @@ unstream (Stream next s0 len) = unsafePerformIO $ do

187189 memcpy dest' src' (fromIntegral srcLen)

188190 return dest

189191

190−encodingError :: String -> a

191−encodingError encoding =

192− error $ "Data.Text.Encoding.Fusion: Bad " ++ encoding ++ " stream"

192+decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8

193+ -> s -> Step s Char

194+decodeError func kind onErr mb i =

195+ case onErr desc mb of

196+ Nothing -> Skip i

197+ Just c -> Yield c i

198+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++

199+ kind ++ " stream"

Data/Text/Lazy/Encoding.hs+8−1

@@ -19,6 +19,7 @@ module Data.Text.Lazy.Encoding

1919 -- * Decoding ByteStrings to Text

2020 -- decodeASCII

2121 decodeUtf8

22+ , decodeUtf8With

2223 --, decodeUtf16LE

2324 --, decodeUtf16BE

2425 --, decodeUtf32LE

@@ -33,13 +34,19 @@ module Data.Text.Lazy.Encoding

3334 ) where

3435

3536import Data.ByteString.Lazy (ByteString)

37+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)

3638import Data.Text.Lazy (Text)

3739import qualified Data.Text.Lazy.Fusion as F

3840import qualified Data.Text.Lazy.Encoding.Fusion as E

3941

42+-- | Decode a 'ByteString' containing UTF-8 encoded text.

43+decodeUtf8With :: OnDecodeError -> ByteString -> Text

44+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

45+{-# INLINE decodeUtf8With #-}

46+

4047-- | Decode a 'ByteString' containing UTF-8 encoded text.

4148decodeUtf8 :: ByteString -> Text

42−decodeUtf8 bs = F.unstream (E.streamUtf8 bs)

49+decodeUtf8 = decodeUtf8With strictDecode

4350{-# INLINE decodeUtf8 #-}

4451

4552-- | Encode text using UTF-8 encoding.

Data/Text/Lazy/Encoding/Fusion.hs+23−18

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns #-}

1+{-# LANGUAGE BangPatterns, Rank2Types #-}

33-- |

44-- Module : Data.Text.Lazy.Encoding.Fusion

@@ -33,6 +33,7 @@ import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)

3333import qualified Data.ByteString as B

3434import qualified Data.ByteString.Unsafe as B

3535import Data.Text.Encoding.Fusion.Common

36+import Data.Text.Encoding.Error

3637import Data.Text.Fusion (Step(..), Stream(..))

3738import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))

3839import Data.Text.UnsafeChar (unsafeChr8)

@@ -50,8 +51,8 @@ unknownLength = 4

5051

5152-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

5253-- UTF-8 encoding.

53−streamUtf8 :: ByteString -> Stream Char

54−streamUtf8 bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength

54+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

55+streamUtf8 onErr bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength

5556 where

5657 empty = S N N N N

5758 {-# INLINE next #-}

@@ -83,18 +84,18 @@ streamUtf8 bs0 = Stream next (bs0 :!: empty :!: 0) unknownLength

8384 where es = bs :!: empty :!: i

8485 {-# INLINE consume #-}

8586 consume (bs@(Chunk ps rest) :!: s :!: i)

86− | i >= len = consume (rest :!: s :!: 0)

87− | otherwise = next (bs :!: s' :!: i+1)

88− where s' = case s of

89− S N _ _ _ -> S x N N N

90− S a N _ _ -> S a x N N

91− S a b N _ -> S a b x N

92− S a b c N -> S a b c x

93− _ -> encodingError "streamUtf8" "UTF-8"

94− x = J (B.unsafeIndex ps i)

95− len = B.length ps

87+ | i >= B.length ps = consume (rest :!: s :!: 0)

88+ | otherwise =

89+ case s of

90+ S N _ _ _ -> next (bs :!: S x N N N :!: i+1)

91+ S a N _ _ -> next (bs :!: S a x N N :!: i+1)

92+ S a b N _ -> next (bs :!: S a b x N :!: i+1)

93+ S a b c N -> next (bs :!: S a b c x :!: i+1)

94+ S (J a) b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)

95+ (bs :!: S b c d N :!: i+1)

96+ where x = J (B.unsafeIndex ps i)

9697 consume (Empty :!: S N _ _ _ :!: _) = Done

97− consume _ = encodingError "streamUtf8" "UTF-8"

98+ consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st

9899{-# INLINE [0] streamUtf8 #-}

99100

100101-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

@@ -138,7 +139,11 @@ unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 len0

138139unstream :: Stream Word8 -> ByteString

139140unstream = unstreamChunks defaultChunkSize

140141

141−encodingError :: String -> String -> a

142−encodingError func encoding =

143− error $ "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Bad " ++

144− encoding ++ " stream"

142+decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8

143+ -> s -> Step s Char

144+decodeError func kind onErr mb i =

145+ case onErr desc mb of

146+ Nothing -> Skip i

147+ Just c -> Yield c i

148+ where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++

149+ kind ++ " stream"

text.cabal+1

@@ -18,6 +18,7 @@ library

1818 exposed-modules:

1919 Data.Text

2020 Data.Text.Encoding

21+ Data.Text.Encoding.Error

2122 Data.Text.Encoding.Fusion

2223 Data.Text.Foreign

2324 Data.Text.Fusion