@@ -264,6 +264,7 @@ module Streamly.Streams.StreamD
264264 -- * UTF8 Encoding / Decoding transformations.
265265 , decodeUtf8
266266 , encodeUtf8
267+ , decodeUtf8Lenient
267268 )
268269where
269270
@@ -3077,12 +3078,29 @@ data CodePoint = FreshPoint
30773078 | GoFour !Word8
30783079 | Four1 !Word8 !Word8
30793080 | Four !Word8 !Word8 !Word8
3080− | YieldPoint !Char
3081−
3082−{-# INLINE_NORMAL decodeUtf8 #-}
3083−decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
3084−decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
3081+ | YieldAndContinue !Char
3082+ | YieldAndStop !Char
3083+ | Done
3084+
3085+data CodingFailureMode
3086+ = TransliterateCodingFailure
3087+ | ErrorOnCodingFailure
3088+ deriving (Show)
3089+
3090+{-# INLINE_NORMAL decodeUtf8With #-}
3091+decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
3092+decodeUtf8With cfm (Stream step state) = Stream step' (state, FreshPoint)
30853093 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+
30863104 {-# INLINE_LATE step' #-}
30873105 step' gst (st, FreshPoint) = do
30883106 r <- step (adaptState gst) st
@@ -3090,12 +3108,13 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
30903108 case r of
30913109 Yield c0 s
30923110 | c0 <= 0x7f ->
3093− Skip (s, YieldPoint $ unsafeChr (fromIntegral c0))
3094− | c0 >= 0xc0 && c0 <= 0xc1 -> error "Invalid Overlong forms"
3111+ Skip (s, YieldAndContinue $ unsafeChr (fromIntegral c0))
3112+ | c0 >= 0xc0 && c0 <= 0xc1 ->
3113+ transliterateOrError "Invalid Overlong forms" s
30953114 | c0 >= 0xc2 && c0 <= 0xdf -> Skip (s, Two c0)
30963115 | c0 >= 0xe0 && c0 <= 0xef -> Skip (s, GoThree c0)
3097− | c0 >= 0xf0 -> Skip (s, GoFour c0)
3098− | otherwise -> error "Invalid Sequence"
3116+ | c0 >= 0xf0 -> Skip (s, GoFour c0)
3117+ | otherwise -> transliterateOrError "Invalid Sequence" s
30993118 Skip s -> Skip (s, FreshPoint)
31003119 Stop -> Stop
31013120
@@ -3106,10 +3125,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31063125 return $
31073126 case r of
31083127 Yield c1 s
3109− | c1 < 0x80 || c1 >= 0xc0 -> error "Invalid Sequence"
3110− | otherwise -> Skip (s, YieldPoint $ chr2 c0 c1)
3128+ | c1 < 0x80 || c1 >= 0xc0 ->
3129+ transliterateOrError "Invalid Sequence" s
3130+ | otherwise -> Skip (s, YieldAndContinue $ chr2 c0 c1)
31113131 Skip s -> Skip (s, Two c0)
3112− Stop -> error "Input Underflow"
3132+ Stop -> inputUnderflow st
31133133
31143134 -- Decoding of a UTF8 character that spans three bytes with first byte (c0)
31153135 -- known.
@@ -3118,11 +3138,12 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31183138 return $
31193139 case r of
31203140 Yield c1 s
3121− | not (validate3 c0 c1 0x80) -> error "Invalid Sequence"
3141+ | not (validate3 c0 c1 0x80) ->
3142+ transliterateOrError "Invalid Sequence" s
31223143 -- See #3341@ghc
31233144 | otherwise -> Skip (s, Three c0 c1)
31243145 Skip s -> Skip (s, GoThree c0)
3125− Stop -> error "Input Underflow"
3146+ Stop -> inputUnderflow st
31263147
31273148 -- Two bytes known of a 3 byte UTF8 encoded unicode character.
31283149 step' gst (st, Three c0 c1) = do
@@ -3130,10 +3151,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31303151 return $
31313152 case r of
31323153 Yield c2 s
3133− | not (validate3 c0 c1 c2) -> error "Invalid Sequence"
3134− | otherwise -> Skip (s, YieldPoint $ chr3 c0 c1 c2)
3154+ | not (validate3 c0 c1 c2) ->
3155+ transliterateOrError "Invalid Sequence" s
3156+ | otherwise -> Skip (s, YieldAndContinue $ chr3 c0 c1 c2)
31353157 Skip s -> Skip (s, Three c0 c1)
3136− Stop -> error "Input Underflow"
3158+ Stop -> inputUnderflow st
31373159
31383160 -- One byte known of a four byte UTF8 unicode character.
31393161 step' gst (st, GoFour c0) = do
@@ -3141,10 +3163,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31413163 return $
31423164 case r of
31433165 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
31453168 | otherwise -> Skip (s, Four1 c0 c1)
31463169 Skip s -> Skip (s, GoFour c0)
3147− Stop -> error "Input Underflow"
3170+ Stop -> inputUnderflow st
31483171
31493172 -- Two bytes known of a four byte UTF8 unicode character.
31503173 step' gst (st, Four1 c0 c1) = do
@@ -3152,10 +3175,11 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31523175 return $
31533176 case r of
31543177 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
31563180 | otherwise -> Skip (s, Four c0 c1 c2)
31573181 Skip s -> Skip (s, Four1 c0 c1)
3158− Stop -> error "Input Underflow"
3182+ Stop -> inputUnderflow st
31593183
31603184 -- Three bytes known of a three byte UTF8 unicode character.
31613185 step' gst (st, Four c0 c1 c2) = do
@@ -3163,13 +3187,24 @@ decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)
31633187 return $
31643188 case r of
31653189 Yield c3 s
3166− | not (validate4 c0 c1 c2 c3) -> error "Invalid Sequence"
3167− | otherwise -> Skip (s, YieldPoint $ chr4 c0 c1 c2 c3)
3190+ | not (validate4 c0 c1 c2 c3) ->
3191+ transliterateOrError "Invalid Sequence" s
3192+ | otherwise -> Skip (s, YieldAndContinue $ chr4 c0 c1 c2 c3)
31683193 Skip s -> Skip (s, Four c0 c1 c2)
3169− Stop -> error "Input Underflow"
3194+ Stop -> inputUnderflow st
31703195
31713196 -- This way so that we only need one Yield.
3172− step' _ (s, YieldPoint c) = return $ Yield c (s, FreshPoint)
3197+ step' _ (s, YieldAndStop c) = return $ Yield c (s, Done)
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
31733208
31743209data YieldMany x = None
31753210 | YieldMany !x