Rewrite the TUI framework (#13)

chshersh · web-flow · commit 84403bc1eaa5 · 2025-01-07T18:51:30.000Z
* Rewrite MintTea to custom TUI implementation
* Implement proper setup and shutdown
* Add logger, switch to async reader
* Fix quit from the model
* Install libcurl on CI
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -15,12 +15,15 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - 5.1.1
+          - 5.2.1
 
     steps:
       - name: Checkout code
         uses: actions/checkout@v3
 
+      - name: Install libcurl development package
+        run: sudo apt-get update && sudo apt-get install -y libcurl4-openssl-dev
+
       - name: Use OCaml ${{ matrix.ocaml-compiler }}
         uses: ocaml/setup-ocaml@v2
         with:
@@ -38,10 +41,13 @@ jobs:
       - name: Checkout code
         uses: actions/checkout@v3
 
-      - name: Use OCaml 5.1.1
+      - name: Install libcurl development package
+        run: sudo apt-get update && sudo apt-get install -y libcurl4-openssl-dev
+
+      - name: Setup OCaml
         uses: ocaml/setup-ocaml@v2
         with:
-          ocaml-compiler: 5.1.1
+          ocaml-compiler: 5.2.1
           dune-cache: true
 
       - name: Lint doc
@@ -53,10 +59,13 @@ jobs:
       - name: Checkout code
         uses: actions/checkout@v3
 
-      - name: Use OCaml 5.1.1
+      - name: Install libcurl development package
+        run: sudo apt-get update && sudo apt-get install -y libcurl4-openssl-dev
+
+      - name: Setup OCaml
         uses: ocaml/setup-ocaml@v2
         with:
-          ocaml-compiler: 5.1.1
+          ocaml-compiler: 5.2.1
           dune-cache: true
 
       - name: Lint fmt
diff --git a/.ocamlformat b/.ocamlformat
@@ -1,4 +1,4 @@
-version = 0.26.2
+version = 0.27.0
 profile = default
 break-cases = fit-or-vertical
 break-infix = wrap-or-vertical
diff --git a/dune-project b/dune-project
@@ -25,6 +25,8 @@
    (minttea (>= "0.0.2"))
    shape-the-term
    (terminal_size (>= "0.2.0"))
+   (tty (>= "0.0.2"))
+   (uutf (>= "1.0.3"))
  )
  (tags
   (tui cli git github)))
diff --git a/github_tui.opam b/github_tui.opam
@@ -17,6 +17,8 @@ depends: [
   "minttea" {>= "0.0.2"}
   "shape-the-term"
   "terminal_size" {>= "0.2.0"}
+  "tty" {>= "0.0.2"}
+  "uutf" {>= "1.0.3"}
   "odoc" {with-doc}
 ]
 build: [
@@ -35,6 +37,5 @@ build: [
 ]
 dev-repo: "git+https://github.com/chshersh/github-tui.git"
 pin-depends: [
-  ["minttea.dev" "git+https://github.com/chshersh/minttea"]
   ["shape-the-term.dev" "git+https://github.com/jmcavanillas/shape-the-term"]
 ]
diff --git a/github_tui.opam.template b/github_tui.opam.template
@@ -1,4 +1,3 @@
 pin-depends: [
-  ["minttea.dev" "git+https://github.com/chshersh/minttea"]
   ["shape-the-term.dev" "git+https://github.com/jmcavanillas/shape-the-term"]
 ]
diff --git a/lib/cli.ml b/lib/cli.ml
@@ -11,8 +11,15 @@ let path_arg =
     & opt (some string) None
     & info [ "d"; "directory" ] ~docv:"DIRECTORY_PATH" ~doc)
 
-let run repo local_path = Tui.start ~repo ~local_path
-let gh_tui_term = Term.(const run $ repo_arg $ path_arg)
+let log_arg =
+  let doc = "Log debug information to the given file" in
+  Arg.(
+    value
+    & opt (some string) None
+    & info [ "l"; "log-to" ] ~docv:"LOG_PATH" ~doc)
+
+let run repo local_path log_file = Tui.start ~repo ~local_path ~log_file
+let gh_tui_term = Term.(const run $ repo_arg $ path_arg $ log_arg)
 
 let cmd =
   let doc = "TUI of a GitHub repository" in
diff --git a/lib/fs/fs.mli b/lib/fs/fs.mli
@@ -1,4 +1,5 @@
-(** File contents as an array of lines, where each line is wrapped into a document (for rendering efficiency) *)
+(** File contents as an array of lines, where each line is wrapped into a
+    document (for rendering efficiency) *)
 type file_contents = {
   lines : Pretty.doc array;
   offset : int;
@@ -46,7 +47,8 @@ val go_down : zipper -> zipper
 (** Move to the previous file within the same directory. Cycles. *)
 val go_up : zipper -> zipper
 
-(** Move to the directory under the current cursor. Doesn't move inside files or empty directories. *)
+(** Move to the directory under the current cursor. Doesn't move inside files or
+    empty directories. *)
 val go_next : zipper -> zipper
 
 (** Move to the parent directory. *)
diff --git a/lib/log/dune b/lib/log/dune
@@ -0,0 +1,3 @@
+(library
+ (name log)
+ (libraries unix))
diff --git a/lib/log/log.ml b/lib/log/log.ml
@@ -0,0 +1,9 @@
+let log ~path ~tag ~msg =
+  match path with
+  | None -> ()
+  | Some path ->
+      let now = Unix.gettimeofday () in
+      let str = Printf.sprintf "timestamp=%f tag=%s msg=%s\n" now tag msg in
+      Out_channel.(
+        with_open_gen [ Open_creat; Open_append; Open_binary ] 0o644 path
+          (fun channel -> output_string channel str))
diff --git a/lib/log/log.mli b/lib/log/log.mli
@@ -0,0 +1,6 @@
+(** Log a single line in the following format to the given file if passed.
+
+    {v
+timestamp=1447865947.56802297 tag=event msg=Retry
+    v} *)
+val log : path:string option -> tag:string -> msg:string -> unit
diff --git a/lib/pretty/chunk.mli b/lib/pretty/chunk.mli
@@ -7,5 +7,6 @@ type t = {
 (** Convert a chunk to string, applying formatting *)
 val fmt : t -> string
 
-(** [replicate_chunk n s] creates a chunk without formatting of [n] repeated strings [s]. *)
+(** [replicate_chunk n s] creates a chunk without formatting of [n] repeated
+    strings [s]. *)
 val replicate : int -> string -> t
diff --git a/lib/pretty/line.mli b/lib/pretty/line.mli
@@ -1,13 +1,13 @@
 (** A type defining a single line of text with different parts ("chunks") having
-potentially different formatting. *)
+    potentially different formatting. *)
 type t
 
 (** Returns the length of a line as in the number of graphemes (before
-formatting applied). *)
+    formatting applied). *)
 val length : t -> int
 
 (** Smart constructor for a line from a list of chunks to calculate the final
-[length] automatically as well. *)
+    [length] automatically as well. *)
 val of_chunks : Chunk.t list -> t
 
 (** Add a chunk to the beginning of a line. *)
diff --git a/lib/pretty/pretty.mli b/lib/pretty/pretty.mli
@@ -9,26 +9,25 @@ val str : string -> doc
 (** Create a single chunk of string with formatting. *)
 val fmt : Style.t -> string -> doc
 
-(** Put all documents in a list horizontally, automatically adding required padding. *)
+(** Put all documents in a list horizontally, automatically adding required
+    padding. *)
 val horizontal : doc list -> doc
 
-(** Put all documents in a list vertically after each other with a line separator. *)
+(** Put all documents in a list vertically after each other with a line
+    separator. *)
 val vertical : doc list -> doc
 
 (** [horizontal_fill filler] fills all the empty horizontal space with the given
-string [filler]. Useful for alignment or separators.
+    string [filler]. Useful for alignment or separators.
 
-{b NOTE:} Only one [horizontal_fill] is allowed per [horizontal] element. The first one
-will be used, the remaining ones will be ignored.
-*)
+    {b NOTE:} Only one [horizontal_fill] is allowed per [horizontal] element.
+    The first one will be used, the remaining ones will be ignored. *)
 val horizontal_fill : string -> doc
 
 (** Render the resulting document.
 
-Parameters:
+    Parameters:
 
-  * [width]: the max allowed width for the document. Passed recursively and
-    currently only used for [horizontal_fill].
-
-*)
+    * [width]: the max allowed width for the document. Passed recursively and
+    currently only used for [horizontal_fill]. *)
 val render : width:int -> doc -> string
diff --git a/lib/shell/shell.mli b/lib/shell/shell.mli
@@ -1,11 +1,10 @@
 (** Run a given string as an external process with arguments.
 
-Redirect the called process stdout and stderr to the current process stdout.
+    Redirect the called process stdout and stderr to the current process stdout.
 
-Also print the command with a pretty prompt.
-
-*)
+    Also print the command with a pretty prompt. *)
 val proc : string -> unit
 
-(** Run the given CLI command as external process and collect its stdout to the resulting string. *)
+(** Run the given CLI command as external process and collect its stdout to the
+    resulting string. *)
 val proc_stdout : string -> string
diff --git a/lib/tui/dune b/lib/tui/dune
@@ -1,11 +1,11 @@
 (library
  (name tui)
  (libraries
-  minttea
   terminal_size
   ;; Internal dependencies
   extra
   fs
   pretty
   scroll
-  shell))
+  shell
+  tea))
diff --git a/lib/tui/init.ml b/lib/tui/init.ml
diff --git a/lib/tui/tea/dune b/lib/tui/tea/dune
@@ -0,0 +1,3 @@
+(library
+ (name tea)
+ (libraries tty unix uutf log))
diff --git a/lib/tui/tea/key.ml b/lib/tui/tea/key.ml
@@ -0,0 +1,65 @@
+(*    Copied and modified from the original implementation at:
+
+    - https://github.com/leostera/minttea/tree/aa5ef898f6ce4b2a5b359dd6f985cbe2a3583b70
+*)
+
+type t =
+  | Up
+  | Down
+  | Left
+  | Right
+  | Space
+  | Escape
+  | Backspace
+  | Enter
+  | Key of string
+
+let show_key = function
+  | Up -> "<up>"
+  | Down -> "<down>"
+  | Left -> "<left>"
+  | Right -> "<right>"
+  | Space -> "<space>"
+  | Escape -> "<esc>"
+  | Backspace -> "<backspace>"
+  | Enter -> "<enter>"
+  | Key key -> key
+
+let parse = function
+  | " " -> Space
+  | "\027" -> Escape
+  | "\027[A" -> Up
+  | "\027[B" -> Down
+  | "\027[C" -> Right
+  | "\027[D" -> Left
+  | "\127" -> Backspace
+  | "\n" -> Enter
+  | key -> Key key
+
+type read =
+  [ `End
+  | `Malformed of string
+  | `Read of t
+  ]
+
+let show_read = function
+  | `End -> "End"
+  | `Malformed s -> Printf.sprintf "Malformed: %s" s
+  | `Read key -> Printf.sprintf "Key: %s" (show_key key)
+
+let read_key key =
+  match key with
+  | "\027" -> (
+      match Stdin.read_utf8 () with
+      | `Read "[" -> (
+          match Stdin.read_utf8 () with
+          | `Read key -> parse ("\027[" ^ key)
+          | _ -> parse key)
+      | _ -> parse key)
+  | "\n" -> parse key
+  | key -> parse key
+
+let read () =
+  match Stdin.read_utf8 () with
+  | `Read key -> `Read (read_key key)
+  | (`End | `Malformed _) as other -> other
diff --git a/lib/tui/tea/key.mli b/lib/tui/tea/key.mli
@@ -0,0 +1,34 @@
+(** A module to describe and handle possible keyboard events.
+
+    Copied and modified from the original implementation at:
+
+    - https://github.com/leostera/minttea/tree/aa5ef898f6ce4b2a5b359dd6f985cbe2a3583b70
+*)
+
+type t =
+  | Up
+  | Down
+  | Left
+  | Right
+  | Space
+  | Escape
+  | Backspace
+  | Enter
+  | Key of string
+
+(** A function to show [t]. Used for debug purposes. *)
+val show_key : t -> string
+
+(** Parse [t] from the standard sequence of characters. *)
+val parse : string -> t
+
+type read =
+  [ `End
+  | `Malformed of string
+  | `Read of t
+  ]
+
+(** Read a key event from [stdin]. *)
+val read : unit -> [> read ]
+
+val show_read : read -> string
diff --git a/lib/tui/tea/stdin.ml b/lib/tui/tea/stdin.ml
@@ -0,0 +1,31 @@
+(*
+    Copied and modified from the original implementation at:
+
+    - https://github.com/ocaml-tui/tty/blob/d9fad1057a21961eb40564611545a1e0700bc7b3/tty/stdin.ml
+*)
+let stdin_fd = Unix.descr_of_in_channel stdin
+let decoder = Uutf.decoder ~encoding:`UTF_8 `Manual
+
+let try_read () =
+  let bytes = Bytes.create 8 in
+  let ready, _, _ = Unix.select [ stdin_fd ] [] [] (-1.0) in
+  if ready = [] then ()
+  else
+    match Unix.read stdin_fd bytes 0 8 with
+    | exception Unix.(Unix_error ((EINTR | EAGAIN | EWOULDBLOCK), _, _)) -> ()
+    | len -> Uutf.Manual.src decoder bytes 0 len
+
+let uchar_to_str u =
+  let buf = Buffer.create 8 in
+  Uutf.Buffer.add_utf_8 buf u;
+  Buffer.contents buf
+
+let rec read_utf8 () =
+  match Uutf.decode decoder with
+  | `Uchar u -> `Read (uchar_to_str u)
+  | `End -> `End
+  | `Malformed err -> `Malformed err
+  | `Await ->
+      (* We read in a blocking way, so there always should be something in the recursive call. *)
+      try_read ();
+      read_utf8 ()
diff --git a/lib/tui/tea/stdin.mli b/lib/tui/tea/stdin.mli
@@ -0,0 +1,10 @@
+(** A module to read key events from keyboards in a blocking way.
+
+    Copied and modified from the original implementation at:
+
+    - https://github.com/ocaml-tui/tty/blob/d9fad1057a21961eb40564611545a1e0700bc7b3/tty/stdin.ml
+*)
+
+(** [read_utf8 ()] will do a blocking read and either return the next valid
+    UTF-8 string available in [stdin] or immediately return. *)
+val read_utf8 : unit -> [> `End | `Malformed of string | `Read of string ]
diff --git a/lib/tui/tea/tea.ml b/lib/tui/tea/tea.ml
diff --git a/lib/tui/tea/tea.mli b/lib/tui/tea/tea.mli
diff --git a/lib/tui/tui.ml b/lib/tui/tui.ml
diff --git a/lib/tui/tui.mli b/lib/tui/tui.mli
diff --git a/lib/tui/update.ml b/lib/tui/update.ml
diff --git a/lib/tui/widget.ml b/lib/tui/widget.ml

Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`		`-version = 0.26.2`
	`1`	`+version = 0.27.0`
`2`	`2`	`profile = default`
`3`	`3`	`break-cases = fit-or-vertical`
`4`	`4`	`break-infix = wrap-or-vertical`
Original file line number	Diff line number	Diff line change
`@@ -25,6 +25,8 @@`
`25`	`25`	`(minttea (>= "0.0.2"))`
`26`	`26`	`shape-the-term`
`27`	`27`	`(terminal_size (>= "0.2.0"))`
	`28`	`+ (tty (>= "0.0.2"))`
	`29`	`+ (uutf (>= "1.0.3"))`
`28`	`30`	`)`
`29`	`31`	`(tags`
`30`	`32`	`(tui cli git github)))`
Original file line number	Diff line number	Diff line change
`@@ -17,6 +17,8 @@ depends: [`
`17`	`17`	`"minttea" {>= "0.0.2"}`
`18`	`18`	`"shape-the-term"`
`19`	`19`	`"terminal_size" {>= "0.2.0"}`
	`20`	`+ "tty" {>= "0.0.2"}`
	`21`	`+ "uutf" {>= "1.0.3"}`
`20`	`22`	`"odoc" {with-doc}`
`21`	`23`	`]`
`22`	`24`	`build: [`
`@@ -35,6 +37,5 @@ build: [`
`35`	`37`	`]`
`36`	`38`	`dev-repo: "git+https://github.com/chshersh/github-tui.git"`
`37`	`39`	`pin-depends: [`
`38`		`- ["minttea.dev" "git+https://github.com/chshersh/minttea"]`
`39`	`40`	`["shape-the-term.dev" "git+https://github.com/jmcavanillas/shape-the-term"]`
`40`	`41`	`]`
Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,3 @@`
`1`	`1`	`pin-depends: [`
`2`		`- ["minttea.dev" "git+https://github.com/chshersh/minttea"]`
`3`	`2`	`["shape-the-term.dev" "git+https://github.com/jmcavanillas/shape-the-term"]`
`4`	`3`	`]`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+(library`
	`2`	`+ (name log)`
	`3`	`+ (libraries unix))`