@@ -81,7 +81,7 @@ where
8181
8282#include "inline.hs"
8383
84−import Control.Monad.Catch (MonadThrow, MonadCatch)
84+import Control.Monad.Catch (MonadThrow(..), MonadCatch)
8585import Control.Monad.IO.Class (MonadIO, liftIO)
8686import Data.Bits (shiftR, shiftL, (.|.), (.&.))
8787import Data.Char (chr, ord)
@@ -435,7 +435,7 @@ data UTF8CharDecodeState a
435435
436436{-# INLINE parseCharUtf8WithD #-}
437437parseCharUtf8WithD ::
438− Monad m => CodingFailureMode -> ParserD.Parser m Word8 Char
438+ MonadThrow m => CodingFailureMode -> ParserD.Parser m Word8 Char
439439parseCharUtf8WithD cfm =
440440 let A.Array _ ptr _ = utf8d
441441 in ParserD.Parser (step' ptr) initial extract
@@ -494,7 +494,15 @@ parseCharUtf8WithD cfm =
494494 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
495495
496496 {-# INLINE extract #-}
497− extract _ = error $ prefix ++ "Not enough input"
497+ extract UTF8CharDecodeInit = error $ prefix ++ "Not enough input"
498+ extract (UTF8CharDecoding _ _) =
499+ case cfm of
500+ ErrorOnCodingFailure ->
501+ throwM $ ParserD.ParseError $ prefix ++ "Not enough input"
502+ TransliterateCodingFailure -> return replacementChar
503+ -- XXX We shouldn't error out here. There is no way to represent an
504+ -- empty parser result unless we return a "Maybe" type.
505+ DropOnCodingFailure -> error $ prefix ++ "Not enough input"
498506
499507-- XXX This should ideally accept a "CodingFailureMode" and perform appropriate
500508-- error handling. This isn't possible now as "TransliterateCodingFailure"'s