(** Line-oriented diffs between two blobs.

    Computes a Myers diff — the greedy O(ND) algorithm from "An O(ND)
    Difference Algorithm and Its Variations" (Myers, 1986), the same algorithm
    [git diff] uses by default — and groups the result into hunks with the
    surrounding context. Cost scales with the number of differences, not with
    file size, so a small change in a large file is cheap. When two files
    differ in more than [max_differences] lines after trimming their common
    prefix and suffix, the diff falls back to listing every remaining old line
    as deleted followed by every remaining new line as added.

    The module is named for the granularity it works at: whole lines, matched as
    opaque units, with no word- or character-level refinement.

    It produces data only. Rendering it is {!module:Ui.Diff}'s job. *)

type line_kind = Context | Addition | Deletion

type line = {
  kind : line_kind;
  old_number : int option;
  new_number : int option;
  text : string;
}

type hunk = {
  old_start : int;
  old_count : int;
  new_start : int;
  new_count : int;
  lines : line list;
}

type file = {
  path : string;
  old_hash : string option;
  new_hash : string option;
  old_mode : int option;
  new_mode : int option;
  binary : bool;
  hunks : hunk list;
}

let split_lines content =
  match String.split_on_char '\n' content with
  | [] -> []
  | lines ->
      if content = "" then []
      else if String.ends_with ~suffix:"\n" content then
        List.rev lines |> List.tl |> List.rev
      else lines

(* The cap on the edit distance D the search explores. The backtracking trace
   grows as D² words — about 8 MB at this cap — and the forward pass costs
   O((N+M)·D), so the cap bounds both for pathological pairs. A commit that
   changes over a thousand lines in one file (after prefix/suffix trimming)
   degrades to all-deletions-then-all-additions rather than failing. *)
let max_differences = 1_024

(* One edit-script step over the trimmed middle of the two files. *)
type edit = Keep | Delete | Insert

(* Myers' greedy shortest-edit-script search over two int arrays (lines are
   interned before the search, so equality is an integer compare).

   Variables follow the paper so the code can be checked against it: the edit
   graph runs from (0, 0) to (n, m), [d] is the edit distance explored so far,
   [k = x - y] indexes diagonals, and [v] holds, per diagonal, the furthest x
   reached. Each round snapshots the slice of [v] its backtrack step needs
   (diagonals -(d+1)..d+1), so trace memory is O(D²) rather than O(D·(N+M)).

   Returns the edit script in order, or [None] when the files differ in more
   than [max_differences] lines. *)
let myers old_ids new_ids =
  let n = Array.length old_ids and m = Array.length new_ids in
  let bound = min (n + m) max_differences in
  let offset = bound + 1 in
  let v = Array.make ((2 * bound) + 3) 0 in
  let trace = ref [] in
  let exception Found of int in
  let found_d =
    try
      for d = 0 to bound do
        let slice =
          Array.init ((2 * d) + 3) (fun i -> v.(i - (d + 1) + offset))
        in
        trace := slice :: !trace;
        let k = ref (-d) in
        while !k <= d do
          let start_x =
            if
              !k = -d
              || (!k <> d && v.(!k - 1 + offset) < v.(!k + 1 + offset))
            then v.(!k + 1 + offset)
            else v.(!k - 1 + offset) + 1
          in
          let x = ref start_x in
          let y = ref (start_x - !k) in
          while !x < n && !y < m && old_ids.(!x) = new_ids.(!y) do
            incr x;
            incr y
          done;
          v.(!k + offset) <- !x;
          if !x >= n && !y >= m then raise (Found d);
          k := !k + 2
        done
      done;
      None
    with Found d -> Some d
  in
  match found_d with
  | None -> None
  | Some found_d ->
      (* Walk back from (n, m), reading each round's snapshot to find where
         the path entered it: a vertical step is an insertion, a horizontal
         step a deletion, and the diagonal run before it is kept lines. *)
      let edits = ref [] in
      let x = ref n and y = ref m in
      let rec go d = function
        | [] -> ()
        | slice :: earlier ->
            let slice_offset = d + 1 in
            let k = !x - !y in
            let previous_k =
              if
                k = -d
                || (k <> d
                   && slice.(k - 1 + slice_offset)
                      < slice.(k + 1 + slice_offset))
              then k + 1
              else k - 1
            in
            let previous_x = slice.(previous_k + slice_offset) in
            let previous_y = previous_x - previous_k in
            while !x > previous_x && !y > previous_y do
              edits := Keep :: !edits;
              decr x;
              decr y
            done;
            if d > 0 then
              edits := (if !x = previous_x then Insert else Delete) :: !edits;
            x := previous_x;
            y := previous_y;
            go (d - 1) earlier
      in
      go found_d !trace;
      Some !edits

let of_contents old_content new_content =
  let old_lines = Array.of_list (split_lines old_content) in
  let new_lines = Array.of_list (split_lines new_content) in
  let old_length = Array.length old_lines in
  let new_length = Array.length new_lines in
  (* Trim the common prefix and suffix before searching: they are context by
     definition, and the difference cap should apply to what actually
     differs. *)
  let prefix = ref 0 in
  while
    !prefix < old_length
    && !prefix < new_length
    && old_lines.(!prefix) = new_lines.(!prefix)
  do
    incr prefix
  done;
  let prefix = !prefix in
  let suffix = ref 0 in
  while
    !suffix < old_length - prefix
    && !suffix < new_length - prefix
    && old_lines.(old_length - 1 - !suffix) = new_lines.(new_length - 1 - !suffix)
  do
    incr suffix
  done;
  let suffix = !suffix in
  let middle_old = old_length - prefix - suffix in
  let middle_new = new_length - prefix - suffix in
  (* Intern the middle lines so the search compares integers, not strings. *)
  let ids = Hashtbl.create 64 in
  let next_id = ref 0 in
  let id_of line =
    match Hashtbl.find_opt ids line with
    | Some id -> id
    | None ->
        let id = !next_id in
        incr next_id;
        Hashtbl.add ids line id;
        id
  in
  let old_ids = Array.init middle_old (fun i -> id_of old_lines.(prefix + i)) in
  let new_ids = Array.init middle_new (fun i -> id_of new_lines.(prefix + i)) in
  let edits =
    match myers old_ids new_ids with
    | Some edits -> edits
    | None ->
        (* Too many differences: list the middle as wholesale replacement. *)
        List.init middle_old (fun _ -> Delete)
        @ List.init middle_new (fun _ -> Insert)
  in
  (* Reassemble: prefix context, the edit script over the middle, suffix
     context, numbering lines in each file as we go. *)
  let context index =
    {
      kind = Context;
      old_number = Some (index + 1);
      new_number = Some (index + 1);
      text = old_lines.(index);
    }
  in
  let prefix_lines = List.init prefix context in
  let old_index = ref prefix and new_index = ref prefix in
  let middle_lines =
    List.map
      (fun edit ->
        match edit with
        | Keep ->
            let line =
              {
                kind = Context;
                old_number = Some (!old_index + 1);
                new_number = Some (!new_index + 1);
                text = old_lines.(!old_index);
              }
            in
            incr old_index;
            incr new_index;
            line
        | Delete ->
            let line =
              {
                kind = Deletion;
                old_number = Some (!old_index + 1);
                new_number = None;
                text = old_lines.(!old_index);
              }
            in
            incr old_index;
            line
        | Insert ->
            let line =
              {
                kind = Addition;
                old_number = None;
                new_number = Some (!new_index + 1);
                text = new_lines.(!new_index);
              }
            in
            incr new_index;
            line)
      edits
  in
  let suffix_lines =
    List.init suffix (fun i ->
        {
          kind = Context;
          old_number = Some (old_length - suffix + i + 1);
          new_number = Some (new_length - suffix + i + 1);
          text = old_lines.(old_length - suffix + i);
        })
  in
  prefix_lines @ middle_lines @ suffix_lines

let hunks ?(context = 3) lines =
  let lines = Array.of_list lines in
  let length = Array.length lines in
  let changed =
    Array.to_list (Array.mapi (fun index line -> (index, line.kind)) lines)
    |> List.filter_map (function
      | index, (Addition | Deletion) -> Some index
      | _, Context -> None)
  in
  let ranges =
    let add_range ranges index =
      let first = max 0 (index - context) in
      let last = min (length - 1) (index + context) in
      match ranges with
      | (range_first, range_last) :: rest when first <= range_last + 1 ->
          (range_first, max range_last last) :: rest
      | _ -> (first, last) :: ranges
    in
    List.fold_left add_range [] changed |> List.rev
  in
  let number_or_zero get_number slice =
    List.find_map get_number slice |> Option.value ~default:0
  in
  let make_hunk (first, last) =
    let rec slice index acc =
      if index > last then List.rev acc
      else slice (index + 1) (lines.(index) :: acc)
    in
    let lines = slice first [] in
    {
      old_start = number_or_zero (fun line -> line.old_number) lines;
      old_count =
        List.fold_left
          (fun count line ->
            if Option.is_some line.old_number then count + 1 else count)
          0 lines;
      new_start = number_or_zero (fun line -> line.new_number) lines;
      new_count =
        List.fold_left
          (fun count line ->
            if Option.is_some line.new_number then count + 1 else count)
          0 lines;
      lines;
    }
  in
  List.map make_hunk ranges