packages feed

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