From d54ebc6c2052517e4ac3a74c8e247525259222e4 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 10:12:32 +0200 Subject: [PATCH 1/6] brr-lwd: Split children and attribute handling --- lib/brr-lwd/elwd.ml | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/lib/brr-lwd/elwd.ml b/lib/brr-lwd/elwd.ml index 4b09c03..ef7d683 100644 --- a/lib/brr-lwd/elwd.ml +++ b/lib/brr-lwd/elwd.ml @@ -266,16 +266,15 @@ let v ?d ?(at=[]) ?(ev=[]) tag children = let children, impure_children = consume_children children in let el = El.v ?d ~at tag children in let result = - match impure_at, impure_children with - | [], None -> Lwd.pure el - | [], Some children -> - update_children el children - | at, None -> - Lwd.map ~f:(fun () -> el) (attach_attribs el at) - | at, Some children -> - Lwd.map2 ~f:(fun () el -> el) - (attach_attribs el at) - (update_children el children) + match impure_children with + | None -> Lwd.pure el + | Some children -> update_children el children + in + let result = + match impure_at with + | [] -> result + | at -> + Lwd.map2 ~f:(fun () el -> el) (attach_attribs el at) result in List.iter (fun h -> ignore (listen el h)) ev; let result = From fb4b2e664db36ec6976f72d0b0e592c72ce9011c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 10:29:02 +0200 Subject: [PATCH 2/6] brr-lwd: naive addition of reactive styles Naive in the sense that it duplicates reactive attributes. --- lib/brr-lwd/elwd.ml | 64 ++++++++++++++++++++++++++++++++++++++++---- lib/brr-lwd/elwd.mli | 12 ++++++--- 2 files changed, 68 insertions(+), 8 deletions(-) diff --git a/lib/brr-lwd/elwd.ml b/lib/brr-lwd/elwd.ml index ef7d683..dcf6ba3 100644 --- a/lib/brr-lwd/elwd.ml +++ b/lib/brr-lwd/elwd.ml @@ -225,6 +225,48 @@ let attach_attribs el attribs = ) (pure_unit, Lwd.map2 ~f:(fun () () -> ())) attribs +let attach_style el styles = + let set_kv (k, v) = + El.set_inline_style k v el + in + let unset_kv (k, _) = + El.remove_inline_style k el + in + let set_lwd_style () = + let prev = ref dummy_kv_at in + fun style -> + if !prev != dummy_kv_at then + unset_kv !prev; + set_kv style; + prev := style + in + Lwd_utils.map_reduce (function + | `P _ -> assert false + | `R at -> Lwd.map ~f:(set_lwd_style ()) at + | `S ats -> + let set_at' st = + set_kv st; + st + in + let reducer = + ref (Lwd_seq.Reducer.make + ~map:set_at' + ~reduce:(fun _ _ -> dummy_kv_at)) + in + let update ats = + let dropped, reducer' = + Lwd_seq.Reducer.update_and_get_dropped !reducer ats + in + reducer := reducer'; + Lwd_seq.Reducer.fold_dropped `Map + (fun kv () -> unset_kv kv) + dropped (); + ignore (Lwd_seq.Reducer.reduce reducer': _ option) + in + Lwd.map ~f:update ats + ) (pure_unit, Lwd.map2 ~f:(fun () () -> ())) + styles + let listen el (Handler {opts; type'; func}) = Ev.listen ?opts type' func (El.as_target el) @@ -260,9 +302,10 @@ let attach_events el events = ) (pure_unit, Lwd.map2 ~f:(fun () () -> ())) events -let v ?d ?(at=[]) ?(ev=[]) tag children = +let v ?d ?(at=[]) ?(ev=[]) ?(st=[]) tag children = let at, impure_at = prepare_col at in let ev, impure_ev = prepare_col ev in + let st, impure_st = prepare_col st in let children, impure_children = consume_children children in let el = El.v ?d ~at tag children in let result = @@ -270,6 +313,12 @@ let v ?d ?(at=[]) ?(ev=[]) tag children = | None -> Lwd.pure el | Some children -> update_children el children in + let result = + match impure_st with + | [] -> result + | st -> + Lwd.map2 ~f:(fun () el -> el) (attach_style el st) result + in let result = match impure_at with | [] -> result @@ -277,6 +326,7 @@ let v ?d ?(at=[]) ?(ev=[]) tag children = Lwd.map2 ~f:(fun () el -> el) (attach_attribs el at) result in List.iter (fun h -> ignore (listen el h)) ev; + List.iter (fun (k,v) -> El.set_inline_style k v el) st; let result = match impure_ev with | [] -> result @@ -289,16 +339,20 @@ let v ?d ?(at=[]) ?(ev=[]) tag children = (** {1:els Element constructors} *) -type cons = ?d:document -> ?at:At.t col -> ?ev:handler col -> t col -> t Lwd.t +type cons = + ?d:document -> ?at:At.t col -> ?ev:handler col -> ?st:(El.Style.prop * Jstr.t) col -> + t col -> t Lwd.t (** The type for element constructors. This is simply {!v} with a pre-applied element name. *) -type void_cons = ?d:document -> ?at:At.t col -> ?ev:handler col -> unit -> t Lwd.t +type void_cons = + ?d:document -> ?at:At.t col -> ?ev:handler col -> ?st:(El.Style.prop * Jstr.t) col -> + unit -> t Lwd.t (** The type for void element constructors. This is simply {!v} with a pre-applied element name and without children. *) -let cons name ?d ?at ?ev cs = v ?d ?at ?ev name cs -let void_cons name ?d ?at ?ev () = v ?d ?at ?ev name [] +let cons name ?d ?at ?ev ?st cs = v ?d ?at ?ev ?st name cs +let void_cons name ?d ?at ?ev ?st () = v ?d ?at ?ev ?st name [] let a = cons Name.a let abbr = cons Name.abbr diff --git a/lib/brr-lwd/elwd.mli b/lib/brr-lwd/elwd.mli index 38fc4ea..eb71d02 100644 --- a/lib/brr-lwd/elwd.mli +++ b/lib/brr-lwd/elwd.mli @@ -16,7 +16,9 @@ type 'a col = [ type handler (* An event handler *) val handler : ?opts:Ev.listen_opts -> 'a Ev.type' -> ('a Ev.t -> unit) -> handler -val v : ?d:document -> ?at:At.t col -> ?ev:handler col -> tag_name -> t col -> t Lwd.t +val v : + ?d:document -> ?at:At.t col -> ?ev:handler col -> ?st:(El.Style.prop * Jstr.t) col -> + tag_name -> t col -> t Lwd.t (** [v ?d ?at name cs] is an element [name] with attribute [at] (defaults to [[]]) and children [cs]. If [at] specifies an attribute more thanonce, the last one takes over with the @@ -26,11 +28,15 @@ val v : ?d:document -> ?at:At.t col -> ?ev:handler col -> tag_name -> t col -> t (** {1:els Element constructors} *) -type cons = ?d:document -> ?at:At.t col -> ?ev:handler col -> t col -> t Lwd.t +type cons = + ?d:document -> ?at:At.t col -> ?ev:handler col -> ?st:(El.Style.prop * Jstr.t) col -> + t col -> t Lwd.t (** The type for element constructors. This is simply {!v} with a pre-applied element name. *) -type void_cons = ?d:document -> ?at:At.t col -> ?ev:handler col -> unit -> t Lwd.t +type void_cons = + ?d:document -> ?at:At.t col -> ?ev:handler col -> ?st:(El.Style.prop * Jstr.t) col -> + unit -> t Lwd.t (** The type for void element constructors. This is simply {!v} with a pre-applied element name and without children. *) From ae1df52ed52466e9a333e808ec7e192780e9112b Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 10:44:11 +0200 Subject: [PATCH 3/6] brr-lwd: factor reactive attributes and reactive styles handling --- lib/brr-lwd/elwd.ml | 82 ++++++++++++++------------------------------- 1 file changed, 26 insertions(+), 56 deletions(-) diff --git a/lib/brr-lwd/elwd.ml b/lib/brr-lwd/elwd.ml index dcf6ba3..db82e30 100644 --- a/lib/brr-lwd/elwd.ml +++ b/lib/brr-lwd/elwd.ml @@ -177,32 +177,22 @@ let pure_unit = Lwd.pure () let dummy_kv_at = (Jstr.empty, Jstr.empty) -let attach_attribs el attribs = - let set_kv (k, v) = - if Jstr.equal k At.Name.class' - then El.set_class v true el - else El.set_at k (Some v) el - in - let unset_kv (k, v) = - if Jstr.equal k At.Name.class' - then El.set_class v false el - else El.set_at k None el - in - let set_lwd_at () = +let attach l set_kv unset_kv to_kv = + let set_lwd () = let prev = ref dummy_kv_at in - fun at -> + fun x -> if !prev != dummy_kv_at then unset_kv !prev; - let pair = At.to_pair at in - set_kv pair; - prev := pair + let kv = to_kv x in + set_kv kv; + prev := kv in Lwd_utils.map_reduce (function | `P _ -> assert false - | `R at -> Lwd.map ~f:(set_lwd_at ()) at + | `R at -> Lwd.map ~f:(set_lwd ()) at | `S ats -> - let set_at' at = - let kv = At.to_pair at in + let set_at' x = + let kv = to_kv x in set_kv kv; kv in @@ -223,49 +213,29 @@ let attach_attribs el attribs = in Lwd.map ~f:update ats ) (pure_unit, Lwd.map2 ~f:(fun () () -> ())) - attribs + l + +let attach_attribs el attribs = + let set_at (k,v) = + if Jstr.equal k At.Name.class' + then El.set_class v true el + else El.set_at k (Some v) el + in + let unset_at (k,v) = + if Jstr.equal k At.Name.class' + then El.set_class v false el + else El.set_at k None el + in + attach attribs set_at unset_at At.to_pair let attach_style el styles = - let set_kv (k, v) = + let set_st (k,v) = El.set_inline_style k v el in - let unset_kv (k, _) = + let unset_st (k,_) = El.remove_inline_style k el in - let set_lwd_style () = - let prev = ref dummy_kv_at in - fun style -> - if !prev != dummy_kv_at then - unset_kv !prev; - set_kv style; - prev := style - in - Lwd_utils.map_reduce (function - | `P _ -> assert false - | `R at -> Lwd.map ~f:(set_lwd_style ()) at - | `S ats -> - let set_at' st = - set_kv st; - st - in - let reducer = - ref (Lwd_seq.Reducer.make - ~map:set_at' - ~reduce:(fun _ _ -> dummy_kv_at)) - in - let update ats = - let dropped, reducer' = - Lwd_seq.Reducer.update_and_get_dropped !reducer ats - in - reducer := reducer'; - Lwd_seq.Reducer.fold_dropped `Map - (fun kv () -> unset_kv kv) - dropped (); - ignore (Lwd_seq.Reducer.reduce reducer': _ option) - in - Lwd.map ~f:update ats - ) (pure_unit, Lwd.map2 ~f:(fun () () -> ())) - styles + attach styles set_st unset_st Fun.id let listen el (Handler {opts; type'; func}) = Ev.listen ?opts type' func (El.as_target el) From b5876938745e68994d87837f493e873725cdba46 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 14:57:33 +0200 Subject: [PATCH 4/6] Add `brr-lwd` reactive styling example --- examples/reactive-styles-brr/Makefile | 9 +++ examples/reactive-styles-brr/dune | 21 +++++++ examples/reactive-styles-brr/index.html | 10 ++++ examples/reactive-styles-brr/main.ml | 80 +++++++++++++++++++++++++ 4 files changed, 120 insertions(+) create mode 100644 examples/reactive-styles-brr/Makefile create mode 100644 examples/reactive-styles-brr/dune create mode 100644 examples/reactive-styles-brr/index.html create mode 100644 examples/reactive-styles-brr/main.ml diff --git a/examples/reactive-styles-brr/Makefile b/examples/reactive-styles-brr/Makefile new file mode 100644 index 0000000..9d83eb4 --- /dev/null +++ b/examples/reactive-styles-brr/Makefile @@ -0,0 +1,9 @@ +ROOT=$(realpath $(PWD)/../..) +NAME=$(subst $(ROOT)/,,$(realpath $(PWD))) + +all: + dune build index.html main.js + @echo "open $(ROOT)/_build/default/$(NAME)/index.html" + +clean: + dune clean diff --git a/examples/reactive-styles-brr/dune b/examples/reactive-styles-brr/dune new file mode 100644 index 0000000..03131bb --- /dev/null +++ b/examples/reactive-styles-brr/dune @@ -0,0 +1,21 @@ +(executables + (names main) + (libraries js_of_ocaml brr lwd brr-lwd) + (modes byte)) + +(rule + (targets main.js) + (action + (run + %{bin:js_of_ocaml} + --noruntime + %{lib:js_of_ocaml-compiler:runtime.js} + --source-map + %{dep:main.bc} + -o + %{targets} + --pretty))) + +(alias + (name default) + (deps main.js index.html)) diff --git a/examples/reactive-styles-brr/index.html b/examples/reactive-styles-brr/index.html new file mode 100644 index 0000000..7aefcb0 --- /dev/null +++ b/examples/reactive-styles-brr/index.html @@ -0,0 +1,10 @@ + + + + Reactive styles + + + + + + diff --git a/examples/reactive-styles-brr/main.ml b/examples/reactive-styles-brr/main.ml new file mode 100644 index 0000000..07212c2 --- /dev/null +++ b/examples/reactive-styles-brr/main.ml @@ -0,0 +1,80 @@ +open Brr +open Brr_lwd +open Lwd_infix + +let float var = + let h = + fun ev -> + let el = ev |> Brr.Ev.target |> Brr.Ev.target_to_jv in + let new_value = Jv.get el "value" |> Jv.to_string |> float_of_string in + Brr.Console.(log [ new_value ]); + Lwd.set var new_value + in + let ev = [ `P (Brr_lwd.Elwd.handler Brr.Ev.input h) ] in + let at = + let v = + let$ v = Lwd.get var in + Brr.At.value (Jstr.of_float v) + in + [ `R v; `P (Brr.At.type' (Jstr.v "number")) ] + in + Brr_lwd.Elwd.input ~at ~ev () + +let ui = + let top = Lwd.var 1.0 in + let set_top = float top in + let left = Lwd.var 1.0 in + let set_left = float left in + let block = + let top = + let$ top = Lwd.get top in + let top = Jstr.append (Jstr.of_float top) (Jstr.v "px") in + (El.Style.top, top) + in + let left = + let$ left = Lwd.get left in + let left = Jstr.append (Jstr.of_float left) (Jstr.v "px") in + (El.Style.left, left) + in + let st = + [ + `R top; + `R left; + `P (El.Style.width, Jstr.v "50px"); + `P (El.Style.height, Jstr.v "50px"); + `P (El.Style.position, Jstr.v "absolute"); + `P (El.Style.background_color, Jstr.v "red"); + ] + in + Elwd.div ~st [] + in + let playground = + Elwd.div + ~st: + [ + `P (El.Style.width, Jstr.v "1000px"); + `P (El.Style.height, Jstr.v "1000px"); + `P (El.Style.position, Jstr.v "relative"); + ] + [ `R block ] + in + Elwd.div [ `R set_top; `R set_left; `R playground ] + +let () = + let ui = Lwd.observe ui in + let on_invalidate _ = + Console.(log [ str "on invalidate" ]); + let _ : int = + G.request_animation_frame @@ fun _ -> + let _ui = Lwd.quick_sample ui in + () + in + () + in + let on_load _ = + Console.(log [ str "onload" ]); + El.append_children (Document.body G.document) [ Lwd.quick_sample ui ]; + Lwd.set_on_invalidate ui on_invalidate + in + ignore (Ev.listen Ev.dom_content_loaded on_load (Window.as_target G.window)); + () From 5fc57e459a4378645b568f3bd79e0af2d451ec4b Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 15:13:41 +0200 Subject: [PATCH 5/6] Add changelog entry for #53 --- CHANGES | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES b/CHANGES index 4053cb9..3642126 100644 --- a/CHANGES +++ b/CHANGES @@ -5,6 +5,7 @@ v0.4 - Alpha 0.4 UNRELEASED - Lwd.set: change binding before invalidation, otherwise the old value could be re-observed (reported by @voodoos) - brr-lwd: support declarative events and set of css classes - Nottui: fix treatment of some terminal events that were delayed because of improper buffer flushing, reported by @darrenldl +- brr-lwd: Fix handling of multiple reactive attributes (by @panglesd) v0.3 - Alpha 0.3 ====== From 0fdf2e8cb823005f0bcadf4e5ff9d3aa1333d43c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 24 Sep 2025 15:14:06 +0200 Subject: [PATCH 6/6] Add changelog entry for #54 --- CHANGES | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES b/CHANGES index 3642126..4eab2f0 100644 --- a/CHANGES +++ b/CHANGES @@ -6,6 +6,7 @@ v0.4 - Alpha 0.4 UNRELEASED - brr-lwd: support declarative events and set of css classes - Nottui: fix treatment of some terminal events that were delayed because of improper buffer flushing, reported by @darrenldl - brr-lwd: Fix handling of multiple reactive attributes (by @panglesd) +- brr-lwd: Add support for reactive inline styles (by @panglesd) v0.3 - Alpha 0.3 ======