feat(leaves): New list component.

The list can be filtered, and elements can be selected.

Author: Lattay

examples/list/dune

@@ -0,0 +1,3 @@
+(executable
+  (name main)
+  (libraries minttea spices leaves str))

examples/list/main.ml

@@ -0,0 +1,110 @@
+open Minttea
+module Input = Leaves.Text_input
+module FList = Leaves.Filtered_list
+
+type model = {
+  elements : FList.t;
+  choices : string list option;
+  edit_filter : bool;
+  filter_input : Input.t;
+}
+
+let initial_model =
+  {
+    (* Choices is to Some list at the end of the program *)
+    choices = None;
+    (* A Text_input is used to enter a substring used for filtering *)
+    filter_input = Input.make "" ~prompt:"/" ();
+    edit_filter = false;
+    elements =
+      FList.make
+        [
+          "brain 🧠";
+          "bread 🍞";
+          "butter 🧈";
+          "cake 🍰";
+          "carrots 🥕";
+          "chocolate 🍫";
+          "cupcakes 🧁";
+          "empanadas 🥟";
+          "hamburgers 🍔";
+          "ice cream 🍦";
+          "milk 🥛";
+          "pizza 🍕";
+          "strawberries 🍓";
+          "waffles 🧇";
+          "yogurt 🥛";
+        ]
+        ~style_selected:Spices.(default |> bold true)
+        ();
+  }
+
+let init _model = Command.Noop
+
+let update event model : model * Command.t =
+  if model.edit_filter then
+    match event with
+    (* validate the search and go back to navigating the list *)
+    | Event.KeyDown Enter ->
+        let elements =
+          FList.show_string_contains model.elements
+            (Input.current_text model.filter_input)
+        in
+        ({ model with elements; edit_filter = false }, Command.Noop)
+    (* cancel the search and go back to navigating the list *)
+    | Event.KeyDown Escape ->
+        let elements = FList.show_all model.elements in
+        ( {
+            model with
+            elements;
+            edit_filter = false;
+            filter_input = Input.set_text "" model.filter_input;
+          },
+          Command.Noop )
+    (* everything else is passed to underlying component *)
+    | _ ->
+        let filter_input = Input.update model.filter_input event in
+        (* incremental search: update the search on all event *)
+        let elements =
+          FList.show_string_contains model.elements
+            (Input.current_text filter_input)
+        in
+        ({ model with filter_input; elements }, Command.Noop)
+  else
+    match event with
+    (* Validate the selection, print it and quit *)
+    | Event.KeyDown Enter ->
+        let elements = FList.get_selection model.elements in
+        ({ model with choices = Some elements }, Command.Quit)
+    (* Quit right away *)
+    | Event.KeyDown (Key "q" | Escape) -> (model, Command.Quit)
+    (* Open the search Text_input *)
+    | Event.KeyDown (Key "/") ->
+        ({ model with edit_filter = true }, Command.Noop)
+    (* Delegate the rest to the list *)
+    | _ ->
+        let elements = FList.update event model.elements in
+        ({ model with elements }, Command.Noop)
+
+let view model =
+  match model.choices with
+  (* ready to leave *)
+  | Some elements -> String.concat "\n" elements
+  (* normal running *)
+  | None ->
+      let help_msg =
+        if model.edit_filter then "Esc: cancel filter, Enter: validate filter"
+        else "q: quit, /: search, j/k: up/down, space: select, enter: validate."
+      in
+      Format.sprintf {|Pick your favorite food:
+
+%s
+%s
+
+%s|}
+        (FList.view model.elements)
+        (if model.edit_filter then Input.view model.filter_input else "")
+        help_msg
+
+let app = Minttea.app ~init ~update ~view ()
+let () = Minttea.start app ~initial_model

leaves/dune

@@ -4,4 +4,4 @@
 (library
  (public_name leaves)
  (name leaves)
- (libraries minttea spices ptime ptime.clock.os))
+ (libraries minttea spices ptime ptime.clock.os str))

leaves/filtered_list.ml

@@ -0,0 +1,241 @@
+module Command = Minttea.Command
+module Event = Minttea.Event
+module Input = Text_input
+
+type t = {
+  elements : (bool * string) list;
+  shown : int list option;
+  cursor : int;
+  max_height : int;
+  cursor_string : string;
+  style_selected : Spices.style;
+  style_unselected : Spices.style;
+  predicate : int -> string -> bool;
+}
+
+let default_cursor = ">"
+
+let make (elements : string list) ?(cursor = default_cursor)
+    ?(style_selected = Spices.default) ?(style_unselected = Spices.default)
+    ?(max_height = 10)
+    () =
+  {
+    elements = List.map (fun e -> (false, e)) elements;
+    cursor = 0;
+    shown = None;
+    cursor_string = cursor;
+    predicate = (fun _ _ -> true);
+    max_height;
+    style_selected;
+    style_unselected;
+  }
+
+let rec last = function
+  | [] -> raise Not_found
+  | [ e ] -> e
+  | _ :: rest -> last rest
+
+let show_pred model predicate =
+  let indices =
+    (* list of shown indices *)
+    model.elements
+    |> List.mapi (fun idx (_, e) -> (idx, predicate idx e))
+    |> List.filter (fun (_, selected) -> selected)
+    |> List.map fst
+  in
+  let cursor =
+    (* set the cursor to the closest visible element *)
+    if List.length indices = 0 then 0
+    else
+      match List.find (( <= ) model.cursor) indices with
+      | exception Not_found -> last indices
+      | idx -> idx
+  in
+  { model with cursor; predicate; shown = Some indices }
+
+let show_string_contains model s =
+  (* return true if the filter matches the element *)
+  let match_filter filter _ element =
+    match Str.search_forward (Str.regexp filter) element 0 with
+    | exception Not_found -> false
+    | _ -> true
+  in
+  show_pred model (match_filter s)
+
+let show_all model = { model with shown = None }
+
+(* move the cursor in the list of visible elements, eventually wrapping *)
+let prev_visible cur shown =
+  if shown = [] then 0
+  else
+    let last = last shown in
+    let rec loop cur shown =
+      match shown with
+      | a :: _ when a < cur -> a
+      | _ :: rest -> loop cur rest
+      | [] -> last
+    in
+    loop cur (List.rev shown)
+
+(* move the cursor in the list of visible elements, eventually wrapping *)
+let next_visible cur shown =
+  let first = match shown with a :: _ -> a | [] -> 0 in
+  let rec loop cur shown =
+    match shown with
+    | a :: _ when a > cur -> a
+    | _ :: rest -> loop cur rest
+    | [] -> first
+  in
+  loop cur shown
+
+let update event (model : t) =
+  match event with
+  | Event.KeyDown (Key "s" | Space) ->
+      (* select current element *)
+      {
+        model with
+        elements =
+          List.mapi
+            (fun idx (s, e) ->
+              if idx = model.cursor then (not s, e) else (s, e))
+            model.elements;
+      }
+  | Event.KeyDown (Up | Key "k") ->
+      let len = List.length model.elements in
+      if len = 0 then model
+      else
+        {
+          model with
+          cursor =
+            (match model.shown with
+            | None -> (model.cursor + len - 1) mod len
+            | Some shown -> prev_visible model.cursor shown);
+        }
+  | Event.KeyDown (Down | Key "j") ->
+      let len = List.length model.elements in
+      if len = 0 then model
+      else
+        {
+          model with
+          cursor =
+            (match model.shown with
+            | None -> (model.cursor + 1) mod len
+            | Some shown -> next_visible model.cursor shown);
+        }
+  | Event.KeyDown (Left | Key "h") ->
+      (* previous page, not wrapping *)
+      { model with cursor = max (model.cursor - model.max_height) 0 }
+  | Event.KeyDown (Right | Key "l") ->
+      (* next page, not wrapping *)
+      {
+        model with
+        cursor =
+          min
+            (model.cursor + model.max_height)
+            (max 0 (List.length model.elements - 1));
+      }
+  | _ -> model
+
+(* drop the first n elements of the list *)
+let rec drop n lst =
+  if n = 0 then lst
+  else match lst with _ :: rest -> drop (n - 1) rest | [] -> []
+
+(* keep the first n elements of the list *)
+let take n lst =
+  let rec aux lst n acc =
+    if n = 0 then List.rev acc
+    else
+      match lst with
+      | x :: rest -> aux rest (n - 1) (x :: acc)
+      | [] -> List.rev acc
+  in
+  aux lst n []
+
+(* only keep visible items, counting on the order of shown and elems *)
+let pick_visible shown elems =
+  let rec loop shown elems acc =
+    match (shown, elems) with
+    | [], _ -> List.rev acc
+    | _, [] -> List.rev acc
+    | idxa :: shown, (idxb, s, e) :: elems when idxa = idxb ->
+        loop shown elems ((idxa, s, e) :: acc)
+    | shown, _ :: elems -> loop shown elems acc
+  in
+  loop shown elems []
+
+let view (model : t) =
+  let npages =
+    (match model.shown with
+    | Some shown -> List.length shown / model.max_height
+    | None -> List.length model.elements / model.max_height)
+    + 1
+  in
+  let page = 1 + (model.cursor / model.max_height) in
+  let elems =
+    model.elements
+    |> List.mapi (fun idx (selected, element) -> (idx, selected, element))
+    |> (match model.shown with
+       | None -> fun x -> x
+       | Some shown -> pick_visible shown)
+    |> drop ((page - 1) * model.max_height)
+    |> take model.max_height
+  in
+
+  (* Represent rows with cursor, index and selection marker *)
+  let format_row (idx, selected, element) =
+    let cursor =
+      if model.cursor = idx then model.cursor_string
+      else String.make (String.length model.cursor_string) ' '
+    in
+    let bullet =
+      if selected then Format.sprintf "[%2d]" (idx + 1)
+      else Format.sprintf " %2d " (idx + 1)
+    in
+    let style =
+      if selected then model.style_selected else model.style_unselected
+    in
+    Spices.build style "%s %s %s" cursor bullet element
+  in
+
+  let rows = List.map format_row elems in
+  let lst =
+    if List.length rows < model.max_height then
+      String.concat "\n"
+        (rows @ List.init (model.max_height - List.length rows) (fun _ -> ""))
+    else String.concat "\n" rows
+  in
+  let page_indicator =
+    String.concat " "
+    @@ List.init npages (fun idx -> if idx + 1 = page then "*" else ".")
+  in
+  lst ^ "\n\n" ^ page_indicator
+
+(* Append more elements at the end of the list *)
+let append model elements =
+  let model =
+    {
+      model with
+      elements = model.elements @ List.map (fun e -> (false, e)) elements;
+    }
+  in
+  (* reapply the predicate with currently active *)
+  match model.shown with
+  | None -> model
+  | Some _ -> show_pred model model.predicate
+
+let filter model predicate =
+  let model =
+    {
+      model with
+      elements = List.filteri (fun idx (_, e) -> predicate idx e) model.elements;
+    }
+  in
+  (* reapply the filter predicate with currently active *)
+  match model.shown with
+  | None -> model
+  | Some _ -> show_pred model model.predicate
+
+(* Return the selected elements of the list *)
+let get_selection model =
+  model.elements |> List.filter (fun (selected, _) -> selected) |> List.map snd

leaves/filtered_list.mli

@@ -0,0 +1,35 @@
+type t
+
+val make :
+  string list ->
+  ?cursor:string ->
+  ?style_selected:Spices.style ->
+  ?style_unselected:Spices.style ->
+  ?max_height:int ->
+  unit ->
+  t
+(** Create a new list component *)
+
+val show_string_contains : t -> string -> t
+(** Only show elements that contain a given substring *)
+
+val show_pred : t -> (int -> string -> bool) -> t
+(** Show elements matching a predicate *)
+
+val show_all : t -> t
+(** Clear filtering *)
+
+val update : Minttea.Event.t -> t -> t
+(** Update the component based on events *)
+
+val view : t -> string
+(** Produce the view as a string *)
+
+val get_selection : t -> string list
+(** Return the selected elements of the list *)
+
+val append : t -> string list -> t
+(** Append more elements at the end of the list *)
+
+val filter : t -> (int -> string -> bool) -> t
+(** Permanently remove elements not verifying the predicate *)