diff.carp

(deftype (Diff a)
  (Eq [a])
  (Insertion [a])
  (Deletion [a]))

(defmodule Diff
  (defn = [a b]
    (match @a
      (Eq x) (match @b (Eq y) (= &x &y) _ false)
      (Insertion x) (match @b (Insertion y) (= &x &y) _ false)
      (Deletion x) (match @b (Deletion y) (= &x &y) _ false)))
  (implements = Diff.=)

  (defn str [d]
    (match-ref d
      (Eq x) (String.concat &[@"(Eq " (str x) @")"])
      (Insertion x) (String.concat &[@"(Insertion " (str x) @")"])
      (Deletion x) (String.concat &[@"(Deletion " (str x) @")"])))
  (implements str Diff.str)

  (defn prn [d]
    (match-ref d
      (Eq x) (String.concat &[@"(Eq " (prn x) @")"])
      (Insertion x) (String.concat &[@"(Insertion " (prn x) @")"])
      (Deletion x) (String.concat &[@"(Deletion " (prn x) @")"])))
  (implements prn Diff.prn)

  (doc diff
    "Computes the diff between two arrays, returning a sequence of Eq, Insertion, and Deletion hunks.")
  (defn diff [old new]
    (let-do [oidxm {}
             overlap {}
             sso 0
             ssn 0
             sl 0]
      (for [i 0 (Array.length old)]
        (let [e (Array.unsafe-nth old i)
              to-u (Map.get-with-default &oidxm e &[])]
          (set! oidxm (Map.put oidxm e &(Array.push-back to-u i)))))
      (for [inew 0 (Array.length new)]
        (let-do [_overlap {}
                 ol &(Map.get-with-default &oidxm
                                           (Array.unsafe-nth new inew)
                                           &[])]
          (for [i 0 (Array.length ol)]
            (let-do [iold @(Array.unsafe-nth ol i)
                     new-val (Int.inc
                       (if (/= iold 0) (Map.get &overlap &(Int.dec iold)) iold))]
              (set! _overlap (Map.put _overlap &iold &new-val))
              (when-do (> (Map.get &_overlap &iold) sl)
                (set! sl (Map.get &_overlap &iold))
                (set! sso (Int.inc (- iold sl)))
                (set! ssn (Int.inc (- inew sl))))))
          (set! overlap _overlap)))
      (if (= 0 sl)
        (let-do [res []]
          (when (> (Array.length new) 0)
            (Array.push-back! &res (Insertion @new)))
          (when (> (Array.length old) 0) (Array.push-back! &res (Deletion @old)))
          res)
        (Array.concat
          &[(Array.concat
              &[(diff &(Array.prefix old sso) &(Array.prefix new ssn))
                [(Eq (Array.slice new ssn (+ ssn sl)))]])
            (diff &(Array.suffix old (+ sso sl)) &(Array.suffix new (+ ssn sl)))]))))

  (doc string-diff "Diffs two strings word by word, splitting on whitespace.")
  (defn string-diff [old new] (diff &(String.words old) &(String.words new)))

  (doc line-diff "Diffs two strings line by line, splitting on newlines.")
  (defn line-diff [old new]
    (diff &(String.split-by old &[\newline]) &(String.split-by new &[\newline])))

  (doc char-diff "Diffs two strings character by character.")
  (defn char-diff [old new] (diff &(String.chars old) &(String.chars new)))

  (doc eq? "Returns true if the diff hunk is an Eq.")
  (defn eq? [d] (match @d (Eq _) true _ false))

  (doc inserted? "Returns true if the diff hunk is an Insertion.")
  (defn inserted? [d] (match @d (Insertion _) true _ false))

  (doc deleted? "Returns true if the diff hunk is a Deletion.")
  (defn deleted? [d] (match @d (Deletion _) true _ false))

  (doc eq "Filters a diff to only the Eq hunks.")
  (defn eq [d] (Array.copy-filter &eq? d))
  (doc insertions "Filters a diff to only the Insertion hunks.")
  (defn insertions [d] (Array.copy-filter &inserted? d))
  (doc deletions "Filters a diff to only the Deletion hunks.")
  (defn deletions [d] (Array.copy-filter &deleted? d))

  (defn- push-all! [res xs]
    (for [j 0 (Array.length xs)] (Array.push-back! res @(Array.unsafe-nth xs j))))

  (doc apply
    "Reconstructs the 'new' array from a diff by collecting Eq and Insertion elements.")
  (defn apply [d]
    (let-do [res []]
      (for [i 0 (Array.length d)]
        (match-ref (Array.unsafe-nth d i)
          (Eq xs) (push-all! &res xs)
          (Insertion xs) (push-all! &res xs)
          (Deletion _) ()))
      res))

  (doc revert
    "Reconstructs the 'old' array from a diff by collecting Eq and Deletion elements.")
  (defn revert [d]
    (let-do [res []]
      (for [i 0 (Array.length d)]
        (match-ref (Array.unsafe-nth d i)
          (Eq xs) (push-all! &res xs)
          (Insertion _) ()
          (Deletion xs) (push-all! &res xs)))
      res))

  (doc lcs-length
    "Returns the length of the longest common subsequence of two arrays.")
  (defn lcs-length [old new]
    (let-do [d &(diff old new)
             len 0]
      (for [i 0 (Array.length d)]
        (match-ref (Array.unsafe-nth d i)
          (Eq xs) (set! len (+ len (Array.length xs)))
          _ ()))
      len))

  (doc edit-distance
    "Returns the edit distance (number of insertions plus deletions) between two arrays.")
  (defn edit-distance [old new]
    (- (+ (Array.length old) (Array.length new)) (* 2 (lcs-length old new))))

  (doc similarity
    "Returns a similarity ratio between 0.0 and 1.0 for two arrays, based on their longest common subsequence. Two empty arrays have similarity 1.0.")
  (defn similarity [old new]
    (let [total (+ (Array.length old) (Array.length new))]
      (if (= total 0)
        1.0
        (/ (Double.from-int (* 2 (lcs-length old new))) (Double.from-int total)))))

  (defn- change? [d] (match-ref d (Eq _) false _ true))

  (defn- format-hunk [old-start old-count new-start new-count hunk-lines]
    (let [header (String.concat
            &[@"@@ -"
              (Int.str old-start)
              @","
              (Int.str old-count)
              @" +"
              (Int.str new-start)
              @","
              (Int.str new-count)
              @" @@"])
          body (String.join "
" hunk-lines)]
      (String.concat &[header @"
" body @"
"])))

  (doc unified-with-context
    "Renders a line diff in unified diff format with hunk headers.
Expects the output of `line-diff` or a diff of string arrays.
Uses the given number of context lines around changes.")
  (defn unified-with-context [d ctx]
    (let-do [old-pos 1
             new-pos 1
             hunk-lines (the (Array String) [])
             hunk-old-start 1
             hunk-new-start 1
             hunk-old-count 0
             hunk-new-count 0
             in-hunk false
             lead-lines (the (Array String) [])
             lead-old-start 1
             lead-new-start 1
             lead-count 0
             hunks (the (Array String) [])]
      (for [i 0 (Array.length d)]
        (let-do [elem (Array.unsafe-nth d i)]
          (when-do (and (not in-hunk) (change? elem))
            (set! in-hunk true)
            (set! hunk-lines (Array.copy &lead-lines))
            (set! hunk-old-start lead-old-start)
            (set! hunk-new-start lead-new-start)
            (set! hunk-old-count lead-count)
            (set! hunk-new-count lead-count)
            (set! lead-lines [])
            (set! lead-count 0))
          (match-ref elem
            (Eq lines)
              (let-do [n (Array.length lines)]
                (if in-hunk
                  (if (<= n (* 2 ctx))
                    (for [j 0 n]
                      (let-do [line (Array.unsafe-nth lines j)]
                        (Array.push-back! &hunk-lines
                                          (String.concat &[@" " @line]))
                        (set! hunk-old-count (+ hunk-old-count 1))
                        (set! hunk-new-count (+ hunk-new-count 1))))
                    (let-do [trailing (Int.min ctx n)]
                      (for [j 0 trailing]
                        (let-do [line (Array.unsafe-nth lines j)]
                          (Array.push-back! &hunk-lines
                                            (String.concat &[@" " @line]))
                          (set! hunk-old-count (+ hunk-old-count 1))
                          (set! hunk-new-count (+ hunk-new-count 1))))
                      (Array.push-back! &hunks
                                        (format-hunk hunk-old-start
                                                     hunk-old-count
                                                     hunk-new-start
                                                     hunk-new-count
                                                     &hunk-lines))
                      (set! in-hunk false)
                      (set! hunk-lines [])
                      (let-do [leading (Int.min ctx (- n trailing))
                               lead-start (- n leading)]
                        (set! lead-lines [])
                        (set! lead-count 0)
                        (set! lead-old-start (+ old-pos lead-start))
                        (set! lead-new-start (+ new-pos lead-start))
                        (for [j lead-start n]
                          (let-do [line (Array.unsafe-nth lines j)]
                            (Array.push-back! &lead-lines
                                              (String.concat &[@" " @line]))
                            (set! lead-count (+ lead-count 1)))))))
                  (let-do [leading (Int.min ctx n)
                           lead-start (- n leading)]
                    (set! lead-lines [])
                    (set! lead-count 0)
                    (set! lead-old-start (+ old-pos lead-start))
                    (set! lead-new-start (+ new-pos lead-start))
                    (for [j lead-start n]
                      (let-do [line (Array.unsafe-nth lines j)]
                        (Array.push-back! &lead-lines
                                          (String.concat &[@" " @line]))
                        (set! lead-count (+ lead-count 1))))))
                (set! old-pos (+ old-pos n))
                (set! new-pos (+ new-pos n)))
            (Deletion lines)
              (let-do [n (Array.length lines)]
                (for [j 0 n]
                  (let-do [line (Array.unsafe-nth lines j)]
                    (Array.push-back! &hunk-lines (String.concat &[@"-" @line]))
                    (set! hunk-old-count (+ hunk-old-count 1))))
                (set! old-pos (+ old-pos n)))
            (Insertion lines)
              (let-do [n (Array.length lines)]
                (for [j 0 n]
                  (let-do [line (Array.unsafe-nth lines j)]
                    (Array.push-back! &hunk-lines (String.concat &[@"+" @line]))
                    (set! hunk-new-count (+ hunk-new-count 1))))
                (set! new-pos (+ new-pos n))))))
      (when in-hunk
        (Array.push-back! &hunks
                          (format-hunk hunk-old-start
                                       hunk-old-count
                                       hunk-new-start
                                       hunk-new-count
                                       &hunk-lines)))
      (String.concat &hunks)))

  (doc unified "Renders a line diff in unified diff format with hunk headers.
Expects the output of `line-diff` or a diff of string arrays.
Uses 3 lines of context around changes.")
  (defn unified [d] (unified-with-context d 3))

  ; core's starts-with?/suffix guard on byte length but index characters; patch input is bytes
  (defn- byte-starts-with? [s sub]
    (let [ls (String.length sub)]
      (and (>= (String.length s) ls) (= sub &(String.byte-slice s 0 ls)))))

  (defn- byte-suffix [s b] (String.byte-slice s b (String.length s)))

  ; parses the 1-based old-file start line from a unified hunk header such as
  ; `@@ -3,4 +3,5 @@`; the count is optional (`@@ -3 +3 @@` means one line).
  (defn- parse-hunk-start [header]
    (let-do [tokens (String.split-by header &[\space])
             res (the (Maybe Int) (Maybe.Nothing))]
      (for [i 0 (Array.length &tokens)]
        (let [tok (Array.unsafe-nth &tokens i)]
          (when (and (Maybe.nothing? &res)
                     (byte-starts-with? tok "-")
                     (> (String.length tok) 1))
            (let [range (byte-suffix tok 1)]
              (set! res
                    (Int.from-string
                      (Array.unsafe-nth &(String.split-by &range &[\,]) 0)))))))
      res))

  (doc patch
    "Applies a unified diff `patch-text` (as produced by `unified`) to the
original document `original`, returning the patched document. Context and
deletion lines are checked against `original`, so this is a safe applier:
it returns `Nothing` if the patch does not apply — a context or deletion
line that does not match, or a hunk header that is malformed, out of range,
or out of order. Both documents are split and rejoined on newlines, so
`(patch old (unified (line-diff old new)))` reproduces `new`.")
  (defn patch [original patch-text]
    (let-do [orig (String.split-by original &[\newline])
             lines (String.split-by patch-text &[\newline])
             out (the (Array String) [])
             olen (Array.length &orig)
             cursor 0
             failed false]
      (for [i 0 (Array.length &lines)]
        (unless failed
          (let [line (Array.unsafe-nth &lines i)]
            (cond
              (byte-starts-with? line "@@")
                (match (parse-hunk-start line)
                  (Maybe.Nothing) (set! failed true)
                  (Maybe.Just start)
                    (let [target (if (< start 1) 0 (Int.dec start))]
                      (if (or (< target cursor) (> target olen))
                        (set! failed true)
                        (do
                          (for [k cursor target]
                            (Array.push-back! &out @(Array.unsafe-nth &orig k)))
                          (set! cursor target)))))
              (byte-starts-with? line " ")
                (let [content (byte-suffix line 1)]
                  (if (or (>= cursor olen)
                          (/= (Array.unsafe-nth &orig cursor) &content))
                    (set! failed true)
                    (do
                      (Array.push-back! &out content)
                      (set! cursor (Int.inc cursor)))))
              (byte-starts-with? line "-")
                (let [content (byte-suffix line 1)]
                  (if (or (>= cursor olen)
                          (/= (Array.unsafe-nth &orig cursor) &content))
                    (set! failed true)
                    (set! cursor (Int.inc cursor))))
              (byte-starts-with? line "+")
                (Array.push-back! &out (byte-suffix line 1))
              ()))))
      (unless failed
        (for [k cursor olen] (Array.push-back! &out @(Array.unsafe-nth &orig k))))
      (if failed (Maybe.Nothing) (Maybe.Just (String.join "
" &out))))))