Rework fields: make them reactive

bin/servers.ml

@@ -45,20 +45,23 @@ module Connect_form = struct
   let fields =
     let url_field =
       field
-        (Field.text_input
-           ~at:[ `P (At.value (Jstr.v "http://localhost:8096")) ]
-           ~required:true "")
+        (Lwd.pure
+        @@ Field.text_input ~required:true (Some "http://localhost:8096"))
         (fun t v -> { t with url = v })
     in
     let username_field =
-      field (Field.text_input ~required:true "") (fun t v ->
-          { t with username = v })
+      field
+        (Lwd.pure @@ Field.text_input ~required:true None)
+        (fun t v -> { t with username = v })
     in
     let password_field =
-      field (Field.password_input ~required:true "") (fun t v ->
-          { t with password = v })
+      field
+        (Lwd.pure @@ Field.password_input ~required:true None)
+        (fun t v -> { t with password = v })
+    in
+    let submit =
+      field (Lwd.pure @@ Field.submit (`P "Connect")) (fun t _v -> t)
     in
-    let submit = field (Field.submit (`P "Connect")) (fun t _v -> t) in
     Lwd.return
       (Lwd_seq.of_list [ url_field; username_field; password_field; submit ])
 end

lib/brr_lwd_ui/forms/field.ml

@@ -19,40 +19,62 @@ module Make (Params : S) = struct end
    - An html input element with potential validation via attributes
    - A validation function that replace or complete the standard validation
    - A function that retieves the value of the element *)
-type 'a t = { elt : Elwd.t; value : unit -> 'a; validate : 'a -> 'a validation }
+type 'a t = {
+  elt : Elwd.t Lwd.t;
+  value : 'a option Lwd.var;
+  validate : 'a -> 'a validation;
+}
 
 let get_value t =
   let jv = El.to_jv t in
   Jv.get jv "value"
 
-let make ~(value : Elwd.t -> 'a) ?validate elt =
-  Lwd.map elt ~f:(fun elt ->
-      let validate = Option.value validate ~default:(fun v -> Ok v) in
-      let value () = value elt in
-      { elt; value; validate })
+let make_handler ~(value : Jv.t -> 'a) ~(value_change_event : _ Ev.type')
+    default_value =
+  let var = Lwd.var default_value in
+  let on_change =
+    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)))
+  in
+  (on_change, var)
 
-let make_input ~(value : Elwd.t -> 'a) ?validate ?d ?(at = []) ?ev
-    ?(required = false) ?pattern type' =
+let make_input ~(value : Jv.t -> 'a) ?validate ?d ?(at = []) ?ev
+    ?(required = false) ~value_change_event ?pattern ~type' default_value =
   let type' = At.type' (Jstr.v type') in
   let at = `P type' :: at in
   let at =
     at |> A.add_bool At.required required |> A.add_opt At.Name.pattern pattern
   in
-  let elt = Elwd.input ?d ~at ?ev () in
-  make ~value ?validate elt
+  let validate = Option.value validate ~default:(fun v -> Ok v) in
+  let on_change, value =
+    make_handler ~value ~value_change_event default_value
+  in
+  let ev = `P on_change :: Option.to_list ev in
+  let elt = Elwd.input ?d ~at ~ev () in
+  { elt; value; validate }
 
 let text_input ?validate ?d ?(at = []) ?ev ?required ?pattern ?placeholder
-    _value =
-  let at = at |> A.add_opt At.Name.placeholder placeholder in
-  let value elt = get_value elt |> Jv.to_string in
-  make_input ~value ?validate ?d ~at ?ev ?required ?pattern "text"
+    default_value =
+  let at =
+    at
+    |> A.add_opt At.Name.placeholder placeholder
+    |> A.add_opt At.Name.value default_value
+  in
+  let value = Jv.to_string in
+  make_input ~value ?validate ?d ~at ?ev ?required ?pattern
+    ~value_change_event:Ev.keyup ~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 elt = get_value elt |> Jv.to_string in
-  make_input ~value ?validate ?d ~at ?ev ?required ?pattern "password"
+  let value = Jv.to_string in
+  make_input ~value ~value_change_event:Ev.keyup ?validate ?d ~at ?ev ?required
+    ?pattern ~type':"password" None
 
 let submit ?d ?(at = []) ?ev text =
   let at = A.add At.Name.value text at in
-  make_input ~value:ignore ?d ~at ?ev "submit"
+  (* 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

lib/brr_lwd_ui/forms/field_textinput.ml

@@ -3,7 +3,6 @@ open! Brrer
 open! Brr
 open! Brr_lwd
 
-type checked = bool
 type label = Elwd.t Elwd.col
 type desc = { placeholder : string option Lwd.t; label : label }
 type t = { name : string; default : string option; desc : desc }

lib/brr_lwd_ui/forms/form.ml

@@ -24,7 +24,11 @@ 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 () = field.value () |> field.validate in
+             let value () =
+               match Lwd.peek field.value with
+               | None -> Field.Empty
+               | Some v -> field.validate v
+             in
              fun t -> mapper t @@ value () ))
          ( (Lwd_seq.empty, Fun.id),
            fun (elts, f) (elts', f') ->
@@ -41,4 +45,4 @@ let create ?d ?at ?ev (type t) (module Form : Form with type t = t) on_submit :
   let on_submit = `R handler in
   let elts = Lwd.map fields ~f:(fun (elts, _) -> elts) in
   let ev = Option.map_or ~default:[ on_submit ] (List.cons on_submit) ev in
-  Elwd.form ?d ?at ~ev [ `S elts ]
+  Elwd.form ?d ?at ~ev [ `S (Lwd_seq.lift elts) ]