Merge pull request #43 from art-w/size

Add `terminal.unix` to re-expose size functions

src/progress/dune

@@ -1,9 +1,6 @@
 (library
  (name progress)
  (public_name progress)
- (foreign_stubs
-  (language c)
-  (names terminal_stubs))
  (libraries
   (re_export progress.engine)
   (re_export terminal)

src/progress/engine/dune

@@ -7,5 +7,5 @@
   fmt
   logs
   logs.fmt
-  terminal
+  terminal_ansi
   vector))

src/progress/engine/import.ml

@@ -4,6 +4,7 @@
   ————————————————————————————————————————————————————————————————————————————*)
 
 include Stdlib_ext
+module Terminal = Terminal_ansi
 
 module Mtime = struct
   include Mtime

src/progress/engine/progress_engine.ml

@@ -3,6 +3,7 @@
    Distributed under the MIT license. See terms at the end of this file.
   ————————————————————————————————————————————————————————————————————————————*)
 
+open! Import
 include Progress_engine_intf
 
 module type Platform = Platform.S

src/progress/engine/progress_engine_intf.ml

@@ -13,7 +13,7 @@ module type S = sig
 
       Some basic types used throughout the rest of the library: *)
 
-  module Color = Terminal.Color
+  module Color = Terminal_ansi.Color
   module Duration = Duration
   module Printer = Printer
   module Units = Units

src/progress/terminal_width.ml

@@ -3,43 +3,19 @@
    Distributed under the MIT license. See terms at the end of this file.
   ————————————————————————————————————————————————————————————————————————————*)
 
-external sigwinch : unit -> int option = "ocaml_terminal_get_sigwinch"
-(** The number of the signal used to indicate terminal size changes. [None] on
-    Windows. *)
-
-type dimensions = { rows : int; columns : int }
-
-external get_dimensions : unit -> dimensions option
-  = "ocaml_terminal_get_terminal_dimensions"
-
-let get_columns () =
-  match get_dimensions () with
-  | Some { columns; _ } -> Some columns
-  | None -> None
-
-let on_change = ref (fun _ -> ())
 let latest_width = ref None
-
-let initialise =
-  let handle_signal _ =
-    let width = get_columns () in
-    latest_width := width;
-    !on_change width
-  in
-  lazy
-    (latest_width := get_columns ();
-     match sigwinch () with
-     | None -> ()
-     | Some n -> Sys.set_signal n (Signal_handle handle_signal))
-
-let set_changed_callback f =
-  Lazy.force initialise;
-  on_change := f
+let refresh () = latest_width := Terminal.Size.get_columns ()
+let initialize = lazy (refresh ())
 
 let get () =
-  Lazy.force_val initialise;
+  Lazy.force initialize;
   !latest_width
 
+let set_changed_callback on_change =
+  Terminal.Size.set_changed_callback (fun () ->
+      refresh ();
+      on_change !latest_width)
+
 (*————————————————————————————————————————————————————————————————————————————
    Copyright (c) 2020–2021 Craig Ferguson <me@craigfe.io>
 

src/terminal/ansi/dune

@@ -0,0 +1,4 @@
+(library
+ (name terminal_ansi)
+ (public_name terminal.ansi)
+ (libraries stdlib-shims uutf uucp))

src/progress/terminal_width.mli → src/terminal/ansi/terminal_ansi.ml

@@ -3,8 +3,12 @@
    Distributed under the MIT license. See terms at the end of this file.
   ————————————————————————————————————————————————————————————————————————————*)
 
-val get : unit -> int option
-val set_changed_callback : (int option -> unit) -> unit
+module Color = Color
+module Style = Style
+module Ansi = Ansi
+
+let guess_printed_width, truncate_to_width =
+  Ansi.(guess_printed_width, truncate_to_width)
 
 (*————————————————————————————————————————————————————————————————————————————
    Copyright (c) 2020–2021 Craig Ferguson <me@craigfe.io>

src/terminal/ansi/terminal_ansi.mli

@@ -0,0 +1,126 @@
+(*————————————————————————————————————————————————————————————————————————————
+   Copyright (c) 2020–2021 Craig Ferguson <me@craigfe.io>
+   Distributed under the MIT license. See terms at the end of this file.
+  ————————————————————————————————————————————————————————————————————————————*)
+
+(** This library provides a small set of standard utility functions for
+    interacting with terminals.
+
+    Note that this module does not depend on the [unix] library. There is
+    therefore a way to use [Terminal_ansi] and [progress.engine] in a context
+    other than a POSIX system (such as a unikernel). To do this, you need to
+    compose [Terminal_ansi] with a library that looks like [terminal.unix]
+    (which should allow you to obtain the size of a TTY). It would then be
+    sufficient to compose the latter (just as the [terminal] library does) to
+    then be able to use [Progess_engine.Make] with the result of this
+    composition.
+*)
+
+module Color : sig
+  type t
+  (** The type of colours that can be rendered to a terminal. *)
+
+  (** {1 4-bit ANSI colours}
+
+      Colours built using {!ansi} will be rendered using the standard
+      {{:https://en.wikipedia.org/wiki/ANSI_escape_code#3-bit_and_4-bit} 4-bit
+        ANSI escape codes} for terminals. The actual colours displayed to the
+      user depend on their terminal configuration / theme, ensuring that they
+      look natural in context. *)
+
+  type plain =
+    [ `black | `blue | `cyan | `green | `magenta | `red | `white | `yellow ]
+
+  val ansi : [ plain | `bright of plain ] -> t
+
+  (** {1 24-bit RGB colours}
+
+      Most modern terminals offer support for full 24-bit RGB colour (called
+      "{{:https://en.wikipedia.org/wiki/ANSI_escape_code#24-bit} true colour}")
+      in addition to the 16 original ANSI colours. These colours are rendered
+      exactly as requested, offering greater flexibility at the risk of clashing
+      with the user's theming. *)
+
+  val rgb : int -> int -> int -> t
+  (** [rgb r g b] is the RGB24 colour with the given red, green and blue colour
+      components respectively. Raises [Invalid_argument] if any of the
+      components are outside the range [\[0, 255\]]. *)
+
+  val hex : string -> t
+  (** [hex s] is the RGB24 colour given by the
+      {{:https://en.wikipedia.org/wiki/Web_colors#Hex_triplet} hex triplet} [s],
+      which must start with [#]. Examples:
+
+      - [hex "#FF8C00"] = [rgb 0xFF 0x8C 0x00]
+      - [hex "#fa0"] = [rgb 0xFF 0xAA 0x00]
+
+      Raises [Invalid_argument] if the given string is not a [#]-prefixed hex
+      triplet. *)
+
+  val pp_dump : Format.formatter -> t -> unit
+  (** Pretty-print a colour with an unspecified format. *)
+end
+
+module Style : sig
+  type t
+  (** The type of terminal {i styles}: values that can be printed to a terminal
+      in order to change the way that it renders text. *)
+
+  val code : t -> string
+  (** Get the ANSI escape code for the given style. *)
+
+  (** Constructing ANSI styles: *)
+
+  val none : t
+  val bold : t
+  val faint : t
+  val italic : t
+  val underline : t
+  val reverse : t
+  val fg : Color.t -> t
+  val bg : Color.t -> t
+end
+
+module Ansi : sig
+  val show_cursor : string
+  val hide_cursor : string
+  val move_up : Format.formatter -> int -> unit
+  val move_down : Format.formatter -> int -> unit
+  val erase_line : string
+  val erase_display_suffix : string
+end
+
+val guess_printed_width : string -> int
+(** [guess_printed_width s] returns an estimate of the number of terminal
+    columns that the UTF-8 encoded string [s] would occupy if displayed in a
+    terminal, after stripping any ANSI escape codes in the string.
+
+    {b Note:}
+    {i this function uses a heuristic ({!Uucp.tty_width_hint}) to guess the
+       rendered length of supplied strings. This function is not guaranteed to
+       be correct on all UTF-8 codepoints. See the [Uucp] documentation for
+       details.} *)
+
+val truncate_to_width : int -> string -> string
+(** [truncate_to_width n s] is the longest prefix of UTF-8 encoded string [s]
+    that will fit within [n] columns when displayed in a terminal (without
+    including unbalanced ANSI control sequences after the [n]-th column).
+
+    As with {!guess_printed_width}, the implementation relies on heuristics and
+    so may not be accurate for all inputs (or for all terminal implementations).*)
+
+(*————————————————————————————————————————————————————————————————————————————
+   Copyright (c) 2020–2021 Craig Ferguson <me@craigfe.io>
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+   THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+   DEALINGS IN THE SOFTWARE.
+  ————————————————————————————————————————————————————————————————————————————*)

src/terminal/dune

@@ -1,4 +1,9 @@
 (library
- (name terminal)
  (public_name terminal)
- (libraries stdlib-shims uutf uucp))
+ (name terminal)
+ (foreign_stubs
+  (language c)
+  (names terminal_stubs))
+ (libraries
+  (re_export terminal_ansi)
+  unix))

src/terminal/terminal.ml

@@ -3,12 +3,39 @@
    Distributed under the MIT license. See terms at the end of this file.
   ————————————————————————————————————————————————————————————————————————————*)
 
-module Color = Color
-module Style = Style
-module Ansi = Ansi
+include Terminal_ansi
 
-let guess_printed_width, truncate_to_width =
-  Ansi.(guess_printed_width, truncate_to_width)
+module Size = struct
+  external sigwinch : unit -> int option = "ocaml_terminal_get_sigwinch"
+  (** The number of the signal used to indicate terminal size changes. [None] on
+      Windows. *)
+
+  type dimensions = { rows : int; columns : int }
+
+  external get_dimensions : unit -> dimensions option
+    = "ocaml_terminal_get_terminal_dimensions"
+
+  let get_columns () =
+    match get_dimensions () with
+    | Some { columns; _ } -> Some columns
+    | None -> None
+
+  let get_rows () =
+    match get_dimensions () with Some { rows; _ } -> Some rows | None -> None
+
+  let on_change = ref (fun _ -> ())
+
+  let initialise =
+    let handle_signal _ = !on_change () in
+    lazy
+      (match sigwinch () with
+      | None -> ()
+      | Some n -> Sys.set_signal n (Signal_handle handle_signal))
+
+  let set_changed_callback f =
+    Lazy.force initialise;
+    on_change := f
+end
 
 (*————————————————————————————————————————————————————————————————————————————
    Copyright (c) 2020–2021 Craig Ferguson <me@craigfe.io>