Rework forms and fields

bin/servers.ml

@@ -71,7 +71,7 @@ module Connect_form = struct
     in
     let password_field =
       field
-        (Lwd.pure @@ Field.password_input ~required:false None)
+        (Lwd.pure @@ Field.password_input ~required:false ())
         (fun t v -> { t with password = v })
     in
     let submit =

vendor/brr_lwd_ui/lib/forms/field.ml

@@ -13,7 +13,7 @@ type 'a desc = { name : string; default : 'a; label : label }
    - A function that retieves the value of the element *)
 type 'a t = {
   elt : Elwd.t Lwd.t;
-  value : 'a option Lwd.var;
+  value : 'a Lwd.var;
   validate : 'a -> 'a validation;
 }
 
@@ -33,7 +33,7 @@ let make_handler ~(value : Jv.t -> 'a) ~(value_change_event : _ Ev.type')
     Elwd.handler value_change_event (fun ev ->
         let t = Ev.target ev |> Ev.target_to_jv in
         let v = Jv.get t "value" in
-        Lwd.set var (Some (value v)))
+        Lwd.set var (value v))
   in
   (on_change, var)
 
@@ -65,19 +65,20 @@ let text_input ?validate ?d ?(at = []) ?ev ?required ?pattern ?placeholder
     |> A.add_opt At.Name.placeholder placeholder
     |> A.add_opt At.Name.value default_value
   in
+  let default_value = Option.get_or ~default:"" default_value in
   let value = Jv.to_string in
   make_input ~value ?validate ?d ~at ?ev ?required ?pattern
     ~value_change_event:Ev.input ~type':"text" default_value
 
 let password_input ?validate ?d ?(at = []) ?ev ?required ?pattern ?placeholder
-    _value =
+    () =
   let at = at |> A.add_opt At.Name.placeholder placeholder in
   let value = Jv.to_string in
   make_input ~value ~value_change_event:Ev.input ?validate ?d ~at ?ev ?required
-    ?pattern ~type':"password" None
+    ?pattern ~type':"password" ""
 
 let submit ?d ?(at = []) ?ev text =
   let at = A.add At.Name.value text at in
   (* TODO this should be more precise. Submit inputs are different. *)
   make_input ~value:ignore ~value_change_event:Ev.change ?d ~at ?ev
-    ~type':"submit" None
+    ~type':"submit" ()

vendor/brr_lwd_ui/lib/forms/field_checkboxes.ml

@@ -14,50 +14,57 @@ let name ~g ~n ~id base_name =
   if id then Printf.sprintf "%s-%i-%i-id" base_name g n
   else Printf.sprintf "%s-%i-%i" base_name g n
 
-let make t =
-  let make_check ~g ~n value label checked =
-    let id = name ~g ~n ~id:true t.name in
-    let name = name ~g ~n ~id:false t.name in
-    let result checked = if checked then Some value else None in
-    let var = Persistent.var ~key:id (result checked) in
-    let lbl = Elwd.label ~at:[ `P (At.for' (Jstr.v id)) ] label in
-    let at =
-      let open Attrs in
-      add At.Name.id (`P id) []
-      |> add At.Name.name (`P name)
-      |> add At.Name.type' (`P "checkbox")
-    in
-    let checked =
-      Lwd.map (Lwd.get var) ~f:(function
-        | Some _ -> At.checked
-        | None -> At.void)
-    in
-    let at = `R checked :: at in
-    let on_change =
-      Elwd.handler Ev.change (fun ev ->
-          let t = Ev.target ev |> Ev.target_to_jv in
-          let checked = Jv.get t "checked" in
-          Lwd.set var (result (Jv.to_bool checked)))
-    in
-    let ev = [ `P on_change ] in
-    (Elwd.(div [ `R (input ~at ~ev ()); `R lbl ]), Lwd.get var)
+let make_single ?persist ?(ev = []) ?(on_change = fun _ -> ()) name value label
+    checked =
+  let id = Format.sprintf "%s-id" name in
+  let result checked = if checked then Some value else None in
+  let var =
+    match persist with
+    | Some true -> Persistent.var ~key:id (result checked)
+    | Some false | None -> Lwd.var (result checked)
   in
+  let lbl = Elwd.label ~at:[ `P (At.for' (Jstr.v id)) ] label in
+  let at =
+    let open Attrs in
+    add At.Name.id (`P id) []
+    |> add At.Name.name (`P name)
+    |> add At.Name.type' (`P "checkbox")
+  in
+  let checked =
+    Lwd.map (Lwd.get var) ~f:(function Some _ -> At.checked | None -> At.void)
+  in
+  let at = `R checked :: at in
+  let on_change =
+    Elwd.handler Ev.change (fun ev ->
+        let t = Ev.target ev |> Ev.target_to_jv in
+        let checked = Jv.get t "checked" in
+        let result = result (Jv.to_bool checked) in
+        on_change result;
+        Lwd.set var result)
+  in
+  let ev = `P on_change :: ev in
+  (Elwd.(div [ `R (input ~at ~ev ()); `R lbl ]), var)
+
+let make ?(persist = true) t =
   (* <fieldset><legend> *)
   (* <fieldset><legend> *)
   let make_all ~g desc =
     let n = ref 0 in
     Lwd_seq.map
       (function
         | Check (v, l, c) ->
-            let elt, value = make_check ~g ~n:!n v l c in
+            let name = name ~g ~n:!n ~id:false t.name in
+            let elt, value = make_single ~persist name v l c in
             incr n;
             (elt, value))
       desc
   in
   let all = make_all ~g:0 t.desc in
   let elts = Lwd_seq.map (fun (elt, _) -> elt) all in
   let value =
-    Lwd_seq.fold_monoid (fun (_, v) -> Lwd_seq.element v) Lwd_seq.monoid all
+    Lwd_seq.fold_monoid
+      (fun (_, v) -> Lwd_seq.element (Lwd.get v))
+      Lwd_seq.monoid all
     |> Lwd_seq.lift |> Lwd_seq.filter_map Fun.id
   in
   { field = Elwd.div [ `S (Lwd_seq.lift elts) ]; value }

vendor/brr_lwd_ui/lib/forms/field_select.ml

@@ -12,10 +12,14 @@ type 'a reactive_field = {
 let name ~id base_name =
   if id then Printf.sprintf "%s--id" base_name else base_name
 
-let make ?(at = []) ?(ev = []) (desc : string Field.desc) options =
+let make ?(persist = true) ?(at = []) ?(ev = []) (desc : string Field.desc)
+    options =
   let id = name ~id:true desc.name in
   let name = name ~id:false desc.name in
-  let value = Persistent.var ~key:id desc.default in
+  let value =
+    if persist then Persistent.var ~key:id desc.default
+    else Lwd.var desc.default
+  in
   let label = Elwd.label ~at:[ `P (At.for' (Jstr.v id)) ] desc.label in
   let field =
     let at =

vendor/brr_lwd_ui/lib/forms/form.ml

@@ -24,11 +24,7 @@ let create ?d ?at ?ev (type t) (module Form : Form with type t = t) on_submit :
     |> Lwd_seq.fold_monoid
          (fun (F (field, mapper)) ->
            ( Lwd_seq.element field.elt,
-             let value () =
-               match Lwd.peek field.value with
-               | None -> Field.Empty
-               | Some v -> field.validate v
-             in
+             let value () = Lwd.peek field.value |> field.validate in
              fun t -> mapper t @@ value () ))
          ( (Lwd_seq.empty, Fun.id),
            fun (elts, f) (elts', f') ->