wip

src/tty/Tty.ml

@@ -8,23 +8,23 @@ let string_of_severity : Diagnostic.severity -> string =
   | Error -> "error"
   | Bug -> "bug"
 
-type index = TtyTag.index = Main_message | Extra_remark of int
-type tag = TtyTag.t
-type 'tag mark = 'tag Marked_source.mark =
-  | Range_begin of 'tag
-  | Range_end of 'tag
-  | Point of 'tag
-
-type marker = use_ansi:bool -> use_color:bool -> [`End_of_line | `End_of_file] option -> tag mark -> string
-
-let default_marker ~use_ansi:_ ~use_color:_ s m =
-  match s, m with
-  | _, (Marked_source.Range_begin _ | Range_end _) -> ""
-  | Some `End_of_line, Point _ -> "‹EOL›"
-  | Some `End_of_file, Point _ -> "‹EOF›"
-  | None, Point _ -> "‹POS›"
+type marker =
+  [ `Ansi_with_color | `Ansi_without_color | `No_ansi ]
+  -> [ `Main_message | `Extra_remark of int ]
+  -> [ `Range_begin
+     | `Range_end of [`End_of_line | `End_of_file] option
+     | `Point of [`End_of_line | `End_of_file] option
+     ]
+  -> string
+
+let default_marker : marker = fun _ _ ->
+  function
+  | `Range_begin | `Range_end _ -> ""
+  | `Point Some `End_of_line -> "‹EOL›"
+  | `Point Some `End_of_file -> "‹EOL›"
+  | `Point None -> "‹POS›"
 
-module SM = Source_marker.Make(TtyTag)
+module SM = Source_marker.Make(Tty_tag)
 
 (* calculating the width of line numbers *)
 
@@ -49,17 +49,17 @@ let indentf ~param fmt =
   let num_lines = List.length lines in
   let p m line =
     Format.fprintf fmt (" " ^^ highlight "@<1>%s" ^^ "%s@.")
-      (Ansi.style_string ~param TtyStyle.indentation)
+      (Ansi.style_string ~param Tty_style.indentation)
       m
-      (Ansi.reset_string ~param TtyStyle.indentation)
+      (Ansi.reset_string ~param Tty_style.indentation)
       line
   in
   List.iteri (fun i line -> p (indent_decorations num_lines i) line) lines
 
 (* different parts of the display *)
 
 let render_code ~param ~severity fmt short_code =
-  let style = TtyStyle.code severity ~param in
+  let style = Tty_style.code severity ~param in
   Format.fprintf fmt (" @<1>%s " ^^ highlight "%s[%s]" ^^ "@.")
     "￫"
     (Ansi.style_string ~param style)
@@ -102,18 +102,18 @@ struct
     | Some title -> Format.fprintf fmt " @<1>%s %s@." "￭" title
 
   let render_line_mark ~param fmt ((_, text) as tag) =
-    let style = TtyStyle.message ~param:param.ansi param.severity tag in
+    let style = Tty_style.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 Tty_style.fringe)
+      (Ansi.reset_string ~param:param.ansi Tty_style.fringe)
       (Ansi.style_string ~param:param.ansi style)
       text
       (Ansi.reset_string ~param:param.ansi style)
 
   let render_styled_segment ~param fmt tag segment =
     if segment <> "" then
-      let style = TtyStyle.highlight ~param:param.ansi param.severity tag in
+      let style = Tty_style.highlight ~param:param.ansi param.severity tag in
       Format.fprintf fmt (highlight "%s")
         (Ansi.style_string ~param:param.ansi style)
         (String_utils.replace_control ~tab_size:param.tab_size segment)
@@ -136,9 +136,9 @@ struct
         render_styled_segment ~param fmt (Some t) mark; next
     in
     Format.fprintf fmt (" " ^^ highlight "%*d |" ^^ " ")
-      (Ansi.style_string ~param:param.ansi TtyStyle.fringe)
+      (Ansi.style_string ~param:param.ansi Tty_style.fringe)
       param.line_number_width line_num
-      (Ansi.reset_string ~param:param.ansi TtyStyle.fringe);
+      (Ansi.reset_string ~param:param.ansi Tty_style.fringe);
     let end_tag_set = List.fold_left go init_tag_set tokens in
     Format.fprintf fmt "@.";
     List.iter (render_line_mark ~param fmt) marks;
@@ -164,7 +164,7 @@ struct
 end
 
 let render_unlocated_tag ~severity ~ansi fmt ((_, text) as tag) =
-  let style = TtyStyle.message ~param:ansi severity tag in
+  let style = Tty_style.message ~param:ansi severity tag in
   Format.fprintf fmt (" @<1>%s " ^^ highlight "@[%t@]" ^^ "@.")
     "￮"
     (Ansi.style_string ~param:ansi style)

src/tty/Tty.mli

@@ -6,29 +6,15 @@
 
 (** {2 Custom markers} *)
 
-(** The index type of all messages within a diagnostic. *)
-type index =
-  | Main_message (** The main message. *)
-  | Extra_remark of int (** [ExtraRemark i] is the [i]th extra remark (zero-based). *)
-
-(** A tag consists of an index (of type {!type:index}) and a message (of type {!type:Text.t}) *)
-type tag = index * Text.t
-
-(** A mark signals the start or end of a non-empty range, or the location of a point (a range of zero width). *)
-type 'tag mark = 'tag Marked_source.mark =
-  | Range_begin of 'tag
-  | Range_end of 'tag
-  | Point of 'tag
-
-(** The type of custom marker functions. Such a function takes four arguments:
-
-    + [use_ansi]: whether ANSI control sequences are used.
-    + [use_color]: whether colors are used. (Must be false if [use_ansi] is false.)
-    + Whether the mark is at the end of a line or a file.
-    + The mark to visualize.
-
-    The output is the string to visualize the mark within the source text. *)
-type marker = use_ansi:bool -> use_color:bool -> [`End_of_line | `End_of_file] option -> tag mark -> string
+(** The type of custom marker functions. The output is the string to visualize the mark within the source text. *)
+type marker =
+  [ `Ansi_with_color | `Ansi_without_color | `No_ansi ]
+  -> [ `Main_message | `Extra_remark of int ]
+  -> [ `Range_begin
+     | `Range_end of [`End_of_line | `End_of_file] option
+     | `Point of [`End_of_line | `End_of_file] option
+     ]
+  -> string
 
 (** The default marker. Currently, it transforms point marks into [‹POS›], [‹EOL›], or [‹EOF›] (depending on whether they are at the end of a line or a file) and ignores all range marks. This function is subject to change; future versions may display range marks when [use_ansi] is false.