hpdft 0.4.7.0 → 0.4.7.1

raw patch · 13 files changed

+525/−77 lines, 13 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• README.md +2/−2
• app/Cli/Misc.hs +21/−34
• app/Cli/Parser.hs +2/−1
• app/hpdft.hs +9/−3
• docs/library.md +9/−4
• hpdft.cabal +1/−1
• src/PDF/ContentStream.hs +15/−4
• src/PDF/Diff.hs +267/−19
• src/PDF/Interpret.hs +16/−3
• src/PDF/Layout.hs +38/−4
• src/PDF/Text.hs +21/−1
• test/Unit.hs +106/−1

@@ -1,5 +1,23 @@ # Changelog +## 0.4.7.1 (2026-08-10)++### Fixed++- Geometry/Interpret: after Form XObject `Do`, pop the graphics state from the post-form state so a wrapping page-level `q`…`Q` stays intact; previously CTM reset to identity and later glyphs with negative device Y were dropped.+- Legacy content stream: accept gray/CMYK color operators (`g`/`G`/`k`/`K`) before the generic `c` branch, and accept name-only BDC property lists (e.g. `/OC /MC0 BDC`). Failed parses on newline-sparse streams after embedded Forms no longer skip the rest of the page.+- Geometry layout: treat footnote marks (`†`, `‡`, `※`, `*`, …) as likely superscripts and allow a wider negative inline gap when attaching them, so markers that slightly overlap the previous glyph (e.g. after `）`) stay in reading order.+- Geometry layout: hanging-indent wraps in footnote bodies (CJK continuation after †1 etc.) no longer become blank-line paragraph breaks.+- Geometry layout: large CJK gaps (chapter title to body) again start a new paragraph; soft-wrap suppression only applies within ~2.2× typical leading.+- Diff: consecutive modified paragraphs stay index-aligned (no more "para N vs N-1" cross-wiring).+- Diff: paragraph comparison ignores whitespace by default (spacing noise from extractors is omitted).+- Diff CLI: unified-diff output (`---`/`+++`/`@@`/`-`/`+`) with changed-span focus; ANSI color on TTY (`--color auto|always|never`).+- Diff CLI: consecutive same-page paragraph changes share one hunk (`@@ page N, para … @@`).++### Added++- Working `hpdft diff --legacy` (and `DiffPipeline` / `compareDocumentsWith` / `pageLegacyText`) to compare stream-order text instead of geometry paragraphs.+ ## 0.4.7.0 (2026-07-06)  ### Added

@@ -128,5 +128,5 @@  ## Version -Released: **0.4.6.0** (2026-07-05) — Quick viewer (`hpdft FILE`) with ANSI TUI, legacy streaming, toc fix.-Previous release: **0.4.5.0**.+Released: **0.4.7.1** (2026-08-10) — Form/stream extraction fixes, layout heuristics, and aligned paragraph diff.+Previous release: **0.4.7.0**.

@@ -18,7 +18,7 @@ import PDF.Definition (Obj(..), ppObj, ppDictEntries) import PDF.Document (Document(..), docInfoDict, docRootRef, docTrailer, openDocument) import PDF.DocumentStructure-import PDF.Diff (TextChange(..), compareDocuments)+import PDF.Diff (TextChange(..), DiffPipeline(..), DiffColor(..), compareDocumentsWith, renderUnifiedDiff) import PDF.FormExtract (extractFormToFile, pageFormNames) import PDF.Image (extractPageImagesToDir) import PDF.Layout (LayoutOptions(..), defaultLayoutOptions)@@ -27,7 +27,7 @@ import PDF.PDFIO (getObjectByRef, getStream)  import System.Exit (exitWith, ExitCode(..))-import System.IO (hPutStrLn, putStrLn, stderr)+import System.IO (hIsTerminalDevice, hPutStrLn, putStr, putStrLn, stderr, stdout)  import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T@@ -67,47 +67,34 @@           putStrLn path  runDiff :: DiffOpt -> IO ()-runDiff DiffOpt{doRuby=rb, doJson=json, doPassword=pw, doFileA=fa, doFileB=fb} =+runDiff DiffOpt{doLegacy=legacy, doRuby=rb, doJson=json, doColor=colorWhen,+                doPassword=pw, doFileA=fa, doFileB=fb} =   withFile fa $   withFile fb $   let mpw = maybePassword pw-      lopts = defaultLayoutOptions {optRuby = rb}+      pipeline =+        if legacy+        then DiffLegacy+        else DiffGeom defaultLayoutOptions {optRuby = rb}   in do     docA <- runOrDie (openDocument fa mpw)     docB <- runOrDie (openDocument fb mpw)-    changes <- runOrDie (return (compareDocuments lopts docA docB))+    changes <- runOrDie (return (compareDocumentsWith pipeline docA docB))     if json       then putStrLn (renderDiffJson changes)-      else mapM_ putStrLn (renderDiffHuman changes)+      else do+        color <- resolveDiffColor colorWhen+        putStr (renderUnifiedDiff color fa fb changes) -renderDiffHuman :: [TextChange] -> [String]-renderDiffHuman = map renderOne-  where-    renderOne (PageCountMismatch pa pb) =-      "page count mismatch: " ++ show pa ++ " vs " ++ show pb-    renderOne TextChange{changePageA = pa, changePageB = pb,-                         changeParaA = pxa, changeParaB = pxb,-                         changeOld = old, changeNew = new} =-      unlines-        ( pageLine-        : paraLine-        : ("- old: " ++ T.unpack old) : ("+ new: " ++ T.unpack new) : []-        )-      where-        pageLine =-          case (pa, pb) of-            (Just a, Just b) | a == b -> "page " ++ show a ++ ":"-            (Just a, Just b) -> "page " ++ show a ++ " vs " ++ show b ++ ":"-            (Just a, Nothing) -> "page " ++ show a ++ " (only in first file):"-            (Nothing, Just b) -> "page " ++ show b ++ " (only in second file):"-            _ -> "page ?:"-        paraLine =-          case (pxa, pxb) of-            (Just a, Just b) | a == b -> "para " ++ show (a + 1) ++ ":"-            (Just a, Just b) -> "para " ++ show (a + 1) ++ " vs " ++ show (b + 1) ++ ":"-            (Just a, Nothing) -> "para " ++ show (a + 1) ++ ":"-            (Nothing, Just b) -> "para " ++ show (b + 1) ++ ":"-            _ -> "para ?:"+resolveDiffColor :: String -> IO DiffColor+resolveDiffColor "always" = return DiffColorAnsi+resolveDiffColor "never"  = return DiffColorOff+resolveDiffColor "auto"   = do+  tty <- hIsTerminalDevice stdout+  return (if tty then DiffColorAnsi else DiffColorOff)+resolveDiffColor other = do+  hPutStrLn stderr ("hpdft: unknown --color " ++ show other ++ " (use auto, always, never)")+  exitWith (ExitFailure 1)  renderDiffJson :: [TextChange] -> String renderDiffJson changes = "[" ++ intercalate "," (map encodeChange changes) ++ "]"

@@ -49,9 +49,10 @@   }  data DiffOpt = DiffOpt-  { doGeom      :: Bool+  { doLegacy    :: Bool   , doRuby      :: Bool   , doJson      :: Bool+  , doColor     :: String   , doPassword  :: String   , doFileA     :: FilePath   , doFileB     :: FilePath

@@ -202,14 +202,20 @@ diffOpts :: Parser DiffOpt diffOpts = DiffOpt   <$> switch-      ( long "geom"-        <> help "Use geometry-based layout (default for diff)" )+      ( long "legacy"+        <> help "Compare using legacy stream-order text (blank-line paragraph splits)" )   <*> switch       ( long "ruby"-        <> help "Embed ruby in Aozora bunko notation during layout" )+        <> help "Embed ruby in Aozora bunko notation (geometry pipeline only)" )   <*> switch       ( long "json"         <> help "Emit JSON instead of human-readable diff" )+  <*> strOption+      ( long "color"+        <> metavar "WHEN"+        <> value "auto"+        <> showDefault+        <> help "Colorize unified diff: auto (TTY only), always, never" )   <*> passwordOpt   <*> strArgument       ( help "first PDF file"

@@ -130,18 +130,23 @@  ## Document diff -`PDF.Diff.compareDocuments` aligns pages by number and diffs paragraph text:+`PDF.Diff.compareDocuments` (geometry paragraphs) and `compareDocumentsWith` (geometry or legacy) align pages by number and diff paragraph-sized text:  ```haskell-import PDF.Diff (compareDocuments, TextChange(..))+import PDF.Diff (compareDocuments, compareDocumentsWith, DiffPipeline(..), TextChange(..)) import PDF.Layout (defaultLayoutOptions)  changes <- compareDocuments defaultLayoutOptions docA docB+legacy  <- compareDocumentsWith DiffLegacy docA docB ``` -Each `TextChange` records old/new paragraph text and optional page/paragraph indices. A `PageCountMismatch` entry appears when page counts differ.+Geometry mode uses `pageParagraphs`. Legacy mode uses stream-order page text split on blank lines (`legacyTextParagraphs`). -CLI equivalent: `hpdft diff FILE_A FILE_B`.+Each `TextChange` records old/new paragraph text and optional page/paragraph indices. A `PageCountMismatch` entry appears when page counts differ. Equality ignores whitespace (spacing noise from extractors); reported text keeps the original spacing.++CLI: `hpdft diff FILE_A FILE_B` (geometry, default). `hpdft diff --legacy FILE_A FILE_B` for legacy stream-order text.++Human output is unified-diff shaped (`---` / `+++` / `@@` / `-` / `+`) so editors highlight `.diff` files; long unchanged sides are elided around the changed span. Consecutive changes on the same page share one hunk (`@@ page N, para 6, 8-11 @@`), with all `-` lines before all `+` lines. ANSI colors apply only on a TTY by default (`--color auto|always|never`).  ## Image extraction 

@@ -1,6 +1,6 @@ cabal-version:       3.8 name:                hpdft-version:             0.4.7.0+version:             0.4.7.1 synopsis:            PDF parsing library and CLI for text, layout, diff, images, and forms description:     hpdft is a Haskell library and command-line tool for parsing PDF files.

@@ -120,6 +120,9 @@          , try $ T.empty <$ oneOf "nsS" <* spaces          , try $ T.empty <$ (digitParam <* spaces) <* oneOf "jJM" <* space <* spaces          , try $ T.empty <$ (digitParam <* spaces) <* oneOf "dwi" <* spaces+         -- Gray / CMYK fill-stroke (must precede the generic "c" branch).+         , try $ T.empty <$ (digitParam <* spaces) <* oneOf "gG" <* spaces+         , try $ T.empty <$ (count 4 (digitParam <* spaces) *> oneOf "kK" <* spaces)          , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "ml" <* space <* spaces)          , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "vy" <* space <* spaces)          , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "re" <* spaces)@@ -204,15 +207,23 @@   string "BDC"   spaces   case tag of-    "/Span" +    "/Span"       | "/ActualText" == (fst prop)+        -- Replace marked content with ActualText; discard operators until EMC.         -> do {spaces >> manyTill (elems formRunner) (try $ string "EMC") >> return (snd prop)}-      | otherwise  -> return $ T.empty-    _ -> return $ T.empty+      | otherwise -> return T.empty+    -- Other BDC markers (e.g. /P, /OC /MC0): leave body to the outer elems loop.+    _ -> return T.empty    where+    -- Property list is either a dict or a name (Properties resource lookup).     propertyList :: PSParser (T.Text, T.Text)-    propertyList = spaces >> try dictionary+    propertyList = spaces >> (try dictionary <|> nameOnly)++    nameOnly :: PSParser (T.Text, T.Text)+    nameOnly = do+      n <- name+      return (n, T.empty)      dictionary :: PSParser (T.Text, T.Text)     dictionary = do

@@ -7,7 +7,8 @@  Compare two opened documents page by page using the same paragraph layout as 'PDF.Page.pageParagraphs'. Emits 'TextChange' records (and optionally a-'PageCountMismatch' when page counts differ).+'PageCountMismatch' when page counts differ). Paragraph equality ignores+whitespace by default.  @example import PDF.Diff (compareDocuments)@@ -17,16 +18,24 @@ -} module PDF.Diff   ( TextChange(..)+  , DiffPipeline(..)+  , DiffColor(..)   , compareDocuments+  , compareDocumentsWith   , diffParagraphs+  , legacyTextParagraphs+  , alignChangeSpans+  , renderUnifiedDiff   ) where  import PDF.Document (Document) import PDF.Error (PdfResult) import PDF.Layout (LayoutOptions) import PDF.Page (pageCount, pageRefAt, pageParagraphs)+import PDF.Text (pageLegacyText)  import Data.Char (isSpace)+import Data.List (intercalate, nub, sort, sortOn) import qualified Data.Text as T  data TextChange@@ -44,32 +53,52 @@     }   deriving (Eq, Show) --- | Paragraph-level diff across two documents (aligned by 1-based page number).+data DiffPipeline+  = DiffGeom !LayoutOptions+  | DiffLegacy++-- | Whether human-readable unified diff should include ANSI colors.+data DiffColor+  = DiffColorOff+  | DiffColorAnsi+  deriving (Eq, Show)++-- | Paragraph-level diff using geometry layout (default). compareDocuments :: LayoutOptions -> Document -> Document -> PdfResult [TextChange]-compareDocuments opts docA docB = do+compareDocuments opts = compareDocumentsWith (DiffGeom opts)++-- | Paragraph-level diff; pipeline selects geometry vs legacy stream-order text.+compareDocumentsWith :: DiffPipeline -> Document -> Document -> PdfResult [TextChange]+compareDocumentsWith pipeline docA docB = do   nA <- pageCount docA   nB <- pageCount docB   let countChange =         if nA /= nB           then [PageCountMismatch {pagesA = nA, pagesB = nB}]           else []-  aligned <- mapM (diffPagePair opts docA docB) [1 .. min nA nB]-  extraA <- mapM (onlyInA opts docA) [min nA nB + 1 .. nA]-  extraB <- mapM (onlyInB opts docB) [min nA nB + 1 .. nB]+  aligned <- mapM (diffPagePair pipeline docA docB) [1 .. min nA nB]+  extraA <- mapM (onlyInA pipeline docA) [min nA nB + 1 .. nA]+  extraB <- mapM (onlyInB pipeline docB) [min nA nB + 1 .. nB]   return (countChange ++ concat aligned ++ concat extraA ++ concat extraB) -diffPagePair :: LayoutOptions -> Document -> Document -> Int -> PdfResult [TextChange]-diffPagePair opts docA docB page = do+diffPagePair :: DiffPipeline -> Document -> Document -> Int -> PdfResult [TextChange]+diffPagePair pipeline docA docB page = do   refA <- pageRefAt docA page   refB <- pageRefAt docB page-  parasA <- pageParagraphs docA refA opts-  parasB <- pageParagraphs docB refB opts+  parasA <- pageParagraphsFor pipeline docA refA+  parasB <- pageParagraphsFor pipeline docB refB   return (diffParagraphsOnPage page parasA parasB) -onlyInA :: LayoutOptions -> Document -> Int -> PdfResult [TextChange]-onlyInA opts doc page = do+pageParagraphsFor :: DiffPipeline -> Document -> Int -> PdfResult [T.Text]+pageParagraphsFor (DiffGeom opts) doc ref = pageParagraphs doc ref opts+pageParagraphsFor DiffLegacy doc ref = do+  txt <- pageLegacyText doc ref+  return (legacyTextParagraphs txt)++onlyInA :: DiffPipeline -> Document -> Int -> PdfResult [TextChange]+onlyInA pipeline doc page = do   ref <- pageRefAt doc page-  paras <- pageParagraphs doc ref opts+  paras <- pageParagraphsFor pipeline doc ref   return     [ TextChange         { changePageA = Just page@@ -82,10 +111,10 @@     | (idx, txt) <- zip [0 ..] paras     ] -onlyInB :: LayoutOptions -> Document -> Int -> PdfResult [TextChange]-onlyInB opts doc page = do+onlyInB :: DiffPipeline -> Document -> Int -> PdfResult [TextChange]+onlyInB pipeline doc page = do   ref <- pageRefAt doc page-  paras <- pageParagraphs doc ref opts+  paras <- pageParagraphsFor pipeline doc ref   return     [ TextChange         { changePageA = Nothing@@ -98,6 +127,14 @@     | (idx, txt) <- zip [0 ..] paras     ] +-- | Split legacy page text into paragraph-sized units (blank-line separated).+legacyTextParagraphs :: T.Text -> [T.Text]+legacyTextParagraphs t =+  let chunks = filter (not . T.null) $ map collapseParaWS $ T.splitOn "\n\n" t+  in if null chunks && not (T.null (collapseParaWS t))+     then [collapseParaWS t]+     else chunks+ diffParagraphsOnPage :: Int -> [T.Text] -> [T.Text] -> [TextChange] diffParagraphsOnPage page parasA parasB =   map attachPage (diffParagraphs parasA parasB)@@ -107,9 +144,13 @@     attachPage other = other  -- | Paragraph LCS diff without page numbers (for unit tests).+--+-- When consecutive paragraphs both change, prefer a paired replace over+-- independent delete+insert. Otherwise LCS + adjacent merge can cross-wire+-- neighbors (e.g. old para N vs new para N-1). diffParagraphs :: [T.Text] -> [T.Text] -> [TextChange] diffParagraphs parasA parasB =-  mergeReplaceChanges $ go (length normA) (length normB) []+  sortChanges $ mergeReplaceChanges $ go (length normA) (length normB) []   where     normA = map normalizePara parasA     normB = map normalizePara parasB@@ -121,7 +162,13 @@     go i j acc       | i > 0 && j > 0 && normA !! (i - 1) == normB !! (j - 1) =           go (i - 1) (j - 1) acc-      | j > 0 && (i == 0 || tableAt (i - 1) j <= tableAt i (j - 1)) =+      | i > 0 && j > 0 && preferReplace i j =+          go (i - 1) (j - 1)+            ( TextChange Nothing Nothing (Just (i - 1)) (Just (j - 1))+                (parasA !! (i - 1)) (parasB !! (j - 1))+                : acc+            )+      | j > 0 && (i == 0 || tableAt (i - 1) j < tableAt i (j - 1)) =           go i (j - 1)             ( TextChange Nothing Nothing Nothing (Just (j - 1)) T.empty (parasB !! (j - 1))                 : acc@@ -133,6 +180,18 @@             )       | otherwise = reverse acc +    -- Substitution keeps the remaining LCS; pure insert or delete would not improve it.+    preferReplace i j =+      let diag = tableAt (i - 1) (j - 1)+      in diag >= tableAt (i - 1) j && diag >= tableAt i (j - 1)++sortChanges :: [TextChange] -> [TextChange]+sortChanges =+  sortOn+    (\c -> case c of+       TextChange{changeParaA = pa, changeParaB = pb} -> (pa, pb)+       PageCountMismatch{} -> (Nothing, Nothing))+ mergeReplaceChanges :: [TextChange] -> [TextChange] mergeReplaceChanges [] = [] mergeReplaceChanges (c : d : rest)@@ -158,8 +217,15 @@   T.null old && not (T.null new) isAddition _ = False +-- | Comparison key for a paragraph. Whitespace is ignored: PDF extractors+-- often disagree on Latin/CJK spacing while the visible text is the same.+-- Display text in 'TextChange' stays as extracted. normalizePara :: T.Text -> T.Text-normalizePara = collapseInternalWS . T.strip+normalizePara = T.filter (not . isSpace)++-- | Soft-normalize legacy paragraph chunks for display (strip + collapse runs).+collapseParaWS :: T.Text -> T.Text+collapseParaWS = collapseInternalWS . T.strip   where     collapseInternalWS t =       T.pack $ go False (T.unpack t)@@ -182,3 +248,185 @@       tableAt i j = table !! (i * (n + 1) + j)       table = [row i j | i <- [0 .. m], j <- [0 .. n]]    in table++-- | Shared prefix / differing middles / shared suffix for two paragraph texts.+-- Newlines are flattened to spaces so each change stays one unified-diff line.+alignChangeSpans :: T.Text -> T.Text -> (T.Text, T.Text, T.Text, T.Text)+alignChangeSpans old0 new0 =+  let old = flattenOneLine old0+      new = flattenOneLine new0+      (pre, oldRest, newRest) = splitCommonPrefix old new+      (suf, oldMid, newMid) = splitCommonSuffix oldRest newRest+  in (pre, oldMid, newMid, suf)++flattenOneLine :: T.Text -> T.Text+flattenOneLine = T.map (\c -> if c == '\n' || c == '\r' then ' ' else c)++splitCommonPrefix :: T.Text -> T.Text -> (T.Text, T.Text, T.Text)+splitCommonPrefix a b =+  let n = length (takeWhile id (zipWith (==) (T.unpack a) (T.unpack b)))+  in (T.take n a, T.drop n a, T.drop n b)++splitCommonSuffix :: T.Text -> T.Text -> (T.Text, T.Text, T.Text)+splitCommonSuffix a b =+  let ra = T.reverse a+      rb = T.reverse b+      n = length (takeWhile id (zipWith (==) (T.unpack ra) (T.unpack rb)))+  in (T.takeEnd n a, T.dropEnd n a, T.dropEnd n b)++-- | Context characters kept on each side of the changed span; longer common+-- sides are elided with an ellipsis so editor -/+ lines stay scannable.+spanContextChars :: Int+spanContextChars = 12++trimSpanContext :: T.Text -> T.Text -> (T.Text, T.Text)+trimSpanContext pre suf =+  ( trimPre pre+  , trimSuf suf+  )+  where+    trimPre t+      | T.length t <= spanContextChars = t+      | otherwise = T.cons '\x2026' (T.takeEnd spanContextChars t)+    trimSuf t+      | T.length t <= spanContextChars = t+      | otherwise = T.take spanContextChars t `T.append` T.singleton '\x2026'++-- | Unified-diff style rendering for CLI / @.diff@ files.+--+-- Structure uses @---@ / @+++@ / @\@\@@ / @-@ / @+@ so editor syntax+-- highlighters treat it as a diff. Consecutive paragraph changes on the+-- same page are merged into one hunk; within a hunk all deletions come+-- before all additions (classic multi-line replace), not interleaved+-- per paragraph. With 'DiffColorAnsi', only the changed span inside each+-- line is colored (TTY); redirected files should use 'DiffColorOff'.+renderUnifiedDiff :: DiffColor -> FilePath -> FilePath -> [TextChange] -> String+renderUnifiedDiff _ _ _ [] = ""+renderUnifiedDiff color fileA fileB changes =+  intercalate "\n" (headerLines ++ concatMap (renderHunk color) (groupDiffHunks changes)) ++ "\n"+  where+    headerLines =+      [ paint color meta ("--- " ++ fileA)+      , paint color meta ("+++ " ++ fileB)+      ]++-- | Merge consecutive same-page 'TextChange's into one hunk.+groupDiffHunks :: [TextChange] -> [[TextChange]]+groupDiffHunks [] = []+groupDiffHunks (c@(PageCountMismatch{}) : rest) =+  [c] : groupDiffHunks rest+groupDiffHunks (c@TextChange{} : rest) =+  let (peers, rest') = span (sameHunkPage c) rest+  in (c : peers) : groupDiffHunks rest'++sameHunkPage :: TextChange -> TextChange -> Bool+sameHunkPage TextChange{changePageA = pa, changePageB = pb}+             TextChange{changePageA = pa', changePageB = pb'} =+  pa == pa' && pb == pb'+sameHunkPage _ _ = False++renderHunk :: DiffColor -> [TextChange] -> [String]+renderHunk color [PageCountMismatch pa pb] =+  [ paint color hunk "@@ page count @@"+  , paintDel color (show pa ++ " pages")+  , paintAdd color (show pb ++ " pages")+  ]+renderHunk _ (PageCountMismatch{} : _) =+  -- PageCountMismatch is always alone; defensive fallback.+  []+renderHunk color cs@(TextChange{changePageA = pa, changePageB = pb} : _) =+  let bodies = map (changeLines color) cs+      dels = concatMap fst bodies+      adds = concatMap snd bodies+  in paint color hunk ("@@ " ++ hunkLocation pa pb cs ++ " @@")+       : (dels ++ adds)+renderHunk _ _ = []++-- | @('-' lines, '+' lines)@ for one paragraph change.+changeLines :: DiffColor -> TextChange -> ([String], [String])+changeLines _ PageCountMismatch{} = ([], [])+changeLines color TextChange{changeOld = old, changeNew = new}+  | T.null old = ([], [paintAdd color (T.unpack (flattenOneLine new))])+  | T.null new = ([paintDel color (T.unpack (flattenOneLine old))], [])+  | otherwise =+      let (pre0, oldMid, newMid, suf0) = alignChangeSpans old new+          (pre, suf) = trimSpanContext pre0 suf0+      in ( [paintSpan color '-' pre oldMid suf]+         , [paintSpan color '+' pre newMid suf]+         )++hunkLocation :: Maybe Int -> Maybe Int -> [TextChange] -> String+hunkLocation pa pb cs =+  case (pa, pb) of+    (Just a, Just b) | a == b ->+      "page " ++ show a ++ ", " ++ paraLabel+    (Just a, Just b) ->+      "page " ++ show a ++ " vs " ++ show b ++ ", " ++ paraLabel+    (Just a, Nothing) ->+      "page " ++ show a ++ " (only in first), " ++ paraLabel+    (Nothing, Just b) ->+      "page " ++ show b ++ " (only in second), " ++ paraLabel+    _ -> paraLabel+  where+    paraLabel = formatParaRefs [ (pxa, pxb) | TextChange{changeParaA = pxa, changeParaB = pxb} <- cs ]++-- | Compact 1-based paragraph references: @para 6@, @para 6-9@, @para 6, 8-11@.+formatParaRefs :: [(Maybe Int, Maybe Int)] -> String+formatParaRefs refs =+  case collect of+    [] -> "para ?"+    xs -> "para " ++ intercalate ", " (map formatRun (groupRuns xs))+  where+    collect = sort $ nub [ n | (ma, mb) <- refs, n <- maybePara ma mb ]+    maybePara (Just a) (Just b)+      | a == b = [a + 1]+      | otherwise = [a + 1, b + 1]+    maybePara (Just a) Nothing = [a + 1]+    maybePara Nothing (Just b) = [b + 1]+    maybePara _ _ = []++    groupRuns [] = []+    groupRuns (x : xs) = go [x] xs+      where+        go run [] = [reverse run]+        go run@(r : _) (y : ys)+          | y == r + 1 = go (y : run) ys+          | otherwise = reverse run : go [y] ys+        go _ _ = []++    formatRun [a] = show a+    formatRun (a : rest) = show a ++ "-" ++ show (last (a : rest))+    formatRun [] = "?"++paintSpan :: DiffColor -> Char -> T.Text -> T.Text -> T.Text -> String+paintSpan DiffColorOff mark pre mid suf =+  mark : T.unpack (pre `T.append` mid `T.append` suf)+paintSpan DiffColorAnsi mark pre mid suf =+  let midColor = if mark == '-' then red else green+  in mark+       : dim (T.unpack pre)+      ++ midColor (T.unpack mid)+      ++ dim (T.unpack suf)+      ++ reset++paintDel :: DiffColor -> String -> String+paintDel DiffColorOff s = '-' : s+paintDel DiffColorAnsi s = '-' : red s ++ reset++paintAdd :: DiffColor -> String -> String+paintAdd DiffColorOff s = '+' : s+paintAdd DiffColorAnsi s = '+' : green s ++ reset++paint :: DiffColor -> (String -> String) -> String -> String+paint DiffColorOff _ s = s+paint DiffColorAnsi style s = style s ++ reset++meta, hunk, red, green, dim :: String -> String+meta s = "\ESC[1m" ++ s+hunk s = "\ESC[36m" ++ s+red s = "\ESC[31m" ++ s+green s = "\ESC[32m" ++ s+dim s = "\ESC[2m" ++ s++reset :: String+reset = "\ESC[0m"

@@ -365,8 +365,14 @@     _ -> st execOp "Do" st =   case operandStack st of-    PdfName name : _ -> invokeXObjectSt name st+    PdfName name : rest -> invokeXObjectSt name (st {operandStack = rest})     _ -> st+execOp "g" st = popColorSt 1 st+execOp "G" st = popColorSt 1 st+execOp "rg" st = popColorSt 3 st+execOp "RG" st = popColorSt 3 st+execOp "k" st = popColorSt 4 st+execOp "K" st = popColorSt 4 st execOp "m" st =   case popNums 2 st of     Just ([y, x], st') -> st' {pathAcc = [devicePoint st' x y]}@@ -521,6 +527,9 @@     Just ([v], st') -> modifyGStateSt (f v) st'     _ -> st +popColorSt :: Int -> IState -> IState+popColorSt n st = maybe st snd (popNums n st)+ popNums :: Int -> IState -> Maybe ([Double], IState) popNums n st = go n (operandStack st) []   where@@ -676,7 +685,6 @@             , glyphMCID = currentMCID st             }       in st {itemsRev = ItemGlyph glyph : itemsRev st, tsCur = Just ts {tmMat = endTm}}-    _ -> st  glyphStep :: GState -> FontInfo -> (T.Text, Matrix) -> Int -> (T.Text, Matrix) glyphStep gs fi (txt, tm) code =@@ -835,16 +843,21 @@                 Right stream ->                   let formMat = formMatrix d                       formRes = fromMaybe (isRes st0) (findResourcesDict d (isObjs st0))+                      -- Isolate the form: push, run, then pop *this* frame from the+                      -- post-run state. Popping from st0 (pre-Do) would discard a+                      -- page-level q that wrapped the Do and leave CTM as identity.                       stPush = pushGStateSt st0                       stMat = modifyGStateSt (\gs -> gs {ctm = multiply formMat (ctm gs)}) stPush                       stRun = stMat {isRes = formRes, depth = depth st0 + 1, operandStack = []}                       stDone = runStream stRun stream-                      stPop = popGStateSt st0+                      stPop = popGStateSt stDone                   in stPop                        { itemsRev = itemsRev stDone                        , imagesRev = imagesRev stDone                        , depth = depth st0                        , isRes = isRes st0+                       , operandStack = operandStack st0+                       , mcStack = mcStack st0                        }                 Left _ -> st0             Just (PdfName "/Image") ->

@@ -864,6 +864,24 @@   , lineLastSuper   :: !Bool   } deriving (Show) ++-- | Leading character looks like a common footnote / reference mark.+superscriptMarkGlyph :: Glyph -> Bool+superscriptMarkGlyph g =+  case T.uncons (glyphText g) of+    Just (c, _) -> isSuperscriptMarkChar c+    Nothing -> False++isSuperscriptMarkChar :: Char -> Bool+isSuperscriptMarkChar c =+  c == '†'  -- dagger+  || c == '‡'  -- double dagger+  || c == '※'  -- reference mark+  || c == '*'+  || c == '＊'  -- fullwidth asterisk+  || c == '⁑'  -- two asterisks+  || c == '⁂'  -- asterism+ buildLines :: [Glyph] -> [Line] buildLines = reverse . foldl' go []   where@@ -877,7 +895,11 @@       where         d = baselineOf (lineWMode l) g - lineBaseline l         gap = inlineStartOf (lineWMode l) g - lineInlineEnd l-        inlineCont refSize = gap >= -0.5 * refSize && gap <= 2.0 * refSize+        -- Footnote marks (†‡※…) are usually superscripts and often overlap+        -- the previous glyph's advance box; allow a wider negative gap for them.+        inlineCont refSize =+          let lo = if superscriptMarkGlyph g then -1.0 * refSize else -0.5 * refSize+          in gap >= lo && gap <= 2.0 * refSize         superAttach =           glyphSize g <= 0.92 * lineSize l           && glyphSize g >= 0.5 * lineSize l@@ -1155,10 +1177,22 @@   || afterListHeadingBreak wmode prev cur gaps   || sameHangListItemBreak wmode prev cur gaps   || codeBlockBreak prev cur-  || (gapBreak && not (cjkWrapContinuation prev cur))-  || indentBreak paraMinInline cur+  || (gapBreak && not (cjkSoftWrap wmode prev cur gaps))+  -- Horizontal hanging wraps (footnote body under †1, etc.) must not+  -- become paragraph breaks. Keep indentBreak for vertical columns,+  -- which also look like CJK continuation across column starts.+  || (indentBreak paraMinInline cur+      && not (wmode == 0 && cjkWrapContinuation prev cur))   || (graphicBreak wmode graphics pageBounds prev cur-      && not (cjkWrapContinuation prev cur))+      && not (cjkSoftWrap wmode prev cur gaps))++-- | CJK line wrap that should stay in one paragraph. Large gaps (heading+-- to body) still break even when the boundary characters are CJK.+cjkSoftWrap :: Int -> Line -> Line -> [Double] -> Bool+cjkSoftWrap wmode prev cur gaps =+  cjkWrapContinuation prev cur+  && abs (baselineGap wmode prev cur)+       <= 2.2 * typicalLeading gaps (max (lineSize prev) (lineSize cur))  cjkWrapContinuation :: Line -> Line -> Bool cjkWrapContinuation prev cur =

@@ -47,11 +47,17 @@   , pdfToTextTaggedDocWith   , pageTextGeom   , pageTextGeomWith+  , pageLegacyText   , pdfToTextStreamDoc   ) where  import PDF.Definition-import PDF.Error (PdfResult, PdfWarning(..), renderPdfError)+import PDF.Error+  ( PdfResult+  , PdfWarning(..)+  , renderPdfError+  , PdfError(MissingKey, MissingObject)+  ) import PDF.Document (Document(..), openDocument, docRootRef) import PDF.DocumentStructure import PDF.Encrypt (Security)@@ -205,6 +211,20 @@ pageTextGeomWith opts doc pageRef = do   items <- interpretPageItems doc pageRef   return $ BSLU.fromString (T.unpack (layoutPageTextWith opts items))++-- | Legacy stream-order text for a single page (object reference number).+pageLegacyText :: Document -> Int -> PdfResult T.Text+pageLegacyText doc ref =+  let sec = docSecurity doc+      objs = docObjs doc+  in case findObjsByRef ref objs of+    Just os -> case findDictOfType "/Page" os of+      Just dict ->+        let (bs, _) = pageContent ref dict initstate sec objs+        in Right (T.pack (BSLU.toString bs))+      Nothing ->+        Left (MissingKey "/Page" ("object " ++ show ref ++ " is not a page"))+    Nothing -> Left (MissingObject ref)  pdfToTextTaggedBS :: FilePath -> Maybe String -> IO (PdfResult BSL.ByteString) pdfToTextTaggedBS = pdfToTextTaggedBSWith defaultLayoutOptions

@@ -11,7 +11,7 @@ import PDF.Structure (StructElem(..), StructKid(..), structTree, logicalOrder) import PDF.Document (Document(..), openDocument) import PDF.Page (pageCount, pageRefAt, pageParagraphs)-import PDF.Diff (TextChange(..), compareDocuments, diffParagraphs)+import PDF.Diff (TextChange(..), DiffPipeline(..), DiffColor(..), compareDocuments, compareDocumentsWith, diffParagraphs, legacyTextParagraphs, alignChangeSpans, renderUnifiedDiff) import PDF.DocumentStructure (parseCIDWidths, simpleWidthAt, decodeStreamBytes) import PDF.Character (jisx0208Map) import PDF.Image@@ -442,6 +442,10 @@         , ItemGlyph (mkGlyph 70 372 8 8 0 "\x3067")         , ItemGlyph (mkGlyph 78 372 8 8 0 "\x898b")         ]+      headingBodySplit = layoutParagraphs+        [ ItemGlyph (mkGlyph 120 456 120 18 0 "言語入門")+        , ItemGlyph (mkGlyph 58 370 80 8 0 "本書では、")+        ]       dingbatBullet = layoutPageText         [ ItemGlyph (mkGlyph 60 434 0 9 0 "r")         , ItemGlyph (mkGlyph 66 431 0 8 0 "HTTP")@@ -493,6 +497,10 @@       , assertBool "layout CJK wrap keeps one paragraph" (length cjkWrapSplit == 1)       , assertTextEq "layout CJK wrap joined text"           (T.pack "\x8a18\x6cd5\x3067\x898b") (head cjkWrapSplit)+      , assertBool "layout heading to body splits paragraph"+          (length headingBodySplit == 2)+      , assertTextEq "layout heading stays separate"+          (T.pack "言語入門") (head headingBodySplit)       , assertTextEq "layout dingbat r prefix becomes bullet"           (T.pack "\8226 HTTP\n") dingbatBullet       , assertBool "layout lettered list items split" (length letteredList == 3)@@ -668,6 +676,17 @@         [ body "text", supAt 132 "\8224", supAt 136 "1", bodyAfter 140 "." ]       farSupGlyphs =         [ g | ItemGlyph g <- [body "text", ItemGlyph (mkGlyph 132 708.5 4 7 0 "\8224")]]+      -- Overlap slightly past the normal -0.5em inlineCont floor (leanbook-work dagger case).+      tightDaggerOverlap =+        let sz = 8.41+            bodyY = 200.0+            prefix = mkGlyph 50 bodyY 50 sz 0 "NNG"+            paren = mkGlyph 100 bodyY sz sz 0 "）"+            dagX = 100 + sz - 0.51 * sz+            dag = mkGlyph dagX (bodyY + 0.44 * sz) (0.45 * sz) (0.71 * sz) 0 "†"+            three = mkGlyph (dagX + 0.45 * sz) (bodyY + 0.36 * sz) (0.45 * sz) (0.71 * sz) 0 "3"+            quote = mkGlyph (dagX + 0.95 * sz) bodyY sz sz 0 "」"+        in linesFromGlyphs [prefix, paren, dag, three, quote]       rebase = layoutParagraphs         [ ItemGlyph (mkGlyph 72 87.6 4 7 0 "\8224")         , ItemGlyph (mkGlyph 76 87.6 4 7 0 "1")@@ -696,11 +715,22 @@           , ItemGlyph (mkGlyph 75 87.6 3 7 0 "2")           , ItemGlyph (mkGlyph 80 84.3 60 8 0 "orphan note")           ])+      hangFootnoteParas =+        layoutParagraphs+          [ ItemGlyph (mkGlyph 72 87.6 4 7 0 "†")+          , ItemGlyph (mkGlyph 76 87.6 4 7 0 "1")+          , ItemGlyph (mkGlyph 82 84.3 120 8 0 "Lean製")+          , ItemGlyph (mkGlyph 82 72.5 120 8 0 "のツール")+          ]    in [ assertBool "superscript merges inline" (length merged == 1)       , assertTextEq "superscript inline text order"           (T.pack "text\8224\&1.") (head merged)       , assertBool "superscript beyond window stays separate line"           (length (linesFromGlyphs farSupGlyphs) == 2)+      , assertBool "dagger overlaps >0.5em still merges"+          (length tightDaggerOverlap == 1)+      , assertTextEq "dagger overlap keeps reading order"+          (T.pack "NNG）†3」") (lineText (head tightDaggerOverlap))       , assertBool "marker line rebases onto body" (length rebase == 1)       , assertTextEq "rebased line text" (T.pack "\8224\&1note body") (head rebase)       , assertBool "footnotes on: body inlined"@@ -715,6 +745,9 @@           (T.isInfixOf "anchor\8224\&9" unmatchedAnchor)       , assertBool "orphan footnote block stays"           (T.isInfixOf "orphan note" orphanBlock)+      , assertBool "hanging footnote wrap stays one paragraph"+          (length hangFootnoteParas == 1+           && T.isInfixOf (T.pack "Lean製のツール") (head hangFootnoteParas))       ]  rubyResults :: [Result]@@ -995,7 +1028,65 @@             old == T.pack "B" && T.null new           _ -> False       )+  , assertBool "diffParagraphs ignores whitespace by default"+      ( null (diffParagraphs [T.pack "Lean の"] [T.pack "Leanの"])+        && null (diffParagraphs [T.pack "a  b\nc"] [T.pack "abc"])+      )+  , assertBool "alignChangeSpans finds middle edit"+      ( case alignChangeSpans (T.pack "prefixOLD-MIDDLEsuffix") (T.pack "prefixNEW-MIDDLEsuffix") of+          (pre, o, n, suf) ->+            pre == T.pack "prefix" && o == T.pack "OLD" && n == T.pack "NEW" && suf == T.pack "-MIDDLEsuffix"+      )+  , assertBool "renderUnifiedDiff is editor-friendly without ANSI"+      ( let out = renderUnifiedDiff DiffColorOff "a.pdf" "b.pdf"+              [ TextChange (Just 11) (Just 11) (Just 4) (Just 4)+                  (T.pack "aaa製作bbb") (T.pack "aaa制作bbb") ]+        in "--- a.pdf\n" `T.isPrefixOf` T.pack out+           && "+++ b.pdf" `T.isInfixOf` T.pack out+           && "@@ page 11, para 5 @@" `T.isInfixOf` T.pack out+           && "-aaa製作bbb" `T.isInfixOf` T.pack out+           && "+aaa制作bbb" `T.isInfixOf` T.pack out+           && '\x1b' `notElem` out+      )+  , assertBool "renderUnifiedDiff groups same-page changes into one hunk"+      ( let out = renderUnifiedDiff DiffColorOff "a.pdf" "b.pdf"+              [ TextChange (Just 62) (Just 62) (Just 5) (Just 5)+                  (T.pack "old-a") (T.pack "new-a")+              , TextChange (Just 62) (Just 62) (Just 7) (Just 7)+                  (T.pack "old-b") (T.pack "new-b")+              , TextChange (Just 62) (Just 62) (Just 8) (Just 8)+                  (T.pack "old-c") (T.pack "new-c")+              ]+            ls = lines out+            n = length (filter (== "@@ page 62, para 6, 8-9 @@") ls)+            -- Classic block replace: all '-' then all '+'.+            body = dropWhile (not . (== "@@ page 62, para 6, 8-9 @@")) ls+            after = drop 1 body+        in n == 1+           && take 3 after == ["-old-a", "-old-b", "-old-c"]+           && take 3 (drop 3 after) == ["+new-a", "+new-b", "+new-c"]+           && length (filter (T.isPrefixOf (T.pack "@@ ")) (T.lines (T.pack out))) == 1+      )+  , assertBool "diffParagraphs consecutive edits stay aligned"+      ( case diffParagraphs+               [T.pack "P", T.pack "old-A", T.pack "old-B", T.pack "Q"]+               [T.pack "P", T.pack "new-A", T.pack "new-B", T.pack "Q"] of+          [ TextChange{changeParaA = Just 1, changeParaB = Just 1, changeOld = a, changeNew = a'}+            , TextChange{changeParaA = Just 2, changeParaB = Just 2, changeOld = b, changeNew = b'}+            ] ->+              a == T.pack "old-A" && a' == T.pack "new-A"+              && b == T.pack "old-B" && b' == T.pack "new-B"+          _ -> False+      )+  , assertBool "legacyTextParagraphs blank-line split"+      ( legacyTextParagraphs (T.pack "First\n\nSecond") ==+        [T.pack "First", T.pack "Second"]+      )+  , assertBool "legacyTextParagraphs single block"+      ( legacyTextParagraphs (T.pack "Only one") == [T.pack "Only one"]+      )   , runMultipageSelfDiff+  , runMultipageSelfDiffLegacy   ]   where     ps = [T.pack "Alpha", T.pack "Beta"]@@ -1013,6 +1104,20 @@       Left err -> testFail "multipage.pdf self-diff open" (show err)  {-# NOINLINE runMultipageSelfDiff #-}++runMultipageSelfDiffLegacy :: Result+runMultipageSelfDiffLegacy =+  let path = "data/fixtures/multipage.pdf"+  in unsafePerformIO $ do+    result <- openDocument path Nothing+    return $ case result of+      Right doc ->+        case compareDocumentsWith DiffLegacy doc doc of+          Right changes -> assertBool "multipage.pdf legacy self-diff empty" (null changes)+          Left err -> testFail "multipage.pdf legacy self-diff" (show err)+      Left err -> testFail "multipage.pdf legacy self-diff open" (show err)++{-# NOINLINE runMultipageSelfDiffLegacy #-}  filterDecodeResults :: [Result] filterDecodeResults =