; Phase 6 — merge: textual diff3 with conflict markers, per-path 3-way tree
; merge with blob auto-merge, fast-forward/up-to-date detection.

(define gmg-db (persist/mem-backend))
(define gmg (git/repo gmg-db))

(define
  gmg-commit!
  (fn
    (files parents msg)
    (git/write
      gmg
      (git/commit (git/tree-from-files gmg files) parents {:message msg}))))

; ---- textual 3-way ----
(git-test "merge3: untouched" (git/merge3-text "x\n" "x\n" "x\n") {:clean true :text "x\n" :conflicts 0})
(git-test
  "merge3: ours-only change wins"
  (get (git/merge3-text "a\nb\n" "a\nB\n" "a\nb\n") :text)
  "a\nB\n")
(git-test
  "merge3: theirs-only change wins"
  (get (git/merge3-text "a\nb\n" "a\nb\n" "a\nB\n") :text)
  "a\nB\n")
(git-test
  "merge3: identical change on both sides is clean"
  (git/merge3-text "a\nb\n" "a\nZ\n" "a\nZ\n")
  {:clean true :text "a\nZ\n" :conflicts 0})
(git-test
  "merge3: non-overlapping changes both apply"
  (git/merge3-text "a\nb\nc\n" "A\nb\nc\n" "a\nb\nC\n")
  {:clean true :text "A\nb\nC\n" :conflicts 0})
(git-test
  "merge3: adjacent line changes merge cleanly"
  (get (git/merge3-text "l1\nl2\nl3\nl4\n" "l1\nX\nl3\nl4\n" "l1\nl2\nY\nl4\n") :text)
  "l1\nX\nY\nl4\n")
(git-test
  "merge3: append and prepend both apply"
  (get (git/merge3-text "m\n" "m\ne\n" "s\nm\n") :text)
  "s\nm\ne\n")
(git-test
  "merge3: clean deletion"
  (get (git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nb\nc\n") :text)
  "a\nc\n")

(git-test
  "merge3: overlapping edits conflict with diff3 markers"
  (git/merge3-text "a\nb\nc\n" "a\nX\nc\n" "a\nY\nc\n")
  {:clean false :text "a\n<<<<<<< ours\nX\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
(git-test
  "merge3: delete vs modify conflicts"
  (git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nY\nc\n")
  {:clean false :text "a\n<<<<<<< ours\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
(git-test
  "merge3: same-point insertions with different content conflict"
  (git/merge3-text "" "A\n" "B\n")
  {:clean false :text "<<<<<<< ours\nA\n||||||| base\n=======\nB\n>>>>>>> theirs\n" :conflicts 1})
(git-test
  "merge3: same-point insertions with the same content are clean"
  (git/merge3-text "a\n" "a\nx\n" "a\nx\n")
  {:clean true :text "a\nx\n" :conflicts 0})
(git-test
  "merge3: two separated conflicts are counted"
  (get
    (git/merge3-text
      "a\nb\nc\nd\ne\nf\ng\nh\ni\n"
      "a\nX1\nc\nd\ne\nf\ng\nX2\ni\n"
      "a\nY1\nc\nd\ne\nf\ng\nY2\ni\n")
    :conflicts)
  2)

; ---- tree-from-cids ----
(git-test
  "tree-from-cids equals tree-from-files"
  (equal?
    (git/tree-from-cids
      gmg
      (assoc
        (assoc {} "a.txt" (git/write-blob gmg "1\n"))
        "s/b.txt"
        (git/write-blob gmg "2\n")))
    (git/tree-from-files
      gmg
      (assoc (assoc {} "a.txt" "1\n") "s/b.txt" "2\n")))
  true)

; ---- tree merge ----
(define
  gmg-base-files
  (assoc (assoc {} "f.txt" "a\nb\nc\n") "g.txt" "same\n"))
(define gmg-base-tree (git/tree-from-files gmg gmg-base-files))

(git-test
  "merge-trees: disjoint paths merge clean"
  (let
    ((ta (git/tree-from-files gmg (assoc gmg-base-files "ours.txt" "o\n")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "theirs.txt" "t\n"))))
    (let
      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
      (list
        (get m :conflicts)
        (=
          (git/tree-files gmg (git/tree-from-cids gmg (get m :files)))
          (assoc (assoc gmg-base-files "ours.txt" "o\n") "theirs.txt" "t\n")))))
  (list (list) true))
(git-test
  "merge-trees: same file, non-overlapping lines auto-merge"
  (let
    ((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "A\nb\nc\n")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nb\nC\n"))))
    (let
      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
      (list
        (get m :conflicts)
        (git/blob-data (git/read gmg (get (get m :files) "f.txt"))))))
  (list (list) "A\nb\nC\n"))
(git-test
  "merge-trees: overlapping edits flag the path"
  (let
    ((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nX\nc\n")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
    (let
      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
      (=
        (list
          (get m :conflicts)
          (contains?
            (git/blob-data (git/read gmg (get (get m :files) "f.txt")))
            "<<<<<<< ours"))
        (list (list "f.txt") true))))
  true)
(git-test
  "merge-trees: both delete is clean"
  (let
    ((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
      (tb (git/tree-from-files gmg (dissoc gmg-base-files "f.txt"))))
    (let
      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
      (list (get m :conflicts) (has-key? (get m :files) "f.txt"))))
  (list (list) false))
(git-test
  "merge-trees: delete vs modify keeps the modified side and flags it"
  (let
    ((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
    (let
      ((m (git/merge-trees gmg gmg-base-tree ta tb)))
      (=
        (list
          (get m :conflicts)
          (git/blob-data (git/read gmg (get (get m :files) "f.txt"))))
        (list (list "f.txt") "a\nY\nc\n"))))
  true)
(git-test
  "merge-trees: both add the same file identically"
  (let
    ((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n"))))
    (get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts))
  (list))
(git-test
  "merge-trees: both add the same file differently"
  (let
    ((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N1\n")))
      (tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N2\n"))))
    (=
      (get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts)
      (list "n.txt")))
  true)

; ---- commit-level ----
(define gmg-c0 (gmg-commit! gmg-base-files (list) "base"))
(define
  gmg-ca
  (gmg-commit! (assoc gmg-base-files "f.txt" "A\nb\nc\n") (list gmg-c0) "ours"))
(define
  gmg-cb
  (gmg-commit!
    (assoc gmg-base-files "f.txt" "a\nb\nC\n")
    (list gmg-c0)
    "theirs"))
(define
  gmg-cx
  (gmg-commit! (assoc gmg-base-files "f.txt" "a\nX\nc\n") (list gmg-c0) "ox"))
(define
  gmg-cy
  (gmg-commit! (assoc gmg-base-files "f.txt" "a\nY\nc\n") (list gmg-c0) "oy"))

(git-test "ff? when ours is behind" (git/ff? gmg gmg-c0 gmg-ca) true)
(git-test "ff? false for diverged heads" (git/ff? gmg gmg-ca gmg-cb) false)
(git-test
  "merge-commits: up-to-date when theirs is an ancestor"
  (git/merge-commits gmg gmg-ca gmg-c0)
  {:cid gmg-ca :result "up-to-date"})
(git-test
  "merge-commits: fast-forward when ours is an ancestor"
  (git/merge-commits gmg gmg-c0 gmg-ca)
  {:cid gmg-ca :result "fast-forward"})
(git-test
  "merge-commits: clean 3-way produces the merged tree"
  (let
    ((m (git/merge-commits gmg gmg-ca gmg-cb)))
    (list
      (get m :result)
      (get m :conflicts)
      (=
        (git/tree-files gmg (get m :tree))
        (assoc gmg-base-files "f.txt" "A\nb\nC\n"))))
  (list "merged" (list) true))
(git-test
  "merge-commits: conflicting 3-way reports paths and marker tree"
  (let
    ((m (git/merge-commits gmg gmg-cx gmg-cy)))
    (=
      (list
        (get m :result)
        (get m :conflicts)
        (contains?
          (get (git/tree-files gmg (get m :tree)) "f.txt")
          ">>>>>>> theirs"))
      (list "conflicts" (list "f.txt") true)))
  true)
(git-test
  "merge-commits: unrelated histories merge over an empty base"
  (let
    ((r1 (gmg-commit! (assoc {} "x.txt" "x\n") (list) "rx"))
      (r2 (gmg-commit! (assoc {} "y.txt" "y\n") (list) "ry")))
    (let
      ((m (git/merge-commits gmg r1 r2)))
      (list
        (get m :result)
        (=
          (git/tree-files gmg (get m :tree))
          (assoc (assoc {} "x.txt" "x\n") "y.txt" "y\n")))))
  (list "merged" true))