@@ -227,6 +227,10 @@ decode1 table state codep byte =
227227-- * A starter was encountered without completing a codepoint
228228-- * The last codepoint was not complete (input underflow)
229229--
230+-- Need to separate resumable and non-resumable error. In case of non-resumable
231+-- error we can also provide the failing byte. In case of resumable error the
232+-- state can be opaque.
233+--
230234data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
231235
232236data FreshPoint s a
@@ -237,26 +241,37 @@ data FreshPoint s a
237241 | YieldAndContinue a (FreshPoint s a)
238242 | Done
239243
240−-- XXX Add proper error messages
241−-- XXX Implement this in terms of decodeUtf8Either
244+-- XXX write it as a parser and use parseMany to decode a stream, need to check
245+-- if that preserves the same performance. Or we can use a resumable parser
246+-- that parses a chunk at a time.
247+--
248+-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
249+-- decodeUtf8Either preserves the performance characterstics.
250+--
242251{-# INLINE_NORMAL decodeUtf8WithD #-}
243−decodeUtf8WithD :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
252+decodeUtf8WithD :: Monad m
253+ => CodingFailureMode -> Stream m Word8 -> Stream m Char
244254decodeUtf8WithD cfm (Stream step state) =
245255 let A.Array p _ = utf8d
246256 !ptr = unsafeForeignPtrToPtr p
247257 in Stream (step' ptr) (FreshPointDecodeInit state)
248− where
249− {-# INLINE transliterateOrError #-}
250− transliterateOrError e s =
258+
259+ where
260+
261+ prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
262+
263+ {-# INLINE handleError #-}
264+ handleError e s =
251265 case cfm of
252266 ErrorOnCodingFailure -> error e
253267 TransliterateCodingFailure -> YieldAndContinue replacementChar s
254− {-# INLINE inputUnderflow #-}
255− inputUnderflow =
268+
269+ {-# INLINE handleUnderflow #-}
270+ handleUnderflow =
256271 case cfm of
257− ErrorOnCodingFailure ->
258− error "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Input Underflow"
272+ ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
259273 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
274+
260275 {-# INLINE_LATE step' #-}
261276 step' _ gst (FreshPointDecodeInit st) = do
262277 r <- step (adaptState gst) st
@@ -287,32 +302,34 @@ decodeUtf8WithD cfm (Stream step state) =
287302 return $
288303 case sv of
289304 12 ->
290− Skip $
291− transliterateOrError
292− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
293− (FreshPointDecodeInit st)
305+ let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
306+ in Skip $ handleError msg (FreshPointDecodeInit st)
294307 0 -> error "unreachable state"
295308 _ -> Skip (FreshPointDecoding st sv cp)
296309
297− -- We recover by trying the new byte x a starter of a new codepoint.
310+ -- We recover by trying the new byte x as a starter of a new codepoint.
298311 -- XXX need to use the same recovery in array decoding routine as well
299312 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
300313 r <- step (adaptState gst) st
301314 case r of
302315 Yield x s -> do
303316 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
304− return $
305− case sv of
306− 0 -> Skip $ YieldAndContinue (unsafeChr cp)
307− (FreshPointDecodeInit s)
308− 12 ->
309− Skip $
310− transliterateOrError
311− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
312− (FreshPointDecodeInit1 s x)
313− _ -> Skip (FreshPointDecoding s sv cp)
314− Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
315− Stop -> return $ Skip inputUnderflow
317+ return $ case sv of
318+ 0 -> Skip $ YieldAndContinue
319+ (unsafeChr cp) (FreshPointDecodeInit s)
320+ 12 ->
321+ let msg = prefix
322+ ++ "Invalid subsequent UTF8 byte "
323+ ++ show x
324+ ++ " in state "
325+ ++ show statePtr
326+ ++ " accumulated value "
327+ ++ show codepointPtr
328+ in Skip $ handleError msg (FreshPointDecodeInit1 s x)
329+ _ -> Skip (FreshPointDecoding s sv cp)
330+ Skip s -> return $
331+ Skip (FreshPointDecoding s statePtr codepointPtr)
332+ Stop -> return $ Skip handleUnderflow
316333
317334 step' _ _ (YieldAndContinue c s) = return $ Yield c s
318335 step' _ _ Done = return Stop
@@ -377,6 +394,7 @@ resumeDecodeUtf8EitherD dst codep (Stream step state) =
377394 _ -> Skip (FreshPointDecoding st sv cp)
378395
379396 -- We recover by trying the new byte x a starter of a new codepoint.
397+ -- XXX on error need to report the next byte "x" as well.
380398 -- XXX need to use the same recovery in array decoding routine as well
381399 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
382400 r <- step (adaptState gst) st