aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bin/main.ml20
-rw-r--r--js/content.ml122
-rw-r--r--js/elements.ml152
-rw-r--r--js/elements.mli40
-rw-r--r--services/capitalize.ml15
5 files changed, 279 insertions, 70 deletions
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")))
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-04 16:59:16 +0000