diff --git a/src-lsp/LspShims.ml b/src-lsp/LspShims.ml
index e79cb07..24f49e0 100644
--- a/src-lsp/LspShims.ml
+++ b/src-lsp/LspShims.ml
@@ -10,11 +10,7 @@ struct
let lsp_range_of_range (r : Asai.Range.t option) =
match r with
| Some r ->
- let (start , stop) =
- match Asai.Range.view r with
- | `Range (start, stop) -> start, stop
- | `End_of_file pos -> pos, pos
- in
+ let (start, stop) = Asai.Range.split r in
L.Range.create
~start:(lsp_pos_of_pos start)
~end_:(lsp_pos_of_pos stop)
diff --git a/src/Explication.ml b/src/Explication.ml
index f2c4ded..f3add5b 100644
--- a/src/Explication.ml
+++ b/src/Explication.ml
@@ -1,11 +1,20 @@
include ExplicationData
-let dump_seg dump_tag = Utils.dump_pair (Utils.dump_option dump_tag) Utils.dump_string
+let dump_marker 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_line dump_tag fmt {tags; segments} =
- Format.fprintf fmt {|@[<1>{@[<2>tags=@,@[%a@]@];@ @[<2>segments=@ @[%a@]@]}@]|}
- (Utils.dump_list dump_tag) tags
- (Utils.dump_list (dump_seg dump_tag)) segments
+let dump_token dump_tag fmt =
+ function
+ | String str -> Format.fprintf fmt {|@[<2>String@ "%s"@]|} (String.escaped str)
+ | Marker m -> Format.fprintf fmt {|@[<2>Marker@ @[<1>(%a)@]@]|} (dump_marker 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
+ (Utils.dump_list (dump_token dump_tag)) tokens
let dump_block dump_tag fmt {begin_line_num; end_line_num; lines} =
Format.fprintf fmt {|@[<1>{begin_line_num=%d;@ end_line_num=%d;@ @[<2>lines=@ @[%a@]@]}@]|}
diff --git a/src/Explication.mli b/src/Explication.mli
index 9956454..0b2193e 100644
--- a/src/Explication.mli
+++ b/src/Explication.mli
@@ -5,5 +5,8 @@ include module type of ExplicationData
(** {1 Debugging} *)
-(** Ugly printer for debugging *)
+(** Ugly printer for {!type:marker} *)
+val dump_marker : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag marker -> unit
+
+(** Ugly printer for {!type:t} *)
val dump : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag t -> unit
diff --git a/src/ExplicationData.ml b/src/ExplicationData.ml
index 29947cc..98f47e6 100644
--- a/src/ExplicationData.ml
+++ b/src/ExplicationData.ml
@@ -1,10 +1,18 @@
-(** A segment is an optionally tagged string from the user content. (Note the use of [option].) *)
-type 'tag segment = 'tag option * string
+(** A marker is a delimiter of a range or a specific point. *)
+type 'tag marker =
+ | RangeBegin of 'tag
+ | RangeEnd of 'tag
+ | Point of 'tag
+
+(** A token is either a string or a marker. *)
+type 'tag token =
+ | String of string
+ | Marker of 'tag marker
(** A line is a list of {!type:segment}s along with tags. *)
type 'tag line =
- { tags : 'tag list
- ; segments : 'tag segment list
+ { markers : 'tag list (** All tags in this line *)
+ ; tokens : 'tag token list
}
(** A block is a collection of consecutive lines. *)
diff --git a/src/Explicator.ml b/src/Explicator.ml
index 9bba26d..dc4249c 100644
--- a/src/Explicator.ml
+++ b/src/Explicator.ml
@@ -30,9 +30,6 @@ let print_invalid_range fmt : UserContent.invalid_range -> unit =
Format.fprintf fmt "its@ beginning@ position@ is@ invalid;@ %a" print_invalid_position r
| `End r ->
Format.fprintf fmt "its@ ending@ position@ is@ invalid;@ %a" print_invalid_position r
- | `Not_end_of_file (l, l') ->
- Format.fprintf fmt "its@ offset@ %d@ is@ not@ the@ end@ of@ file@ (%d)." l l'
- | `End_of_file r -> print_invalid_position fmt r
let () = Printexc.register_printer @@
function
@@ -45,12 +42,11 @@ let () = Printexc.register_printer @@
| _ -> None
let to_start_of_line (pos : Range.position) = {pos with offset = pos.start_of_line}
-let default_blend ~(priority : _ -> int) t1 t2 = if priority t2 <= priority t1 then t2 else t1
module Make (Tag : Tag) = struct
type position = Range.position
- (** Skip the newline sequence, assuming that [shift] is not zero. (Otherwise, it means we already reached eof.) *)
+ (** Skip the newline sequence, assuming that [shift] is not zero. (Otherwise, it means we already reached EOF.) *)
let eol_to_next_line shift (pos : position) : position =
assert (shift <> 0);
{ source = pos.source;
@@ -65,9 +61,8 @@ module Make (Tag : Tag) = struct
type explicator_state =
{ lines : Tag.t line bwd
- ; segments : Tag.t segment bwd
- ; remaining_tagged_lines : (Tag.t * int) list
- ; current_tag : Tag.t option
+ ; tokens : Tag.t token bwd
+ ; remaining_line_markers : (int * Tag.t) list
; cursor : Range.position
; eol : int
; eol_shift : int option
@@ -76,96 +71,95 @@ module Make (Tag : Tag) = struct
module F = Flattener.Make(Tag)
- let explicate_block ~line_breaks (b : Tag.t Flattener.block) : Tag.t block =
- match b.tagged_positions with
- | [] -> invalid_arg "explicate_block: empty block"
- | ((_, ploc) :: _) as ps ->
- let source = SourceReader.load ploc.source in
+ let explicate_block ~line_breaks source (b : Tag.t Flattener.block) : Tag.t block =
+ match b.markers with
+ | [] -> invalid_arg "explicate_block: empty block; should be impossible"
+ | ((first_loc, _) :: _) as markers ->
+ let source = SourceReader.load source in
let eof = SourceReader.length source in
let find_eol i = UserContent.find_eol ~line_breaks (SourceReader.unsafe_get source) (i, eof) in
- let rec go state : (Tag.t option * Range.position) list -> _ =
+ let rec go state : (Range.position * Tag.t marker) list -> _ =
function
- | (ptag, ploc) :: ps when state.cursor.line_num = ploc.line_num ->
- if ploc.offset > eof then invalid_arg "Asai.Explicator.explicate: beyond eof; use the debug mode";
- if ploc.offset > state.eol then invalid_arg "Asai.Explicator.explicate: unexpected newline; use the debug mode";
- if ploc.offset = state.cursor.offset then
- go {state with cursor = ploc; current_tag = ptag} ps
- else
- (* Still on the same line *)
- let segments =
- state.segments <:
- (state.current_tag, read_between ~source state.cursor.offset ploc.offset)
- in
- go { state with segments; cursor = ploc; current_tag = ptag } ps
- | ps ->
+ | (loc, marker) :: markers when state.cursor.line_num = loc.line_num (* on the same line *) ->
+ if loc.offset > eof then invalid_arg "Asai.Explicator.explicate: position beyond EOF; use the debug mode";
+ if loc.offset > state.eol then invalid_arg "Asai.Explicator.explicate: unexpected newline; use the debug mode";
+ let tokens =
+ if loc.offset = state.cursor.offset then
+ state.tokens <: Marker marker
+ else
+ state.tokens <: String (read_between ~source state.cursor.offset loc.offset) <: Marker marker
+ in
+ go { state with tokens; cursor = loc } markers
+ | markers ->
(* Shifting to the next line *)
- let lines, remaining_tagged_lines =
- let segments =
+ let lines, remaining_line_markers =
+ let tokens =
if state.cursor.offset < state.eol then
- state.segments
- <: (state.current_tag, read_between ~source state.cursor.offset state.eol)
- else if Option.is_none state.eol_shift && Option.is_some state.current_tag then
- state.segments
- <: (state.current_tag, "‹EOF›")
+ state.tokens <: String (read_between ~source state.cursor.offset state.eol)
else
- state.segments
+ state.tokens
+ in
+ let line_markers, remaining_line_markers =
+ Utils.span (fun (line_num, _) -> line_num = state.line_num) state.remaining_line_markers
in
- let tagged_lines, remaining_tagged_lines = Utils.span (fun (_, i) -> i = state.line_num) state.remaining_tagged_lines in
- (state.lines <: {segments = Bwd.to_list segments; tags = List.map fst tagged_lines}), remaining_tagged_lines
+ (state.lines <:
+ { tokens = Bwd.to_list tokens
+ ; markers = List.map snd line_markers
+ }),
+ remaining_line_markers
in
- (* Continue the process if [ps] is not empty. *)
- match ps, state.eol_shift with
+ (* Continue the process if [markers] is not empty. *)
+ match markers, state.eol_shift with
| [], _ ->
assert (state.line_num = b.end_line_num);
lines
- | _ :: _, None -> invalid_arg "Asai.Explicator.explicate: beyond eof; use the debug mode"
- | (_, ploc) :: _, Some eol_shift ->
- if ploc.offset > eof then invalid_arg "Asai.Explicator.explicate: beyond eof; use the debug mode";
- if ploc.offset <= state.eol then invalid_arg "Asai.Explicator.explicate: expected newline missing; use the debug mode";
- if ploc.offset < state.eol + eol_shift then invalid_arg "Asai.Explicator.explicate: offset within newline; use the debug mode";
+ | _ :: _, None -> invalid_arg "Asai.Explicator.explicate: position beyond EOF; use the debug mode"
+ | (loc, _) :: _, Some eol_shift ->
+ if loc.offset > eof then invalid_arg "Asai.Explicator.explicate: position beyond EOF; use the debug mode";
+ if loc.offset <= state.eol then invalid_arg "Asai.Explicator.explicate: expected newline missing; use the debug mode";
+ if loc.offset < state.eol + eol_shift then invalid_arg "Asai.Explicator.explicate: offset within newline; use the debug mode";
(* Okay, p is really on the next line *)
let cursor = eol_to_next_line eol_shift {state.cursor with offset = state.eol} in
let eol, eol_shift = find_eol (state.eol + eol_shift) in
go
{ lines
- ; segments = Emp
- ; remaining_tagged_lines
- ; current_tag = state.current_tag
+ ; tokens = Emp
+ ; remaining_line_markers
; cursor
; eol
; eol_shift
; line_num = state.line_num + 1
}
- ps
+ markers
in
- let begin_pos = to_start_of_line ploc in
- let eol, eol_shift = find_eol ploc.offset 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
- ; segments = Emp
- ; remaining_tagged_lines = b.tagged_lines
- ; current_tag = None
+ ; tokens = Emp
+ ; remaining_line_markers = b.line_markers
; cursor = begin_pos
; eol
; eol_shift
; line_num = b.begin_line_num
}
- ps
+ markers
in
{ begin_line_num = b.begin_line_num
; end_line_num = b.end_line_num
; lines = Bwd.to_list @@ lines
}
- let[@inline] explicate_blocks ~line_breaks = List.map (explicate_block ~line_breaks)
+ let[@inline] explicate_blocks ~line_breaks source ranges =
+ List.map (explicate_block ~line_breaks source) ranges
let[@inline] explicate_part ~line_breaks (source, bs) : Tag.t part =
- { source; blocks = explicate_blocks ~line_breaks bs }
+ { source; blocks = explicate_blocks ~line_breaks source bs }
let check_ranges ~line_breaks ranges =
List.iter
- (fun (_, range) ->
+ (fun (range, _) ->
let source = SourceReader.load @@ Range.source range in
let read = SourceReader.unsafe_get source in
let eof = SourceReader.length source in
@@ -173,8 +167,7 @@ module Make (Tag : Tag) = struct
with UserContent.Invalid_range reason -> raise @@ Invalid_range (range, reason))
ranges
- let explicate ?(line_breaks=`Traditional) ?(block_splitting_threshold=5)
- ?(blend=default_blend ~priority:Tag.priority) ?(debug=false) ranges =
+ let explicate ?(line_breaks=`Traditional) ?(block_splitting_threshold=5) ?(debug=false) ranges =
if debug then check_ranges ~line_breaks ranges;
- List.map (explicate_part ~line_breaks) @@ F.flatten ~block_splitting_threshold ~blend ranges
+ List.map (explicate_part ~line_breaks) @@ F.flatten ~block_splitting_threshold ranges
end
diff --git a/src/Explicator.mli b/src/Explicator.mli
index 68c44a8..aa101eb 100644
--- a/src/Explicator.mli
+++ b/src/Explicator.mli
@@ -1,7 +1,4 @@
include module type of ExplicatorSigs
-(** The default tag blending algorithm that chooses the more important tag based on priority. *)
-val default_blend : priority:('tag -> int) -> 'tag -> 'tag -> 'tag
-
(** Making an explicator. *)
module Make : functor (Tag : Tag) -> S with module Tag := Tag
diff --git a/src/ExplicatorSigs.ml b/src/ExplicatorSigs.ml
index 4f0fd22..f005b43 100644
--- a/src/ExplicatorSigs.ml
+++ b/src/ExplicatorSigs.ml
@@ -8,7 +8,9 @@ module type Tag = sig
(** The abstract type of tags. *)
type t
- (** Get the priority number of a tag. We followed the UNIX convention here---a {i smaller} priority number represents higher priority. The convention works well with {!val:List.sort}, which sorts numbers in ascending order. (The more important things go first.) *)
+ (** Get the priority number of a tag. A {i smaller} priority number represents higher priority.
+
+ The convention works well with {!val:List.sort}, which sorts numbers in ascending order: the more important things go first. *)
val priority : t -> int
(** Ugly printer for debugging *)
@@ -19,12 +21,11 @@ end
module type S = sig
module Tag : Tag
- val explicate : ?line_breaks:[`Unicode | `Traditional] -> ?block_splitting_threshold:int -> ?blend:(Tag.t -> Tag.t -> Tag.t) -> ?debug:bool -> (Tag.t * Range.t) list -> Tag.t t
+ val explicate : ?line_breaks:[`Unicode | `Traditional] -> ?block_splitting_threshold:int -> ?debug:bool -> (Range.t * Tag.t) list -> Tag.t t
(** Explicate a list of ranges using content from a data reader. This function must be run under [SourceReader.run].
@param line_breaks The set of character sequences that are recognized as (hard) line breaks. The [`Unicode] set contains all Unicode character sequences in {{:https://www.unicode.org/versions/Unicode15.0.0/ch05.pdf#G41643}Unicode 15.0.0 Table 5-1.} The [`Traditional] set only contains [U+000A (LF)], [U+000D (CR)], and [U+000D U+000A (CRLF)] as line breaks. The default is the [`Traditional] set.
@param block_splitting_threshold The maximum number of consecutive, non-highlighted lines allowed in a block. The function will try to minimize the number of blocks, as long as no block has too many consecutive, non-highlighted lines. A higher threshold will lead to fewer blocks. When the threshold is zero, it means no block can contain any non-highlighted line. The default value is zero.
- @param blend The algorithm to blend two tags on a visual range. The default algorithm chooses the more important tag based on priority.
@param debug Whether to enable the debug mode that performs expensive extra checking. The default is [false].
@raise Invalid_range See {!exception:Invalid_range}.
diff --git a/src/Flattener.ml b/src/Flattener.ml
index 9d17038..2a9279b 100644
--- a/src/Flattener.ml
+++ b/src/Flattener.ml
@@ -1,28 +1,30 @@
open Bwd
open Bwd.Infix
+open Explication
open ExplicatorSigs
type 'tag block =
{ begin_line_num : int
; end_line_num : int
- ; tagged_positions : ('tag option * Range.position) list
- ; tagged_lines : ('tag * int) list}
+ ; markers : (Range.position * 'tag marker) list
+ ; line_markers : (int * 'tag) list}
type 'tag t = (Range.source * 'tag block list) list
-let dump_block dump_tag fmt {begin_line_num; end_line_num; tagged_positions; tagged_lines} : unit =
+let dump_block dump_tag fmt {begin_line_num; end_line_num; markers; line_markers} : unit =
Format.fprintf fmt
begin
"@[<1>{" ^^
"begin_line_num=%d;@ " ^^
"end_line_num=%d;@ " ^^
- "@[<2>tagged_positions=@ @[%a@]@];@ " ^^
- "@[<2>tagged_lines=@,@[%a@]@]}@]"
+ "@[<2>markers=@ @[%a@]@];@ " ^^
+ "@[<2>marked_lines=@,@[%a@]@]" ^^
+ "}@]"
end
begin_line_num end_line_num
- (Utils.dump_list (Utils.dump_pair (Utils.dump_option dump_tag) Range.dump_position)) tagged_positions
- (Utils.dump_list (Utils.dump_pair dump_tag Format.pp_print_int)) tagged_lines
+ (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
let dump dump_tag =
Utils.dump_list @@ Utils.dump_pair Range.dump_source (Utils.dump_list (dump_block dump_tag))
@@ -32,152 +34,166 @@ struct
type unflattened_block =
{ begin_line_num : int
; end_line_num : int
- ; ranges : (Tag.t * Range.t) list}
+ ; ranges : (Range.t * Tag.t) list
+ }
- module Splitter :
+ let compare_position (p1 : Range.position) (p2 : Range.position) =
+ Int.compare p1.offset p2.offset
+
+ (* Stage 1: group ranges into blocks *)
+ module RangePartitioner :
sig
- val partition : block_splitting_threshold:int -> (Tag.t * Range.t) list -> unflattened_block list
+ val partition : block_splitting_threshold:int -> (Range.t * Tag.t) list -> unflattened_block list
end
=
struct
- let compare_range (s1 : Range.t) (s2 : Range.t) =
- Utils.compare_pair Int.compare Int.compare
- (Range.end_offset s1, Range.begin_offset s1)
- (Range.end_offset s2, Range.begin_offset s2)
-
- let compare_range_tagged (t1, sp1) (t2, sp2) =
- Utils.compare_pair compare_range Int.compare
- (sp1, Tag.priority t1)
- (sp2, Tag.priority t2)
-
- let sort_tagged = List.stable_sort compare_range_tagged
+ (* Sort the ranges by their ending positions;
+ if equal sort them by their beginning positions in reverse (larger ranges go last);
+ if still equal, sort them by priority (important ones go first) *)
+ let sort_tagged =
+ let compare_range (s1 : Range.t) (s2 : Range.t) =
+ let b1, e1 = Range.split s1
+ and b2, e2 = Range.split s2
+ in
+ Utils.compare_pair compare_position (Utils.compare_opposite compare_position)
+ (e1, b1) (e2, b2)
+ in
+ let compare_range_tagged (sp1, t1) (sp2, t2) =
+ Utils.compare_pair compare_range Int.compare
+ (sp1, Tag.priority t1) (sp2, Tag.priority t2)
+ in
+ List.stable_sort compare_range_tagged
- let block_of_range ((_, sloc) as s) : unflattened_block =
- { begin_line_num = Range.begin_line_num sloc
- ; end_line_num = Range.end_line_num sloc
- ; ranges = [s]}
+ let singleton ((range, _) as r) : unflattened_block =
+ { begin_line_num = Range.begin_line_num range
+ ; end_line_num = Range.end_line_num range
+ ; ranges = [ r ]
+ }
let partition_sorted ~block_splitting_threshold l : unflattened_block list =
let rec go rs block (blocks : unflattened_block list) =
match rs with
| Emp -> block :: blocks
- | Snoc (rs, ((_, rloc) as r)) ->
- if block.begin_line_num - Range.end_line_num rloc > block_splitting_threshold then
- go rs (block_of_range r) (block :: blocks)
+ | Snoc (rs, ((range, _) as r)) ->
+ if block.begin_line_num - Range.end_line_num range > block_splitting_threshold then
+ go rs (singleton r) (block :: blocks)
else
- let begin_line_num = Int.min block.begin_line_num (Range.begin_line_num rloc) in
+ let begin_line_num = Int.min block.begin_line_num (Range.begin_line_num range) in
go rs {block with begin_line_num; ranges = r :: block.ranges} blocks
in
- match Bwd.of_list l with
+ match l with
| Emp -> []
| Snoc (rs, r) ->
- go rs (block_of_range r) []
+ go rs (singleton r) []
let partition ~block_splitting_threshold l =
- partition_sorted ~block_splitting_threshold (sort_tagged l)
+ partition_sorted ~block_splitting_threshold @@ Bwd.of_list @@ sort_tagged l
end
+ (* Stage 2: for each block, flatten out ranges into markers
+
+ The code needs to handle several subtleties, using the XML-like notation to demonstrate:
+ 1. The ordering of markers and text strings should be ordered like this:
+ ......
+ Note that, in the middle, RangeEnd goes first, and then Point, and then RangeBegin.
+ 2. 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:
+ ......
+ 3. For two ranges marking the same text with different priorities, the prioritized one goes inside.
+ For two ranges with the same text and priority, the order of beginning markers will follow
+ the order of the original input list. This is to reduce interruption of the prioritized highlighting.
+ ...
+ *)
module BlockFlattener :
sig
- val flatten : blend:(Tag.t -> Tag.t -> Tag.t) -> (Tag.t * Range.t) list -> (Tag.t option * Range.position) list
+ val flatten : (Range.t * Tag.t) list -> (Range.position * Tag.t marker) list
end
=
struct
- type t = (Tag.t option * Range.position) bwd
+ type t =
+ { begins : (Range.position * Tag.t marker) bwd
+ ; points : (Range.position * Tag.t marker) bwd
+ ; ends : (Range.position * Tag.t marker) list
+ }
- (* precondition: x1 < x2 and there are already points at x1 and x2 *)
- let impose ~blend xtag (x1 : int) (x2 : int) : t -> t =
- let blend_opt =
- function
- | None -> Some xtag
- | Some t -> Some (blend t xtag)
- in
- let[@tail_mod_cons] rec go2 : t -> t =
- function
- | Snoc (ps, (ptag, ploc)) when ploc.offset >= x1 ->
- Snoc (go2 ps, (blend_opt ptag, ploc))
- | ps -> ps
- in
- let[@tail_mod_cons] rec go1 : t -> t =
- function
- | Snoc (ps, ((_, ploc) as p)) when ploc.offset >= x2 ->
- Snoc (go1 ps, p)
- | ps -> go2 ps
- in
- go1
+ let add (range, tag) {begins; points; ends} =
+ let b, e = Range.split range in
+ if b.offset = e.offset then
+ {begins; points = points <: (b, Point tag); ends}
+ else
+ {begins = begins <: (b, RangeBegin tag); points; ends = (e, RangeEnd tag) :: ends}
- let ensure_point (x : Range.position) =
- let[@tail_mod_cons] rec go : t -> t =
+ let sort_marker =
+ let marker_order =
function
- | Snoc (ps, ((_, ploc) as p)) when ploc.offset > x.offset ->
- Snoc (go ps, p)
- | Emp -> Emp <: (None, x)
- | Snoc (_, (ptag, p)) as ps ->
- if p.offset = x.offset then
- ps
- else
- ps <: (ptag, x)
+ | RangeEnd _ -> -1
+ | Point _ -> 0
+ | RangeBegin _ -> 1
in
- go
+ 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 add ~blend l (tag, value) =
- match Range.view value with
- | `Range (x1, x2) ->
- impose ~blend tag x1.offset x2.offset @@ ensure_point x2 @@ ensure_point x1 l
- | `End_of_file x ->
- impose ~blend tag x.offset Int.max_int @@ ensure_point x l
+ let merge_marker {begins; points; ends} =
+ begins @> points @> ends
- let flatten ~blend l =
- Bwd.to_list @@ List.fold_left (add ~blend) Emp l
+ let flatten l =
+ sort_marker @@ merge_marker @@
+ Bwd.fold_right add (Bwd.of_list l) {begins = Emp; points = Emp; ends = []}
end
- module File :
+ module FileFlattener :
sig
- val flatten : block_splitting_threshold:int -> blend:(Tag.t -> Tag.t -> Tag.t) -> (Tag.t * Range.t) list -> Tag.t block list
+ val flatten : block_splitting_threshold:int -> (Range.t * Tag.t) list -> Tag.t block list
end
=
struct
- let flatten_block ~blend ({begin_line_num; end_line_num; ranges} : unflattened_block) =
- { begin_line_num
- ; end_line_num
- ; tagged_positions = BlockFlattener.flatten ~blend ranges
- ; tagged_lines = List.map (fun (tag, value) -> tag, Range.end_line_num value) ranges
- }
+ let flatten_block ({begin_line_num; end_line_num; ranges} : unflattened_block) =
+ let markers = BlockFlattener.flatten ranges in
+ let line_markers =
+ List.filter_map
+ (function
+ | (_, RangeBegin _) -> None
+ | (p, RangeEnd tag) | (p, Point tag) -> Some (p.Range.line_num, tag))
+ markers
+ in
+ { begin_line_num; end_line_num; markers; line_markers }
- let flatten ~block_splitting_threshold ~blend rs =
- List.map (flatten_block ~blend) @@ Splitter.partition ~block_splitting_threshold rs
+ let flatten ~block_splitting_threshold rs =
+ List.map flatten_block @@ RangePartitioner.partition ~block_splitting_threshold rs
end
module Files :
sig
- val flatten : block_splitting_threshold:int -> blend:(Tag.t -> Tag.t -> Tag.t) -> (Tag.t * Range.t) list -> (Range.source * Tag.t block list) list
+ val flatten : block_splitting_threshold:int -> (Range.t * Tag.t) list -> (Range.source * Tag.t block list) list
end
=
struct
module FileMap = Map.Make(struct
type t = Range.source
- let compare : t -> t -> int = Stdlib.compare
+ let compare = Stdlib.compare
end)
- let add m data =
+ let add m ((range, _) as data) =
m |>
- FileMap.update (Range.source (snd data)) @@ function
+ FileMap.update (Range.source range) @@ function
| None -> Some (Emp <: data)
| Some rs -> Some (rs <: data)
- let priority l : int = List.fold_left (fun p (tag, _) -> Int.min p (Tag.priority tag)) Int.max_int l
+ let priority l : int = List.fold_left (fun p (_, tag) -> Int.min p (Tag.priority tag)) Int.max_int l
- let compare_part (p1 : Range.source * int * Tag.t block list) (p2 : Range.source * int * Tag.t block list) =
- match p1, p2 with
- | (_, pri1, _), (_, pri2, _) when pri1 <> pri2 -> Int.compare pri1 pri2
- | (s1, _, _), (s2, _, _) -> Option.compare String.compare (Range.title s1) (Range.title s2)
+ let compare_part (source1, priority1, _) (source2, priority2, _) =
+ Utils.compare_pair Int.compare (Option.compare String.compare)
+ (priority1, Range.title source1) (priority2, Range.title source2)
- let flatten ~block_splitting_threshold ~blend rs =
+ let flatten ~block_splitting_threshold rs =
rs
|> List.fold_left add FileMap.empty
|> FileMap.bindings
- |> List.map (fun (src, rs) -> let rs = Bwd.to_list rs in src, priority rs, File.flatten ~block_splitting_threshold ~blend rs)
- |> List.filter (fun (_, _, l) -> l <> []) (* filter out sources with only empty ranges *)
+ |> List.map
+ (fun (src, rs) ->
+ let rs = Bwd.to_list rs in
+ (src, priority rs, FileFlattener.flatten ~block_splitting_threshold rs))
|> List.stable_sort compare_part
|> List.map (fun (src, _, part) -> src, part)
end
diff --git a/src/Flattener.mli b/src/Flattener.mli
index 47f2b7f..21caba6 100644
--- a/src/Flattener.mli
+++ b/src/Flattener.mli
@@ -1,16 +1,17 @@
+open Explication
+
type 'tag block =
{ begin_line_num : int
; end_line_num : int
- ; tagged_positions : ('tag option * Range.position) list
- ; tagged_lines : ('tag * int) list
+ ; markers : (Range.position * 'tag marker) list
+ ; line_markers : (int * 'tag) list (* should be sorted by line numbers *)
}
type 'tag t = (Range.source * 'tag block list) list
val dump_block : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag block -> unit
-
val dump : (Format.formatter -> 'tag -> unit) -> Format.formatter -> 'tag t -> unit
module Make (Tag : ExplicatorSigs.Tag) : sig
- val flatten : block_splitting_threshold:int -> blend:(Tag.t -> Tag.t -> Tag.t) -> (Tag.t * Range.t) list -> Tag.t t
+ val flatten : block_splitting_threshold:int -> (Range.t * Tag.t) list -> Tag.t t
end
diff --git a/src/Range.ml b/src/Range.ml
index ba5ee35..4d36229 100644
--- a/src/Range.ml
+++ b/src/Range.ml
@@ -12,9 +12,7 @@ type position = {
line_num : int;
}
-type t =
- | Range of position * position
- | End_of_file of position
+type t = position * position
type 'a located = { loc : t option; value : 'a }
@@ -33,14 +31,7 @@ let dump_position fmt {source; offset; start_of_line; line_num} =
Format.fprintf fmt {|@[<1>{@[<2>source=@[%a@]@];@ offset=%d;@ start_of_line=%d;@ line_num=%d}@]|}
dump_source source offset start_of_line line_num
-let dump fmt =
- function
- | Range (begin_, ending_) ->
- Format.fprintf fmt {|@[<2>Range@ %a@]|}
- (Utils.dump_pair dump_position dump_position) (begin_, ending_)
- | End_of_file pos ->
- Format.fprintf fmt {|@[<2>End_of_file@ %a@]|}
- dump_position pos
+let dump = Utils.dump_pair dump_position dump_position
let title : source -> string option =
function
@@ -57,25 +48,20 @@ let make (begin_ , end_ : position * position) : t =
invalid_arg @@
Format.asprintf "make: the ending position comes before the starting position"
else
- Range (begin_, end_)
+ (begin_, end_)
-let eof pos = End_of_file pos
+let eof pos = make (pos, pos)
-let view =
- function
- | Range (p1, p2) -> `Range (p1, p2)
- | End_of_file p -> `End_of_file p
+let view (p1, p2) =
+ if p1 <> p2 then `Range (p1, p2) else `End_of_file p1
-let split =
- function
- | Range (p1, p2) -> p1, p2
- | End_of_file _ -> invalid_arg "Asai.Range.split"
-
-let source = function Range (x, _) | End_of_file x -> x.source
-let begin_line_num = function Range (x, _) | End_of_file x -> x.line_num
-let begin_offset = function Range (x, _) | End_of_file x -> x.offset
-let end_line_num = function Range (_, x) | End_of_file x -> x.line_num
-let end_offset = function Range (_, x) | End_of_file x -> x.offset
+let split r = r
+
+let source (x, _) = x.source
+let begin_line_num (x, _) = x.line_num
+let begin_offset (x, _) = x.offset
+let end_line_num (_, x) = x.line_num
+let end_offset (_, x) = x.offset
let locate_opt loc value = {loc; value}
let locate loc value = {loc = Some loc; value}
diff --git a/src/Range.mli b/src/Range.mli
index 04b6082..cf173ff 100644
--- a/src/Range.mli
+++ b/src/Range.mli
@@ -50,22 +50,15 @@ type 'a located = { loc : t option; value : 'a }
*)
val make : position * position -> t
-(** [eof pos] builds a special range referring to the end of the source. The input [pos] must be pointing at the end position; for example, if the position referring to a string source, [pos.offset] should be the length of the string.
-
- @since 0.3.0
-*)
+(** [eof pos] builds a special range referring to the end of the source. The input [pos] must be pointing at the end position; for example, if the position referring to a string source, [pos.offset] should be the length of the string. *)
val eof : position -> t
+[@@ocaml.alert deprecated "Use Range.of_pos instead"]
-(** [view range] returns a {i view} of the range.
-
- @since 0.3.0
-*)
+(** [view range] returns a {i view} of the range. *)
val view : t -> [`Range of position * position | `End_of_file of position]
+[@@ocaml.alert deprecated "Use Range.split instead"]
-(** [split range] returning the pair of the beginning and ending positions of [range]. It is the left-inverse of {!val:make}.
-
- @raise Invalid_argument if range is a special range marking the end of the source. See {!val:eof}.
-*)
+(** [split range] returning the pair of the beginning and ending positions of [range]. It is the left-inverse of {!val:make}. *)
val split : t -> position * position
(** [source range] returns the source associated with [range]. *)
diff --git a/src/UserContent.ml b/src/UserContent.ml
index 14e1323..c7a952d 100644
--- a/src/UserContent.ml
+++ b/src/UserContent.ml
@@ -80,13 +80,9 @@ let check_pos ~line_breaks ~eof read pos =
raise @@ Invalid_position (`Incorrect_start_of_line (pos.start_of_line, new_pos.start_of_line))
let check_range ~line_breaks ~eof read range =
- match Range.view range with
- | `Range (p1, p2) ->
- (try check_pos ~line_breaks ~eof read p1 with Invalid_position reason -> raise @@ Invalid_range (`Begin reason));
- (try check_pos ~line_breaks ~eof read p2 with Invalid_position reason -> raise @@ Invalid_range (`End reason))
- | `End_of_file p ->
- if p.offset <> eof then raise @@ Invalid_range (`Not_end_of_file (p.offset, eof));
- (try check_pos ~line_breaks ~eof read p with Invalid_position reason -> raise @@ Invalid_range (`End_of_file reason))
+ let p1, p2 = Range.split range in
+ (try check_pos ~line_breaks ~eof read p1 with Invalid_position reason -> raise @@ Invalid_range (`Begin reason));
+ (try check_pos ~line_breaks ~eof read p2 with Invalid_position reason -> raise @@ Invalid_range (`End reason))
let replace_control ~tab_size str =
let tab_string = String.make tab_size ' ' in
diff --git a/src/UserContentData.ml b/src/UserContentData.ml
index 86c1eb5..394d59a 100644
--- a/src/UserContentData.ml
+++ b/src/UserContentData.ml
@@ -16,6 +16,4 @@ type invalid_position =
type invalid_range =
[ `Begin of invalid_position (** The first position of a range is invalid. *)
| `End of invalid_position (** The second position of a range is invalid. *)
- | `End_of_file of invalid_position (** The range is a special end-of-file marking, but the position is invalid. *)
- | `Not_end_of_file of int * int (** The range is a special end-of-file marking, but the offset of the position is not at the end of file. The pair [(m, n)] means that the current offset is [m] but the length or size of the source is [n]. *)
]
diff --git a/src/Utils.ml b/src/Utils.ml
index 795c15a..d175a46 100644
--- a/src/Utils.ml
+++ b/src/Utils.ml
@@ -11,9 +11,12 @@ let dump_option dump fmt =
let dump_pair dump_x dump_y fmt (x, y) =
Format.fprintf fmt {|@[<1>(%a,@ %a)@]|} dump_x x dump_y y
+let dump_triple dump_x dump_y dump_z fmt (x, y, z) =
+ Format.fprintf fmt {|@[<1>(%a,@ %a,@ %a)@]|} dump_x x dump_y y dump_z z
+
let dump_list p fmt l =
Format.fprintf fmt "@[[%a]@]"
- (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,") p)
+ (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ") p)
l
(* Currently note used
@@ -62,6 +65,8 @@ let compare_pair c1 c2 (x1, y1) (x2, y2) : int =
| 0 -> c2 y1 y2
| r -> r
+let compare_opposite c x y = - c x y
+
let span p =
let rec go acc =
function
diff --git a/src/tty/Ansi.ml b/src/tty/Ansi.ml
index 2e5e597..c9d7bab 100644
--- a/src/tty/Ansi.ml
+++ b/src/tty/Ansi.ml
@@ -105,7 +105,7 @@ struct
let guess ?use_ansi ?use_color o =
if use_color = Some true && use_ansi = Some false then
- invalid_arg "Ansi.Tty.display: called with use_color=true but use_ansi=false";
+ invalid_arg "Asai.Tty.S.display: called with use_color=true but use_ansi=false";
let enabled = match use_ansi with Some a -> a | None -> rich_term && is_tty o in
let color = enabled && match use_color with Some c -> c | None -> not no_color in
{enabled; color}
diff --git a/src/tty/Tty.ml b/src/tty/Tty.ml
index 27ecd93..2a34588 100644
--- a/src/tty/Tty.ml
+++ b/src/tty/Tty.ml
@@ -43,13 +43,13 @@ let indentf ~param fmt =
(* different parts of the display *)
let render_code ~param ~severity fmt short_code =
- let st = TtyStyle.code severity ~param in
+ let style = TtyStyle.code severity ~param in
Format.fprintf fmt (" @<1>%s " ^^ highlight "%s[%s]" ^^ "@.")
"→"
- (Ansi.style_string ~param st)
+ (Ansi.style_string ~param style)
(string_of_severity severity)
short_code
- (Ansi.reset_string ~param st)
+ (Ansi.reset_string ~param style)
(* explication *)
@@ -83,35 +83,57 @@ struct
| None -> ()
| Some title -> Format.fprintf fmt " @<1>%s %s@." "■" title
- let render_segment ~param fmt (tag, seg) =
- let st = TtyStyle.highlight ~param:param.ansi param.severity tag in
- Format.fprintf fmt (highlight "%s")
- (Ansi.style_string ~param:param.ansi st)
- (UserContent.replace_control ~tab_size:param.tab_size seg)
- (Ansi.reset_string ~param:param.ansi st)
-
- let render_line_tag ~param fmt ((_, text) as tag) =
- let st = TtyStyle.message ~param:param.ansi param.severity tag in
+ let render_line_marker ~param fmt ((_, text) as tag) =
+ let style = TtyStyle.message ~param:param.ansi param.severity tag in
Format.fprintf fmt (" %*s " ^^ highlight "^" ^^ " " ^^ highlight "@[%t@]" ^^ "@.")
param.line_number_width ""
(Ansi.style_string ~param:param.ansi TtyStyle.fringe)
(Ansi.reset_string ~param:param.ansi TtyStyle.fringe)
- (Ansi.style_string ~param:param.ansi st)
+ (Ansi.style_string ~param:param.ansi style)
text
- (Ansi.reset_string ~param:param.ansi st)
+ (Ansi.reset_string ~param:param.ansi style)
- let render_line ~line_num ~param fmt Explication.{segments; tags} =
+ let render_styled_segment ~param fmt tag segment =
+ let style = TtyStyle.highlight ~param:param.ansi param.severity tag in
+ Format.fprintf fmt (highlight "%s")
+ (Ansi.style_string ~param:param.ansi style)
+ (UserContent.replace_control ~tab_size:param.tab_size segment)
+ (Ansi.reset_string ~param:param.ansi style)
+
+ (* Current design:
+
+ ‹let x◂POS₀▸ = 1› in let ‹x› = «1 + ‹x›»◂POS₁▸
+ ‹let x◂POS₀▸ = 1›₀ in let ‹x›₁ = «1 + ‹x›₂»◂POS₁▸
+ *)
+
+ let render_line ~line_num ~param fmt init_tag_set Explication.{tokens; markers} =
+ let go set =
+ function
+ | Explication.String s ->
+ render_styled_segment ~param fmt (TtyTagSet.prioritized set) s; set
+ | Explication.Marker RangeEnd t ->
+ TtyTagSet.remove t set
+ | Explication.Marker Point t ->
+ render_styled_segment ~param fmt (Some t) "‹POS›"; set
+ | Explication.Marker RangeBegin t ->
+ TtyTagSet.add t set
+ in
Format.fprintf fmt (" " ^^ highlight "%*d |" ^^ " ")
(Ansi.style_string ~param:param.ansi TtyStyle.fringe)
param.line_number_width line_num
(Ansi.reset_string ~param:param.ansi TtyStyle.fringe);
- List.iter (render_segment ~param fmt) segments;
+ let end_tag_set = List.fold_left go init_tag_set tokens in
Format.fprintf fmt "@.";
- List.iter (render_line_tag ~param fmt) tags
+ List.iter (render_line_marker ~param fmt) markers;
+ end_tag_set
let render_lines ~param ~begin_line_num fmt lines =
- lines |> List.iteri @@ fun i line ->
- render_line ~line_num:(begin_line_num + i) ~param fmt line
+ ignore @@ List.fold_left
+ (fun (line_num, set) line ->
+ let set = render_line ~line_num ~param fmt set line in
+ (line_num+1, set))
+ (begin_line_num, TtyTagSet.empty)
+ lines
let render_block ~param fmt Explication.{begin_line_num; end_line_num=_; lines} =
render_lines ~param ~begin_line_num fmt lines
@@ -125,12 +147,12 @@ struct
end
let render_unlocated_tag ~severity ~ansi fmt ((_, text) as tag) =
- let st = TtyStyle.message ~param:ansi severity tag in
+ let style = TtyStyle.message ~param:ansi severity tag in
Format.fprintf fmt (" @<1>%s " ^^ highlight "@[%t@]" ^^ "@.")
"○"
- (Ansi.style_string ~param:ansi st)
+ (Ansi.style_string ~param:ansi style)
text
- (Ansi.reset_string ~param:ansi st)
+ (Ansi.reset_string ~param:ansi style)
module DiagnosticRenderer :
sig
@@ -173,7 +195,7 @@ struct
List.partition_map
(function
| (tag, Range.{loc = None; value = text}) -> Either.Right (tag, text)
- | (tag, Range.{loc = Some r; value = text}) -> Either.Left ((tag, text), r))
+ | (tag, Range.{loc = Some r; value = text}) -> Either.Left (r, (tag, text)))
(main :: extra_remarks)
in
let explication =
diff --git a/src/tty/TtyTag.ml b/src/tty/TtyTag.ml
index 132cc7e..f0928c5 100644
--- a/src/tty/TtyTag.ml
+++ b/src/tty/TtyTag.ml
@@ -4,6 +4,9 @@ let priority =
function
| Main, _ -> -1
| Extra i, _ -> i
+let compare t1 t2 =
+ Utils.compare_pair Int.compare Stdlib.compare
+ (priority t1, t1) (priority t2, t2)
let dump fmt =
function
| Main, _ -> Format.pp_print_string fmt "Main"
diff --git a/src/tty/TtyTagSet.ml b/src/tty/TtyTagSet.ml
new file mode 100644
index 0000000..a0d3bb3
--- /dev/null
+++ b/src/tty/TtyTagSet.ml
@@ -0,0 +1,14 @@
+module TagMap = Map.Make(TtyTag)
+type t = int TagMap.t
+let empty : t = TagMap.empty
+let is_empty : t -> bool = TagMap.is_empty
+let add t =
+ TagMap.update t @@ function
+ | None -> Some 1
+ | Some n -> Some (n+1)
+let remove t =
+ TagMap.update t @@ function
+ | None -> failwith "Asai.Tty.S.display: removing a non-existing tag from a tag set"
+ | Some 1 -> None
+ | Some n -> Some (n-1)
+let prioritized s = Option.map fst @@ TagMap.min_binding_opt s
diff --git a/test/TestExplicator.ml b/test/TestExplicator.ml
index 34b4d41..0cef458 100644
--- a/test/TestExplicator.ml
+++ b/test/TestExplicator.ml
@@ -7,21 +7,25 @@ let test_explication = Alcotest.of_pp (Explication.dump IntTag.dump)
let single_line mode eol () =
let source = `String {Range.title = None; content = "aaabbbcccdddeee" ^ eol} in
let begin_of_line1 : Range.position = {source; offset = 0; start_of_line = 0; line_num = 1} in
- let range1 = (1, "1"), Range.make ({begin_of_line1 with offset = 3}, {begin_of_line1 with offset = 9}) in
- let range2 = (2, "2"), Range.make ({begin_of_line1 with offset = 6}, {begin_of_line1 with offset = 12}) in
+ let range1 = Range.make ({begin_of_line1 with offset = 3}, {begin_of_line1 with offset = 9}), (1, "1") in
+ let range2 = Range.make ({begin_of_line1 with offset = 6}, {begin_of_line1 with offset = 12}), (2, "2") in
let expected : _ Explication.t =
[{source;
blocks =
[{begin_line_num = 1;
end_line_num = 1;
lines =
- [{tags = [(1, "1"); (2, "2")];
- segments =
- [(None, "aaa");
- (Some (1, "1"), "bbb");
- (Some (2, "2"), "ccc");
- (Some (2, "2"), "ddd");
- (None, "eee");
+ [{markers = [(1, "1"); (2, "2")];
+ tokens =
+ [String "aaa";
+ Marker (RangeBegin (1, "1"));
+ String "bbb";
+ Marker (RangeBegin (2, "2"));
+ String "ccc";
+ Marker (RangeEnd (1, "1"));
+ String "ddd";
+ Marker (RangeEnd (2, "2"));
+ String "eee";
]}]}
]}
] in
@@ -32,22 +36,24 @@ let multi_lines_with_ls () =
let source = `String {Range.title = None; content = "aabbbbb\u{2028}bbbbccc"} in
let begin_of_line1 : Range.position = {source; offset = 0; start_of_line = 0; line_num = 1} in
let begin_of_line2 : Range.position = {source; offset = 10; start_of_line = 10; line_num = 2} in
- let range = (1, "1"), Range.make ({begin_of_line1 with offset = 2}, {begin_of_line2 with offset = 14}) in
+ let range = Range.make ({begin_of_line1 with offset = 2}, {begin_of_line2 with offset = 14}), (1, "1") in
let expected : _ Explication.t =
[{source;
blocks =
[{begin_line_num = 1;
end_line_num = 2;
lines =
- [{tags=[];
- segments=
- [(None, "aa");
- (Some (1, "1"), "bbbbb");
+ [{markers=[];
+ tokens=
+ [String "aa";
+ Marker (RangeBegin (1, "1"));
+ String "bbbbb";
]};
- {tags=[(1, "1")];
- segments=
- [(Some (1, "1"), "bbbb");
- (None, "ccc");
+ {markers=[(1, "1")];
+ tokens=
+ [String "bbbb";
+ Marker (RangeEnd (1, "1"));
+ String "ccc";
]}]}
]}
]
@@ -83,11 +89,11 @@ ggggghh
let begin_of_line15 : Range.position = {source; offset = 51; start_of_line = 51; line_num = 15} in
let ranges =
[
- (2, "1"), Range.make ({begin_of_line4 with offset = 17+1}, {begin_of_line4 with offset = 17+4});
- (1, "2"), Range.make ({begin_of_line2 with offset = 1+2}, {begin_of_line4 with offset = 17+4});
- (4, "3"), Range.make ({begin_of_line9 with offset = 33+2}, {begin_of_line9 with offset = 33+7});
- (8, "4"), Range.make ({begin_of_line9 with offset = 33+4}, {begin_of_line9 with offset = 33+7});
- (16, "5"), Range.make (begin_of_line15, {begin_of_line15 with offset = 51+5});
+ Range.make ({begin_of_line4 with offset = 17+1}, {begin_of_line4 with offset = 17+4}), (2, "1");
+ Range.make ({begin_of_line2 with offset = 1+2}, {begin_of_line4 with offset = 17+4}), (1, "2");
+ Range.make ({begin_of_line9 with offset = 33+2}, {begin_of_line9 with offset = 33+7}), (4, "3");
+ Range.make ({begin_of_line9 with offset = 33+4}, {begin_of_line9 with offset = 33+7}), (8, "4");
+ Range.make (begin_of_line15, {begin_of_line15 with offset = 51+5}), (16, "5");
]
in
let expected : _ Explication.t =
@@ -96,42 +102,52 @@ ggggghh
[{begin_line_num=2;
end_line_num=9;
lines=
- [{tags=[];
- segments=
- [(None, "aa");
- (Some (1, "2"), "bbbbb")]};
- {tags=[];
- segments=
- [(Some (1, "2"), "bbbbbbb")]};
- {tags=[(1, "2"); (2, "1")];
- segments=
- [(Some (1, "2"), "b");
- (Some (2, "1"), "*cc");
- (None, "ddd")]};
- {tags=[];
- segments=
- [(None, "1")]};
- {tags=[];
- segments=
- [(None, "2")]};
- {tags=[];
- segments=
- [(None, "3")]};
- {tags=[];
- segments=
- [(None, "4")]};
- {tags=[(4, "3"); (8, "4")];
- segments=
- [(None, "ee");
- (Some (4, "3"), "++");
- (Some (8, "4"), "fff")]}]};
+ [{markers=[];
+ tokens=
+ [String "aa";
+ Marker (RangeBegin (1, "2"));
+ String "bbbbb"]};
+ {markers=[];
+ tokens=
+ [String "bbbbbbb"]};
+ {markers=[(2, "1"); (1, "2")];
+ tokens=
+ [String "b";
+ Marker (RangeBegin (2, "1"));
+ String "*cc";
+ Marker (RangeEnd (2, "1"));
+ Marker (RangeEnd (1, "2"));
+ String "ddd"]};
+ {markers=[];
+ tokens=
+ [String "1"]};
+ {markers=[];
+ tokens=
+ [String "2"]};
+ {markers=[];
+ tokens=
+ [String "3"]};
+ {markers=[];
+ tokens=
+ [String "4"]};
+ {markers=[(8, "4"); (4, "3")];
+ tokens=
+ [String "ee";
+ Marker (RangeBegin (4, "3"));
+ String "++";
+ Marker (RangeBegin (8, "4"));
+ String "fff";
+ Marker (RangeEnd (8, "4"));
+ Marker (RangeEnd (4, "3"))]}]};
{begin_line_num=15;
end_line_num=15;
lines=
- [{tags=[(16, "5")];
- segments=
- [(Some (16, "5"), "ggggg");
- (None, "hh")]}]}]}]
+ [{markers=[(16, "5")];
+ tokens=
+ [Marker (RangeBegin (16, "5"));
+ String "ggggg";
+ Marker (RangeEnd (16, "5"));
+ String "hh"]}]}]}]
in
let actual = E.explicate ~line_breaks:`Traditional ~block_splitting_threshold:5 ranges in
Alcotest.(check test_explication) "Explication is correct" expected actual
diff --git a/test/TestFlattener.ml b/test/TestFlattener.ml
index 68f9625..0c99471 100644
--- a/test/TestFlattener.ml
+++ b/test/TestFlattener.ml
@@ -15,20 +15,29 @@ let single_line_flatten () =
{begin_of_line1 with offset = 12}
in
let ranges =
- [ (1, "1"), Range.make (pt1, pt3)
- ; (2, "2"), Range.make (pt1, pt3)
- ; (1, "3"), Range.make (pt1, pt3)
- ; (3, "4"), Range.make (pt2, pt4)
+ [ Range.make (pt1, pt3), (1, "1")
+ ; Range.make (pt1, pt3), (2, "2")
+ ; Range.make (pt1, pt3), (1, "3")
+ ; Range.make (pt2, pt4), (3, "4")
]
in
let expected : _ Flattener.t =
[(source,
[{begin_line_num=1;
end_line_num=1;
- tagged_positions=[(Some (2, "2"), pt1);(Some (3, "4"), pt2);(Some (3, "4"), pt3);(None, pt4)];
- tagged_lines=[((2, "2"), 1); ((1, "1"), 1); ((1, "3"), 1); ((3, "4"), 1)]}])]
+ markers=
+ [ pt1, RangeBegin (1, "3")
+ ; pt1, RangeBegin (1, "1")
+ ; pt1, RangeBegin (2, "2")
+ ; pt2, RangeBegin (3, "4")
+ ; pt3, RangeEnd (2, "2")
+ ; pt3, RangeEnd (1, "1")
+ ; pt3, RangeEnd (1, "3")
+ ; pt4, RangeEnd (3, "4")
+ ];
+ line_markers=[(1, (2, "2")); (1, (1, "1")); (1, (1, "3")); (1, (3, "4"))]}])]
in
- let actual = F.flatten ~block_splitting_threshold:5 ~blend:(Explicator.default_blend ~priority:IntTag.priority) ranges in
+ let actual = F.flatten ~block_splitting_threshold:5 ranges in
Alcotest.(check test_flattened) "Flattener is correct" expected actual
let multi_lines () =
@@ -64,38 +73,42 @@ ggggghh
in
let ranges =
[
- (2, "1"), Range.make (pt18, pt21);
- (1, "2"), Range.make (pt3, pt21);
- (4, "3"), Range.make (pt35, pt40);
- (8, "4"), Range.make (pt37, pt40);
- (16, "5"), Range.make (begin_of_line15, pt56);
+ Range.make (pt18, pt21), (2, "1");
+ Range.make (pt3, pt21), (1, "2");
+ Range.make (pt35, pt40), (4, "3");
+ Range.make (pt37, pt40), (8, "4");
+ Range.make (begin_of_line15, pt56), (16, "5");
]
in
let expected : _ Flattener.t =
[(source,
[{begin_line_num=2;
end_line_num=9;
- tagged_positions=
- [(Some (1, "2"), pt3);
- (Some (2, "1"), pt18);
- (None, pt21);
- (Some (4, "3"), pt35);
- (Some (8, "4"), pt37);
- (None, pt40)];
- tagged_lines=
- [((1, "2"), 4);
- ((2, "1"), 4);
- ((4, "3"), 9);
- ((8, "4"), 9)]};
+ markers=
+ [(pt3, RangeBegin (1, "2"));
+ (pt18, RangeBegin (2, "1"));
+ (pt21, RangeEnd (2, "1"));
+ (pt21, RangeEnd (1, "2"));
+ (pt35, RangeBegin (4, "3"));
+ (pt37, RangeBegin (8, "4"));
+ (pt40, RangeEnd (8, "4"));
+ (pt40, RangeEnd (4, "3"));
+ ];
+ line_markers=
+ [ 4, (2, "1")
+ ; 4, (1, "2")
+ ; 9, (8, "4")
+ ; 9, (4, "3")
+ ]};
{begin_line_num=15;
end_line_num=15;
- tagged_positions=
- [(Some (16, "5"), begin_of_line15);
- (None, pt56)];
- tagged_lines=
- [((16, "5"), 15)]}])]
+ markers=
+ [(begin_of_line15, RangeBegin (16, "5"));
+ (pt56, RangeEnd (16, "5"))];
+ line_markers=
+ [(15, (16, "5"))]}])]
in
- let actual = F.flatten ~block_splitting_threshold:5 ~blend:(Explicator.default_blend ~priority:IntTag.priority) ranges in
+ let actual = F.flatten ~block_splitting_threshold:5 ranges in
Alcotest.(check test_flattened) "Flattener is correct" expected actual
let () =
diff --git a/test/TestTty.expected b/test/TestTty.expected
index 84e14b8..9091b4b 100644
--- a/test/TestTty.expected
+++ b/test/TestTty.expected
@@ -101,16 +101,16 @@
[2m^[m message 7
[2m 3 |[m [4mcccc[mcccccc
[2m^[m message 2
- [2m10 |[m jjjjjjjjjj
+ [2m10 |[m [4m‹POS›[mjjjjjjjjjj
[2m^[m message 8
○ message 1
○ message 3
→ [33mwarning[hello][m
- [2m23 |[m wwwwwwwwww[4;33m‹EOF›[m
+ [2m23 |[m wwwwwwwwww[4;33m‹POS›[m
[2m^[m [33mthis is the main message[m
■ /path/to/file.cool
- [2m23 |[m wwwwwwwwww[4m‹EOF›[m
+ [2m23 |[m wwwwwwwwww[4m‹POS›[m
[2m^[m ending of another file
→ [1mwarning[hello][m
@@ -216,16 +216,16 @@
[2m^[m message 7
[2m 3 |[m [4mcccc[mcccccc
[2m^[m message 2
- [2m10 |[m jjjjjjjjjj
+ [2m10 |[m [4m‹POS›[mjjjjjjjjjj
[2m^[m message 8
○ message 1
○ message 3
→ [1mwarning[hello][m
- [2m23 |[m wwwwwwwwww[4;1m‹EOF›[m
+ [2m23 |[m wwwwwwwwww[4;1m‹POS›[m
[2m^[m [1mthis is the main message[m
■ /path/to/file.cool
- [2m23 |[m wwwwwwwwww[4m‹EOF›[m
+ [2m23 |[m wwwwwwwwww[4m‹POS›[m
[2m^[m ending of another file
→ warning[hello]
@@ -331,15 +331,15 @@
^ message 7
3 | cccccccccc
^ message 2
- 10 | jjjjjjjjjj
+ 10 | ‹POS›jjjjjjjjjj
^ message 8
○ message 1
○ message 3
→ warning[hello]
- 23 | wwwwwwwwww‹EOF›
+ 23 | wwwwwwwwww‹POS›
^ this is the main message
■ /path/to/file.cool
- 23 | wwwwwwwwww‹EOF›
+ 23 | wwwwwwwwww‹POS›
^ ending of another file
diff --git a/test/TestTty.ml b/test/TestTty.ml
index 72e99f1..b90da4d 100644
--- a/test/TestTty.ml
+++ b/test/TestTty.ml
@@ -79,9 +79,9 @@ let exec handler =
Loctext.make ~loc:(Range.make (~@ s2 10 0, ~@ s2 10 0)) "message 8";
];
- Reporter.emit ~loc:(Range.eof (~@ s1 23 width)) Hello "this is the main message"
+ Reporter.emit ~loc:(Range.make (~@ s1 23 width, ~@ s1 23 width)) Hello "this is the main message"
~extra_remarks:[
- Loctext.make ~loc:(Range.eof (~@ s2 23 width)) "ending of another file";
+ Loctext.make ~loc:(Range.make (~@ s2 23 width, ~@ s2 23 width)) "ending of another file";
]
let () =