Text.Pandoc.Class.PandocMonad: report accurate offset in toTextM errors.

The offset in PandocUTF8DecodingError was computed with B.elemIndex,
i.e. the first occurrence of the offending byte *value* anywhere in
the file.  If the same byte occurred earlier as part of a valid
multi-byte sequence, the reported position pointed at valid text.
Scan for the first invalid UTF-8 sequence instead and report its
actual position and byte.

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
John MacFarlane
2026-09-09 19:05:05 +00:00
co-authored by Claude
parent cb749b61e6
commit 1dc9cd7d22
+39 -3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -66,6 +67,7 @@ import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad (when)
import Data.Char (chr, digitToInt, isHexDigit)
import Data.List (intercalate)
import Data.Word (Word8)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds,
posixSecondsToUTCTime)
@@ -494,9 +496,9 @@ toTextM :: PandocMonad m => FilePath -> B.ByteString -> m T.Text
toTextM fp bs =
case TSE.decodeUtf8' . filterCRs . dropBOM $ bs of
Left (TSE.DecodeError _ (Just w)) ->
case B.elemIndex w bs of
Just offset ->
throwError $ PandocUTF8DecodingError (T.pack fp) offset w
case findDecodingError bs of
Just (offset, w') ->
throwError $ PandocUTF8DecodingError (T.pack fp) offset w'
Nothing -> throwError $ PandocUTF8DecodingError (T.pack fp) 0 w
Left e -> throwError $ PandocAppError (tshow e)
Right t -> return t
@@ -511,6 +513,40 @@ toTextM fp bs =
then B.filter (/=13) bs'
else bs'
-- Find the offset and value of the first byte at which UTF-8 decoding
-- fails (RFC 3629). Used to give an accurate position in decoding
-- error messages. (The BOM and CR bytes stripped before decoding are
-- themselves valid UTF-8, so scanning the unstripped input finds the
-- same error, at its offset in the original file.)
findDecodingError :: B.ByteString -> Maybe (Int, Word8)
findDecodingError = go 0
where
go !i bs = case B.uncons bs of
Nothing -> Nothing
Just (w, rest)
| w < 0x80 -> go (i + 1) rest
| w < 0xC2 -> Just (i, w) -- continuation byte or overlong lead
| w == 0xE0 -> cont i w rest [(0xA0,0xBF),(0x80,0xBF)]
| w == 0xED -> cont i w rest [(0x80,0x9F),(0x80,0xBF)] -- no surrogates
| w < 0xE0 -> cont i w rest [(0x80,0xBF)]
| w < 0xF0 -> cont i w rest [(0x80,0xBF),(0x80,0xBF)]
| w == 0xF0 -> cont i w rest [(0x90,0xBF),(0x80,0xBF),(0x80,0xBF)]
| w == 0xF4 -> cont i w rest [(0x80,0x8F),(0x80,0xBF),(0x80,0xBF)]
| w < 0xF4 -> cont i w rest [(0x80,0xBF),(0x80,0xBF),(0x80,0xBF)]
| otherwise -> Just (i, w) -- above U+10FFFF
-- check that the bytes following the lead byte w at offset i fall
-- into the given ranges; report the first byte that does not
cont i w = go' (i + 1)
where
go' !j rest [] = go j rest
go' !j rest ((lo,hi):ranges) =
case B.uncons rest of
Just (b, rest')
| b >= lo && b <= hi -> go' (j + 1) rest' ranges
| otherwise -> Just (j, b)
-- input ends in the middle of a sequence: report the lead byte
Nothing -> Just (i, w)
-- | Returns @fp@ if the file exists in the current directory; otherwise
-- searches for the data file relative to @/subdir/@. Returns @Nothing@
-- if neither file exists.