From 63282986267a996176fc6851750c3b925cf73375 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Sat, 19 Oct 2024 14:37:29 +0200 Subject: [PATCH] Rework forms and fields --- bin/servers.ml | 2 +- vendor/brr_lwd_ui/lib/forms/field.ml | 11 ++-- .../brr_lwd_ui/lib/forms/field_checkboxes.ml | 65 ++++++++++--------- vendor/brr_lwd_ui/lib/forms/field_select.ml | 8 ++- vendor/brr_lwd_ui/lib/forms/form.ml | 6 +- 5 files changed, 50 insertions(+), 42 deletions(-) diff --git a/bin/servers.ml b/bin/servers.ml index 852ad13..9bd3c7d 100644 --- a/bin/servers.ml +++ b/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 = diff --git a/vendor/brr_lwd_ui/lib/forms/field.ml b/vendor/brr_lwd_ui/lib/forms/field.ml index 48eed6b..f5113df 100644 --- a/vendor/brr_lwd_ui/lib/forms/field.ml +++ b/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" () diff --git a/vendor/brr_lwd_ui/lib/forms/field_checkboxes.ml b/vendor/brr_lwd_ui/lib/forms/field_checkboxes.ml index 8b847a5..90c2da3 100644 --- a/vendor/brr_lwd_ui/lib/forms/field_checkboxes.ml +++ b/vendor/brr_lwd_ui/lib/forms/field_checkboxes.ml @@ -14,34 +14,38 @@ 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 = (*
*) (*
*) let make_all ~g desc = @@ -49,7 +53,8 @@ let make t = 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 @@ -57,7 +62,9 @@ let make t = 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 } diff --git a/vendor/brr_lwd_ui/lib/forms/field_select.ml b/vendor/brr_lwd_ui/lib/forms/field_select.ml index 517e79a..941bb31 100644 --- a/vendor/brr_lwd_ui/lib/forms/field_select.ml +++ b/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 = diff --git a/vendor/brr_lwd_ui/lib/forms/form.ml b/vendor/brr_lwd_ui/lib/forms/form.ml index ffd6da8..65ad229 100644 --- a/vendor/brr_lwd_ui/lib/forms/form.ml +++ b/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') ->