feat(Tty): custom markers

src/MarkedSource.ml

@@ -1,26 +1,26 @@
 include MarkedSourceData
 
-let dump_marker dump_tag fmt =
+let dump_mark dump_tag fmt =
   function
   | RangeBegin tag -> Format.fprintf fmt {|@[<2>RangeBegin@ @[%a@]@]|} dump_tag tag
   | RangeEnd tag -> Format.fprintf fmt {|@[<2>RangeEnd@ @[%a@]@]|} dump_tag tag
   | Point tag -> Format.fprintf fmt {|@[<2>Point@ @[%a@]@]|} dump_tag tag
 
 let dump_special_position fmt =
   function
-  | End_of_line -> Format.fprintf fmt {|End_of_line|}
-  | End_of_file -> Format.fprintf fmt {|End_of_file|}
+  | `End_of_line -> Format.fprintf fmt {|`End_of_line|}
+  | `End_of_file -> Format.fprintf fmt {|`End_of_file|}
 
 let dump_token dump_tag fmt =
   function
   | String str -> Format.fprintf fmt {|@[<2>String@ "%s"@]|} (String.escaped str)
-  | Marker (p, m) ->
+  | Mark (p, m) ->
     Format.fprintf fmt {|@[<2>Marker@ @[<1>(@[%a@],@ @[%a@])@]@]|}
-      (Utils.dump_option dump_special_position) p (dump_marker dump_tag) m
+      (Utils.dump_option dump_special_position) p (dump_mark dump_tag) m
 
-let dump_line dump_tag fmt {markers; tokens} =
-  Format.fprintf fmt {|@[<1>{@[<2>markers=@,@[%a@]@];@ @[<2>tokens=@ @[%a@]@]}@]|}
-    (Utils.dump_list dump_tag) markers
+let dump_line dump_tag fmt {marks; tokens} =
+  Format.fprintf fmt {|@[<1>{@[<2>marks=@,@[%a@]@];@ @[<2>tokens=@ @[%a@]@]}@]|}
+    (Utils.dump_list dump_tag) marks
     (Utils.dump_list (dump_token dump_tag)) tokens
 
 let dump_block dump_tag fmt {begin_line_num; end_line_num; lines} =

src/MarkedSource.mli

@@ -5,8 +5,8 @@ include module type of MarkedSourceData
 
 (** {1 Debugging} *)
 
-(** Ugly printer for {!type:marker} *)
-val dump_marker : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag marker -> unit
+(** Ugly printer for {!type:mark} *)
+val dump_mark : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag mark -> unit
 
 (** Ugly printer for {!type:t} *)
 val dump : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag t -> unit

src/MarkedSourceData.ml

@@ -1,22 +1,17 @@
-(** Special positions. *)
-type special_position =
-  | End_of_line
-  | End_of_file
-
-(** A marker is a delimiter of a range or a specific point. *)
-type 'tag marker =
+(** A mark is a delimiter of a range or a specific point. *)
+type 'tag mark =
   | RangeBegin of 'tag
   | RangeEnd of 'tag
   | Point of 'tag
 
-(** A token is either a string or a marker. *)
+(** A token is either a string or a mark. *)
 type 'tag token =
   | String of string
-  | Marker of special_position option * 'tag marker
+  | Mark of [`End_of_line | `End_of_file] option * 'tag mark
 
 (** A line is a list of {!type:segment}s along with tags. *)
 type 'tag line =
-  { markers : 'tag list (** All tags in this line *)
+  { marks : 'tag list (** All tags in this line *)
   ; tokens : 'tag token list
   }
 

src/RangeFlattener.ml

@@ -7,24 +7,24 @@ open SourceMarkerSigs
 type 'tag block =
   { begin_line_num : int
   ; end_line_num : int
-  ; markers : (Range.position * 'tag marker) list
-  ; line_markers : (int * 'tag) list}
+  ; marks : (Range.position * 'tag mark) list
+  ; line_marks : (int * 'tag) list}
 
 type 'tag t = (Range.source * 'tag block list) list
 
-let dump_block dump_tag fmt {begin_line_num; end_line_num; markers; line_markers} : unit =
+let dump_block dump_tag fmt {begin_line_num; end_line_num; marks; line_marks} : unit =
   Format.fprintf fmt
     begin
       "@[<1>{" ^^
       "begin_line_num=%d;@ " ^^
       "end_line_num=%d;@ " ^^
-      "@[<2>markers=@ @[%a@]@];@ " ^^
+      "@[<2>marks=@ @[%a@]@];@ " ^^
       "@[<2>marked_lines=@,@[%a@]@]" ^^
       "}@]"
     end
     begin_line_num end_line_num
-    (Utils.dump_list (Utils.dump_pair Range.dump_position (dump_marker dump_tag))) markers
-    (Utils.dump_list (Utils.dump_pair Format.pp_print_int dump_tag)) line_markers
+    (Utils.dump_list (Utils.dump_pair Range.dump_position (dump_mark dump_tag))) marks
+    (Utils.dump_list (Utils.dump_pair Format.pp_print_int dump_tag)) line_marks
 
 let dump dump_tag =
   Utils.dump_list @@ Utils.dump_pair Range.dump_source (Utils.dump_list (dump_block dump_tag))
@@ -90,17 +90,17 @@ struct
       partition_sorted ~block_splitting_threshold @@ Bwd.of_list @@ sort_tagged l
   end
 
-  (* Stage 2: for each block, flatten out ranges into markers *)
+  (* Stage 2: for each block, flatten out ranges into marks *)
   module BlockFlattener :
   sig
-    val flatten : (Range.t * Tag.t) list -> (Range.position * Tag.t marker) list
+    val flatten : (Range.t * Tag.t) list -> (Range.position * Tag.t mark) list
   end
   =
   struct
     type t =
-      { begins : (Range.position * Tag.t marker) bwd
-      ; points : (Range.position * Tag.t marker) bwd
-      ; ends : (Range.position * Tag.t marker) list
+      { begins : (Range.position * Tag.t mark) bwd
+      ; points : (Range.position * Tag.t mark) bwd
+      ; ends : (Range.position * Tag.t mark) list
       }
 
     let add (range, tag) {begins; points; ends} =
@@ -110,21 +110,21 @@ struct
       else
         {begins = begins <: (b, RangeBegin tag); points; ends = (e, RangeEnd tag) :: ends}
 
-    let sort_marker =
-      let marker_order =
+    let sort_marks =
+      let mark_order =
         function
         | RangeEnd _ -> -1
         | Point _ -> 0
         | RangeBegin _ -> 1
       in
-      let compare_marker m1 m2 = Int.compare (marker_order m1) (marker_order m2) in
-      List.stable_sort (Utils.compare_pair compare_position compare_marker)
+      let compare_mark m1 m2 = Int.compare (mark_order m1) (mark_order m2) in
+      List.stable_sort (Utils.compare_pair compare_position compare_mark)
 
-    let merge_marker {begins; points; ends} =
+    let merge_marks {begins; points; ends} =
       begins @> points @> ends
 
     let flatten l =
-      sort_marker @@ merge_marker @@
+      sort_marks @@ merge_marks @@
       Bwd.fold_right add (Bwd.of_list l) {begins = Emp; points = Emp; ends = []}
   end
 
@@ -135,15 +135,15 @@ struct
   =
   struct
     let flatten_block ({begin_line_num; end_line_num; ranges} : unflattened_block) =
-      let markers = BlockFlattener.flatten ranges in
-      let line_markers =
+      let marks = BlockFlattener.flatten ranges in
+      let line_marks =
         List.filter_map
           (function
             | (_, RangeBegin _) -> None
             | (p, RangeEnd tag) | (p, Point tag) -> Some (p.Range.line_num, tag))
-          markers
+          marks
       in
-      { begin_line_num; end_line_num; markers; line_markers }
+      { begin_line_num; end_line_num; marks; line_marks }
 
     let flatten ~block_splitting_threshold rs =
       List.map flatten_block @@ RangePartitioner.partition ~block_splitting_threshold rs

src/RangeFlattener.mli

@@ -3,8 +3,8 @@ open MarkedSource
 type 'tag block =
   { begin_line_num : int
   ; end_line_num : int
-  ; markers : (Range.position * 'tag marker) list
-  ; line_markers : (int * 'tag) list (* should be sorted by line numbers *)
+  ; marks : (Range.position * 'tag mark) list
+  ; line_marks : (int * 'tag) list (* should be sorted by line numbers *)
   }
 
 type 'tag t = (Range.source * 'tag block list) list
@@ -16,17 +16,17 @@ module Make (Tag : SourceMarkerSigs.Tag) : sig
   val flatten : block_splitting_threshold:int -> (Range.t * Tag.t) list -> Tag.t t
   (**
      The code needs to handle several subtle cases, expressing in an XML-like notation:
-     - The ordering of range markers and point markers at the same location should be ordered like this:
+     - The ordering of range marks and point marks at the same location should be ordered like this:
        [...</range1><point/><range2>...]
        [RangeEnd] goes first, and then [Point], and then [RangeBegin].
      - If the set of ranges is "well-scoped" (that is, a range is always completely included in,
        completely including, or being disjoint from another range), then matching beginning and
-       ending markers will have the expected nested structures, like this:
+       ending marks will have the expected nested structures, like this:
        [<range1><range2>...</range2><range3>...</range3></range1>]
      - For two ranges marking the same text with different priorities, the prioritized one goes inside.
        This is to reduce interruption of the prioritized highlighting.
        [<low_priority><high_priority>...</high_priority></low_priority>]
-     - For two ranges with the same text and priority, the order of ending markers will follow
+     - For two ranges with the same text and priority, the order of ending marks will follow
        the order of the original input list. This will help the TTY backend display the messages in order.
        [<message2><message1>...</message1></message2>]
   *)

src/SourceMarker.ml

@@ -62,7 +62,7 @@ module Make (Tag : Tag) = struct
   type marker_state =
     { lines : Tag.t line bwd
     ; tokens : Tag.t token bwd
-    ; remaining_line_markers : (int * Tag.t) list
+    ; remaining_line_marks : (int * Tag.t) list
     ; cursor : Range.position
     ; eol : int
     ; eol_shift : int option
@@ -72,53 +72,53 @@ module Make (Tag : Tag) = struct
   module F = RangeFlattener.Make(Tag)
 
   let mark_block ~line_breaks source (b : Tag.t RangeFlattener.block) : Tag.t block =
-    match b.markers with
+    match b.marks with
     | [] -> invalid_arg "mark_block: empty block; should be impossible"
-    | ((first_loc, _) :: _) as markers ->
+    | ((first_loc, _) :: _) as marks ->
       let source = SourceReader.load source in
       let eof = SourceReader.length source in
       let find_eol i = StringUtils.find_eol ~line_breaks (SourceReader.unsafe_get source) (i, eof) in
-      let rec go state : (Range.position * Tag.t marker) list -> _ =
+      let rec go state : (Range.position * Tag.t mark) list -> _ =
         function
-        | (loc, marker) :: markers when state.cursor.line_num = loc.line_num (* on the same line *) ->
+        | (loc, mark) :: marks when state.cursor.line_num = loc.line_num (* on the same line *) ->
           if loc.offset > eof then invalid_arg "Asai.SourceMarker.mark: position beyond EOF; use the debug mode";
           if loc.offset > state.eol then invalid_arg "Asai.SourceMarker.mark: unexpected newline; use the debug mode";
           let special_position =
             if loc.offset = state.eol then
               if loc.offset = eof then
-                Some End_of_file
+                Some `End_of_file
               else
-                Some End_of_line
+                Some `End_of_line
             else
               None
           in
           let tokens =
             if loc.offset = state.cursor.offset then
-              state.tokens <: Marker (special_position, marker)
+              state.tokens <: Mark (special_position, mark)
             else
-              state.tokens <: String (read_between ~source state.cursor.offset loc.offset) <: Marker (special_position, marker)
+              state.tokens <: String (read_between ~source state.cursor.offset loc.offset) <: Mark (special_position, mark)
           in
-          go { state with tokens; cursor = loc } markers
-        | markers ->
+          go { state with tokens; cursor = loc } marks
+        | marks ->
           (* Shifting to the next line *)
-          let lines, remaining_line_markers =
+          let lines, remaining_line_marks =
             let tokens =
               if state.cursor.offset < state.eol then
                 state.tokens <: String (read_between ~source state.cursor.offset state.eol)
               else
                 state.tokens
             in
-            let line_markers, remaining_line_markers =
-              Utils.span (fun (line_num, _) -> line_num = state.line_num) state.remaining_line_markers
+            let line_marks, remaining_line_marks =
+              Utils.span (fun (line_num, _) -> line_num = state.line_num) state.remaining_line_marks
             in
             (state.lines <:
              { tokens = Bwd.to_list tokens
-             ; markers = List.map snd line_markers
+             ; marks = List.map snd line_marks
              }),
-            remaining_line_markers
+            remaining_line_marks
           in
-          (* Continue the process if [markers] is not empty. *)
-          match markers, state.eol_shift with
+          (* Continue the process if [marks] is not empty. *)
+          match marks, state.eol_shift with
           | [], _ ->
             assert (state.line_num = b.end_line_num);
             lines
@@ -133,27 +133,27 @@ module Make (Tag : Tag) = struct
             go
               { lines
               ; tokens = Emp
-              ; remaining_line_markers
+              ; remaining_line_marks
               ; cursor
               ; eol
               ; eol_shift
               ; line_num = state.line_num + 1
               }
-              markers
+              marks
       in
       let lines =
         let begin_pos = to_start_of_line first_loc in
         let eol, eol_shift = find_eol first_loc.offset in
         go
           { lines = Emp
           ; tokens = Emp
-          ; remaining_line_markers = b.line_markers
+          ; remaining_line_marks = b.line_marks
           ; cursor = begin_pos
           ; eol
           ; eol_shift
           ; line_num = b.begin_line_num
           }
-          markers
+          marks
       in
       { begin_line_num = b.begin_line_num
       ; end_line_num = b.end_line_num