From 0f509663c78ada3a7d7bbba3da721b99c32ef9e0 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 30 Jun 2025 09:13:18 +0200
Subject: Added a radio-button element and added it with an example

---
 bin/main.ml            |  20 +++++--
 js/content.ml          | 122 ++++++++++++++++++++++++++++-----------
 js/elements.ml         | 152 ++++++++++++++++++++++++++++++++++++++++---------
 js/elements.mli        |  40 ++++++++++---
 services/capitalize.ml |  15 +++++
 5 files changed, 279 insertions(+), 70 deletions(-)
 create mode 100644 services/capitalize.ml

diff --git a/bin/main.ml b/bin/main.ml
index 79593c9..1c1c442 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,5 +1,5 @@
 (** Create the handler for the service *)
-let handler =
+let nbcar_handler =
   Dream_handler.handle
     (module Services_impl.Nb_car)
     (fun (() : Services_impl.Nb_car.placeholders) body ->
@@ -10,12 +10,23 @@ let handler =
             nbcar = Int64.of_int (String.length body.value);
           })
 
+let capitalize_handler =
+  Dream_handler.handle
+    (module Services_impl.Capitalize)
+    (fun () body ->
+      Lwt.return_ok
+        Services_impl.Capitalize.{ value = String.uppercase_ascii body.value })
+
 (* The handler and the route are not created at the same time because we may
    want create a specific handler, for example one checking CRSF in the query
    and can’t infer this from the service signature only *)
 
 (** And create the route. *)
-let route = Dream_handler.register (module Services_impl.Nb_car) handler
+let nbcar_route =
+  Dream_handler.register (module Services_impl.Nb_car) nbcar_handler
+
+and capitalize_route =
+  Dream_handler.register (module Services_impl.Capitalize) capitalize_handler
 
 (** Generate a default static page *)
 let hello : Dream.handler =
@@ -32,7 +43,7 @@ let hello : Dream.handler =
           <div class="level">
             <div class="level-left">
               <div class="level-item"><h1 class="title">
-                Dashboard
+                Example
               </h1></div>
             </div>
             <div class="level-right" style="display: none;">
@@ -76,7 +87,8 @@ let () =
          Dream.get "/js/**" (Dream.static ~loader:js_assets "");
          Dream.get "/css/**" (Dream.static ~loader:css_assets "");
          Dream.get "/" hello;
-         route;
+         nbcar_route;
+         capitalize_route;
        ]
 
 (* Now test the application by connecting to 
diff --git a/js/content.ml b/js/content.ml
index 7096524..62d4444 100644
--- a/js/content.ml
+++ b/js/content.ml
@@ -1,10 +1,10 @@
 module OptionInfix = Operators.Binding (Option)
 
 module State = struct
-  type t = { word : string; len : int; counter : int }
+  type t = { word : string; len : int; counter : int; selected : Jstr.t }
 
   let repr_html : t -> Brr.El.t list =
-   fun { word; len; counter } ->
+   fun { word; len; counter; selected } ->
     [
       Brr.El.div
         ~at:Brr.At.[ class' (Jstr.v "card") ]
@@ -25,12 +25,14 @@ module State = struct
             [
               Brr.El.form
                 [
-                  Elements.input_field ~label:(Jstr.v "Word received")
+                  Elements.Form.input_field ~label:(Jstr.v "Word received")
                     ~value':(Jstr.v word) ();
-                  Elements.input_field ~label:(Jstr.v "Nb of car")
+                  Elements.Form.input_field ~label:(Jstr.v "Nb of car")
                     ~value':(Jstr.of_int len) ();
-                  Elements.input_field ~label:(Jstr.v "Request sent")
+                  Elements.Form.input_field ~label:(Jstr.v "Request sent")
                     ~value':(Jstr.of_int counter) ();
+                  Elements.Form.input_field ~label:(Jstr.v "Selected method")
+                    ~value':selected ();
                 ];
             ];
         ];
@@ -49,12 +51,33 @@ module WordCount = struct
       ];
     State.
       {
+        state with
         counter = state.counter + 1;
         word = response.Services_impl.Nb_car.value;
         len = Int64.to_int response.Services_impl.Nb_car.nbcar;
       }
 end
 
+module Capitalize = struct
+  type t = Services_impl.Capitalize.response
+
+  let process response state =
+    Brr.Console.log [ Jstr.v response.Services_impl.Capitalize.value ];
+    State.
+      {
+        state with
+        counter = state.counter + 1;
+        word = response.Services_impl.Capitalize.value;
+      }
+end
+
+(** Show how to react to a user event *)
+module SelectOption = struct
+  type t = Jstr.t
+
+  let process v state = State.{ state with selected = v }
+end
+
 module App = Application.Make (State)
 
 let main () =
@@ -63,29 +86,48 @@ let main () =
     Brr.Document.find_el_by_id Brr.G.document (Jstr.v "content")
   in
 
+  let radio =
+    Elements.Form.radio ~label:(Jstr.v "Method") ~name:(Jstr.v "method")
+      ~values:
+        [
+          {
+            id' = None;
+            label = Jstr.v "Count the letters";
+            value = Jstr.v "count";
+            checked = true;
+          };
+          {
+            id' = None;
+            label = Jstr.v "Capitalize";
+            value = Jstr.v "capitalize";
+            checked = false;
+          };
+        ]
+      ()
+  in
+
+  (* Catch the change event from the radio button list. 
+
+    Each radio button triggers it’s own event when selected, but the event
+    bubbles, so we just listen the parent, and target the event source for
+    reading the value. *)
+  let radio_value =
+    Note_brr.Evr.on_el Brr.Ev.change
+      (fun evt ->
+        let target_as_element : Brr.El.t = Brr.Ev.target evt |> Obj.magic in
+
+        let raw_value = Brr.El.prop Brr.El.Prop.value target_as_element in
+        App.dispatch (module SelectOption) raw_value)
+      radio
+  in
+
   let form =
     Brr.El.form
       [
-        Elements.input_field ~name:(Jstr.v "text") ~id':(Jstr.v "text")
+        Elements.Form.input_field ~name:(Jstr.v "text") ~id':(Jstr.v "text")
           ~label:(Jstr.v "Text") ();
-        Brr.El.div
-          ~at:Brr.At.[ class' (Jstr.v "field is-horizontal") ]
-          [
-            Brr.El.div ~at:Brr.At.[ class' (Jstr.v "field-label") ] [];
-            Brr.El.div
-              ~at:Brr.At.[ class' (Jstr.v "field-body") ]
-              [
-                Brr.El.input
-                  ~at:
-                    Brr.At.
-                      [
-                        class' (Jstr.v "button is-primary");
-                        type' (Jstr.v "submit");
-                        value (Jstr.v "Count");
-                      ]
-                  ();
-              ];
-          ];
+        radio;
+        Elements.Form.submit ~value':(Jstr.v "Send") ();
       ]
   in
 
@@ -110,12 +152,28 @@ let main () =
              | _ -> ""
            in
 
-           (* Send the request *)
-           Js_handler.send (module Services_impl.Nb_car) () { value }
-           |> Note_brr.Futr.to_event
-           |> Note.E.map (function
-                | Error _ -> App.dispatch (module App.ID) ()
-                | Ok response -> App.dispatch (module WordCount) response))
+           let service_name =
+             Option.bind
+               (Brr_io.Form.Data.find data (Jstr.v "method"))
+               (function `String s -> Some (Jstr.to_string s) | _ -> None)
+           in
+
+           match service_name with
+           | Some "count" ->
+               (* Send the request *)
+               Js_handler.send (module Services_impl.Nb_car) () { value }
+               |> Note_brr.Futr.to_event
+               |> Note.E.map (function
+                    | Error _ -> App.dispatch (module App.ID) ()
+                    | Ok response -> App.dispatch (module WordCount) response)
+           | Some "capitalize" ->
+               (* Send the request *)
+               Js_handler.send (module Services_impl.Capitalize) () { value }
+               |> Note_brr.Futr.to_event
+               |> Note.E.map (function
+                    | Error _ -> App.dispatch (module App.ID) ()
+                    | Ok response -> App.dispatch (module Capitalize) response)
+           | _ -> Note.E.never)
          form
   in
   let bottom = Brr.El.div [] in
@@ -143,8 +201,8 @@ let main () =
 
   let state =
     App.run
-      { word = ""; len = 0; counter = 0 }
-      (Note.E.select [ post_event form ])
+      { word = ""; len = 0; counter = 0; selected = Jstr.v "count" }
+      (Note.E.select [ post_event form; radio_value ])
   in
 
   Note_brr.Elr.def_children bottom (Note.S.map State.repr_html state);
diff --git a/js/elements.ml b/js/elements.ml
index b3c07a2..783f791 100644
--- a/js/elements.ml
+++ b/js/elements.ml
@@ -1,25 +1,8 @@
-let input_field :
-    ?name:Jstr.t ->
-    ?id':Jstr.t ->
-    ?value':Jstr.t ->
-    label:Jstr.t ->
-    unit ->
-    Brr.El.t =
- fun ?name ?id' ?(value' = Jstr.empty) ~label () ->
-  let name' = name in
-  let input =
-    Brr.El.input
-      ~at:
-        Brr.At.
-          [
-            if_some (Option.map Brr.At.id id');
-            if_some (Option.map Brr.At.name name');
-            class' (Jstr.v "input");
-            type' (Jstr.v "text");
-            value value';
-          ]
-      ()
-  and label =
+open StdLabels
+
+module Form = struct
+  let label_for_field : ?id':Jstr.t -> Jstr.t -> Brr.El.t =
+   fun ?id' label ->
     Brr.El.label
       ~at:
         Brr.At.
@@ -28,8 +11,125 @@ let input_field :
             class' (Jstr.v "field-label is-normal");
           ]
       [ Brr.El.txt label ]
-  in
 
-  Brr.El.div
-    ~at:Brr.At.[ class' (Jstr.v "field is-horizontal") ]
-    [ label; Brr.El.div ~at:Brr.At.[ class' (Jstr.v "field-body") ] [ input ] ]
+  let input_field :
+      ?name:Jstr.t ->
+      ?id':Jstr.t ->
+      ?value':Jstr.t ->
+      label:Jstr.t ->
+      unit ->
+      Brr.El.t =
+   fun ?name ?id' ?(value' = Jstr.empty) ~label () ->
+    let name' = name in
+    let input =
+      Brr.El.input
+        ~at:
+          Brr.At.
+            [
+              if_some (Option.map Brr.At.id id');
+              if_some (Option.map Brr.At.name name');
+              class' (Jstr.v "input");
+              type' (Jstr.v "text");
+              value value';
+            ]
+        ()
+    and label = label_for_field ?id' label in
+
+    Brr.El.div
+      ~at:Brr.At.[ class' (Jstr.v "field is-horizontal") ]
+      [
+        label; Brr.El.div ~at:Brr.At.[ class' (Jstr.v "field-body") ] [ input ];
+      ]
+
+  type choice_value = {
+    id' : Jstr.t option;
+    label : Jstr.t;
+    value : Jstr.t;
+    checked : bool;
+  }
+
+  let radio :
+      ?name:Jstr.t ->
+      ?values:choice_value list ->
+      label:Jstr.t ->
+      unit ->
+      Brr.El.t =
+   fun ?name ?(values = []) ~label () ->
+    let name' = name in
+    let label = label_for_field label in
+
+    let radios =
+      List.map values ~f:(fun entry ->
+          (* This is the element receiving the events *)
+          let input =
+            Brr.El.input
+              ~at:
+                Brr.At.
+                  [
+                    if_some (Option.map Brr.At.name name');
+                    if_some (Option.map Brr.At.id entry.id');
+                    if' entry.checked Brr.At.checked;
+                    type' (Jstr.v "radio");
+                    value entry.value;
+                  ]
+              ()
+          in
+
+          Brr.El.label
+            ~at:Brr.At.[ class' (Jstr.v "radio") ]
+            [
+              input;
+              Brr.El.span
+                ~at:Brr.At.[ class' (Jstr.v "control-label") ]
+                [ Brr.El.nbsp (); Brr.El.txt entry.label ];
+            ])
+    in
+
+    let form_entry =
+      Brr.El.div
+        ~at:Brr.At.[ class' (Jstr.v "field has-check is-horizontal") ]
+        [
+          label;
+          Brr.El.div
+            ~at:Brr.At.[ class' (Jstr.v "field-body") ]
+            [
+              Brr.El.div
+                ~at:Brr.At.[ class' (Jstr.v "field") ]
+                [
+                  Brr.El.div
+                    ~at:
+                      Brr.At.
+                        [
+                          class' (Jstr.v "field is-grouped-multine is-grouped");
+                        ]
+                    [
+                      Brr.El.div ~at:Brr.At.[ class' (Jstr.v "radios") ] radios;
+                    ];
+                ];
+            ];
+        ]
+    in
+    (* Report each change_event to the main html element  *)
+    form_entry
+
+  let submit : ?value':Jstr.t -> unit -> Brr.El.t =
+   fun ?(value' = Jstr.empty) () ->
+    Brr.El.div
+      ~at:Brr.At.[ class' (Jstr.v "field is-horizontal") ]
+      [
+        Brr.El.div ~at:Brr.At.[ class' (Jstr.v "field-label") ] [];
+        Brr.El.div
+          ~at:Brr.At.[ class' (Jstr.v "field-body") ]
+          [
+            Brr.El.input
+              ~at:
+                Brr.At.
+                  [
+                    class' (Jstr.v "button is-primary");
+                    type' (Jstr.v "submit");
+                    value value';
+                  ]
+              ();
+          ];
+      ]
+end
diff --git a/js/elements.mli b/js/elements.mli
index fcb5588..c2b145b 100644
--- a/js/elements.mli
+++ b/js/elements.mli
@@ -1,8 +1,32 @@
-val input_field :
-  ?name:Jstr.t ->
-  ?id':Jstr.t ->
-  ?value':Jstr.t ->
-  label:Jstr.t ->
-  unit ->
-  Brr.El.t
-(** Create a new input element *)
+module Form : sig
+  (** Fonctions for creating forms elements
+
+      In each function, the element returned by the function is not the field
+      element. *)
+
+  val input_field :
+    ?name:Jstr.t ->
+    ?id':Jstr.t ->
+    ?value':Jstr.t ->
+    label:Jstr.t ->
+    unit ->
+    Brr.El.t
+  (** Create a new input element *)
+
+  type choice_value = {
+    id' : Jstr.t option;
+    label : Jstr.t;
+    value : Jstr.t;
+    checked : bool;
+  }
+  (** Values inside a radio button list *)
+
+  val radio :
+    ?name:Jstr.t ->
+    ?values:choice_value list ->
+    label:Jstr.t ->
+    unit ->
+    Brr.El.t
+
+  val submit : ?value':Jstr.t -> unit -> Brr.El.t
+end
diff --git a/services/capitalize.ml b/services/capitalize.ml
new file mode 100644
index 0000000..a7ddf32
--- /dev/null
+++ b/services/capitalize.ml
@@ -0,0 +1,15 @@
+(** Service capitalizing a word *)
+
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives
+
+type request = { value : string } [@@deriving yojson]
+type response = { value : string } [@@deriving yojson]
+
+(** The method used in the service *)
+let method_ = Services.POST
+
+type placeholders = unit
+(** No placeholder here in the request url *)
+
+(** The path to the service, matching the type parameters *)
+let path = Path.(T1 (Fixed (V_string.v "api/capitalize")))
-- 
cgit v1.2.3