1a12bb1 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add decodeUtf8Lenient to String module.

1a12bb1Pranay Sashank7 years ago

src/Streamly/Data/String.hs+8

compare with master

unifiedsplit

@@ -51,6 +51,7 @@ module Streamly.Data.String

51 -- * Construction (Decoding)

52 decodeChar8

53 , decodeUtf8

54+ , decodeUtf8Lenient

55 -- * Elimination (Encoding)

56 -- * Elimination (Encoding)

56 , encodeChar8

57 , encodeChar8

@@ -143,6 +144,13 @@ encodeChar8Unchecked = S.map (fromIntegral . ord)

143decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char

144decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char

144decodeUtf8 = D.fromStreamD . D.decodeUtf8 . D.toStreamD

145decodeUtf8 = D.fromStreamD . D.decodeUtf8 . D.toStreamD

145

146

147+-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.

148+-- Any invalid codepoint encountered is replaced with the unicode replacement

149+-- character.

150+{-# INLINE decodeUtf8Lenient #-}

151+decodeUtf8Lenient :: (Monad m, IsStream t) => t m Word8 -> t m Char

152+decodeUtf8Lenient = D.fromStreamD . D.decodeUtf8Lenient . D.toStreamD

153+

146-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

154-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

147{-# INLINE encodeUtf8 #-}

155{-# INLINE encodeUtf8 #-}

148encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

156encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

src/Streamly/Streams/StreamD.hs+60−25

@@ -264,6 +264,7 @@ module Streamly.Streams.StreamD

264 -- * UTF8 Encoding / Decoding transformations.

265 , decodeUtf8

266 , encodeUtf8

267+ , decodeUtf8Lenient

267 )

268 )

268where

269where

269

270

@@ -3077,12 +3078,29 @@ data CodePoint = FreshPoint

3077 | GoFour !Word8

3078 | GoFour !Word8

3078 | Four1 !Word8 !Word8

3079 | Four1 !Word8 !Word8

3079 | Four !Word8 !Word8 !Word8

3080 | Four !Word8 !Word8 !Word8

3080− | YieldPoint !Char

3081+ | YieldAndContinue !Char

3081−

3082+ | YieldAndStop !Char

3083+ | Done

3084+

3085+data CodingFailureMode

3086+ = TransliterateCodingFailure

3087+ | ErrorOnCodingFailure

3088+ deriving (Show)

3089+

3082−{-# INLINE_NORMAL decodeUtf8 #-}

3090+{-# INLINE_NORMAL decodeUtf8With #-}

3083−decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

3091+decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char

3084−decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3092+decodeUtf8With cfm (Stream step state) = Stream step' (state, FreshPoint)

3085 where

3093 where

3094+ {-# INLINE transliterateOrError #-}

3095+ {-# INLINE inputUnderflow #-}

3096+ transliterateOrError e s =

3097+ case cfm of

3098+ ErrorOnCodingFailure -> error e

3099+ TransliterateCodingFailure -> Skip (s, YieldAndContinue '\xFFFD')

3100+ inputUnderflow s = case cfm of

3101+ ErrorOnCodingFailure -> error "Input Underflow"

3102+ TransliterateCodingFailure -> Skip (s, YieldAndStop '\xFFFD')

3103+

3086 {-# INLINE_LATE step' #-}

3104 {-# INLINE_LATE step' #-}

3087 step' gst (st, FreshPoint) = do

3105 step' gst (st, FreshPoint) = do

3088 r <- step (adaptState gst) st

3106 r <- step (adaptState gst) st

@@ -3090,12 +3108,13 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3090 case r of

3108 case r of

3091 Yield c0 s

3109 Yield c0 s

3092 | c0 <= 0x7f ->

3110 | c0 <= 0x7f ->

3093− Skip (s, YieldPoint $ unsafeChr (fromIntegral c0))

3111+ Skip (s, YieldAndContinue $ unsafeChr (fromIntegral c0))

3112+ | c0 >= 0xc0 && c0 <= 0xc1 ->

3094− | c0 >= 0xc0 && c0 <= 0xc1 -> error "Invalid Overlong forms"

3113+ transliterateOrError "Invalid Overlong forms" s

3095 | c0 >= 0xc2 && c0 <= 0xdf -> Skip (s, Two c0)

3114 | c0 >= 0xc2 && c0 <= 0xdf -> Skip (s, Two c0)

3096 | c0 >= 0xe0 && c0 <= 0xef -> Skip (s, GoThree c0)

3115 | c0 >= 0xe0 && c0 <= 0xef -> Skip (s, GoThree c0)

3097− | c0 >= 0xf0 -> Skip (s, GoFour c0)

3116+ | c0 >= 0xf0 -> Skip (s, GoFour c0)

3098− | otherwise -> error "Invalid Sequence"

3117+ | otherwise -> transliterateOrError "Invalid Sequence" s

3099 Skip s -> Skip (s, FreshPoint)

3118 Skip s -> Skip (s, FreshPoint)

3100 Stop -> Stop

3119 Stop -> Stop

3101

3120

@@ -3106,10 +3125,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3106 return $

3125 return $

3107 case r of

3126 case r of

3108 Yield c1 s

3127 Yield c1 s

3109− | c1 < 0x80 || c1 >= 0xc0 -> error "Invalid Sequence"

3128+ | c1 < 0x80 || c1 >= 0xc0 ->

3129+ transliterateOrError "Invalid Sequence" s

3110− | otherwise -> Skip (s, YieldPoint $ chr2 c0 c1)

3130+ | otherwise -> Skip (s, YieldAndContinue $ chr2 c0 c1)

3111 Skip s -> Skip (s, Two c0)

3131 Skip s -> Skip (s, Two c0)

3112− Stop -> error "Input Underflow"

3132+ Stop -> inputUnderflow st

3113

3133

3114 -- Decoding of a UTF8 character that spans three bytes with first byte (c0)

3134 -- Decoding of a UTF8 character that spans three bytes with first byte (c0)

3115 -- known.

3135 -- known.

@@ -3118,11 +3138,12 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3118 return $

3138 return $

3119 case r of

3139 case r of

3120 Yield c1 s

3140 Yield c1 s

3121− | not (validate3 c0 c1 0x80) -> error "Invalid Sequence"

3141+ | not (validate3 c0 c1 0x80) ->

3142+ transliterateOrError "Invalid Sequence" s

3122 -- See #3341@ghc

3143 -- See #3341@ghc

3123 | otherwise -> Skip (s, Three c0 c1)

3144 | otherwise -> Skip (s, Three c0 c1)

3124 Skip s -> Skip (s, GoThree c0)

3145 Skip s -> Skip (s, GoThree c0)

3125− Stop -> error "Input Underflow"

3146+ Stop -> inputUnderflow st

3126

3147

3127 -- Two bytes known of a 3 byte UTF8 encoded unicode character.

3148 -- Two bytes known of a 3 byte UTF8 encoded unicode character.

3128 step' gst (st, Three c0 c1) = do

3149 step' gst (st, Three c0 c1) = do

@@ -3130,10 +3151,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3130 return $

3151 return $

3131 case r of

3152 case r of

3132 Yield c2 s

3153 Yield c2 s

3133− | not (validate3 c0 c1 c2) -> error "Invalid Sequence"

3154+ | not (validate3 c0 c1 c2) ->

3155+ transliterateOrError "Invalid Sequence" s

3134− | otherwise -> Skip (s, YieldPoint $ chr3 c0 c1 c2)

3156+ | otherwise -> Skip (s, YieldAndContinue $ chr3 c0 c1 c2)

3135 Skip s -> Skip (s, Three c0 c1)

3157 Skip s -> Skip (s, Three c0 c1)

3136− Stop -> error "Input Underflow"

3158+ Stop -> inputUnderflow st

3137

3159

3138 -- One byte known of a four byte UTF8 unicode character.

3160 -- One byte known of a four byte UTF8 unicode character.

3139 step' gst (st, GoFour c0) = do

3161 step' gst (st, GoFour c0) = do

@@ -3141,10 +3163,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3141 return $

3163 return $

3142 case r of

3164 case r of

3143 Yield c1 s

3165 Yield c1 s

3144− | not (validate4 c0 c1 0x80 0x80) -> error "Invalid Sequence"

3166+ | not (validate4 c0 c1 0x80 0x80) ->

3167+ transliterateOrError "Invalid Sequence" s

3145 | otherwise -> Skip (s, Four1 c0 c1)

3168 | otherwise -> Skip (s, Four1 c0 c1)

3146 Skip s -> Skip (s, GoFour c0)

3169 Skip s -> Skip (s, GoFour c0)

3147− Stop -> error "Input Underflow"

3170+ Stop -> inputUnderflow st

3148

3171

3149 -- Two bytes known of a four byte UTF8 unicode character.

3172 -- Two bytes known of a four byte UTF8 unicode character.

3150 step' gst (st, Four1 c0 c1) = do

3173 step' gst (st, Four1 c0 c1) = do

@@ -3152,10 +3175,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3152 return $

3175 return $

3153 case r of

3176 case r of

3154 Yield c2 s

3177 Yield c2 s

3155− | not (validate4 c0 c1 c2 0x80) -> error "Invalid Sequence"

3178+ | not (validate4 c0 c1 c2 0x80) ->

3179+ transliterateOrError "Invalid Sequence" s

3156 | otherwise -> Skip (s, Four c0 c1 c2)

3180 | otherwise -> Skip (s, Four c0 c1 c2)

3157 Skip s -> Skip (s, Four1 c0 c1)

3181 Skip s -> Skip (s, Four1 c0 c1)

3158− Stop -> error "Input Underflow"

3182+ Stop -> inputUnderflow st

3159

3183

3160 -- Three bytes known of a three byte UTF8 unicode character.

3184 -- Three bytes known of a three byte UTF8 unicode character.

3161 step' gst (st, Four c0 c1 c2) = do

3185 step' gst (st, Four c0 c1 c2) = do

@@ -3163,13 +3187,24 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

3163 return $

3187 return $

3164 case r of

3188 case r of

3165 Yield c3 s

3189 Yield c3 s

3166− | not (validate4 c0 c1 c2 c3) -> error "Invalid Sequence"

3190+ | not (validate4 c0 c1 c2 c3) ->

3191+ transliterateOrError "Invalid Sequence" s

3167− | otherwise -> Skip (s, YieldPoint $ chr4 c0 c1 c2 c3)

3192+ | otherwise -> Skip (s, YieldAndContinue $ chr4 c0 c1 c2 c3)

3168 Skip s -> Skip (s, Four c0 c1 c2)

3193 Skip s -> Skip (s, Four c0 c1 c2)

3169− Stop -> error "Input Underflow"

3194+ Stop -> inputUnderflow st

3170

3195

3171 -- This way so that we only need one Yield.

3196 -- This way so that we only need one Yield.

3197+ step' _ (s, YieldAndStop c) = return $ Yield c (s, Done)

3172− step' _ (s, YieldPoint c) = return $ Yield c (s, FreshPoint)

3198+ step' _ (s, YieldAndContinue c) = return $ Yield c (s, FreshPoint)

3199+ step' _ (_, Done) = return Stop

3200+

3201+{-# INLINE decodeUtf8 #-}

3202+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

3203+decodeUtf8 = decodeUtf8With ErrorOnCodingFailure

3204+

3205+{-# INLINE decodeUtf8Lenient #-}

3206+decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char

3207+decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure

3173

3208

3174data YieldMany x = None

3209data YieldMany x = None

3175 | YieldMany !x

3210 | YieldMany !x