Merge pull request #8429 from Alizter/tui_branch

boot/libs.ml

@@ -74,9 +74,11 @@ let local_libraries =
     None)
   ; ("src/dune_vcs", Some "Dune_vcs", false, None)
   ; ("src/dune_threaded_console", Some "Dune_threaded_console", false, None)
+  ; ("vendor/lwd/lwd", None, false, None)
   ; ("vendor/notty/src", None, true, None)
   ; ("vendor/notty/src-unix", None, true, None)
-  ; ("src/dune_tui", Some "Dune_tui", false, None)
+  ; ("vendor/lwd/nottui", None, false, None)
+  ; ("src/dune_tui", Some "Dune_tui", true, None)
   ; ("src/dune_config_file", Some "Dune_config_file", false, None)
   ; ("src/dune_shared_cache", Some "Dune_shared_cache", false, None)
   ; ("src/scheme", Some "Scheme", false, None)

doc/changes/8429.md

@@ -0,0 +1,4 @@
+- Added experimental `--display tui` option for Dune that opens an interactive
+  Terminal User Interface (TUI) when Dune is running. Press '?' to open up a
+  help screen when running for more information. (#8429, @Alizter and
+  @rgrinberg) 

otherlibs/stdune/src/ansi_color.ml

@@ -4,6 +4,7 @@ module RGB8 : sig
   val to_dyn : t -> Dyn.t
   val of_int : int -> t
   val to_int : t -> int
+  val compare : t -> t -> Ordering.t
 
   (** This is only used internally. *)
   val write_to_buffer : Buffer.t -> t -> unit
@@ -13,6 +14,7 @@ end = struct
   let to_dyn t = Dyn.Int (int_of_char t)
   let of_int t = char_of_int (t land 0xFF)
   let to_int t = int_of_char t
+  let compare t1 t2 = Char.compare t1 t2
 
   let write_to_buffer buf c =
     Buffer.add_string buf "38;5;";
@@ -24,6 +26,7 @@ module RGB24 : sig
   type t
 
   val to_dyn : t -> Dyn.t
+  val compare : t -> t -> Ordering.t
   val red : t -> int
   val green : t -> int
   val blue : t -> int
@@ -34,6 +37,7 @@ module RGB24 : sig
 end = struct
   type t = int
 
+  let compare = Int.compare
   let red t = Int.shift_right t 16 land 0xFF
   let green t = Int.shift_right t 8 land 0xFF
   let blue t = t land 0xFF
@@ -186,6 +190,134 @@ module Style = struct
     | `Underline -> Dyn.variant "Underline" []
   ;;
 
+  let compare (t1 : t) (t2 : t) : Ordering.t =
+    match t1, t2 with
+    | `Fg_default, `Fg_default -> Eq
+    | `Fg_default, _ -> Lt
+    | _, `Fg_default -> Gt
+    | `Fg_black, `Fg_black -> Eq
+    | `Fg_black, _ -> Lt
+    | _, `Fg_black -> Gt
+    | `Fg_red, `Fg_red -> Eq
+    | `Fg_red, _ -> Lt
+    | _, `Fg_red -> Gt
+    | `Fg_green, `Fg_green -> Eq
+    | `Fg_green, _ -> Lt
+    | _, `Fg_green -> Gt
+    | `Fg_yellow, `Fg_yellow -> Eq
+    | `Fg_yellow, _ -> Lt
+    | _, `Fg_yellow -> Gt
+    | `Fg_blue, `Fg_blue -> Eq
+    | `Fg_blue, _ -> Lt
+    | _, `Fg_blue -> Gt
+    | `Fg_magenta, `Fg_magenta -> Eq
+    | `Fg_magenta, _ -> Lt
+    | _, `Fg_magenta -> Gt
+    | `Fg_cyan, `Fg_cyan -> Eq
+    | `Fg_cyan, _ -> Lt
+    | _, `Fg_cyan -> Gt
+    | `Fg_white, `Fg_white -> Eq
+    | `Fg_white, _ -> Lt
+    | _, `Fg_white -> Gt
+    | `Fg_bright_black, `Fg_bright_black -> Eq
+    | `Fg_bright_black, _ -> Lt
+    | _, `Fg_bright_black -> Gt
+    | `Fg_bright_red, `Fg_bright_red -> Eq
+    | `Fg_bright_red, _ -> Lt
+    | _, `Fg_bright_red -> Gt
+    | `Fg_bright_green, `Fg_bright_green -> Eq
+    | `Fg_bright_green, _ -> Lt
+    | _, `Fg_bright_green -> Gt
+    | `Fg_bright_yellow, `Fg_bright_yellow -> Eq
+    | `Fg_bright_yellow, _ -> Lt
+    | _, `Fg_bright_yellow -> Gt
+    | `Fg_bright_blue, `Fg_bright_blue -> Eq
+    | `Fg_bright_blue, _ -> Lt
+    | _, `Fg_bright_blue -> Gt
+    | `Fg_bright_magenta, `Fg_bright_magenta -> Eq
+    | `Fg_bright_magenta, _ -> Lt
+    | _, `Fg_bright_magenta -> Gt
+    | `Fg_bright_cyan, `Fg_bright_cyan -> Eq
+    | `Fg_bright_cyan, _ -> Lt
+    | _, `Fg_bright_cyan -> Gt
+    | `Fg_bright_white, `Fg_bright_white -> Eq
+    | `Fg_bright_white, _ -> Lt
+    | _, `Fg_bright_white -> Gt
+    | `Fg_8_bit_color c1, `Fg_8_bit_color c2 -> RGB8.compare c1 c2
+    | `Fg_8_bit_color _, _ -> Lt
+    | _, `Fg_8_bit_color _ -> Gt
+    | `Fg_24_bit_color c1, `Fg_24_bit_color c2 -> RGB24.compare c1 c2
+    | `Fg_24_bit_color _, _ -> Lt
+    | _, `Fg_24_bit_color _ -> Gt
+    | `Bg_default, `Bg_default -> Eq
+    | `Bg_default, _ -> Lt
+    | _, `Bg_default -> Gt
+    | `Bg_black, `Bg_black -> Eq
+    | `Bg_black, _ -> Lt
+    | _, `Bg_black -> Gt
+    | `Bg_red, `Bg_red -> Eq
+    | `Bg_red, _ -> Lt
+    | _, `Bg_red -> Gt
+    | `Bg_green, `Bg_green -> Eq
+    | `Bg_green, _ -> Lt
+    | _, `Bg_green -> Gt
+    | `Bg_yellow, `Bg_yellow -> Eq
+    | `Bg_yellow, _ -> Lt
+    | _, `Bg_yellow -> Gt
+    | `Bg_blue, `Bg_blue -> Eq
+    | `Bg_blue, _ -> Lt
+    | _, `Bg_blue -> Gt
+    | `Bg_magenta, `Bg_magenta -> Eq
+    | `Bg_magenta, _ -> Lt
+    | _, `Bg_magenta -> Gt
+    | `Bg_cyan, `Bg_cyan -> Eq
+    | `Bg_cyan, _ -> Lt
+    | _, `Bg_cyan -> Gt
+    | `Bg_white, `Bg_white -> Eq
+    | `Bg_white, _ -> Lt
+    | _, `Bg_white -> Gt
+    | `Bg_bright_black, `Bg_bright_black -> Eq
+    | `Bg_bright_black, _ -> Lt
+    | _, `Bg_bright_black -> Gt
+    | `Bg_bright_red, `Bg_bright_red -> Eq
+    | `Bg_bright_red, _ -> Lt
+    | _, `Bg_bright_red -> Gt
+    | `Bg_bright_green, `Bg_bright_green -> Eq
+    | `Bg_bright_green, _ -> Lt
+    | _, `Bg_bright_green -> Gt
+    | `Bg_bright_yellow, `Bg_bright_yellow -> Eq
+    | `Bg_bright_yellow, _ -> Lt
+    | _, `Bg_bright_yellow -> Gt
+    | `Bg_bright_blue, `Bg_bright_blue -> Eq
+    | `Bg_bright_blue, _ -> Lt
+    | _, `Bg_bright_blue -> Gt
+    | `Bg_bright_magenta, `Bg_bright_magenta -> Eq
+    | `Bg_bright_magenta, _ -> Lt
+    | _, `Bg_bright_magenta -> Gt
+    | `Bg_bright_cyan, `Bg_bright_cyan -> Eq
+    | `Bg_bright_cyan, _ -> Lt
+    | _, `Bg_bright_cyan -> Gt
+    | `Bg_bright_white, `Bg_bright_white -> Eq
+    | `Bg_bright_white, _ -> Lt
+    | _, `Bg_bright_white -> Gt
+    | `Bg_8_bit_color c1, `Bg_8_bit_color c2 -> RGB8.compare c1 c2
+    | `Bg_8_bit_color _, _ -> Lt
+    | _, `Bg_8_bit_color _ -> Gt
+    | `Bg_24_bit_color c1, `Bg_24_bit_color c2 -> RGB24.compare c1 c2
+    | `Bg_24_bit_color _, _ -> Lt
+    | _, `Bg_24_bit_color _ -> Gt
+    | `Bold, `Bold -> Eq
+    | `Bold, _ -> Lt
+    | _, `Bold -> Gt
+    | `Dim, `Dim -> Eq
+    | `Dim, _ -> Lt
+    | _, `Dim -> Gt
+    | `Italic, `Italic -> Eq
+    | `Italic, _ -> Lt
+    | _, `Italic -> Gt
+    | `Underline, `Underline -> Eq
+  ;;
+
   module Of_ansi_code = struct
     type code = t
 

otherlibs/stdune/src/ansi_color.mli

@@ -68,6 +68,7 @@ module Style : sig
     ]
 
   val to_dyn : t -> Dyn.t
+  val compare : t -> t -> Ordering.t
 
   (** Ansi escape sequence that set the terminal style to exactly these styles *)
   val escape_sequence : t list -> string

otherlibs/stdune/src/char.ml

@@ -11,3 +11,4 @@ let is_lowercase_hex = function
 ;;
 
 let[@inline always] hash c = Int.hash (code c)
+let compare x y = Ordering.of_int (compare x y)

otherlibs/stdune/src/char.mli

@@ -9,3 +9,4 @@ val is_digit : t -> bool
 val is_lowercase_hex : t -> bool
 
 val hash : t -> int
+val compare : t -> t -> Ordering.t

otherlibs/stdune/src/stdune.ml

@@ -22,7 +22,16 @@ module Map = Map
 module Option = Option
 module Or_exn = Or_exn
 module Ordering = Ordering
-module Pp = Pp
+
+module Pp = struct
+  include Pp
+
+  (** This version of [Pp.compare] uses [Ordering.t] rather than returning an [int]. *)
+  let compare ~compare x y =
+    Ordering.of_int (Pp.compare (fun a b -> Ordering.to_int (compare a b)) x y)
+  ;;
+end
+
 module Result = Result
 module Set = Set
 module Signal = Signal

otherlibs/stdune/src/user_message.ml

@@ -12,6 +12,44 @@ module Style = struct
     | Debug
     | Success
     | Ansi_styles of Ansi_color.Style.t list
+
+  let compare t1 t2 : Ordering.t =
+    match t1, t2 with
+    | Loc, Loc -> Eq
+    | Loc, _ -> Lt
+    | _, Loc -> Gt
+    | Error, Error -> Eq
+    | Error, _ -> Lt
+    | _, Error -> Gt
+    | Warning, Warning -> Eq
+    | Warning, _ -> Lt
+    | _, Warning -> Gt
+    | Kwd, Kwd -> Eq
+    | Kwd, _ -> Lt
+    | _, Kwd -> Gt
+    | Id, Id -> Eq
+    | Id, _ -> Lt
+    | _, Id -> Gt
+    | Prompt, Prompt -> Eq
+    | Prompt, _ -> Lt
+    | _, Prompt -> Gt
+    | Hint, Hint -> Eq
+    | Hint, _ -> Lt
+    | _, Hint -> Gt
+    | Details, Details -> Eq
+    | Details, _ -> Lt
+    | _, Details -> Gt
+    | Ok, Ok -> Eq
+    | Ok, _ -> Lt
+    | _, Ok -> Gt
+    | Debug, Debug -> Eq
+    | Debug, _ -> Lt
+    | _, Debug -> Gt
+    | Success, Success -> Eq
+    | Success, _ -> Lt
+    | _, Success -> Gt
+    | Ansi_styles _, Ansi_styles _ -> Eq
+  ;;
 end
 
 module Annots = struct

otherlibs/stdune/src/user_message.mli

@@ -21,6 +21,8 @@ module Style : sig
     | Debug
     | Success
     | Ansi_styles of Ansi_color.Style.t list
+
+  val compare : t -> t -> Ordering.t
 end
 
 module Annots : sig