ocaml-git / lib / diff.ml

(** Tree and commit diff operations. *)

type change =
  | Added of { path : string; hash : Hash.t; perm : Tree.perm }
  | Removed of { path : string; hash : Hash.t; perm : Tree.perm }
  | Modified of {
      path : string;
      old_hash : Hash.t;
      new_hash : Hash.t;
      old_perm : Tree.perm;
      new_perm : Tree.perm;
    }

type t = change list
type stats = { additions : int; deletions : int; modifications : int }

let change_path = function
  | Added { path; _ } | Removed { path; _ } | Modified { path; _ } -> path

let compare_by_path c1 c2 = String.compare (change_path c1) (change_path c2)
let path prefix name = if prefix = "" then name else prefix ^ "/" ^ name

(** Read a tree from the repository, returning empty list if not found. *)
let read_tree repo hash =
  match Repository.read repo hash with
  | Ok (Value.Tree tree) -> Ok (Tree.to_list tree)
  | Ok _ -> Error (`Msg "expected tree object")
  | Error e -> Error e

(** Check if an entry is a directory (tree). *)
let is_dir (entry : Tree.entry) = entry.perm = `Dir

(** Recursively collect all entries in a tree as Added changes. *)
let rec collect_added repo prefix entries acc =
  List.fold_left
    (fun acc (entry : Tree.entry) ->
      match acc with
      | Error _ -> acc
      | Ok changes ->
          let path = path prefix entry.name in
          if is_dir entry then
            (* Recurse into subdirectory *)
            match read_tree repo entry.hash with
            | Error e -> Error e
            | Ok sub_entries -> collect_added repo path sub_entries (Ok changes)
          else
            Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes))
    acc entries

(** Recursively collect all entries in a tree as Removed changes. *)
let rec collect_removed repo prefix entries acc =
  List.fold_left
    (fun acc (entry : Tree.entry) ->
      match acc with
      | Error _ -> acc
      | Ok changes ->
          let path = path prefix entry.name in
          if is_dir entry then
            match read_tree repo entry.hash with
            | Error e -> Error e
            | Ok sub_entries ->
                collect_removed repo path sub_entries (Ok changes)
          else
            Ok
              (Removed { path; hash = entry.hash; perm = entry.perm } :: changes))
    acc entries

(** Process a single added entry (file or directory). *)
let process_added_entry repo prefix (entry : Tree.entry) changes =
  let path = path prefix entry.name in
  if is_dir entry then
    match read_tree repo entry.hash with
    | Error e -> Error e
    | Ok sub -> collect_added repo path sub (Ok changes)
  else Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes)

(** Process a single removed entry (file or directory). *)
let process_removed_entry repo prefix (entry : Tree.entry) changes =
  let path = path prefix entry.name in
  if is_dir entry then
    match read_tree repo entry.hash with
    | Error e -> Error e
    | Ok sub -> collect_removed repo path sub (Ok changes)
  else Ok (Removed { path; hash = entry.hash; perm = entry.perm } :: changes)

(** Handle entries with same name but different content/type. *)
let rec process_matched_entries repo prefix old_e new_e changes walk_fn =
  let path = path prefix old_e.Tree.name in
  match (is_dir old_e, is_dir new_e) with
  | true, true -> (
      (* Both directories, recurse *)
      match (read_tree repo old_e.hash, read_tree repo new_e.hash) with
      | Ok old_entries', Ok new_entries' ->
          walk_fn repo path old_entries' new_entries' (Ok changes)
      | Error e, _ | _, Error e -> Error e)
  | false, false ->
      (* Both files, content changed *)
      Ok
        (Modified
           {
             path;
             old_hash = old_e.hash;
             new_hash = new_e.hash;
             old_perm = old_e.perm;
             new_perm = new_e.perm;
           }
        :: changes)
  | true, false -> (
      (* Dir became file: remove dir contents, add file *)
      match read_tree repo old_e.hash with
      | Error e -> Error e
      | Ok sub -> (
          match collect_removed repo path sub (Ok changes) with
          | Error e -> Error e
          | Ok changes' ->
              Ok
                (Added { path; hash = new_e.hash; perm = new_e.perm }
                :: changes')))
  | false, true -> (
      (* File became dir: remove file, add dir contents *)
      let change = Removed { path; hash = old_e.hash; perm = old_e.perm } in
      match read_tree repo new_e.hash with
      | Error e -> Error e
      | Ok sub -> collect_added repo path sub (Ok (change :: changes)))

(** Merge-walk two sorted entry lists and compute differences. *)
and walk_trees repo prefix old_entries new_entries acc =
  match (old_entries, new_entries, acc) with
  | _, _, Error _ -> acc
  | [], [], Ok changes -> Ok changes
  | [], new_e :: rest, Ok changes -> (
      match process_added_entry repo prefix new_e changes with
      | Error e -> Error e
      | Ok changes' -> walk_trees repo prefix [] rest (Ok changes'))
  | old_e :: rest, [], Ok changes -> (
      match process_removed_entry repo prefix old_e changes with
      | Error e -> Error e
      | Ok changes' -> walk_trees repo prefix rest [] (Ok changes'))
  | old_e :: old_rest, new_e :: new_rest, Ok changes -> (
      let cmp = String.compare old_e.Tree.name new_e.Tree.name in
      if cmp < 0 then
        match process_removed_entry repo prefix old_e changes with
        | Error e -> Error e
        | Ok changes' ->
            walk_trees repo prefix old_rest new_entries (Ok changes')
      else if cmp > 0 then
        match process_added_entry repo prefix new_e changes with
        | Error e -> Error e
        | Ok changes' ->
            walk_trees repo prefix old_entries new_rest (Ok changes')
      else if Hash.equal old_e.hash new_e.hash && old_e.perm = new_e.perm then
        walk_trees repo prefix old_rest new_rest acc
      else
        match
          process_matched_entries repo prefix old_e new_e changes walk_trees
        with
        | Error e -> Error e
        | Ok changes' -> walk_trees repo prefix old_rest new_rest (Ok changes'))

let trees repo ~old_tree ~new_tree =
  let old_entries = read_tree repo old_tree in
  let new_entries = read_tree repo new_tree in
  match (old_entries, new_entries) with
  | Error e, _ | _, Error e -> Error e
  | Ok old_e, Ok new_e -> (
      match walk_trees repo "" old_e new_e (Ok []) with
      | Error e -> Error e
      | Ok changes -> Ok (List.sort compare_by_path changes))

let commits repo ~old_commit ~new_commit =
  let read_commit_tree hash =
    match Repository.read repo hash with
    | Ok (Value.Commit commit) -> Ok (Commit.tree commit)
    | Ok _ -> Error (`Msg "expected commit object")
    | Error e -> Error e
  in
  match (read_commit_tree old_commit, read_commit_tree new_commit) with
  | Error e, _ | _, Error e -> Error e
  | Ok old_tree, Ok new_tree -> trees repo ~old_tree ~new_tree

let tree_to_empty repo tree =
  match read_tree repo tree with
  | Error e -> Error e
  | Ok entries -> (
      match collect_added repo "" entries (Ok []) with
      | Error e -> Error e
      | Ok changes -> Ok (List.sort compare_by_path changes))

let empty_to_tree repo tree =
  match read_tree repo tree with
  | Error e -> Error e
  | Ok entries -> (
      match collect_removed repo "" entries (Ok []) with
      | Error e -> Error e
      | Ok changes -> Ok (List.sort compare_by_path changes))

let filter_by_path ~prefix diff =
  let prefix_len = String.length prefix in
  List.filter
    (fun change ->
      let path = change_path change in
      String.length path >= prefix_len
      && String.sub path 0 prefix_len = prefix
      && (String.length path = prefix_len || path.[prefix_len] = '/'))
    diff

let stats diff =
  List.fold_left
    (fun acc change ->
      match change with
      | Added _ -> { acc with additions = acc.additions + 1 }
      | Removed _ -> { acc with deletions = acc.deletions + 1 }
      | Modified _ -> { acc with modifications = acc.modifications + 1 })
    { additions = 0; deletions = 0; modifications = 0 }
    diff

let pp_change ppf change =
  match change with
  | Added { path; _ } -> Fmt.pf ppf "A %s" path
  | Removed { path; _ } -> Fmt.pf ppf "D %s" path
  | Modified { path; _ } -> Fmt.pf ppf "M %s" path

let pp ppf diff = Fmt.pf ppf "@[<v>%a@]" Fmt.(list ~sep:cut pp_change) diff

let pp_stats ppf stats =
  Fmt.pf ppf "%d additions, %d deletions, %d modifications" stats.additions
    stats.deletions stats.modifications