Towards word diffing

.ocamlformat

@@ -1 +1,2 @@
-version = 0.26.1
+version = 0.26.1
+parse-docstrings=true

example.diff

@@ -1,3 +1,52 @@
+--- a/document.txt
++++ b/document.txt
+@@ -1,5 +1,5 @@
+-The quick brown fox jumps over the lazy dog.
++The fast brown fox leaps over the sleeping dog.
+ She sells seashells by the seashore.
+-The rain in Spain stays mainly in the plain.
++The rain in France falls mainly on the plain.
+ To be or not to be, that is the question.
+-All that glitters is not gold.
++Not all that glitters is gold.
+@@ -7,3 +7,3 @@
+ A stitch in time saves nine.
+-An apple a day keeps the doctor away.
++An apple each day keeps the doctor away.
+ Actions speak louder than words.
+@@ -11,2 +11,2 @@
+-The early bird catches the worm.
++The early riser catches the worm.
+@@ -14,2 +14,2 @@
+-Practice makes perfect.
++Practice leads to perfection.
+@@ -17,3 +17,3 @@
+ When in Rome, do as the Romans do.
+-Don't put all your eggs in one basket.
++Never put all your eggs in one basket.
+ A penny saved is a penny earned.
+@@ -21,2 +21,2 @@
+-Every cloud has a silver lining.
++Every cloud possesses a silver lining.
+@@ -24,2 +24,2 @@
+-Two wrongs don't make a right.
++Two wrongs never make a right.
+@@ -27,1 +27,2 @@
+ The pen is mightier than the sword.
++Words can be sharper than any blade.
+
+--- a/sample.txt
++++ b/sample.txt
+@@ -1,2 +1,2 @@
+-foo bar baz
++foo bat bak
+@@ -4,2 +4,1 @@
+-The quick brown fox jumps over the lazy dog.
++The quick black cat jumps over the lazy dog.
+@@ -7,2 +6,2 @@
+-She sells sea shells by the sea shore.
++He sells sea shells by the sea floor.
+
 diff --git a/bin/dune b/bin/dune
 index fca70de..fd7f225 100644
 --- a/bin/dune

lib/Block.ml

@@ -0,0 +1,59 @@
+type block_origin = Mine | Their | None
+
+type 'a t =
+  | Common of 'a
+  | Changed of { mine : 'a list; their : 'a list; order : block_origin }
+
+let rec first_change_order (hunk_lines : 'a Patch.line list) : block_origin =
+  match hunk_lines with
+  | [] -> None
+  | `Common _ :: rest -> first_change_order rest
+  | `Mine _ :: _ -> Mine
+  | `Their _ :: _ -> Their
+
+let of_hunk (hunk_lines : 'a Patch.line list) : 'a t list =
+  let collect_consecutive_added lines =
+    let rec aux acc lines =
+      match lines with
+      | `Mine x :: rest -> aux (x :: acc) rest
+      | rest -> (List.rev acc, rest)
+    in
+    aux [] lines
+  in
+  let collect_consecutive_removed lines =
+    let rec aux acc lines =
+      match lines with
+      | `Their x :: rest -> aux (x :: acc) rest
+      | rest -> (List.rev acc, rest)
+    in
+    aux [] lines
+  in
+
+  let make_block ~adds ~dels remaining_lines =
+    let order = first_change_order remaining_lines in
+    Changed { mine = adds; their = dels; order }
+  in
+  let rec process acc = function
+    | [] -> List.rev acc
+    | `Mine x :: rest as lines ->
+        let adds, rest' = collect_consecutive_added (`Mine x :: rest) in
+        let dels, rest'' = collect_consecutive_removed rest' in
+        process (make_block ~adds ~dels lines :: acc) rest''
+    | `Their x :: rest as lines ->
+        let dels, rest' = collect_consecutive_removed (`Their x :: rest) in
+        let adds, rest'' = collect_consecutive_added rest' in
+        process (make_block ~adds ~dels lines :: acc) rest''
+    | `Common x :: rest -> process (Common x :: acc) rest
+  in
+  process [] hunk_lines
+
+let to_hunk (blocks : 'a t list) : 'a Patch.line list =
+  List.concat_map
+    (function
+      | Common x -> [ `Common x ]
+      | Changed { mine; their; order } ->
+          let mine_lines = List.map (fun x -> `Mine x) mine in
+          let their_lines = List.map (fun x -> `Their x) their in
+          if order = Mine then mine_lines @ their_lines
+          else their_lines @ mine_lines)
+    blocks

lib/Block.mli

@@ -0,0 +1,12 @@
+type block_origin = Mine | Their | None
+
+type 'a t =
+  | Common of 'a
+  | Changed of { mine : 'a list; their : 'a list; order : block_origin }
+
+val of_hunk : 'a Patch.line list -> 'a t list
+
+(* Turns a hunk into a list of blocks by grouping consecutive changed lines. *)
+val to_hunk : 'a t list -> 'a Patch.line list
+(* Turns back a list of blocks into a hunk.
+       [x |> of_hunk |> to_hunk] should yield [x] back. *)

lib/HunkView.ml

@@ -1,9 +1,45 @@
 open Nottui
 module W = Nottui_widgets
 
-(* Implementation of Single View Mode *)
+(* Types *)
 
-let ui_hunk_summary (hunk : Patch.hunk) : Nottui.ui =
+type line = Change of string | Common of string | Empty
+
+(* Utility Functions *)
+
+let split_and_align_hunk hunks : line list * line list =
+  let rec process_hunk mine_acc their_acc = function
+    | [] -> (List.rev mine_acc, List.rev their_acc)
+    | `Common line :: rest ->
+        process_hunk (Common line :: mine_acc) (Common line :: their_acc) rest
+    | changes ->
+        let rec buffer_changes mine their = function
+          | `Mine line :: rest ->
+              buffer_changes (Change line :: mine) their rest
+          | `Their line :: rest ->
+              buffer_changes mine (Change line :: their) rest
+          | remaining -> (List.rev mine, List.rev their, remaining)
+        in
+        let mine_changes, their_changes, rest = buffer_changes [] [] changes in
+        let max_len =
+          max (List.length mine_changes) (List.length their_changes)
+        in
+        let rec pad_and_append orig_acc changes i =
+          if i < max_len then
+            if i < List.length changes then
+              pad_and_append (List.nth changes i :: orig_acc) changes (i + 1)
+            else pad_and_append (Empty :: orig_acc) changes (i + 1)
+          else orig_acc
+        in
+        let new_mine_acc = pad_and_append mine_acc mine_changes 0 in
+        let new_their_acc = pad_and_append their_acc their_changes 0 in
+        process_hunk new_mine_acc new_their_acc rest
+  in
+  process_hunk [] [] hunks
+
+(* Normal Mode *)
+
+let ui_hunk_summary (hunk : string Patch.hunk) : Nottui.ui =
   let mine_info =
     if hunk.Patch.mine_len = 0 then "0,0"
     else Printf.sprintf "%d,%d" (hunk.Patch.mine_start + 1) hunk.Patch.mine_len
@@ -31,99 +67,36 @@ let ui_hunk_summary (hunk : Patch.hunk) : Nottui.ui =
       at_symbols;
     ]
 
-let rec process_lines (mine_num : int) (their_num : int) (acc : Nottui.ui list)
-    = function
-  | [] -> List.rev acc
-  | line :: rest ->
-      let new_mine, new_their, ui_element =
-        match line with
-        | `Common line ->
-            let ui =
-              W.string ~attr:Notty.A.empty
-                (Printf.sprintf "%2d %2d   %s" (mine_num + 1) (their_num + 1)
-                   line)
-            in
-            (mine_num + 1, their_num + 1, ui)
-        | `Their line ->
-            let ui =
-              W.string
-                ~attr:Notty.A.(fg green)
-                (Printf.sprintf "   %2d + %s" (their_num + 1) line)
-            in
-            (mine_num, their_num + 1, ui)
-        | `Mine line ->
-            let ui =
-              W.string
-                ~attr:Notty.A.(fg red)
-                (Printf.sprintf "%2d    - %s" (mine_num + 1) line)
-            in
-            (mine_num + 1, their_num, ui)
-      in
-      process_lines new_mine new_their (ui_element :: acc) rest
-
-let ui_unified_diff (hunk : Patch.hunk) : Nottui.ui =
-  let lines_ui =
-    process_lines hunk.Patch.mine_start hunk.Patch.their_start []
-      hunk.Patch.lines
+let ui_unified_diff (hunk : string Patch.hunk) : Nottui.ui =
+  let hunk_summary = ui_hunk_summary hunk in
+  let hunk_content =
+    let blocks = Block.of_hunk hunk.Patch.lines in
+    let single_line_changes =
+      List.for_all
+        (function
+          | Block.Changed { mine; their; _ } ->
+              List.length mine = 1 && List.length their = 1
+          | _ -> true)
+        blocks
+    in
+    if single_line_changes then
+      let word_diff_blocks = List.map WordDiff.compute blocks in
+      let word_diff_lines = Block.to_hunk word_diff_blocks in
+      WordDiff.render_hunk_lines word_diff_lines
+    else WordDiff.render_hunk hunk
   in
-  let lines_ui_vcat = Ui.vcat lines_ui in
-
-  Ui.vcat [ ui_hunk_summary hunk; lines_ui_vcat ]
+  Ui.vcat [ hunk_summary; hunk_content ]
 
-let current_hunks (z_patches : Patch.t Zipper.t) : Nottui.ui =
+let current_hunks (z_patches : string Patch.t Zipper.t) : Nottui.ui =
   let p = Zipper.get_focus z_patches in
   let hunks = List.map ui_unified_diff p.Patch.hunks in
   Ui.vcat hunks
 
 (** Side by side diff view implementation **)
 
-type line = Change of string | Common of string | Empty
-
-(*
-
-    [Common, Their, Their, Mine]
-
-   List A [Common, Their, Their]
-   List B [Common, Mine, Empty]
-*)
-
-let split_and_align_hunk hunks : line list * line list =
-  let rec process_hunk (mine_acc : line list) (their_acc : line list) = function
-    | [] -> (List.rev mine_acc, List.rev their_acc)
-    | `Common line :: rest ->
-        process_hunk (Common line :: mine_acc) (Common line :: their_acc) rest
-    | changes ->
-        let rec buffer_changes (mine : line list) (their : line list) = function
-          | `Mine line :: rest ->
-              buffer_changes (Change line :: mine) their rest
-          | `Their line :: rest ->
-              buffer_changes mine (Change line :: their) rest
-          | remaining -> (List.rev mine, List.rev their, remaining)
-        in
-        let mine_changes, their_changes, rest = buffer_changes [] [] changes in
-        let max_len =
-          max (List.length mine_changes) (List.length their_changes)
-        in
-        let pad_and_append (orig_acc : line list) (changes : line list) :
-            line list =
-          let rec pad_append (acc : line list) (i : int) : line list =
-            if i < max_len then
-              if i < List.length changes then
-                pad_append (List.nth changes i :: acc) (i + 1)
-              else pad_append (Empty :: acc) (i + 1)
-            else acc
-          in
-          pad_append orig_acc 0
-        in
-        let new_mine_acc = pad_and_append mine_acc mine_changes in
-        let new_their_acc = pad_and_append their_acc their_changes in
-        process_hunk new_mine_acc new_their_acc rest
-  in
-  process_hunk [] [] hunks
-
 let lines_with_numbers (lines : line list) (attr_change : Notty.attr)
     (prefix : string) : Nottui.ui list =
-  let rec process_lines (line_num : int) (acc : Nottui.ui list) = function
+  let rec process_lines line_num acc = function
     | [] -> List.rev acc
     | line :: rest ->
         let content, attr, next_num =
@@ -151,7 +124,7 @@ let create_summary (start_line_num : int) (hunk_length : int)
       (Printf.sprintf "@@ %s%d,%d @@" sign start_line_num hunk_length)
   else W.string ~attr (Printf.sprintf "@@ %s0,0 @@" sign)
 
-let ui_of_hunk_side_by_side (hunk : Patch.hunk) : Nottui.ui =
+let ui_of_hunk_side_by_side (hunk : string Patch.hunk) : Nottui.ui =
   let attr_mine = Notty.A.(fg red ++ st bold) in
   let attr_their = Notty.A.(fg green ++ st bold) in
 
@@ -177,7 +150,8 @@ let ui_of_hunk_side_by_side (hunk : Patch.hunk) : Nottui.ui =
       Ui.resize ~w:0 ~sw:2 (Ui.vcat (summary_their :: content_their));
     ]
 
-let current_hunks_side_by_side (z_patches : Patch.t Zipper.t) : Nottui.ui =
+let current_hunks_side_by_side (z_patches : string Patch.t Zipper.t) : Nottui.ui
+    =
   let p = Zipper.get_focus z_patches in
   let hunks_ui = List.map ui_of_hunk_side_by_side p.Patch.hunks in
   Ui.vcat hunks_ui

lib/HunkView.mli

@@ -1,5 +1,7 @@
-val current_hunks : Patch.t Zipper.t -> Nottui.ui
-(** [current_hunks zipper] returns the current hunks in a patch zipper for normal view. *)
+val current_hunks : string Patch.t Zipper.t -> Nottui.ui
+(** [current_hunks zipper] returns the current hunks in a patch zipper for
+    normal view. *)
 
-val current_hunks_side_by_side : Patch.t Zipper.t -> Nottui.ui
-(** [current_hunks_side_by_side zipper] returns the current hunks in a patch zipper for side-by-side view. *)
+val current_hunks_side_by_side : string Patch.t Zipper.t -> Nottui.ui
+(** [current_hunks_side_by_side zipper] returns the current hunks in a patch
+    zipper for side-by-side view. *)

lib/InteractiveViewer.ml

@@ -17,8 +17,8 @@ let quit = Lwd.var false
 let toggle_help_visibility () =
   Lwd.set help_visible (not (Lwd.peek help_visible))
 
-let view (patches : Patch.t list) =
-  let z_patches_var : Patch.t Zipper.t Lwd.var =
+let view (patches : string Patch.t list) =
+  let z_patches_var : string Patch.t Zipper.t Lwd.var =
     match Zipper.zipper_of_list patches with
     | Some z -> Lwd.var z
     | None -> failwith "zipper_of_list: empty list"

lib/InteractiveViewer.mli

@@ -1,5 +1,6 @@
-val start : ?term:Notty_unix.Term.t -> Patch.t list -> unit
+val start : ?term:Notty_unix.Term.t -> string Patch.t list -> unit
 (** [start patches] starts diffcessible with the given patches *)
 
-val start_test : Patch.t list -> char list -> int -> int -> unit
-(** [start_test patches input start_line start_col] starts diffcessible with the given patches and input *)
+val start_test : string Patch.t list -> char list -> int -> int -> unit
+(** [start_test patches input start_line start_col] starts diffcessible with the
+    given patches and input *)

lib/OperationView.ml

@@ -1,7 +1,7 @@
 open Nottui
 module W = Nottui_widgets
 
-let operation_info (z_patches : Patch.t Zipper.t) : Nottui.ui =
+let operation_info (z_patches : string Patch.t Zipper.t) : Nottui.ui =
   let p = Zipper.get_focus z_patches in
   let num_hunks = List.length p.Patch.hunks in
   let hunk_text =
@@ -45,7 +45,7 @@ let ui_of_operation (operation : Patch.operation) : Nottui.ui =
       Ui.hcat
         [ W.string "Modification of "; W.string ~attr:blue_bold_attr path ]
 
-let current_operation (z_patches : Patch.t Zipper.t) : Nottui.ui =
+let current_operation (z_patches : string Patch.t Zipper.t) : Nottui.ui =
   let p = Zipper.get_focus z_patches in
   ui_of_operation p.Patch.operation
 
@@ -58,7 +58,7 @@ let additions_and_removals lines : int * int =
   in
   List.fold_left add_line (0, 0) lines
 
-let accumulate_count (hunks : Patch.hunk list) : int * int =
+let accumulate_count (hunks : string Patch.hunk list) : int * int =
   List.fold_left
     (fun (add_acc, remove_acc) hunk ->
       let add_in_hunk, remove_in_hunk =
@@ -67,7 +67,7 @@ let accumulate_count (hunks : Patch.hunk list) : int * int =
       (add_acc + add_in_hunk, remove_acc + remove_in_hunk))
     (0, 0) hunks
 
-let change_summary (z_patches : Patch.t Zipper.t) : Nottui.ui =
+let change_summary (z_patches : string Patch.t Zipper.t) : Nottui.ui =
   let p = Zipper.get_focus z_patches in
   let total_additions, total_removals = accumulate_count p.Patch.hunks in
   let format_plural n singular plural =