mdoc-0.1.0.0: src/Mdoc/Dump/Diff.hs
-- |
--
-- Module : Mdoc.Dump.Diff
-- Copyright : (c) 2026 Patrick Brisbin
-- License : AGPL-3
-- Maintainer : pbrisbin@gmail.com
-- Stability : experimental
-- Portability : POSIX
module Mdoc.Dump.Diff
( Differences (..)
, getDifferences
, prettyDifferences
)
where
import Mdoc.Prelude
import Data.Algorithm.Diff
import Data.Function (on)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Mdoc.Pretty
data Differences
= NoDifferences
| Differences [Diff Text]
getDifferences :: Text -> Text -> Differences
getDifferences a b
| all isBoth diff = NoDifferences
| otherwise = Differences diff
where
cmp = (==) `on` normalize
diff = (getDiffBy cmp `on` T.lines) a b
normalize :: Text -> Text
normalize = T.replace ".\\\" " ".\\\"" . collapseSpaces . T.strip
collapseSpaces :: Text -> Text
collapseSpaces t
| "." `T.isPrefixOf` t = T.unwords $ T.words t
| otherwise = t
isBoth :: Diff a -> Bool
isBoth (Both {}) = True
isBoth _ = False
prettyDifferences :: String -> Differences -> Doc Ann
prettyDifferences name = \case
NoDifferences -> annotate AnnComment "No differences"
Differences diffs ->
vsep
$ [ "Differences in rendered output:"
, annotate AnnFile $ "--- a" <> pretty (ensureSlash name)
, annotate AnnFile $ "+++ b" <> pretty (ensureSlash name)
]
<> map prettyDiff (collapse diffs)
ensureSlash :: String -> String
ensureSlash = \case
x@('/' : _) -> x
x -> '/' : x
prettyDiff :: Diff Text -> Doc Ann
prettyDiff = \case
First x -> annotate AnnDiffAddition $ "-" <+> pretty x
Second x -> annotate AnnDiffDeletion $ "+" <+> pretty x
Both x _ -> annotate AnnDiffContext $ " " <+> pretty x
-- | Collapse groups of only context, eliding all but the first and last line
collapse :: [Diff Text] -> [Diff Text]
collapse = concatMap elide . NE.groupBy shouldGroup
elide :: NonEmpty (Diff Text) -> [Diff Text]
elide ne@(x :| _) = case (x, length ne) of
(Both {}, n)
| n > 3 ->
[ NE.head ne
, ellipseLine $ n - 2
, NE.last ne
]
_ -> toList ne
-- | Show omitted lines
--
-- This will only ever be used with an @n >= 2@, so the 0-vs-1-vs-n language
-- doesn't matter, but we do it anyway in case we mess up in the future.
ellipseLine :: Int -> Diff Text
ellipseLine n = Both msg msg
where
msg = case n of
0 -> "... no lines omitted ..." -- doesn't happen
1 -> "... 1 line omitted ..."
_ -> "... " <> pack (show n) <> " lines omitted ..."
-- | Create groups of either only context or only additions/deletions
shouldGroup :: Diff Text -> Diff Text -> Bool
shouldGroup (First {}) (First {}) = True
shouldGroup (First {}) (Second {}) = True
shouldGroup (Second {}) (Second {}) = True
shouldGroup (Second {}) (First {}) = True
shouldGroup (Both {}) (Both {}) = True
shouldGroup _ _ = False