From f5e0f24e8ab6f64a37d9b45198ed65835c83c212 Mon Sep 17 00:00:00 2001 From: Rizo Date: Thu, 5 Sep 2024 16:57:29 +0100 Subject: [PATCH 01/12] Example improvements --- .ocamlformat | 6 +- default.nix | 7 +- examples/todomvc-jsoo-ml/Todomvc.ml | 246 ++++++++++------------------ examples/todomvc-jsoo-ml/Todos.ml | 31 ++++ examples/todomvc-jsoo-ml/dune | 1 + onix-lock.json | 141 ++++++++++------ 6 files changed, 216 insertions(+), 216 deletions(-) create mode 100644 examples/todomvc-jsoo-ml/Todos.ml diff --git a/.ocamlformat b/.ocamlformat index 1d69b43..1470995 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -4,15 +4,15 @@ break-cases = fit cases-matching-exp-indent = normal exp-grouping = preserve cases-exp-indent = 2 -margin = 80 +margin = 100 parse-docstrings = true wrap-comments = false break-cases = fit-or-vertical break-infix = fit-or-vertical break-collection-expressions = fit-or-vertical -break-separators = after +break-separators = before space-around-lists = true -dock-collection-brackets = true +dock-collection-brackets = false wrap-fun-args = true indicate-multiline-delimiters = closing-on-separate-line diff --git a/default.nix b/default.nix index d491f7f..bd3fd50 100644 --- a/default.nix +++ b/default.nix @@ -1,19 +1,18 @@ { pkgs ? import { } }: let - ocamlPackages = pkgs.ocaml-ng.ocamlPackages_5_1; onix = import (builtins.fetchGit { url = "https://github.com/rizo/onix.git"; - rev = "41bf9e887fa8f1399ac328f1868d6d2ba27aab9f"; + rev = "00720d8a87daef3bbf66eb89e2b7d8efcaf577aa"; }) { - inherit pkgs ocamlPackages; + inherit pkgs; verbosity = "info"; }; in onix.env { path = ./.; deps = { - "ocaml-system" = "5.1.1"; + "ocaml-base-compiler" = "5.2.0"; }; roots = [ ./helix.opam ]; vars = { diff --git a/examples/todomvc-jsoo-ml/Todomvc.ml b/examples/todomvc-jsoo-ml/Todomvc.ml index 8d1a254..7c862f4 100644 --- a/examples/todomvc-jsoo-ml/Todomvc.ml +++ b/examples/todomvc-jsoo-ml/Todomvc.ml @@ -1,56 +1,24 @@ -module Event = Stdweb.Dom.Event -module Document = Stdweb.Dom.Document -module Node = Stdweb.Dom.Node +open struct + module Event = Stdweb.Dom.Event + module Document = Stdweb.Dom.Document + module Node = Stdweb.Dom.Node +end + open Helix open Signal.Syntax -module Todos = struct - type t = { - items : (string * bool) list; - filter : [ `all | `completed | `remaining ]; - } - - let empty = { items = []; filter = `all } - let add todo todos = { todos with items = todo :: todos.items } - let length todos = List.length todos.items - - let remove title todos = - { todos with items = List.remove_assq title todos.items } - - let toggle target todos = - { - todos with - items = - List.map - (fun (title, completed) -> - if String.equal title target then (title, not completed) - else (title, completed) - ) - todos.items; - } - - let clear todos = - { - todos with - items = List.filter (fun (_, completed) -> not completed) todos.items; - } - - let count_remaining todos = - List.fold_left - (fun n (_, completed) -> if completed then n else n + 1) - 0 todos.items - - let set_filter filter todos = { todos with filter } - - let filtered { items; filter } = - match filter with - | `all -> items - | `completed -> List.filter (fun (_, completed) -> completed) items - | `remaining -> List.filter (fun (_, completed) -> not completed) items -end - let main () = let todos = Signal.make Todos.empty in + (* let filteredTodos = + Signal.map2 + (fun todos path -> + match path with + | [ "remaining" ] -> Todos.set_filter `remaining todos + | [ "completed" ] -> Todos.set_filter `completed todos + | _ -> todos + ) + todos Helix.History.hash_path + in *) let remaining = Signal.map Todos.count_remaining todos in let on_todo_input ev = @@ -67,132 +35,98 @@ let main () = let open Html in section [ class_list [ "todoapp" ] ] - [ - header + [ header [ class_list [ "header" ] ] - [ - h1 [] [ text "todos" ]; - input - [ - class_name "new-todo"; - autofocus true; - placeholder "What is to be done?"; - on Event.keydown on_todo_input; - ]; - ]; - section - [ - conditional - ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos); - class_list [ "main" ]; + [ h1 [] [ text "todos" ] + ; input + [ class_name "new-todo" + ; autofocus true + ; placeholder "What is to be done?" + ; on Event.keydown on_todo_input + ] + ] + ; section + [ conditional ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos) + ; class_list [ "main" ] ] - [ - input - [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ]; - label [ for' "toggle-all" ] [ text "Toggle all" ]; - ul + [ input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ] + ; label [ for' "toggle-all" ] [ text "Toggle all" ] + ; ul [ class_name "todo-list" ] - [ - todos + [ todos |> Signal.map Todos.filtered |> each (fun (title, completed) -> li [ class_name "todo" ] - [ - div + [ div [ class_name "view" ] - [ - input - [ - class_name "toggle"; - type' "checkbox"; - Attr.on completed (checked true); - on Event.click (fun _ -> - Signal.update (Todos.toggle title) todos - ); - ]; - label [] [ text title ]; - button - [ - class_name "destroy"; - on Event.click (fun _ -> - Signal.update (Todos.remove title) todos - ); + [ input + [ class_name "toggle" + ; type' "checkbox" + ; Attr.on completed (checked true) + ; on Event.click (fun _ -> Signal.update (Todos.toggle title) todos) ] - []; - ]; + ; label [] [ text title ] + ; button + [ class_name "destroy" + ; on Event.click (fun _ -> Signal.update (Todos.remove title) todos) + ] + [] + ] ] - ); - ]; - ]; - footer + ) + ] + ] + ; footer [ class_name "footer" ] - [ - span + [ span [ class_name "todo-count" ] - [ - strong [] - [ - show - (fun n -> - [ - string_of_int n; - (if n = 1 then "item" else "items"); - "left"; - ] - |> String.concat " " - |> text - ) - remaining; - ]; - ]; - ul + [ strong [] + [ (let$ n = remaining in + [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] + |> String.concat " " + |> text + ) + ] + (* [ show + (fun n -> + [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] + |> String.concat " " + |> text + ) + remaining + ] *) + ] + ; ul [ class_name "filters" ] - [ - li [] - [ - a - [ - on Event.click (fun _ -> - Signal.update (Todos.set_filter `all) todos - ); - ] - [ text "All" ]; - ]; - li [] - [ - a - [ - on Event.click (fun _ -> - Signal.update (Todos.set_filter `remaining) todos - ); - ] - [ text "Remaining" ]; - ]; - li [] - [ - a - [ - on Event.click (fun _ -> - Signal.update (Todos.set_filter `completed) todos - ); - ] - [ text "Completed" ]; - ]; - ]; - button - [ - conditional + [ li [] + [ a + [ on Event.click (fun _ -> Signal.update (Todos.set_filter `all) todos) ] + [ text "All" ] + ] + ; li [] + [ a + [ on Event.click (fun _ -> Signal.update (Todos.set_filter `remaining) todos) ] + [ text "Remaining" ] + ] + ; li [] + [ a + [ on Event.click (fun _ -> Signal.update (Todos.set_filter `completed) todos) ] + [ text "Completed" ] + ] + ] + ; button + [ conditional ~on: (let+ todos and+ remaining in let len = Todos.length todos in len > 0 && len - remaining > 0 - ); - class_name "clear-completed"; - on Event.click (fun _ -> Signal.update Todos.clear todos); + ) + ; class_name "clear-completed" + ; on Event.click (fun _ -> Signal.update Todos.clear todos) ] - [ text "Clear completed" ]; - ]; + [ text "Clear completed" ] + ] ] let () = diff --git a/examples/todomvc-jsoo-ml/Todos.ml b/examples/todomvc-jsoo-ml/Todos.ml new file mode 100644 index 0000000..abb3e20 --- /dev/null +++ b/examples/todomvc-jsoo-ml/Todos.ml @@ -0,0 +1,31 @@ +type t = { items : (string * bool) list; filter : [ `all | `completed | `remaining ] } + +let empty = { items = []; filter = `all } +let add todo todos = { todos with items = todo :: todos.items } +let length todos = List.length todos.items +let remove title todos = { todos with items = List.remove_assq title todos.items } + +let toggle target todos = + { + todos with + items = + List.map + (fun (title, completed) -> + if String.equal title target then (title, not completed) else (title, completed) + ) + todos.items; + } + +let clear todos = + { todos with items = List.filter (fun (_, completed) -> not completed) todos.items } + +let count_remaining todos = + List.fold_left (fun n (_, completed) -> if completed then n else n + 1) 0 todos.items + +let set_filter filter todos = { todos with filter } + +let filtered { items; filter } = + match filter with + | `all -> items + | `completed -> List.filter (fun (_, completed) -> completed) items + | `remaining -> List.filter (fun (_, completed) -> not completed) items diff --git a/examples/todomvc-jsoo-ml/dune b/examples/todomvc-jsoo-ml/dune index a935f4c..57e8a00 100644 --- a/examples/todomvc-jsoo-ml/dune +++ b/examples/todomvc-jsoo-ml/dune @@ -3,6 +3,7 @@ (executable (name todomvc) (libraries helix signal html jx_jsoo stdweb) + (js_of_ocaml (flags --target-env=browser --opt=3)) (modes js)) (alias diff --git a/onix-lock.json b/onix-lock.json index e1cb9db..b2c2da0 100644 --- a/onix-lock.json +++ b/onix-lock.json @@ -3,7 +3,7 @@ "repositories": [ { "url": "https://github.com/ocaml/opam-repository.git", - "rev": "bfd47b937173bac86060cb182ed6cc22fdcb573c" + "rev": "7cdc6607e7dbdffad037d5fa675859fc5c094158" } ], "packages" : { @@ -40,6 +40,9 @@ "dune-configurator" ] }, + "base-bigarray": { + "version": "base" + }, "base-bytes": { "version": "base", "depends": [ @@ -50,6 +53,18 @@ "ocamlfind" ] }, + "base-domains": { + "version": "base", + "depends": [ + "ocaml" + ] + }, + "base-nnp": { + "version": "base", + "depends": [ + "base-domains" + ] + }, "base-threads": { "version": "base" }, @@ -95,10 +110,10 @@ ] }, "cppo": { - "version": "1.6.9", + "version": "1.7.0", "src": { - "url": "https://github.com/ocaml-community/cppo/archive/v1.6.9.tar.gz", - "sha512": "26ff5a7b7f38c460661974b23ca190f0feae3a99f1974e0fd12ccf08745bd7d91b7bc168c70a5385b837bfff9530e0e4e41cf269f23dd8cf16ca658008244b44" + "url": "https://github.com/ocaml-community/cppo/archive/refs/tags/v1.7.0.tar.gz", + "sha512": "cafa2f7add42912b413f39e1d9fb7a2a42a9be134128c179dfe353f35a6c32840720d2166a77d985941300cb945b9c424b38401d20027d814b25f3bac534506d" }, "depends": [ "base-unix", @@ -223,7 +238,8 @@ "sha256": "bf674de3312dee7b7215f07df1e8a96eb3d679164b8a918cdd95b8d97e505884" }, "depends": [ - "dune" + "dune", + "ocaml" ], "build-depends": [ "dune" @@ -327,7 +343,10 @@ ], "vars": { "with-test": true, "with-doc": true, "with-dev-setup": true } }, - "host-arch-unknown": { + "host-arch-x86_64": { + "version": "1" + }, + "host-system-other": { "version": "1" }, "js_of_ocaml-compiler": { @@ -355,10 +374,10 @@ ] }, "jsonrpc": { - "version": "1.18.0", + "version": "1.19.0", "src": { - "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.18.0/lsp-1.18.0.tbz", - "sha256": "b59da43ccfd2ffd277c9e5f695a0e39c72c0d78e1bf2cbf2f62c1a7b7da75f03" + "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.19.0/lsp-1.19.0.tbz", + "sha256": "e783d9f1a7f89ce1bf4c9148aa34a228368bd149bbcca43de80b459221dee5ec" }, "depends": [ "dune", @@ -369,10 +388,10 @@ ] }, "lsp": { - "version": "1.18.0", + "version": "1.19.0", "src": { - "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.18.0/lsp-1.18.0.tbz", - "sha256": "b59da43ccfd2ffd277c9e5f695a0e39c72c0d78e1bf2cbf2f62c1a7b7da75f03" + "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.19.0/lsp-1.19.0.tbz", + "sha256": "e783d9f1a7f89ce1bf4c9148aa34a228368bd149bbcca43de80b459221dee5ec" }, "depends": [ "dune", @@ -446,10 +465,10 @@ ] }, "merlin-lib": { - "version": "4.16-501", + "version": "5.1-502", "src": { - "url": "https://github.com/ocaml/merlin/releases/download/v4.16-501/merlin-4.16-501.tbz", - "sha256": "da5bf309b040645c292ae4572cc6a0a700dbd2bcfc996ac13c8e5c3836c21e26" + "url": "https://github.com/ocaml/merlin/releases/download/v5.1-502/merlin-5.1-502.tbz", + "sha256": "4fd808bc26929cffcca8ea06344790159c10e3eaf9c914cf46ef79e917fcae15" }, "depends": [ "csexp", @@ -461,20 +480,33 @@ ] }, "ocaml": { - "version": "5.1.1", + "version": "5.2.0", "depends": [ - "ocaml-config", - "ocaml-system" + "ocaml-base-compiler", + "ocaml-config" ], "build-depends": [ - "ocaml-system" + "ocaml-base-compiler" ] }, + "ocaml-base-compiler": { + "version": "5.2.0", + "src": { + "url": "https://github.com/ocaml/ocaml/archive/5.2.0.tar.gz", + "sha256": "48554abfd530fcdaa08f23f801b699e4f74c320ddf7d0bd56b0e8c24e55fc911" + }, + "src-extra": { + "ocaml-base-compiler.install": { + "url": "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/ocaml-base-compiler/ocaml-base-compiler.install", + "sha256": "79f2a1a5044a91350a0eb6ce12e261a72a2855c094c425cddf3860e58c486678" + } + } + }, "ocaml-compiler-libs": { - "version": "v0.12.4", + "version": "v0.17.0", "src": { - "url": "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz", - "sha256": "4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" + "url": "https://github.com/janestreet/ocaml-compiler-libs/archive/refs/tags/v0.17.0.tar.gz", + "sha512": "c5cd418b0eb74e00c3f63235754bbdb3a3328ac743d6ae885424d8c50b4edaa7068572e689cb3456d222793283927f2984a1ff840b1bc3817f810b5314faf897" }, "depends": [ "dune", @@ -497,17 +529,32 @@ } }, "depends": [ - "ocaml-system" + "ocaml-base-compiler" ], "build-depends": [ - "ocaml-system" + "ocaml-base-compiler" + ] + }, + "ocaml-index": { + "version": "1.0", + "src": { + "url": "https://github.com/voodoos/ocaml-index/releases/download/v1.0/ocaml-index-1.0.tbz", + "sha256": "01e39ca310d561f7012f5dad47905173747466c5c9f7dfe14833db5c72871e1c" + }, + "depends": [ + "dune", + "merlin-lib", + "ocaml" + ], + "build-depends": [ + "dune" ] }, "ocaml-lsp-server": { - "version": "1.18.0", + "version": "1.19.0", "src": { - "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.18.0/lsp-1.18.0.tbz", - "sha256": "b59da43ccfd2ffd277c9e5f695a0e39c72c0d78e1bf2cbf2f62c1a7b7da75f03" + "url": "https://github.com/ocaml/ocaml-lsp/releases/download/1.19.0/lsp-1.19.0.tbz", + "sha256": "e783d9f1a7f89ce1bf4c9148aa34a228368bd149bbcca43de80b459221dee5ec" }, "depends": [ "astring", @@ -539,26 +586,14 @@ "dune" ] }, - "ocaml-system": { - "version": "5.1.1", - "src-extra": { - "gen_ocaml_config.ml.in": { - "url": "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/ocaml-system/gen_ocaml_config.ml.in", - "sha256": "71bcd3d35e28cbf71eda81991c8741268f4b87ced71573b2e75f64f136cebfc1" - } - }, - "depends": [ - "host-arch-unknown" - ], - "depexts": [ - "ocaml-ng.ocamlPackages_5_1.ocaml" - ] + "ocaml-options-vanilla": { + "version": "1" }, "ocaml-version": { - "version": "3.6.7", + "version": "3.6.8", "src": { - "url": "https://github.com/ocurrent/ocaml-version/releases/download/v3.6.7/ocaml-version-3.6.7.tbz", - "sha256": "d50ffd5b669d33edb0d889c476a71de4888d90008d58336038d210ced28f810c" + "url": "https://github.com/ocurrent/ocaml-version/releases/download/v3.6.8/ocaml-version-3.6.8.tbz", + "sha512": "e8e1d0637dc12e9397339fc85e86fa8af7b31848bb19f76bd3116f07d68e9aa68322688633bfc5b1e3781012a9a2594200f09d8ad05f87497ce77d5ba0ed6fde" }, "depends": [ "dune", @@ -569,10 +604,10 @@ ] }, "ocaml_intrinsics_kernel": { - "version": "v0.17.0", + "version": "v0.17.1", "src": { - "url": "https://github.com/janestreet/ocaml_intrinsics_kernel/archive/refs/tags/v0.17.0.tar.gz", - "sha512": "e197202f6af364caf864efda5d7496416c30bdc3ade9bf0e81e17014f1a046daee21897fc9d47fc4fa44408b1466cf8cff38831b5df45468f3f4a15723d75aac" + "url": "https://github.com/janestreet/ocaml_intrinsics_kernel/archive/refs/tags/v0.17.1.tar.gz", + "sha512": "21e596d6407a620866cee7cab47ef1a9446d6a733b4994e809ea5566d5fa956682a5c6a6190ffb0ed48458abd658301944ed10c4389d91ecb8df677a5f87f2ab" }, "depends": [ "dune", @@ -803,10 +838,10 @@ ] }, "ppxlib": { - "version": "0.32.1", + "version": "0.33.0", "src": { - "url": "https://github.com/ocaml-ppx/ppxlib/releases/download/0.32.1/ppxlib-0.32.1.tbz", - "sha256": "9dbad8bcb1c8b4f3df3f58bca60a5ed23d86531f0da34b4196c86bd585c09d7f" + "url": "https://github.com/ocaml-ppx/ppxlib/releases/download/0.33.0/ppxlib-0.33.0.tbz", + "sha256": "ffa44ef551f23b75e21dbd698a30310431381aaf140b9fe4b81c2e70a2d2c63a" }, "depends": [ "dune", @@ -836,10 +871,10 @@ ] }, "re": { - "version": "1.11.0", + "version": "1.12.0", "src": { - "url": "https://github.com/ocaml/ocaml-re/releases/download/1.11.0/re-1.11.0.tbz", - "sha256": "01fc244780c0f6be72ae796b1fb750f367de18624fd75d07ee79782ed6df8d4f" + "url": "https://github.com/ocaml/ocaml-re/releases/download/1.12.0/re-1.12.0.tbz", + "sha256": "a01f2bf22f72c2f4ababd8d3e7635e35c1bf6bc5a41ad6d5a007454ddabad1d4" }, "depends": [ "dune", From 5a7724bc32146ab007c521d2ee8169d3d396a8be Mon Sep 17 00:00:00 2001 From: Rizo Date: Fri, 6 Sep 2024 19:28:41 +0100 Subject: [PATCH 02/12] Improve 7guis example --- examples/7guis/Index.ml | 236 +++++++++++++++++----------------------- 1 file changed, 97 insertions(+), 139 deletions(-) diff --git a/examples/7guis/Index.ml b/examples/7guis/Index.ml index a4662ac..3f7b8fe 100644 --- a/examples/7guis/Index.ml +++ b/examples/7guis/Index.ml @@ -8,21 +8,19 @@ let view_counter () = let count = Signal.make 0 in let open Html in fragment - [ - h2 [] [ text "Counter" ]; - div + [ h2 [] [ text "Counter" ] + ; div [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Increment or decrement a number by 1." ]; - div [] - [ - button - [ on Event.click (fun _ -> Signal.update (fun n -> n + 1) count) ] - [ text "+" ]; - button - [ on Event.click (fun _ -> Signal.update (fun n -> n - 1) count) ] - [ text "-" ]; - span [ style_list [ "margin-left" => "5px" ] ] [ show int count ]; - ]; + [ text "Increment or decrement a number by 1." ] + ; div [] + [ button [ on Event.click (fun _ -> Signal.update (fun n -> n + 1) count) ] [ text "+" ] + ; button [ on Event.click (fun _ -> Signal.update (fun n -> n - 1) count) ] [ text "-" ] + ; span + [ bind (fun n -> if n < 0 then style_list [ ("color", "red") ] else Attr.empty) count + ; style_list [ "margin-left" => "5px" ] + ] + [ show int count ] + ] ] let view_temp_conv () = @@ -32,35 +30,26 @@ let view_temp_conv () = let f_signal = Signal.make "" in let on_temp_input conv signal ev = let value = Node.get_value (Event.target ev) in - let value' = - try value |> float_of_string |> conv |> string_of_float - with Failure _ -> "" - in + let value' = try value |> float_of_string |> conv |> string_of_float with Failure _ -> "" in Signal.emit value' signal in let open Html in fragment - [ - h2 [] [ text "Temperature Converter" ]; - div + [ h2 [] [ text "Temperature Converter" ] + ; div [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Bidirectional temperature converter." ]; - input - [ bind value c_signal; on Event.input (on_temp_input f_of_c f_signal) ]; - text " Celsius = "; - input - [ bind value f_signal; on Event.input (on_temp_input c_of_f c_signal) ]; - text " Fahrenheit"; + [ text "Bidirectional temperature converter." ] + ; input [ bind value c_signal; on Event.input (on_temp_input f_of_c f_signal) ] + ; text " Celsius = " + ; input [ bind value f_signal; on Event.input (on_temp_input c_of_f c_signal) ] + ; text " Fahrenheit" ] let view_flight_booker () = let is_valid_date str = String.length str = 10 in let is_valid_book (d1, d2) ft = (String.equal "oneway" ft && is_valid_date d1) - || String.equal "return" ft - && is_valid_date d1 - && is_valid_date d2 - && d2 >= d1 + || (String.equal "return" ft && is_valid_date d1 && is_valid_date d2 && d2 >= d1) in let flight_type = Signal.make "oneway" in let dates = Signal.make ("2023-01-01", "2023-01-01") in @@ -70,8 +59,7 @@ let view_flight_booker () = let ft = Signal.get flight_type in let msg = String.concat " " - ( if String.equal ft "oneway" then - [ "You have booked a one-way flight on"; d1 ] + ( if String.equal ft "oneway" then [ "You have booked a one-way flight on"; d1 ] else [ "You have booked a return flight on"; d1; "and"; d2 ] ) in @@ -79,134 +67,104 @@ let view_flight_booker () = in let open Html in fragment - [ - h2 [] [ text "Flight Booker" ]; - div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Demonstrates constraints." ]; - div - [ - style_list - [ - "display" => "flex"; - "gap" => "10px"; - "flex-direction" => "column"; - "width" => "200px"; - ]; + [ h2 [] [ text "Flight Booker" ] + ; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Demonstrates constraints." ] + ; div + [ style_list + [ "display" => "flex" + ; "gap" => "10px" + ; "flex-direction" => "column" + ; "width" => "200px" + ] ] - [ - select - [ - name "flight_type"; - on Event.change (fun ev -> + [ select + [ name "flight_type" + ; on Event.change (fun ev -> Signal.emit "" msg_signal; Signal.emit (Event.target ev |> Node.get_value) flight_type - ); + ) + ] + [ option [ value "oneway" ] [ text "one-way flight" ] + ; option [ value "return" ] [ text "return flight" ] ] - [ - option [ value "oneway" ] [ text "one-way flight" ]; - option [ value "return" ] [ text "return flight" ]; - ]; - input - [ - placeholder "YYYY-MM-DD"; - value (fst (Signal.get dates)); - on_input (fun value -> - Signal.update (fun (_, d2) -> (value, d2)) dates - ); - toggle + ; input + [ placeholder "YYYY-MM-DD" + ; value (fst (Signal.get dates)) + ; on_input (fun value -> Signal.update (fun (_, d2) -> (value, d2)) dates) + ; toggle ~on:(fun (d1, _) -> not (is_valid_date d1)) (style_list [ "outline" => "1px solid red" ]) - dates; - ]; - input - [ - placeholder "YYYY-MM-DD"; - value (snd (Signal.get dates)); - on_input (fun value -> - Signal.update (fun (d1, _) -> (d1, value)) dates - ); - toggle ~on:(String.equal "oneway") (disabled true) flight_type; - toggle - ~on:(fun ((_, d2), ft) -> - String.equal "return" ft && not (is_valid_date d2) - ) + dates + ] + ; input + [ placeholder "YYYY-MM-DD" + ; value (snd (Signal.get dates)) + ; on_input (fun value -> Signal.update (fun (d1, _) -> (d1, value)) dates) + ; toggle ~on:(String.equal "oneway") (disabled true) flight_type + ; toggle + ~on:(fun ((_, d2), ft) -> String.equal "return" ft && not (is_valid_date d2)) (style_list [ "outline" => "1px solid red" ]) - (Signal.pair dates flight_type); - ]; - button - [ - on Event.click click_submit; - toggle + (Signal.pair dates flight_type) + ] + ; button + [ on Event.click click_submit + ; toggle ~on:(fun (dates, ft) -> not (is_valid_book dates ft)) - (disabled true) - (Signal.pair dates flight_type); + (disabled true) (Signal.pair dates flight_type) ] - [ text "Book" ]; - show text msg_signal; - ]; + [ text "Book" ] + ; show text msg_signal + ] ] (* [TODO] Incomplete impl. *) let view_timer () = let open Html in fragment - [ - h2 [] [ text "Timer" ]; - div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Concurrency." ]; - div - [ - style_list - [ - "display" => "flex"; - "gap" => "10px"; - "flex-direction" => "column"; - "width" => "350px"; - ]; + [ h2 [] [ text "Timer" ] + ; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Concurrency." ] + ; div + [ style_list + [ "display" => "flex" + ; "gap" => "10px" + ; "flex-direction" => "column" + ; "width" => "350px" + ] ] - [ - div [] - [ - text "Elapsed time: "; - progress - [ - style_list [ "width" => "100%" ]; attr "max" "100"; value "70"; - ] - []; - text "10s"; - ]; - div + [ div [] + [ text "Elapsed time: " + ; progress [ style_list [ "width" => "100%" ]; attr "max" "100"; value "70" ] [] + ; text "10s" + ] + ; div [ style_list [ "border" => "1px" ] ] - [ - label [ for' "duration" ] [ text "Duration:" ]; - input - [ - name "duration"; - type' "range"; - attr "min" "0"; - attr "max" "100"; - value "10"; - attr "step" "1"; - style_list [ "width" => "100%" ]; - ]; - ]; - button [] [ text "Reset" ]; - ]; + [ label [ for' "duration" ] [ text "Duration:" ] + ; input + [ name "duration" + ; type' "range" + ; attr "min" "0" + ; attr "max" "100" + ; value "10" + ; attr "step" "1" + ; style_list [ "width" => "100%" ] + ] + ] + ; button [] [ text "Reset" ] + ] ] let main () = let open Html in div [ class_list [ "w-full" ] ] - [ - h1 [] [ text "Helix 7 GUIs" ]; - view_counter (); - hr []; - view_temp_conv (); - hr []; - view_flight_booker (); - hr []; - view_timer (); + [ h1 [] [ text "Helix 7 GUIs" ] + ; view_counter () + ; (* hr []; *) + view_temp_conv () + ; (* hr []; *) + view_flight_booker () + ; (* hr []; *) + view_timer () ] let () = From 0c9403de55a0d21fcfae8eac131a8ff2d4eb8f26 Mon Sep 17 00:00:00 2001 From: Rizo Date: Fri, 6 Sep 2024 19:28:53 +0100 Subject: [PATCH 03/12] Add composition example --- examples/composition/Index.ml | 120 ++++++++++++++++++++++++++++++++ examples/composition/dune | 9 +++ examples/composition/index.html | 25 +++++++ 3 files changed, 154 insertions(+) create mode 100644 examples/composition/Index.ml create mode 100644 examples/composition/dune create mode 100644 examples/composition/index.html diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml new file mode 100644 index 0000000..a489847 --- /dev/null +++ b/examples/composition/Index.ml @@ -0,0 +1,120 @@ +module Document = Stdweb.Dom.Document +open Helix + +module Test_01_component = struct + let component ~label:lbl ~by () = + let state = Signal.make 0 in + let html = + let open Html in + div [] + [ span [] [ text (lbl ^ ": ") ] + ; button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ] + ; span [] [ show int state ] + ; button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ] + ] + in + (html, state) + + let make () = + let html, _ = component ~label:"counter" ~by:1 () in + Html.div [] [ Html.h2 [] [ Html.text "01 - Components" ]; html ] +end + +module Test_02_parallel = struct + let component ~label:lbl ~by () = + let state = Signal.make 0 in + let html = + let open Html in + div [] + [ span [] [ text (lbl ^ ": ") ] + ; button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ] + ; span [] [ show int state ] + ; button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ] + ] + in + (html, state) + + let make () = + let first, _ = component ~label:"first" ~by:1 () in + let second, _ = component ~label:"second" ~by:1 () in + Html.div [] [ Html.h2 [] [ Html.text "02 - Parallel Composition" ]; first; second ] +end + +module Test_03_sequential = struct + let component ~label:lbl ?(by = Signal.make 1) () = + let state = Signal.make 0 in + let html = + let open Html in + div [] + [ span [] [ text (lbl ^ ": ") ] + ; button + [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] + [ text "-" ] + ; span [] [ show int state ] + ; button + [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] + [ text "+" ] + ] + in + (html, state) + + let make () = + let first, by = component ~label:"first" () in + let second, _ = component ~label:"second" ~by () in + Html.div [] [ Html.h2 [] [ Html.text "03 - Sequential" ]; first; second ] +end + +module Test_04_multiplicity = struct + let component ~label:lbl ?(by = Signal.make 1) () = + let state = Signal.make 0 in + let html = + let open Html in + div [] + [ span [] [ text (lbl ^ ": ") ] + ; button + [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] + [ text "-" ] + ; span [] [ show int state ] + ; button + [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] + [ text "+" ] + ] + in + (html, state) + + let make () = + let counter_view, how_many = component ~label:"how many" () in + Html.div [] + [ Html.h2 [] [ Html.text "04 - Multiplicity" ] + ; counter_view + ; how_many + |> Signal.map (fun n -> List.init n (fun i -> fst (component ~label:(string_of_int i) ()))) + |> each Fun.id + ] +end + +let main () = + let open Html in + div + [ class_list [ "w-full" ] ] + [ h1 [] [ text "Composition" ] + ; blockquote [] + [ text "See: " + ; a + [ href "https://github.com/TyOverby/composition-comparison" ] + [ text "https://github.com/TyOverby/composition-comparison" ] + ] + ; hr [] + ; Test_01_component.make () + ; hr [] + ; Test_02_parallel.make () + ; hr [] + ; Test_03_sequential.make () + ; hr [] + ; Test_04_multiplicity.make () + ] + +let () = + match Document.get_element_by_id "root" with + | Some root -> Html.mount root (main ()) + | None -> failwith "No #root element found" diff --git a/examples/composition/dune b/examples/composition/dune new file mode 100644 index 0000000..40032bc --- /dev/null +++ b/examples/composition/dune @@ -0,0 +1,9 @@ + +(executable + (name index) + (libraries helix signal html jx_jsoo stdweb) + (modes js)) + +(alias + (name all) + (deps index.html)) diff --git a/examples/composition/index.html b/examples/composition/index.html new file mode 100644 index 0000000..1b6d419 --- /dev/null +++ b/examples/composition/index.html @@ -0,0 +1,25 @@ + + + + + Helix - Composition + + + +
+ + + + From 77c171795c66f7ab3d23db6b81adc8bbb1d30f6a Mon Sep 17 00:00:00 2001 From: Rizo Date: Sat, 7 Sep 2024 14:16:53 +0100 Subject: [PATCH 04/12] Add back each cache --- examples/7guis/index.html | 5 +- examples/todomvc-jsoo-ml/Todos.ml | 5 +- src/helix/View.ml | 128 +++++++++++++++++++----------- 3 files changed, 86 insertions(+), 52 deletions(-) diff --git a/examples/7guis/index.html b/examples/7guis/index.html index abe13bc..b3f65a0 100644 --- a/examples/7guis/index.html +++ b/examples/7guis/index.html @@ -5,10 +5,11 @@ Helix - 7 GUIs diff --git a/examples/todomvc-jsoo-ml/Todos.ml b/examples/todomvc-jsoo-ml/Todos.ml index abb3e20..00ff9e7 100644 --- a/examples/todomvc-jsoo-ml/Todos.ml +++ b/examples/todomvc-jsoo-ml/Todos.ml @@ -6,14 +6,13 @@ let length todos = List.length todos.items let remove title todos = { todos with items = List.remove_assq title todos.items } let toggle target todos = - { - todos with + { todos with items = List.map (fun (title, completed) -> if String.equal title target then (title, not completed) else (title, completed) ) - todos.items; + todos.items } let clear todos = diff --git a/src/helix/View.ml b/src/helix/View.ml index 8546720..0a7617b 100644 --- a/src/helix/View.ml +++ b/src/helix/View.ml @@ -11,8 +11,7 @@ let option_get option = let insert_after_anchor ~parent ~anchor node = match Node.next_sibling anchor with - | Some anchor_sibling -> - Node.insert_before ~parent ~reference:anchor_sibling node + | Some anchor_sibling -> Node.insert_before ~parent ~reference:anchor_sibling node | None -> Node.append_child ~parent node (* Show *) @@ -20,11 +19,7 @@ let insert_after_anchor ~parent ~anchor node = let fake_debug_html _render_count _comment_data html = html let real_debug_html = - let colors = - [| - "magenta"; "cyan"; "salmon"; "aquamarine"; "lime"; "yellow"; "palegreen"; - |] - in + let colors = [| "magenta"; "cyan"; "salmon"; "aquamarine"; "lime"; "yellow"; "palegreen" |] in let i = ref (-1) in let get_color () = if !i + 1 >= Array.length colors then i := 0 else incr i; @@ -33,47 +28,35 @@ let real_debug_html = fun render_count comment_data html -> let c = get_color () in Html.div - [ - Html.style_list - [ - ("display", "flex"); - ("flex-direction", "column"); - ("border", "2px solid " ^ c); - ]; + [ Html.style_list + [ ("display", "flex"); ("flex-direction", "column"); ("border", "2px solid " ^ c) ] ] - [ - Html.span - [ - Html.style_list - [ - ("background-color", c); - ("font-size", "small"); - ("font-weight", "bold"); - ("font-family", "courier"); - ]; + [ Html.span + [ Html.style_list + [ ("background-color", c) + ; ("font-size", "small") + ; ("font-weight", "bold") + ; ("font-family", "courier") + ] ] - [ Html.text_list [ comment_data; "#"; string_of_int render_count ] ]; - html; + [ Html.text_list [ comment_data; "#"; string_of_int render_count ] ] + ; html ] -let debug_html : (int -> string -> Html.elem -> Html.elem) ref = - ref fake_debug_html - -let enable_debug flag = - debug_html := if flag then real_debug_html else fake_debug_html +let debug_html : (int -> string -> Html.elem -> Html.elem) ref = ref fake_debug_html +let enable_debug flag = debug_html := if flag then real_debug_html else fake_debug_html let gen_show_id = let i = ref (-1) in fun label -> incr i; String.concat "" - [ - "show:"; - string_of_int !i; - ( match label with + [ "show:" + ; string_of_int !i + ; ( match label with | None -> "" | Some x -> "/" ^ x - ); + ) ] let show ?label (to_html : 'a -> Html.elem) signal : Html.elem = @@ -89,9 +72,7 @@ let show ?label (to_html : 'a -> Html.elem) signal : Html.elem = let next_html = !debug_html !count comment_data (to_html x) in incr count; Html.Elem.unmount !state; - let next_state = - next_html parent (Node.insert_after ~parent ~reference:anchor) - in + let next_state = next_html parent (Node.insert_after ~parent ~reference:anchor) in state := next_state ) signal @@ -156,8 +137,7 @@ let conditional ~on:active_sig node = let unset () = let () = (* Put the node back, if not mounted. *) - if Option.is_none (Node.parent node) then - Node.replace_child ~parent ~reference:anchor node + if Option.is_none (Node.parent node) then Node.replace_child ~parent ~reference:anchor node in !unsub (); (* [IMPORTANT] Must be set to ignore in case free is called. *) @@ -168,6 +148,64 @@ let conditional ~on:active_sig node = (* Each *) +module Each_cache : sig + type t + type slots + type key + + val key : 'a -> key + val make : unit -> t + val set : t -> key:key -> slots -> unit + val get : t -> key:key -> slots option + val get_slot : slots -> int * Html.elem + val add_slot : t -> key:key -> int -> Html.elem -> unit + val del_slot : t -> key:key -> slots -> int -> unit + val clear : t -> unit +end = struct + module Map = Stdweb.Map + module Iterator = Stdweb.Iterator + module Dict = Stdweb.Dict + + type key = string + type slots = Html.elem Map.t + type t = slots Dict.t + + let key x = string_of_int (Hashtbl.hash x) + let make () = Dict.empty () + let make_slots = Map.make + + let get_slot slots = + match Map.first_key slots with + | None -> failwith "BUG: get_slot: slots must not be empty" + | Some idx_js -> + let idx = Jx.Decoder.int idx_js in + let html = Map.get slots idx_js in + (idx, html) + + let set cache ~key slots = Dict.set cache key slots + let get cache ~key = Dict.get_opt cache key + + let add_slot cache ~key idx html = + let slots = + match get cache ~key with + | None -> make_slots () + | Some slots -> slots + in + Map.set slots (Jx.Encoder.int idx) html; + set cache ~key slots + + let del_slot cache ~key slots idx = + Map.delete slots (Jx.Encoder.int idx); + if Map.size slots = 0 then Dict.del cache key + + let clear cache = + Dict.iter cache (fun (slots : slots) -> + let values = Map.values slots in + (* Iterator.iter (fun (elem : Html.elem) -> Html.Elem.unmount elem ()) values; *) + Map.clear slots + ) +end + let gen_each_id = let i = ref (-1) in fun () -> @@ -213,15 +251,11 @@ let each (to_html : 'a -> Html.elem) items_signal : Html.elem = items_signal in let free () = - List.iter - (fun (state : Html.Elem.state) -> Option.iter (fun f -> f ()) state.free) - !states; + List.iter (fun (state : Html.Elem.state) -> Option.iter (fun f -> f ()) state.free) !states; unsub (); states := [] in - let remove () = - List.iter (fun (state : Html.Elem.state) -> state.remove ()) !states - in + let remove () = List.iter (fun (state : Html.Elem.state) -> state.remove ()) !states in { free = Some free; remove } (* Bind *) From 779c932f5ca705c837873c803953f1fc50a99d7c Mon Sep 17 00:00:00 2001 From: Rizo I Date: Mon, 9 Sep 2024 18:37:17 +0100 Subject: [PATCH 05/12] Re-introduce cache for each --- .ocamlformat | 4 +- TODO.md | 1 + examples/7guis/Index.ml | 199 +++++---- examples/composition/Index.ml | 85 ++-- examples/composition/dune | 1 + examples/todomvc-jsoo-ml/Todomvc.ml | 171 +++---- examples/todomvc-jsoo-ml/Todos.ml | 5 +- src/helix-docs/Docs.ml | 32 +- src/helix/Helix.ml | 2 +- src/helix/Helix.mli | 23 +- src/helix/Router.ml | 114 ++--- src/helix/View.ml | 337 +++++++------- tests/test_conditional.ml | 134 +++--- tests/test_each.ml | 426 +++++++++--------- tests/test_router.ml | 428 ++++++++---------- tests/test_show.ml | 203 ++++----- vendor/html/src/Html.ml | 300 +++++-------- vendor/html/src/Html.mli | 664 +++++++++++----------------- vendor/jx/src/jx/Jx.ml | 1 + vendor/jx/src/jx/Jx.mli | 1 + vendor/stdweb/src/Stdweb.mli | 2 +- vendor/stdweb/src/Stdweb_map.ml | 2 +- 22 files changed, 1381 insertions(+), 1754 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 1470995..3c399de 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -11,8 +11,8 @@ break-cases = fit-or-vertical break-infix = fit-or-vertical break-collection-expressions = fit-or-vertical -break-separators = before +break-separators = after space-around-lists = true -dock-collection-brackets = false +dock-collection-brackets = true wrap-fun-args = true indicate-multiline-delimiters = closing-on-separate-line diff --git a/TODO.md b/TODO.md index 28db0dc..9a86f0c 100644 --- a/TODO.md +++ b/TODO.md @@ -29,6 +29,7 @@ - [ ] Http.get ~url - [ ] BUG? Sharing html references leads to problems (See shared_ref) - [ ] Consider structuring each router segment as "path?opts" to allow passing extra params to intermediate views. +- [ ] Unmounting should NOT free. Because remounting is acceptable. Test for this. ## shared_ref diff --git a/examples/7guis/Index.ml b/examples/7guis/Index.ml index 3f7b8fe..0491117 100644 --- a/examples/7guis/Index.ml +++ b/examples/7guis/Index.ml @@ -8,19 +8,22 @@ let view_counter () = let count = Signal.make 0 in let open Html in fragment - [ h2 [] [ text "Counter" ] - ; div + [ + h2 [] [ text "Counter" ]; + div [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Increment or decrement a number by 1." ] - ; div [] - [ button [ on Event.click (fun _ -> Signal.update (fun n -> n + 1) count) ] [ text "+" ] - ; button [ on Event.click (fun _ -> Signal.update (fun n -> n - 1) count) ] [ text "-" ] - ; span - [ bind (fun n -> if n < 0 then style_list [ ("color", "red") ] else Attr.empty) count - ; style_list [ "margin-left" => "5px" ] + [ text "Increment or decrement a number by 1." ]; + div [] + [ + button [ on Event.click (fun _ -> Signal.update (fun n -> n + 1) count) ] [ text "+" ]; + button [ on Event.click (fun _ -> Signal.update (fun n -> n - 1) count) ] [ text "-" ]; + span + [ + bind (fun n -> if n < 0 then style_list [ ("color", "red") ] else Attr.nop) count; + style_list [ "margin-left" => "5px" ]; ] - [ show int count ] - ] + [ show int count ]; + ]; ] let view_temp_conv () = @@ -35,14 +38,15 @@ let view_temp_conv () = in let open Html in fragment - [ h2 [] [ text "Temperature Converter" ] - ; div + [ + h2 [] [ text "Temperature Converter" ]; + div [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Bidirectional temperature converter." ] - ; input [ bind value c_signal; on Event.input (on_temp_input f_of_c f_signal) ] - ; text " Celsius = " - ; input [ bind value f_signal; on Event.input (on_temp_input c_of_f c_signal) ] - ; text " Fahrenheit" + [ text "Bidirectional temperature converter." ]; + input [ bind value c_signal; on Event.input (on_temp_input f_of_c f_signal) ]; + text " Celsius = "; + input [ bind value f_signal; on Event.input (on_temp_input c_of_f c_signal) ]; + text " Fahrenheit"; ] let view_flight_booker () = @@ -67,104 +71,115 @@ let view_flight_booker () = in let open Html in fragment - [ h2 [] [ text "Flight Booker" ] - ; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Demonstrates constraints." ] - ; div - [ style_list - [ "display" => "flex" - ; "gap" => "10px" - ; "flex-direction" => "column" - ; "width" => "200px" - ] + [ + h2 [] [ text "Flight Booker" ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Demonstrates constraints." ]; + div + [ + style_list + [ + "display" => "flex"; "gap" => "10px"; "flex-direction" => "column"; "width" => "200px"; + ]; ] - [ select - [ name "flight_type" - ; on Event.change (fun ev -> + [ + select + [ + name "flight_type"; + on Event.change (fun ev -> Signal.emit "" msg_signal; Signal.emit (Event.target ev |> Node.get_value) flight_type - ) - ] - [ option [ value "oneway" ] [ text "one-way flight" ] - ; option [ value "return" ] [ text "return flight" ] + ); ] - ; input - [ placeholder "YYYY-MM-DD" - ; value (fst (Signal.get dates)) - ; on_input (fun value -> Signal.update (fun (_, d2) -> (value, d2)) dates) - ; toggle + [ + option [ value "oneway" ] [ text "one-way flight" ]; + option [ value "return" ] [ text "return flight" ]; + ]; + input + [ + placeholder "YYYY-MM-DD"; + value (fst (Signal.get dates)); + on_input (fun value -> Signal.update (fun (_, d2) -> (value, d2)) dates); + toggle ~on:(fun (d1, _) -> not (is_valid_date d1)) (style_list [ "outline" => "1px solid red" ]) - dates - ] - ; input - [ placeholder "YYYY-MM-DD" - ; value (snd (Signal.get dates)) - ; on_input (fun value -> Signal.update (fun (d1, _) -> (d1, value)) dates) - ; toggle ~on:(String.equal "oneway") (disabled true) flight_type - ; toggle + dates; + ]; + input + [ + placeholder "YYYY-MM-DD"; + value (snd (Signal.get dates)); + on_input (fun value -> Signal.update (fun (d1, _) -> (d1, value)) dates); + toggle ~on:(String.equal "oneway") (disabled true) flight_type; + toggle ~on:(fun ((_, d2), ft) -> String.equal "return" ft && not (is_valid_date d2)) (style_list [ "outline" => "1px solid red" ]) - (Signal.pair dates flight_type) - ] - ; button - [ on Event.click click_submit - ; toggle + (Signal.pair dates flight_type); + ]; + button + [ + on Event.click click_submit; + toggle ~on:(fun (dates, ft) -> not (is_valid_book dates ft)) - (disabled true) (Signal.pair dates flight_type) + (disabled true) (Signal.pair dates flight_type); ] - [ text "Book" ] - ; show text msg_signal - ] + [ text "Book" ]; + show text msg_signal; + ]; ] (* [TODO] Incomplete impl. *) let view_timer () = let open Html in fragment - [ h2 [] [ text "Timer" ] - ; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Concurrency." ] - ; div - [ style_list - [ "display" => "flex" - ; "gap" => "10px" - ; "flex-direction" => "column" - ; "width" => "350px" - ] + [ + h2 [] [ text "Timer" ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Concurrency." ]; + div + [ + style_list + [ + "display" => "flex"; "gap" => "10px"; "flex-direction" => "column"; "width" => "350px"; + ]; ] - [ div [] - [ text "Elapsed time: " - ; progress [ style_list [ "width" => "100%" ]; attr "max" "100"; value "70" ] [] - ; text "10s" - ] - ; div + [ + div [] + [ + text "Elapsed time: "; + progress [ style_list [ "width" => "100%" ]; attr "max" "100"; value "70" ] []; + text "10s"; + ]; + div [ style_list [ "border" => "1px" ] ] - [ label [ for' "duration" ] [ text "Duration:" ] - ; input - [ name "duration" - ; type' "range" - ; attr "min" "0" - ; attr "max" "100" - ; value "10" - ; attr "step" "1" - ; style_list [ "width" => "100%" ] - ] - ] - ; button [] [ text "Reset" ] - ] + [ + label [ for' "duration" ] [ text "Duration:" ]; + input + [ + name "duration"; + type' "range"; + attr "min" "0"; + attr "max" "100"; + value "10"; + attr "step" "1"; + style_list [ "width" => "100%" ]; + ]; + ]; + button [] [ text "Reset" ]; + ]; ] let main () = let open Html in div [ class_list [ "w-full" ] ] - [ h1 [] [ text "Helix 7 GUIs" ] - ; view_counter () - ; (* hr []; *) - view_temp_conv () - ; (* hr []; *) - view_flight_booker () - ; (* hr []; *) - view_timer () + [ + h1 [] [ text "Helix 7 GUIs" ]; + view_counter (); + (* hr []; *) + view_temp_conv (); + (* hr []; *) + view_flight_booker (); + (* hr []; *) + view_timer (); ] let () = diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index a489847..d1fc66b 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -7,10 +7,11 @@ module Test_01_component = struct let html = let open Html in div [] - [ span [] [ text (lbl ^ ": ") ] - ; button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ] - ; span [] [ show int state ] - ; button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ] + [ + span [] [ text (lbl ^ ": ") ]; + button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ]; + span [] [ show int state ]; + button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ]; ] in (html, state) @@ -26,10 +27,11 @@ module Test_02_parallel = struct let html = let open Html in div [] - [ span [] [ text (lbl ^ ": ") ] - ; button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ] - ; span [] [ show int state ] - ; button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ] + [ + span [] [ text (lbl ^ ": ") ]; + button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ]; + span [] [ show int state ]; + button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ]; ] in (html, state) @@ -46,14 +48,15 @@ module Test_03_sequential = struct let html = let open Html in div [] - [ span [] [ text (lbl ^ ": ") ] - ; button + [ + span [] [ text (lbl ^ ": ") ]; + button [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] - [ text "-" ] - ; span [] [ show int state ] - ; button + [ text "-" ]; + span [] [ show int state ]; + button [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] - [ text "+" ] + [ text "+" ]; ] in (html, state) @@ -70,14 +73,15 @@ module Test_04_multiplicity = struct let html = let open Html in div [] - [ span [] [ text (lbl ^ ": ") ] - ; button + [ + span [] [ text (lbl ^ ": ") ]; + button [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] - [ text "-" ] - ; span [] [ show int state ] - ; button + [ text "-" ]; + span [] [ show int state ]; + button [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] - [ text "+" ] + [ text "+" ]; ] in (html, state) @@ -85,11 +89,12 @@ module Test_04_multiplicity = struct let make () = let counter_view, how_many = component ~label:"how many" () in Html.div [] - [ Html.h2 [] [ Html.text "04 - Multiplicity" ] - ; counter_view - ; how_many - |> Signal.map (fun n -> List.init n (fun i -> fst (component ~label:(string_of_int i) ()))) - |> each Fun.id + [ + Html.h2 [] [ Html.text "04 - Multiplicity" ]; + counter_view; + how_many + |> Signal.map (fun n -> List.init n (fun i -> string_of_int i)) + |> each (fun label -> fst (component ~label ())); ] end @@ -97,21 +102,23 @@ let main () = let open Html in div [ class_list [ "w-full" ] ] - [ h1 [] [ text "Composition" ] - ; blockquote [] - [ text "See: " - ; a + [ + h1 [] [ text "Composition" ]; + blockquote [] + [ + text "See: "; + a [ href "https://github.com/TyOverby/composition-comparison" ] - [ text "https://github.com/TyOverby/composition-comparison" ] - ] - ; hr [] - ; Test_01_component.make () - ; hr [] - ; Test_02_parallel.make () - ; hr [] - ; Test_03_sequential.make () - ; hr [] - ; Test_04_multiplicity.make () + [ text "https://github.com/TyOverby/composition-comparison" ]; + ]; + hr []; + Test_01_component.make (); + hr []; + Test_02_parallel.make (); + hr []; + Test_03_sequential.make (); + hr []; + Test_04_multiplicity.make (); ] let () = diff --git a/examples/composition/dune b/examples/composition/dune index 40032bc..3f6a565 100644 --- a/examples/composition/dune +++ b/examples/composition/dune @@ -2,6 +2,7 @@ (executable (name index) (libraries helix signal html jx_jsoo stdweb) + (js_of_ocaml (flags --target-env=browser --opt=3 --pretty)) (modes js)) (alias diff --git a/examples/todomvc-jsoo-ml/Todomvc.ml b/examples/todomvc-jsoo-ml/Todomvc.ml index 7c862f4..3befc84 100644 --- a/examples/todomvc-jsoo-ml/Todomvc.ml +++ b/examples/todomvc-jsoo-ml/Todomvc.ml @@ -35,58 +35,75 @@ let main () = let open Html in section [ class_list [ "todoapp" ] ] - [ header + [ + header [ class_list [ "header" ] ] - [ h1 [] [ text "todos" ] - ; input - [ class_name "new-todo" - ; autofocus true - ; placeholder "What is to be done?" - ; on Event.keydown on_todo_input - ] - ] - ; section - [ conditional ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos) - ; class_list [ "main" ] - ] - [ input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ] - ; label [ for' "toggle-all" ] [ text "Toggle all" ] - ; ul - [ class_name "todo-list" ] - [ todos - |> Signal.map Todos.filtered - |> each (fun (title, completed) -> - li - [ class_name "todo" ] - [ div - [ class_name "view" ] - [ input - [ class_name "toggle" - ; type' "checkbox" - ; Attr.on completed (checked true) - ; on Event.click (fun _ -> Signal.update (Todos.toggle title) todos) - ] - ; label [] [ text title ] - ; button - [ class_name "destroy" - ; on Event.click (fun _ -> Signal.update (Todos.remove title) todos) - ] - [] - ] - ] - ) - ] - ] - ; footer + [ + h1 [] [ text "todos" ]; + input + [ + class_name "new-todo"; + autofocus true; + placeholder "What is to be done?"; + on Event.keydown on_todo_input; + ]; + ]; + conditional + ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos) + (section + [ class_list [ "main" ] ] + [ + input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ]; + label [ for' "toggle-all" ] [ text "Toggle all" ]; + ul + [ class_name "todo-list" ] + [ + todos + |> Signal.map Todos.filtered + |> each (fun (title, completed) -> + li + [ class_name "todo" ] + [ + div + [ class_name "view" ] + [ + input + [ + class_name "toggle"; + type' "checkbox"; + Attr.on completed (checked true); + on Event.click (fun _ -> + Signal.update (Todos.toggle title) todos + ); + ]; + label [] [ text title ]; + button + [ + class_name "destroy"; + on Event.click (fun _ -> + Signal.update (Todos.remove title) todos + ); + ] + []; + ]; + ] + ); + ]; + ] + ); + footer [ class_name "footer" ] - [ span + [ + span [ class_name "todo-count" ] - [ strong [] - [ (let$ n = remaining in + [ + strong [] + [ + (let$ n = remaining in [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] |> String.concat " " |> text - ) + ); ] (* [ show (fun n -> @@ -95,38 +112,44 @@ let main () = |> text ) remaining - ] *) - ] - ; ul + ] *); + ]; + ul [ class_name "filters" ] - [ li [] - [ a + [ + li [] + [ + a [ on Event.click (fun _ -> Signal.update (Todos.set_filter `all) todos) ] - [ text "All" ] - ] - ; li [] - [ a + [ text "All" ]; + ]; + li [] + [ + a [ on Event.click (fun _ -> Signal.update (Todos.set_filter `remaining) todos) ] - [ text "Remaining" ] - ] - ; li [] - [ a + [ text "Remaining" ]; + ]; + li [] + [ + a [ on Event.click (fun _ -> Signal.update (Todos.set_filter `completed) todos) ] - [ text "Completed" ] - ] - ] - ; button - [ conditional - ~on: - (let+ todos and+ remaining in - let len = Todos.length todos in - len > 0 && len - remaining > 0 - ) - ; class_name "clear-completed" - ; on Event.click (fun _ -> Signal.update Todos.clear todos) - ] - [ text "Clear completed" ] - ] + [ text "Completed" ]; + ]; + ]; + conditional + ~on: + (let+ todos and+ remaining in + let len = Todos.length todos in + len > 0 && len - remaining > 0 + ) + (button + [ + class_name "clear-completed"; + on Event.click (fun _ -> Signal.update Todos.clear todos); + ] + [ text "Clear completed" ] + ); + ]; ] let () = diff --git a/examples/todomvc-jsoo-ml/Todos.ml b/examples/todomvc-jsoo-ml/Todos.ml index 00ff9e7..abb3e20 100644 --- a/examples/todomvc-jsoo-ml/Todos.ml +++ b/examples/todomvc-jsoo-ml/Todos.ml @@ -6,13 +6,14 @@ let length todos = List.length todos.items let remove title todos = { todos with items = List.remove_assq title todos.items } let toggle target todos = - { todos with + { + todos with items = List.map (fun (title, completed) -> if String.equal title target then (title, not completed) else (title, completed) ) - todos.items + todos.items; } let clear todos = diff --git a/src/helix-docs/Docs.ml b/src/helix-docs/Docs.ml index 60b94e4..b4094e0 100644 --- a/src/helix-docs/Docs.ml +++ b/src/helix-docs/Docs.ml @@ -6,8 +6,7 @@ let ( => ) a b = (a, b) open Stdweb open Helix -let view_function_docs ~signature ~description ~example ?preview ?console - func_title = +let view_function_docs ~signature ~description ~example ?preview ?console func_title = let open Html in div [] [ @@ -17,26 +16,20 @@ let view_function_docs ~signature ~description ~example ?preview ?console h3 [] [ text "Example" ]; pre [] [ code [ class_name "language-ocaml" ] [ text example ] ]; ( match preview with - | None -> empty + | None -> null | Some preview -> fragment [ h3 [] [ text "Preview" ]; - div - [ - style_list - [ ("padding", "0.5em"); ("background-color", "#F0F0F0") ]; - ] - preview; + div [ style_list [ ("padding", "0.5em"); ("background-color", "#F0F0F0") ] ] preview; ] ); ( match console with - | None -> empty + | None -> null | Some console -> fragment [ - h3 [] [ text "Console" ]; - div [] [ pre [] [ code [ class_name "plaintext" ] console ] ]; + h3 [] [ text "Console" ]; div [] [ pre [] [ code [ class_name "plaintext" ] console ] ]; ] ); ] @@ -53,13 +46,10 @@ module Doc = struct let toggle_attributes () = let is_visible = Signal.make false in let open Html in - view_function_docs "Toggle attributes" - ~signature:"val toggle : on:bool signal -> attr -> attr" + view_function_docs "Toggle attributes" ~signature:"val toggle : on:bool signal -> attr -> attr" ~description: [ - text - "Toggle an attribute based on a boolean signal. If the signal's \ - value is "; + text "Toggle an attribute based on a boolean signal. If the signal's value is "; code [] [ text "true" ]; text " the attribute is added, otherwise it is omitted"; ] @@ -75,12 +65,8 @@ div [] ]|} ~preview: [ - button - [ on Event.click (fun _ -> Signal.update not is_visible) ] - [ text "Toggle" ]; - div - [ toggle ~on:Fun.id (style_list [ ("color", "red") ]) is_visible ] - [ text "HELLO" ]; + button [ on Event.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle" ]; + div [ toggle ~on:Fun.id (style_list [ ("color", "red") ]) is_visible ] [ text "HELLO" ]; ] end diff --git a/src/helix/Helix.ml b/src/helix/Helix.ml index 83971ae..d5110b7 100644 --- a/src/helix/Helix.ml +++ b/src/helix/Helix.ml @@ -1,4 +1,4 @@ -type elem = Html.elem +type html = Html.t type attr = Html.attr type 'a signal = 'a Signal.t diff --git a/src/helix/Helix.mli b/src/helix/Helix.mli index bcf1651..40fd1d9 100644 --- a/src/helix/Helix.mli +++ b/src/helix/Helix.mli @@ -42,8 +42,8 @@ | None -> failwith "No #root element found" ]}*) -type elem = Html.elem -(** An alias for {!type:Html.elem}. *) +type html = Html.t +(** An alias for {!type:Html.t}. *) type attr = Html.attr (** An alias for {!type:Html.attr}. *) @@ -56,21 +56,19 @@ val signal : ?equal:('a -> 'a -> bool) -> ?label:string -> 'a -> 'a signal (** {1 Reactive views} *) -val show : ?label:string -> ('a -> Html.elem) -> 'a Signal.t -> Html.elem +val show : ?label:string -> ('a -> html) -> 'a signal -> html (** [show to_html signal] is a dynamic HTML node created from [signal] values using [to_html]. *) -val show_some : - ?label:string -> ('a -> Html.elem) -> 'a option Signal.t -> Html.elem +val show_some : ?label:string -> ('a -> html) -> 'a option signal -> html (** [show_some] is similar to {!val:show}, but operates on reactive option values. When the signal's value is [None], {!val:Html.empty} is rendered. *) -val show_ok : - ?label:string -> ('a -> Html.elem) -> ('a, _) result Signal.t -> Html.elem +val show_ok : ?label:string -> ('a -> html) -> ('a, _) result signal -> html (** [show_ok] is similar to {!val:show}, but operates on reactive result values. When the signal's value is [Error _], {!val:Html.empty} is rendered. *) -val each : ('a -> Html.elem) -> 'a list Signal.t -> Html.elem +val each : ('a -> html) -> 'a list signal -> html (** [each to_html signal] reactively renders items from [signal] with [to_html]. {[ @@ -101,7 +99,7 @@ val toggle : on:('a -> bool) -> Html.attr -> 'a Signal.t -> Html.attr (** [toggle ~on:pred attr s] is [attr] if [pred x] is [true] and {!val:Html.empty} otherwise, where [x] is the value of [s]. *) -val conditional : on:bool Signal.t -> Html.attr +val conditional : on:bool Signal.t -> Html.t -> Html.t (** [conditional on:signal] an attribute that shows the element if [signal] is [true]. *) @@ -356,7 +354,7 @@ module Router : sig equal to the current path. Additionally, the path is considered active if it is equal to [alias]. *) - val route : ('view, 'link, Html.elem) path -> 'view -> route + val route : ('view, 'link, html) path -> 'view -> route (** Create a route by assigning a path to a view. *) val alias : (unit -> 'a, 'a, 'a) path -> ('view, 'link, route) path -> 'link @@ -371,8 +369,7 @@ module Router : sig (** [go ?absolute ?up path vars...] navigates to [path] by updating browser's hash, which will trigger a routing event. *) - val dispatch : - ?label:string -> ?default:Html.elem -> t -> route list -> Html.elem + val dispatch : ?label:string -> ?default:html -> t -> route list -> html (** [dispatch router routes] the current routing state described by [router] to [routes] rendering a view that matches the current path. If no matches are found, render [default]. *) @@ -421,7 +418,7 @@ end Additionally, reactive attributes can be bound with [let@] and [and@]. *) -val ( let$ ) : 'a signal -> ('a -> elem) -> elem +val ( let$ ) : 'a signal -> ('a -> html) -> html val ( and$ ) : 'a signal -> 'b signal -> ('a * 'b) signal val ( let@ ) : 'a signal -> ('a -> attr) -> attr val ( and@ ) : 'a signal -> 'b signal -> ('a * 'b) signal diff --git a/src/helix/Router.ml b/src/helix/Router.ml index d64156f..5f1c759 100644 --- a/src/helix/Router.ml +++ b/src/helix/Router.ml @@ -30,24 +30,12 @@ type 'a var = { equal : 'a -> 'a -> bool; } -let var ~of_string ~to_string ?(equal = Stdlib.( = )) label = - { label; to_string; of_string; equal } +let var ~of_string ~to_string ?(equal = Stdlib.( = )) label = { label; to_string; of_string; equal } let int = - { - label = "int"; - to_string = string_of_int; - of_string = int_of_string_opt; - equal = Int.equal; - } + { label = "int"; to_string = string_of_int; of_string = int_of_string_opt; equal = Int.equal } -let string = - { - label = "string"; - to_string = Fun.id; - of_string = Option.some; - equal = String.equal; - } +let string = { label = "string"; to_string = Fun.id; of_string = Option.some; equal = String.equal } let query = { @@ -56,9 +44,7 @@ let query = of_string = (fun str -> Some (Stdweb.Url_search_params.of_string str)); equal = (fun x1 x2 -> - String.equal - (Stdweb.Url_search_params.to_string x1) - (Stdweb.Url_search_params.to_string x2) + String.equal (Stdweb.Url_search_params.to_string x1) (Stdweb.Url_search_params.to_string x2) ); } @@ -73,7 +59,7 @@ type ('view, 'link, 'a) path = | End : (unit -> 'a, 'a, 'a) path type route = - | Route : ('view, 'link, Html.elem) path * 'view -> route + | Route : ('view, 'link, Html.t) path * 'view -> route | Alias : (unit -> 'a, 'a, 'a) path * string list -> route type lookup = { route : route; matched : string list; args : string list } @@ -164,25 +150,16 @@ module Table = struct | None -> Error (Incomplete_match input0) | Some bt -> bt () ) - | Match route -> - Ok { route; matched = List.rev matched; args = List.rev args } - | Partial route -> - Ok { route; matched = List.rev matched; args = List.rev args } + | Match route -> Ok { route; matched = List.rev matched; args = List.rev args } + | Partial route -> Ok { route; matched = List.rev matched; args = List.rev args } ) | input_hd :: input' -> ( let bt () = match node.capture with - | Partial route -> - Ok - { - route; - matched = List.rev matched; - args = List.rev args @ input; - } + | Partial route -> Ok { route; matched = List.rev matched; args = List.rev args @ input } | _ -> ( match String_map.find_opt ":" node.children with - | Some node' -> - loop node' input' (input_hd :: matched) (input_hd :: args) + | Some node' -> loop node' input' (input_hd :: matched) (input_hd :: args) | None -> Error (No_match input0) ) in @@ -196,8 +173,7 @@ module Table = struct in loop table0 input0 [] [] - let of_route_list routes = - List.fold_left (fun acc x -> register x acc) empty routes + let of_route_list routes = List.fold_left (fun acc x -> register x acc) empty routes end let table = Table.of_route_list @@ -205,16 +181,14 @@ let make ?(prefix = Signal.make []) rest = { prefix; rest } let path (router : t) = router.rest let prefix (router : t) = router.prefix -let rec eval_path : - type view link a. (string list -> a) -> (view, link, a) path -> link = +let rec eval_path : type view link a. (string list -> a) -> (view, link, a) path -> link = fun k path -> match path with | End -> k [] | Rest -> fun path2 -> eval_path k path2 | Const (const, End) -> k [ const ] | Const (const, tail) -> eval_path (fun rest -> k (const :: rest)) tail - | Var (var, _, tail) -> - fun x -> eval_path (fun rest -> k (var.to_string x :: rest)) tail + | Var (var, _, tail) -> fun x -> eval_path (fun rest -> k (var.to_string x :: rest)) tail let location_set_path path = let hash = "#/" ^ String.concat "/" path in @@ -243,9 +217,7 @@ let go_up n0 prefix = let go ?(absolute = false) ?(up = 0) (router : t) path = eval_path (fun str_path -> - let prefix = - if absolute then [] else go_up up (Signal.get router.prefix) - in + let prefix = if absolute then [] else go_up up (Signal.get router.prefix) in location_set_path (prefix @ str_path) ) path @@ -258,8 +230,8 @@ let pick_qpath segments = ) segments -let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.empty) - ?(inactive = Html.Attr.empty) ?(exact = false) ?alias (router : t) path0 = +let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.nop) ?(inactive = Html.Attr.nop) + ?(exact = false) ?alias (router : t) path0 = let alias = Option.map list_of_path alias in let check_is_active link curr = let eq = @@ -279,7 +251,7 @@ let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.empty) in Signal.pair out router.rest |> Signal.uniq ~equal:(fun ((p1, s1), r1) ((p2, s2), r2) -> - if active == Html.Attr.empty then + if active == Html.Attr.nop then List.equal String.equal p1 p2 && List.equal String.equal s1 s2 else List.equal String.equal p1 p2 @@ -287,12 +259,10 @@ let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.empty) && List.equal String.equal r1 r2 ) |> View.bind (fun ((link_prefix, link_suffix), rest) -> - let path_str = - String.concat "/" (("#" :: link_prefix) @ link_suffix) - in + let path_str = String.concat "/" (("#" :: link_prefix) @ link_suffix) in let href_attr = Html.href path_str in let user_attr = - if active == Html.Attr.empty then inactive + if active == Html.Attr.nop then inactive else if check_is_active link_suffix rest then active else inactive in @@ -308,17 +278,11 @@ type emits = { } let init_emits () = - { - emit_args = []; - emit_prefix = (fun ~notify:_ _ -> ()); - emit_rest = (fun ~notify:_ _ -> ()); - } + { emit_args = []; emit_prefix = (fun ~notify:_ _ -> ()); emit_rest = (fun ~notify:_ _ -> ()) } let apply emits ~prefix:absprefix0 ~matched ~args:args0 = let ( let* ) = Result.bind in - let absprefix_sig = - Signal.map (fun absprefix0 -> absprefix0 @ matched) absprefix0 - in + let absprefix_sig = Signal.map (fun absprefix0 -> absprefix0 @ matched) absprefix0 in let absprefix_emit ~notify prefix' = let absprefix' = Signal.get absprefix0 @ prefix' in if not (List.equal String.equal absprefix' (Signal.get absprefix_sig)) then @@ -330,9 +294,9 @@ let apply emits ~prefix:absprefix0 ~matched ~args:args0 = string list -> _ list -> (string, string signal) Either.t list -> - (view, link, Html.elem) path -> + (view, link, Html.t) path -> view -> - (Html.elem * (string, string signal) Either.t list, string) result = + (Html.t * (string, string signal) Either.t list, string) result = fun args args_emits rev_qualified_path path view -> match (path, args) with | Rest, _ -> @@ -353,17 +317,13 @@ let apply emits ~prefix:absprefix0 ~matched ~args:args0 = emits.emit_args <- List.rev args_emits; Ok (view (), List.rev rev_qualified_path) | End, _ :: _ -> Error "too many arguments for path" - | Const (const, path'), _ -> - loop args args_emits (Left const :: rev_qualified_path) path' view + | Const (const, path'), _ -> loop args args_emits (Left const :: rev_qualified_path) path' view | Var _, [] -> Error "insufficient arguments for path" | Var (var, var_sig_opt, path'), arg_str :: args' -> let* arg = var.of_string arg_str |> Option.to_result - ~none: - (String.concat "" - [ "could not decode "; var.label; " variable: "; arg_str ] - ) + ~none:(String.concat "" [ "could not decode "; var.label; " variable: "; arg_str ]) in let arg_sig = match var_sig_opt with @@ -373,15 +333,10 @@ let apply emits ~prefix:absprefix0 ~matched ~args:args0 = var_sig in let arg_emit ~notify arg_str' = - let arg' = - var.of_string arg_str' |> or_fail ("var decoding failed: " ^ var.label) - in - if not (var.equal (Signal.get arg_sig) arg') then - Signal.emit ~notify arg' arg_sig - in - let qualified_path' = - Either.Right (Signal.map var.to_string arg_sig) :: rev_qualified_path + let arg' = var.of_string arg_str' |> or_fail ("var decoding failed: " ^ var.label) in + if not (var.equal (Signal.get arg_sig) arg') then Signal.emit ~notify arg' arg_sig in + let qualified_path' = Either.Right (Signal.map var.to_string arg_sig) :: rev_qualified_path in loop args' (arg_emit :: args_emits) qualified_path' path' (view arg_sig) in loop args0 [] [] @@ -394,23 +349,17 @@ let render_lookup_error ~prefix ?alias ~label ~default err = in match err with | Table.No_match path -> - default - or Html.text - (label ^ ": no match: /" ^ String.concat "/" (Signal.get prefix @ path)) + default or Html.text (label ^ ": no match: /" ^ String.concat "/" (Signal.get prefix @ path)) | Table.Incomplete_match path -> default - or Html.text - (label - ^ ": incomplete match: /" - ^ String.concat "/" (Signal.get prefix @ path) - ) + or Html.text (label ^ ": incomplete match: /" ^ String.concat "/" (Signal.get prefix @ path)) | exn -> Jx.log exn; Html.text (label ^ ": unexpected exception") (* TODO: must be lazy initialized similar to View.show. *) (* TODO: improve exn context logging. *) -let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.elem = +let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.t = fun parent insert -> let label = match label with @@ -482,8 +431,7 @@ let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.elem = match (args_emits, args) with | [], [] -> emits.emit_rest ~notify [] | [], rest -> emits.emit_rest ~notify rest - | _arg_emits, [] -> - invalid_arg "router: insufficient args for emit" + | _arg_emits, [] -> invalid_arg "router: insufficient args for emit" | arg_emit :: arg_emits', arg :: args' -> (* TODO: these emits can raise var decoding exceptions, handle this here and update view with error. *) arg_emit ~notify arg; diff --git a/src/helix/View.ml b/src/helix/View.ml index 0a7617b..1d46742 100644 --- a/src/helix/View.ml +++ b/src/helix/View.ml @@ -4,11 +4,26 @@ module Document = Stdweb.Dom.Document module Node = Stdweb.Dom.Node module Event = Stdweb.Dom.Event +module List_ext = struct + let rev_mapi f l0 = + let rec loop i acc l = + match l with + | [] -> acc + | x :: l' -> loop (i + 1) (f i x :: acc) l' + in + loop 0 [] l0 +end + let option_get option = match option with | Some x -> x | None -> invalid_arg "option is None" +let or_fail msg option = + match option with + | Some x -> x + | None -> failwith msg + let insert_after_anchor ~parent ~anchor node = match Node.next_sibling anchor with | Some anchor_sibling -> Node.insert_before ~parent ~reference:anchor_sibling node @@ -28,22 +43,26 @@ let real_debug_html = fun render_count comment_data html -> let c = get_color () in Html.div - [ Html.style_list - [ ("display", "flex"); ("flex-direction", "column"); ("border", "2px solid " ^ c) ] + [ + Html.style_list + [ ("display", "flex"); ("flex-direction", "column"); ("border", "2px solid " ^ c) ]; ] - [ Html.span - [ Html.style_list - [ ("background-color", c) - ; ("font-size", "small") - ; ("font-weight", "bold") - ; ("font-family", "courier") - ] + [ + Html.span + [ + Html.style_list + [ + ("background-color", c); + ("font-size", "small"); + ("font-weight", "bold"); + ("font-family", "courier"); + ]; ] - [ Html.text_list [ comment_data; "#"; string_of_int render_count ] ] - ; html + [ Html.text comment_data; Html.text "#"; Html.int render_count ]; + html; ] -let debug_html : (int -> string -> Html.elem -> Html.elem) ref = ref fake_debug_html +let debug_html : (int -> string -> Html.t -> Html.t) ref = ref fake_debug_html let enable_debug flag = debug_html := if flag then real_debug_html else fake_debug_html let gen_show_id = @@ -51,46 +70,59 @@ let gen_show_id = fun label -> incr i; String.concat "" - [ "show:" - ; string_of_int !i - ; ( match label with + [ + "show:"; + string_of_int !i; + ( match label with | None -> "" | Some x -> "/" ^ x - ) + ); ] -let show ?label (to_html : 'a -> Html.elem) signal : Html.elem = - fun parent insert -> +let show ?label (to_html : 'a -> Html.t) signal : Html.t = + fun ctx parent -> + let count = ref 0 in let comment_data = gen_show_id label in let anchor = Comment.make comment_data in - let state = ref { Html.Elem.free = None; remove = ignore } in - let count = ref 0 in - insert anchor; + let this_ctx = Html.Ctx.make () in + let curr_state = + let html = to_html (Signal.get signal) in + let html = !debug_html !count comment_data html in + incr count; + ref (html this_ctx parent) + in let unsub = - Signal.use' ~label:comment_data + let insert = Node.insert_after ~parent ~reference:anchor in + Signal.sub' (fun x -> - let next_html = !debug_html !count comment_data (to_html x) in + let html = to_html x in + let html = !debug_html !count comment_data html in incr count; - Html.Elem.unmount !state; - let next_state = next_html parent (Node.insert_after ~parent ~reference:anchor) in - state := next_state + let next_state = html this_ctx parent in + !curr_state.unmount (); + next_state.mount insert; + curr_state := next_state ) signal in - let free () = - unsub (); - Option.iter (fun f -> f ()) !state.free + Html.Ctx.on_cleanup this_ctx unsub; + let mount insert = + insert anchor; + !curr_state.mount insert; + Html.Ctx.link ctx this_ctx in - let remove () = - !state.remove (); - Node.remove anchor + let unmount () = + Node.remove anchor; + !curr_state.unmount (); + Html.Ctx.cleanup this_ctx; + Html.Ctx.unlink ctx this_ctx in - { free = Some free; remove } + { mount; unmount } let show_some ?label to_html opt_signal = show ?label (function - | None -> Html.empty + | None -> Html.null | Some x -> to_html x ) opt_signal @@ -98,7 +130,7 @@ let show_some ?label to_html opt_signal = let show_ok ?label to_html res_signal = show ?label (function - | Error _ -> Html.empty + | Error _ -> Html.null | Ok x -> to_html x ) res_signal @@ -112,39 +144,8 @@ let gen_conditional_id = "conditional:" ^ string_of_int !i (* [TODO] on should be a pred fn. *) -let conditional ~on:active_sig node = - let active_sig = Signal.uniq ~equal:( == ) active_sig in - let anchor = Comment.make (gen_conditional_id ()) in - let parent = - match Node.parent node with - | None -> failwith "conditional: attribute node has no parent" - | Some parent -> parent - in - let unsub = ref ignore in - - let set () = - let active0 = Signal.get active_sig in - if not active0 then Node.replace_child ~parent ~reference:node anchor; - - unsub := - Signal.sub' - (fun active -> - if active then Node.replace_child ~parent ~reference:anchor node - else Node.replace_child ~parent ~reference:node anchor - ) - active_sig - in - let unset () = - let () = - (* Put the node back, if not mounted. *) - if Option.is_none (Node.parent node) then Node.replace_child ~parent ~reference:anchor node - in - !unsub (); - (* [IMPORTANT] Must be set to ignore in case free is called. *) - unsub := ignore - in - let free () = !unsub () in - { Html.Attr.set; unset; free = Some free } +let conditional ~on:active_sig html : Html.t = + show ~label:"conditional" (fun active -> if active then html else Html.null) active_sig (* Each *) @@ -157,8 +158,8 @@ module Each_cache : sig val make : unit -> t val set : t -> key:key -> slots -> unit val get : t -> key:key -> slots option - val get_slot : slots -> int * Html.elem - val add_slot : t -> key:key -> int -> Html.elem -> unit + val get_first_slot : slots -> int * Html.Elem.state + val add_slot : t -> key:key -> int -> Html.Elem.state -> unit val del_slot : t -> key:key -> slots -> int -> unit val clear : t -> unit end = struct @@ -166,27 +167,27 @@ end = struct module Iterator = Stdweb.Iterator module Dict = Stdweb.Dict - type key = string - type slots = Html.elem Map.t - type t = slots Dict.t + type key = Jx.t + type slots = Html.Elem.state Map.t + type t = slots Map.t - let key x = string_of_int (Hashtbl.hash x) - let make () = Dict.empty () + let key x = Jx.Encoder.any x + let make = Map.make let make_slots = Map.make - let get_slot slots = + let get_first_slot (slots : slots) = match Map.first_key slots with | None -> failwith "BUG: get_slot: slots must not be empty" | Some idx_js -> let idx = Jx.Decoder.int idx_js in - let html = Map.get slots idx_js in + let html = Map.get slots idx_js |> Option.get in (idx, html) - let set cache ~key slots = Dict.set cache key slots - let get cache ~key = Dict.get_opt cache key + let set cache ~key (slots : slots) = Map.set cache key slots + let get (cache : t) ~key = Map.get cache key - let add_slot cache ~key idx html = - let slots = + let add_slot (cache : t) ~key idx html = + let slots : slots = match get cache ~key with | None -> make_slots () | Some slots -> slots @@ -196,14 +197,15 @@ end = struct let del_slot cache ~key slots idx = Map.delete slots (Jx.Encoder.int idx); - if Map.size slots = 0 then Dict.del cache key + if Map.size slots = 0 then Map.delete cache key let clear cache = - Dict.iter cache (fun (slots : slots) -> - let values = Map.values slots in - (* Iterator.iter (fun (elem : Html.elem) -> Html.Elem.unmount elem ()) values; *) - Map.clear slots - ) + Map.values cache + |> Iterator.iter (fun (slots : slots) -> + let states = Map.values slots in + Iterator.iter (fun (s : Html.Elem.state) -> s.unmount ()) states; + Map.clear slots + ) end let gen_each_id = @@ -212,81 +214,90 @@ let gen_each_id = incr i; "each:" ^ string_of_int !i -let each (to_html : 'a -> Html.elem) items_signal : Html.elem = - fun parent insert -> - (* Create anchor. *) +let each (to_html : 'a -> Html.t) items_signal : Html.t = + fun ctx parent -> let anchor = Comment.make (gen_each_id ()) in - - (* Initialize cache with items0. *) - (* let fragment = Fragment.make () in *) - let items0_rev = Signal.get items_signal |> List.rev in - - (* Initial render *) - insert anchor; - let states0 = - List.map - (fun item -> - let html = to_html item in - html parent (Node.insert_after ~parent ~reference:anchor) - ) - items0_rev - in - - let states = ref states0 in - - (* Subscribe to changes. *) + let frag = Fragment.make () in + let curr_cache = ref (Each_cache.make ()) in + let this_ctx = Html.Ctx.make () in let unsub = Signal.sub' (fun new_items -> - let new_items_rev = List.rev new_items in - List.iter Html.Elem.unmount !states; - states := - List.map - (fun item -> - let html = to_html item in - html parent (Node.insert_after ~parent ~reference:anchor) - ) - new_items_rev + let next_cache = Each_cache.make () in + List.iteri + (fun j item -> + let key = Each_cache.key item in + match Each_cache.get !curr_cache ~key with + | None -> + let html : Html.t = to_html item in + let state = html this_ctx parent in + state.mount (Node.append_child ~parent:frag); + Each_cache.add_slot next_cache ~key j state + | Some old_slots -> + let i, i_state = Each_cache.get_first_slot old_slots in + i_state.mount (Node.append_child ~parent:frag); + Each_cache.del_slot !curr_cache ~key old_slots i; + Each_cache.add_slot next_cache ~key j i_state + ) + new_items; + Each_cache.clear !curr_cache; + Node.insert_after ~parent ~reference:anchor frag; + curr_cache := next_cache ) items_signal in - let free () = - List.iter (fun (state : Html.Elem.state) -> Option.iter (fun f -> f ()) state.free) !states; - unsub (); - states := [] + Html.Ctx.on_cleanup this_ctx unsub; + let mount insert = + insert anchor; + let items = Signal.get items_signal in + List.iteri + (fun i item -> + let html : Html.t = to_html item in + let state = html this_ctx parent in + state.mount (Node.append_child ~parent:frag); + let key = Each_cache.key item in + Each_cache.add_slot !curr_cache ~key i state + ) + items; + Node.insert_after ~parent ~reference:anchor frag; + Html.Ctx.link ctx this_ctx in - let remove () = List.iter (fun (state : Html.Elem.state) -> state.remove ()) !states in - { free = Some free; remove } + let unmount () = + Each_cache.clear !curr_cache; + Html.Ctx.cleanup this_ctx; + Html.Ctx.unlink ctx this_ctx + in + { mount; unmount } (* Bind *) -let bind to_attr signal node = - let state = ref { Html.Attr.set = ignore; unset = ignore; free = None } in - let unsub = ref ignore in - let set () = - unsub := - Signal.use' - (fun x -> - Html.Attr.unset !state; - let next_state : Html.Attr.state = (to_attr x) node in - next_state.set (); - state := next_state - ) - signal +let bind to_attr signal ctx node = + let curr_state = ref { Html.Attr.set = ignore; unset = ignore } in + let unsub = + Signal.sub' + (fun x -> + !curr_state.unset (); + let next_attr : Html.attr = to_attr x in + let next_state = next_attr ctx node in + next_state.set (); + curr_state := next_state + ) + signal in - let unset () = - Html.Attr.unset !state; - Signal.unsub !unsub; - (* [IMPORTANT] Must be set to ignore in case free is called. *) - unsub := ignore + Html.Ctx.on_cleanup ctx unsub; + let set () = + let next_attr : Html.attr = to_attr (Signal.get signal) in + let next_state = next_attr ctx node in + next_state.set (); + curr_state := next_state in - let free () = Signal.unsub !unsub in - { Html.Attr.set; unset; free = Some free } + let unset () = !curr_state.unset () in + { Html.Attr.set; unset } let bind_some to_attr opt_signal = bind (function - | None -> Html.Attr.empty + | None -> Html.Attr.nop | Some x -> to_attr x ) opt_signal @@ -294,35 +305,33 @@ let bind_some to_attr opt_signal = let bind_ok to_attr res_signal = bind (function - | Error _ -> Html.Attr.empty + | Error _ -> Html.Attr.nop | Ok x -> to_attr x ) res_signal (* Toggle *) -let toggle' ~on:active_sig attr node = +let toggle' ~on:active_sig attr : Html.attr = + fun ctx node -> let active_sig = Signal.uniq ~equal:( == ) active_sig in - let state : Html.Attr.state = attr node in - let unsub = ref ignore in + let state : Html.Attr.state = attr ctx node in let is_active = ref false in - let set () = - unsub := - Signal.use' - (fun active -> - if active then state.set () else state.unset (); - is_active := active - ) - active_sig + let unsub = + Signal.use' + (fun active -> + if active then state.set () else state.unset (); + is_active := active + ) + active_sig in - let unset () = - if !is_active then state.unset (); - !unsub (); - (* [IMPORTANT] Must be set to ignore in case free is called. *) - unsub := ignore + Html.Ctx.on_cleanup ctx unsub; + let set () = + is_active := Signal.get active_sig; + if !is_active then state.set () else state.unset () in - let free () = !unsub () in - { Html.Attr.set; unset; free = Some free } + let unset () = if !is_active then state.unset () in + { Html.Attr.set; unset } let toggle ~on:pred attr s = toggle' ~on:(Signal.map pred s) attr diff --git a/tests/test_conditional.ml b/tests/test_conditional.ml index 5256f00..efa58a8 100644 --- a/tests/test_conditional.ml +++ b/tests/test_conditional.ml @@ -4,20 +4,16 @@ open Helix let test_simple () = let open Html in div [] - [ - div [ conditional ~on:(Signal.make true) ] [ text "present" ]; - footer [ conditional ~on:(Signal.make false) ] [ text "missing" ]; + [ conditional ~on:(Signal.make true) (div [] [ text "present" ]) + ; conditional ~on:(Signal.make false) (footer [] [ text "missing" ]) ] let test_toggle_simple () = let is_present = Signal.make true in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update not is_present) ] - [ text "Toggle present" ]; - ul [] [ li [] [ span [ conditional ~on:is_present ] [ text "HELLO" ] ] ]; + [ button [ on Ev.click (fun _ -> Signal.update not is_present) ] [ text "Toggle present" ] + ; ul [] [ li [] [ conditional ~on:is_present (span [] [ text "HELLO" ]) ] ] ] let test_toggle_siblings () = @@ -25,85 +21,71 @@ let test_toggle_siblings () = let bye = Signal.make false in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update not hello) ] - [ text "Toggle HELLO" ]; - button - [ on Ev.click (fun _ -> Signal.update not bye) ] - [ text "Toggle BYE" ]; - button - [ - on Ev.click (fun _ -> + [ button [ on Ev.click (fun _ -> Signal.update not hello) ] [ text "Toggle HELLO" ] + ; button [ on Ev.click (fun _ -> Signal.update not bye) ] [ text "Toggle BYE" ] + ; button + [ on Ev.click (fun _ -> Signal.update not hello; Signal.update not bye - ); + ) + ] + [ text "Toggle BOTH" ] + ; ul [] + [ li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] + ] + ; ul [] + [ li [] [ span [] [ text "before 1" ] ] + ; li [] [ span [] [ text "before 2" ] ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO" ]) ] + ; li [] [ span [] [ text "after 1" ] ] + ; li [] [ span [] [ text "after 2" ] ] + ] + ; ul [] + [ li [] [ span [] [ text "before 1" ] ] + ; li [] [ span [] [ text "before 2" ] ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] + ; li [] [ span [] [ text "after 1" ] ] + ; li [] [ span [] [ text "after 2" ] ] + ] + ; ul [] + [ li [] [ span [] [ text "before 1" ] ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] + ] + ; ul [] + [ li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] + ; li [] [ span [] [ text "after 1" ] ] + ] + ; ul [] + [ li [] [ conditional ~on:hello (span [] [ text "HELLO" ]) ] + ; li [] [ conditional ~on:bye (span [] [ text "BYE" ]) ] + ] + ; ul [] + [ li [] [ span [] [ text "before 1" ] ] + ; li [] [ conditional ~on:bye (span [] [ text "BYE 1" ]) ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] + ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] + ; li [] [ conditional ~on:bye (span [] [ text "BYE 2" ]) ] + ; li [] [ span [] [ text "after 1" ] ] ] - [ text "Toggle BOTH" ]; - ul [] - [ - li [] [ span [ conditional ~on:hello ] [ text "HELLO 1" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 2" ] ]; - ]; - ul [] - [ - li [] [ span [] [ text "before 1" ] ]; - li [] [ span [] [ text "before 2" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO" ] ]; - li [] [ span [] [ text "after 1" ] ]; - li [] [ span [] [ text "after 2" ] ]; - ]; - ul [] - [ - li [] [ span [] [ text "before 1" ] ]; - li [] [ span [] [ text "before 2" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 1" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 2" ] ]; - li [] [ span [] [ text "after 1" ] ]; - li [] [ span [] [ text "after 2" ] ]; - ]; - ul [] - [ - li [] [ span [] [ text "before 1" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 1" ] ]; - ]; - ul [] - [ - li [] [ span [ conditional ~on:hello ] [ text "HELLO 1" ] ]; - li [] [ span [] [ text "after 1" ] ]; - ]; - ul [] - [ - li [] [ span [ conditional ~on:hello ] [ text "HELLO" ] ]; - li [] [ span [ conditional ~on:bye ] [ text "BYE" ] ]; - ]; - ul [] - [ - li [] [ span [] [ text "before 1" ] ]; - li [] [ span [ conditional ~on:bye ] [ text "BYE 1" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 1" ] ]; - li [] [ span [ conditional ~on:hello ] [ text "HELLO 2" ] ]; - li [] [ span [ conditional ~on:bye ] [ text "BYE 2" ] ]; - li [] [ span [] [ text "after 1" ] ]; - ]; ] let main () = let open Html in div [] - [ - h2 [] [ text "test_simple" ]; - test_simple (); - hr []; - h2 [] [ text "test_togglsimple" ]; - test_toggle_simple (); - hr []; - h2 [] [ text "test_toggle_siblings" ]; - test_toggle_siblings (); + [ h2 [] [ text "test_simple" ] + ; test_simple () + ; hr [] + ; h2 [] [ text "test_togglsimple" ] + ; test_toggle_simple () + ; hr [] + ; h2 [] [ text "test_toggle_siblings" ] + ; test_toggle_siblings () ] let () = - Helix.enable_debug true; + Helix.enable_debug false; match Stdweb.Dom.Document.get_element_by_id "root" with | Some root -> Html.mount root (main ()) | None -> failwith "no #app" diff --git a/tests/test_each.ml b/tests/test_each.ml index 4807e3c..bc18abc 100644 --- a/tests/test_each.ml +++ b/tests/test_each.ml @@ -3,13 +3,11 @@ open Helix let test_simple () = let open Html in - ul [] - [ Signal.make [ "a"; "b"; "c" ] |> each (fun item -> li [] [ text item ]) ] + ul [] [ Signal.make [ "a"; "b"; "c" ] |> each (fun item -> li [] [ text item ]) ] let test_simple_same () = let open Html in - ul [] - [ Signal.make [ "a"; "a"; "a" ] |> each (fun item -> li [] [ text item ]) ] + ul [] [ Signal.make [ "a"; "a"; "a" ] |> each (fun item -> li [] [ text item ]) ] let test_swap_1 () = let l1 = [ "a"; "b"; "c" ] in @@ -17,14 +15,12 @@ let test_swap_1 () = let flag = Signal.make true in let open Html in div [] - [ - button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; - ul [] - [ - flag + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]); - ]; + |> each (fun item -> li [] [ text item ]) + ] ] let test_swap_2 () = @@ -33,14 +29,12 @@ let test_swap_2 () = let flag = Signal.make true in let open Html in div [] - [ - button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; - ul [] - [ - flag + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]); - ]; + |> each (fun item -> li [] [ text item ]) + ] ] let test_swap_3 () = @@ -49,14 +43,12 @@ let test_swap_3 () = let flag = Signal.make true in let open Html in div [] - [ - button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; - ul [] - [ - flag + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]); - ]; + |> each (fun item -> li [] [ text item ]) + ] ] let test_swap_4 () = @@ -65,14 +57,53 @@ let test_swap_4 () = let flag = Signal.make true in let open Html in div [] - [ - button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; - ul [] - [ - flag + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]); - ]; + |> each (fun item -> li [] [ text item ]) + ] + ] + +let test_swap_5 () = + let l1 = [ "a"; "a" ] in + let l2 = [ "x"; "a"; "a" ] in + let flag = Signal.make true in + let open Html in + div [] + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag + |> Signal.map (fun b -> if b then l1 else l2) + |> each (fun item -> li [] [ text item ]) + ] + ] + +let test_swap_6 () = + let flag = Signal.make true in + let open Html in + let l1 = [ "same" ] in + let l2 = "new" :: l1 in + div [] + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag + |> Signal.map (fun b -> if b then l1 else l2) + |> each (fun item -> li [] [ text item ]) + ] + ] + +let to_string x = Jx.Fun.call1 (Jx.global "toString") ~return:Jx.Decoder.string Jx.Encoder.any x + +let test_swap_7 () = + let flag = Signal.make true in + let open Html in + let l1 = [ input [ placeholder "same" ] ] in + let l2 = input [ placeholder "new" ] :: l1 in + div [] + [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] + ; ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) |> each (fun item -> li [] [ item ]) ] ] let test_append () = @@ -80,43 +111,35 @@ let test_append () = let items = Signal.make [] in let open Html in div [] - [ - button - [ - on Ev.click (fun _ -> + [ button + [ on Ev.click (fun _ -> Signal.update (fun items -> incr n; List.append items [ !n ] ) items - ); + ) ] - [ text "Add" ]; - button - [ - on Ev.click (fun _ -> + [ text "Add" ] + ; button + [ on Ev.click (fun _ -> n := -1; Signal.emit [] items - ); + ) ] - [ text "Clear" ]; - ul [] [ items |> each (fun item -> li [] [ int item ]) ]; + [ text "Clear" ] + ; ul [] [ items |> each (fun item -> li [] [ int item ]) ] ] let test_append_same () = let items = Signal.make [ 0 ] in let open Html in div [] - [ - button - [ - on Ev.click (fun _ -> - Signal.update (fun items -> List.append items [ 0 ]) items - ); - ] - [ text "Add" ]; - ul [] [ items |> each (fun item -> li [] [ int item ]) ]; + [ button + [ on Ev.click (fun _ -> Signal.update (fun items -> List.append items [ 0 ]) items) ] + [ text "Add" ] + ; ul [] [ items |> each (fun item -> li [] [ int item ]) ] ] let test_conditional_1 () = @@ -126,44 +149,48 @@ let test_conditional_1 () = let l2 = [ "b"; "d"; "e" ] in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update not is_visible) ] - [ text "Toggle show" ]; - button - [ on Ev.click (fun _ -> Signal.update not flag) ] - [ text "Swap list" ]; - ul - [ conditional ~on:is_visible ] - [ - flag - |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]); - ]; + [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ] + ; button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ] + ; conditional ~on:is_visible + (ul [] + [ flag + |> Signal.map (fun b -> if b then l1 else l2) + |> each (fun item -> li [] [ text item ]) + ] + ) ] let test_conditional_2 () = + let is_visible = Signal.make true in + let flag = Signal.make false in + let l1 = [ "a"; "b"; "c" ] in + let l2 = [ "b"; "d"; "e" ] in + let open Html in + div [] + [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ] + ; button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ] + ; conditional ~on:is_visible + (ul [] + [ flag + |> Signal.map (fun b -> if b then l1 else l2) + |> each (fun item -> li [] [ text item ]) + ] + ) + ] + +let test_conditional_3 () = let is_visible = Signal.make true in let items = Signal.make [ "a"; "b"; "X"; "c" ] in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update not is_visible) ] - [ text "Toggle X" ]; - ul [] - [ - items + [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle X" ] + ; ul [] + [ items |> each (fun item -> - li - [ - ( if item = "X" then conditional ~on:is_visible - else Attr.empty - ); - ] - [ text item ] - ); - ]; + if item = "X" then conditional ~on:is_visible (li [] [ text item ]) + else li [] [ text item ] + ) + ] ] let test_show_1 () = @@ -173,25 +200,17 @@ let test_show_1 () = let items = Signal.make [ `a; `b; `c ] in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_a) ] - [ text "Increment a" ]; - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_b) ] - [ text "Increment b" ]; - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_c) ] - [ text "Increment c" ]; - ul [] - [ - items + [ button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ] + ; button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ] + ; button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ] + ; ul [] + [ items |> each (function | `a -> show (fun n -> li [] [ text "a: "; int n ]) count_a | `b -> show (fun n -> li [] [ text "b: "; int n ]) count_b | `c -> show (fun n -> li [] [ text "c: "; int n ]) count_c - ); - ]; + ) + ] ] let test_show_2 () = @@ -201,147 +220,126 @@ let test_show_2 () = let items = Signal.make [ "a"; "b"; "c" ] in let open Html in div [] - [ - button - [ - on_click (fun () -> + [ button + [ on_click (fun () -> Signal.update - (fun xs -> - if List.length xs = 3 then [ "a"; "c" ] else [ "a"; "b"; "c" ] - ) + (fun xs -> if List.length xs = 3 then [ "a"; "c" ] else [ "a"; "b"; "c" ]) items - ); + ) ] - [ text "Toggle b" ]; - br []; - button - [ on_click (fun () -> Signal.update (( + ) 1) count_a) ] - [ text "Increment a" ]; - button - [ on_click (fun () -> Signal.update (( + ) 1) count_b) ] - [ text "Increment b" ]; - button - [ on_click (fun () -> Signal.update (( + ) 1) count_c) ] - [ text "Increment c" ]; - ul [] - [ - items + [ text "Toggle b" ] + ; br [] + ; button [ on_click (fun () -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ] + ; button [ on_click (fun () -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ] + ; button [ on_click (fun () -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ] + ; ul [] + [ items |> each (function | "a" -> show (fun n -> li [] [ text "a: "; int n ]) count_a - | "b" -> show (fun n -> li [] [ text "b: "; int n ]) count_b + | "b" -> show ~label:"b" (fun n -> li [] [ text "b: "; int n ]) count_b | "c" -> show (fun n -> li [] [ text "c: "; int n ]) count_c | _ -> assert false - ); - ]; + ) + ] ] let test_random () = let items = Signal.make (List.init 7 string_of_int) in let open Html in div [] - [ - button - [ - on Ev.click (fun _ -> - Signal.emit (List.init (1 + Random.int 10) string_of_int) items - ); - ] - [ text "Generate" ]; - ul [] [ items |> each (fun item -> li [] [ text item ]) ]; + [ button + [ on Ev.click (fun _ -> Signal.emit (List.init (1 + Random.int 10) string_of_int) items) ] + [ text "Generate" ] + ; ul [] [ items |> each (fun item -> li [] [ text item ]) ] ] let test_interleave () = let items = Signal.make (List.init 7 string_of_int) in let open Html in div [] - [ - button - [ - on Ev.click (fun _ -> - Signal.emit (List.init (1 + Random.int 10) string_of_int) items - ); - ] - [ text "Generate" ]; - div + [ button + [ on Ev.click (fun _ -> Signal.emit (List.init (1 + Random.int 10) string_of_int) items) ] + [ text "Generate" ] + ; div [ style_list [ ("display", "flex"); ("flex-direction", "row") ] ] - [ - ul [] - [ - li [] [ Html.text "before 1" ]; - each (fun item -> li [] [ Html.text item ]) items; - ]; - ul [] - [ - each (fun item -> li [] [ Html.text item ]) items; - li [] [ Html.text "after 1" ]; - ]; - ul [] - [ - li [] [ Html.text "before 1" ]; - each (fun item -> li [] [ Html.text item ]) items; - li [] [ Html.text "after 1" ]; - ]; - ul [] - [ - li [] [ Html.text "before 1" ]; - each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items; - each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items; - li [] [ Html.text "after 1" ]; - ]; - ul [] - [ - each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items; - li [] [ Html.text "middle 1" ]; - each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items; - li [] [ Html.text "after 1" ]; - ]; - ]; + [ ul [] + [ li [] [ Html.text "before 1" ]; each (fun item -> li [] [ Html.text item ]) items ] + ; ul [] [ each (fun item -> li [] [ Html.text item ]) items; li [] [ Html.text "after 1" ] ] + ; ul [] + [ li [] [ Html.text "before 1" ] + ; each (fun item -> li [] [ Html.text item ]) items + ; li [] [ Html.text "after 1" ] + ] + ; ul [] + [ li [] [ Html.text "before 1" ] + ; each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items + ; each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items + ; li [] [ Html.text "after 1" ] + ] + ; ul [] + [ each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items + ; li [] [ Html.text "middle 1" ] + ; each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items + ; li [] [ Html.text "after 1" ] + ] + ] ] let main () = let open Html in div [] - [ - h2 [] [ text "simple" ]; - test_simple (); - hr []; - h2 [] [ text "simple_same" ]; - test_simple_same (); - hr []; - h2 [] [ text "swap_1" ]; - test_swap_1 (); - hr []; - h2 [] [ text "swap_2" ]; - test_swap_2 (); - hr []; - h2 [] [ text "swap_3" ]; - test_swap_3 (); - hr []; - h2 [] [ text "swap_4" ]; - test_swap_4 (); - hr []; - h2 [] [ text "conditional_1" ]; - test_conditional_1 (); - hr []; - h2 [] [ text "conditional_2" ]; - test_conditional_2 (); - hr []; - h2 [] [ text "show_1" ]; - test_show_1 (); - hr []; - h2 [] [ text "show_2" ]; - test_show_2 (); - hr []; - h2 [] [ text "append" ]; - test_append (); - h2 [] [ text "append_same" ]; - test_append_same (); - hr []; - h2 [] [ text "random" ]; - test_random (); - hr []; - h2 [] [ text "interleave" ]; - test_interleave (); + [ h2 [] [ text "simple" ] + ; test_simple () + ; hr [] + ; h2 [] [ text "simple_same" ] + ; test_simple_same () + ; hr [] + ; h2 [] [ text "swap_1" ] + ; test_swap_1 () + ; hr [] + ; h2 [] [ text "swap_2" ] + ; test_swap_2 () + ; hr [] + ; h2 [] [ text "swap_3" ] + ; test_swap_3 () + ; hr [] + ; h2 [] [ text "swap_4" ] + ; test_swap_4 () + ; hr [] + ; h2 [] [ text "swap_5" ] + ; test_swap_5 () + ; hr [] + ; h2 [] [ text "swap_6" ] + ; test_swap_6 () + ; hr [] + ; h2 [] [ text "swap_7" ] + ; test_swap_7 () + ; hr [] + ; h2 [] [ text "conditional_1" ] + ; test_conditional_1 () + ; hr [] + ; h2 [] [ text "conditional_2" ] + ; test_conditional_2 () + ; hr [] + ; h2 [] [ text "conditional_3" ] + ; test_conditional_3 () + ; hr [] + ; h2 [] [ text "show_1" ] + ; test_show_1 () + ; hr [] + ; h2 [] [ text "show_2" ] + ; test_show_2 () + ; hr [] + ; h2 [] [ text "append" ] + ; test_append () + ; h2 [] [ text "append_same" ] + ; test_append_same () + ; hr [] + ; h2 [] [ text "random" ] + ; test_random () + ; hr [] + ; h2 [] [ text "interleave" ] + ; test_interleave () ] let () = diff --git a/tests/test_router.ml b/tests/test_router.ml index 7b140e8..4f2c848 100644 --- a/tests/test_router.ml +++ b/tests/test_router.ml @@ -12,10 +12,8 @@ end = struct let of_string str = match String.split_on_char '-' str with - | [ yyyy; mm; dd ] - when String.length yyyy = 4 - && String.length dd = 2 - && String.length mm = 2 -> Some str + | [ yyyy; mm; dd ] when String.length yyyy = 4 && String.length dd = 2 && String.length mm = 2 + -> Some str | _ -> None let to_string t = t @@ -25,8 +23,7 @@ end module Device_metrics = struct module Links = struct let date = - Router.var ~of_string:Date.of_string ~to_string:Date.to_string - ~equal:Date.equal "date" + Router.var ~of_string:Date.of_string ~to_string:Date.to_string ~equal:Date.equal "date" let index = Router.End let count = Router.Const ("count", End) @@ -49,113 +46,87 @@ module Device_metrics = struct let end_date = Signal.make (Option.get (Date.of_string "2023-04-01")) in let open Html in div [] - [ - div [] - [ - (*show (fun path -> code [] (String.concat "/" path)) (Router.path router);*) + [ div [] + [ (*show (fun path -> code [] (String.concat "/" path)) (Router.path router);*) ul [] - [ - li [] - [ - a - [ - Router.link + [ li [] + [ a + [ Router.link ~active:(style_list [ ("font-weight", "bold") ]) - router Links.count; + router Links.count ] - [ text "Count" ]; - ]; - li [] - [ - text "Average from "; - input - [ - type' "date"; - bind - (fun date -> value (Date.to_string date)) - start_date; - on Event.input (fun ev -> + [ text "Count" ] + ] + ; li [] + [ text "Average from " + ; input + [ type' "date" + ; bind (fun date -> value (Date.to_string date)) start_date + ; on Event.input (fun ev -> let date = - Event.target ev - |> Node.get_value - |> Date.of_string - |> Option.get + Event.target ev |> Node.get_value |> Date.of_string |> Option.get in Signal.emit date start_date - ); - ]; - text " to "; - input - [ - type' "date"; - bind (fun date -> value (Date.to_string date)) end_date; - on Event.input (fun ev -> + ) + ] + ; text " to " + ; input + [ type' "date" + ; bind (fun date -> value (Date.to_string date)) end_date + ; on Event.input (fun ev -> let date = - Event.target ev - |> Node.get_value - |> Date.of_string - |> Option.get + Event.target ev |> Node.get_value |> Date.of_string |> Option.get in Signal.emit date end_date - ); - ]; - nbsp; - a - [ - bind + ) + ] + ; nbsp + ; a + [ bind (fun (start_date, end_date) -> Router.link ~active:(style_list [ ("font-weight", "bold") ]) router Links.avg start_date end_date ) - (Signal.pair start_date end_date); + (Signal.pair start_date end_date) ] - [ text "Go" ]; - ]; - li [] - [ - a - [ - Router.link + [ text "Go" ] + ] + ; li [] + [ a + [ Router.link ~active:(style_list [ ("font-weight", "bold") ]) - router Links.sum 2 3; + router Links.sum 2 3 ] - [ text "Sum 2 3" ]; - ]; - li [] - [ - a - [ - Router.link + [ text "Sum 2 3" ] + ] + ; li [] + [ a + [ Router.link ~active:(style_list [ ("font-weight", "bold") ]) - router Links.sum 100 1; + router Links.sum 100 1 ] - [ text "Sum 100 1" ]; - ]; - ]; - hr []; - ]; - div + [ text "Sum 100 1" ] + ] + ] + ; hr [] + ] + ; div [ style "background: #cef" ] - [ - Router.dispatch ~label:"metrics" router - [ - Router.route Links.index (fun () -> - Html.text "PICK METRIC ABOVE" - ); - Router.route Links.count (fun () -> Html.text "COUNT"); - Router.route Links.avg (fun start_date end_date () -> + [ Router.dispatch ~label:"metrics" router + [ Router.route Links.index (fun () -> Html.text "PICK METRIC ABOVE") + ; Router.route Links.count (fun () -> Html.text "COUNT") + ; Router.route Links.avg (fun start_date end_date () -> Html.span [] - [ - text "AVG for "; - show (fun date -> text (Date.to_string date)) start_date; - text " - "; - show (fun date -> text (Date.to_string date)) end_date; + [ text "AVG for " + ; show (fun date -> text (Date.to_string date)) start_date + ; text " - " + ; show (fun date -> text (Date.to_string date)) end_date ] - ); - Router.route Links.sum view_sum; - ]; - ]; + ) + ; Router.route Links.sum view_sum + ] + ] ] end @@ -169,59 +140,48 @@ module Device = struct let view (device_id : string signal) router = let open Html in div [] - [ - h2 [] [ text "Device" ]; - device_id + [ h2 [] [ text "Device" ] + ; device_id |> show ~label:"device-header" (fun device_id -> div [] - [ - text ("device_id=" ^ device_id); - ul [] - [ - li [] - [ - a - [ - Router.link + [ text ("device_id=" ^ device_id) + ; ul [] + [ li [] + [ a + [ Router.link ~active:(style_list [ ("font-weight", "bold") ]) - ~exact:true router Links.index; + ~exact:true router Links.index ] - [ text "Overview" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "Overview" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.metrics Device_metrics.Links.index; + Links.metrics Device_metrics.Links.index ] - [ text "Metrics" ]; - ]; - li [] - [ - a - [ - Router.link + [ text "Metrics" ] + ] + ; li [] + [ a + [ Router.link ~active:(style_list [ ("font-weight", "bold") ]) - router Links.schema; + router Links.schema ] - [ text "Schema" ]; - ]; - ]; - hr []; + [ text "Schema" ] + ] + ] + ; hr [] ] - ); - div + ) + ; div [ style "background: #cef" ] - [ - Router.dispatch ~label:"device" router - [ - Router.route Links.index (fun () -> Html.text "OVERVIEW"); - Router.route Links.metrics Device_metrics.view; - Router.route Links.schema (fun () -> Html.text "SCHEMA"); - ]; - ]; + [ Router.dispatch ~label:"device" router + [ Router.route Links.index (fun () -> Html.text "OVERVIEW") + ; Router.route Links.metrics Device_metrics.view + ; Router.route Links.schema (fun () -> Html.text "SCHEMA") + ] + ] ] end @@ -242,7 +202,7 @@ module Links = struct let device_schema_edit = let open Router in - Const ("devices", Var (string, None, Const ("schema", (Const ("!edit", End))))) + Const ("devices", Var (string, None, Const ("schema", Const ("!edit", End)))) let account = let open Router in @@ -252,145 +212,115 @@ end let view router = let open Html in div [] - [ - h1 [] [ text "INDEX" ]; - pre [] - [ - show - (fun parts -> text ("/" ^ String.concat "/" parts)) - (Router.path router); - ]; - hr []; - ul [] - [ - li [] - [ - a - [ - Router.link router + [ h1 [] [ text "INDEX" ] + ; pre [] [ show (fun parts -> text ("/" ^ String.concat "/" parts)) (Router.path router) ] + ; hr [] + ; ul [] + [ li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - ~exact:true Links.root; + ~exact:true Links.root ] - [ text "#/" ]; - ]; - li [] - [ - a - [ - Router.link router - ~active:(style_list [ ("font-weight", "bold") ]) - Links.account; + [ text "#/" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) Links.account ] - [ text "#/account" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/account" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_1" Device.Links.index; + Links.devices "dev_1" Device.Links.index ] - [ text "#/devices/dev_1" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_1" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_3" Device.Links.index; + Links.devices "dev_3" Device.Links.index ] - [ text "#/devices/dev_3" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_3" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_1" Device.Links.metrics - Device_metrics.Links.index; + Links.devices "dev_1" Device.Links.metrics Device_metrics.Links.index ] - [ text "#/devices/dev_1/metrics" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_1/metrics" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_1" Device.Links.schema; + Links.devices "dev_1" Device.Links.schema ] - [ text "#/devices/dev_1/schema" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_1/schema" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_2" Device.Links.schema; + Links.devices "dev_2" Device.Links.schema ] - [ text "#/devices/dev_2/schema" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_2/schema" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices "dev_2" Device.Links.metrics - Device_metrics.Links.index; + Links.devices "dev_2" Device.Links.metrics Device_metrics.Links.index ] - [ text "#/devices/dev_2/metrics" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_2/metrics" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices_edit "dev_2"; + Links.devices_edit "dev_2" ] - [ text "#/devices/dev_2/!edit" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/dev_2/!edit" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.devices_new; + Links.devices_new ] - [ text "#/devices/!new" ]; - ]; - li [] - [ - a - [ - Router.link router + [ text "#/devices/!new" ] + ] + ; li [] + [ a + [ Router.link router ~active:(style_list [ ("font-weight", "bold") ]) - Links.device_schema_edit "dev_1"; + Links.device_schema_edit "dev_1" ] - [ text "#/devices/dev_1/schema/!edit" ]; - ]; - ]; - hr []; - Router.dispatch router ~label:"main" ~default:(text "NOT FOUND") - [ - Router.route Links.root (fun () -> Html.text "ROOT"); - Router.route Links.account (fun () -> Html.text "ACCOUNT"); - Router.route Links.devices Device.view; - Router.route Links.devices_edit (fun id () -> + [ text "#/devices/dev_1/schema/!edit" ] + ] + ] + ; hr [] + ; Router.dispatch router ~label:"main" ~default:(text "NOT FOUND") + [ Router.route Links.root (fun () -> Html.text "ROOT") + ; Router.route Links.account (fun () -> Html.text "ACCOUNT") + ; Router.route Links.devices Device.view + ; Router.route Links.devices_edit (fun id () -> show (fun id -> Html.text ("DEVICE EDIT: " ^ id)) id - ); - Router.route Links.devices_new (fun () -> Html.text "DEVICE NEW"); - Router.route Links.device_schema_edit (fun dev_id () -> let$ dev_id in Html.text ("DEVICE SCHEMA EDIT: " ^ dev_id)); - ]; + ) + ; Router.route Links.devices_new (fun () -> Html.text "DEVICE NEW") + ; Router.route Links.device_schema_edit (fun dev_id () -> + let$ dev_id in + Html.text ("DEVICE SCHEMA EDIT: " ^ dev_id) + ) + ] ] let () = + Helix.enable_debug true; let router = Router.make History.hash_path in match Stdweb.Dom.Document.get_element_by_id "root" with | Some node -> Html.mount node (view router) diff --git a/tests/test_show.ml b/tests/test_show.ml index 3ee76a6..6fc0aa1 100644 --- a/tests/test_show.ml +++ b/tests/test_show.ml @@ -4,169 +4,126 @@ open Helix let test_simple () = let open Html in ul [] - [ - li [] [ show Html.text (Signal.make "text") ]; - li [] [ show Html.int (Signal.make 42) ]; - li [] [ show (fun () -> Html.empty) (Signal.make ()) ]; - li [] - [ - show - (fun (num, msg) -> - Html.span [] [ text msg; text (string_of_int num) ] - ) - (Signal.make (42, "hello")); - ]; + [ li [] [ show Html.text (Signal.make "text") ] + ; li [] [ show Html.int (Signal.make 42) ] + ; li [] [ show (fun () -> Html.null) (Signal.make ()) ] + ; li [] + [ show + (fun (num, msg) -> Html.span [] [ text msg; text (string_of_int num) ]) + (Signal.make (42, "hello")) + ] ] let test_updates () = let number = Signal.make 0 in let open Html in div [] - [ - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] - [ text "incr" ]; - show int number; + [ button [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] [ text "incr" ] + ; show int number ] let test_nested () = let open Html in let number = Signal.make 0 in div [] - [ - div [] [ show (fun x -> show text (Signal.make x)) (Signal.make "hello") ]; - div [] - [ - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] - [ text "incr" ]; - show (fun x -> show int (Signal.make x)) number; - ]; - div [] - [ - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] - [ text "incr" ]; - show - (fun x -> - if x mod 2 = 0 then text "NOP" else show int (Signal.make x) - ) - number; - ]; - ] - -let test_nested_bug_1 () = - let signal = Signal.make 0 in - let open Html in - div [] - [ - show ~label:"outer" - (fun x1 -> - show ~label:"inner" - (fun x2 -> - text (String.concat "+" [ string_of_int x1; string_of_int x2 ]) - ) - signal - ) - signal; - br []; - button - [ on Ev.click (fun _ -> Signal.update (( + ) 1) signal) ] - [ text "Trigger nested bug 1" ]; + [ div [] [ show (fun x -> show text (Signal.make x)) (Signal.make "hello") ] + ; div [] + [ button [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] [ text "incr" ] + ; show (fun x -> show int (Signal.make x)) number + ] + ; div [] + [ button [ on Ev.click (fun _ -> Signal.update (( + ) 1) number) ] [ text "incr" ] + ; show (fun x -> if x mod 2 = 0 then text "NOP" else show int (Signal.make x)) number + ] ] let test_switcher () = let complex () = let open Html in - fragment - [ - h2 [] [ text "h2" ]; - pre [] [ code [ class_name "language-ocaml" ] [ text "code" ] ]; - p [] [ text "descr" ]; - h3 [] [ text "Example" ]; - pre [] [ code [ class_name "language-ocaml" ] [ text "example" ] ]; - empty; - fragment - [ - h3 [] [ text "Console" ]; - div [] - [ pre [] [ code [ class_name "plaintext" ] [ text "console" ] ] ]; - ]; + div [] + [ h2 [] [ text "h2" ] + ; pre [] [ code [ class_name "language-ocaml" ] [ text "code" ] ] + ; p [] [ text "descr" ] + ; h3 [] [ text "Example" ] + ; pre [] [ code [ class_name "language-ocaml" ] [ text "example" ] ] + ; null + ; div [] + [ h3 [] [ text "Console" ] + ; div [] [ pre [] [ code [ class_name "plaintext" ] [ text "console" ] ] ] + ] ] in let what = Signal.make `text in let open Html in div [] - [ - div + [ div [ style_list [ ("gap", "10px"); ("display", "flex") ] ] - [ - button - [ on Ev.click (fun _ -> Signal.emit `text what) ] - [ text "text" ]; - button - [ on Ev.click (fun _ -> Signal.emit `fragment1 what) ] - [ text "fragment1" ]; - button - [ on Ev.click (fun _ -> Signal.emit `fragment2 what) ] - [ text "fragment2" ]; - button [ on Ev.click (fun _ -> Signal.emit `div what) ] [ text "div" ]; - button - [ on Ev.click (fun _ -> Signal.emit `empty1 what) ] - [ text "empty1" ]; - button - [ on Ev.click (fun _ -> Signal.emit `empty2 what) ] - [ text "empty2" ]; - button - [ on Ev.click (fun _ -> Signal.emit `complex1 what) ] - [ text "complex1" ]; - button - [ on Ev.click (fun _ -> Signal.emit `complex2 what) ] - [ text "complex2" ]; - ]; - what + [ button [ on Ev.click (fun _ -> Signal.emit `text what) ] [ text "text" ] + ; button [ on Ev.click (fun _ -> Signal.emit `fragment1 what) ] [ text "fragment1" ] + ; button [ on Ev.click (fun _ -> Signal.emit `fragment2 what) ] [ text "fragment2" ] + ; button [ on Ev.click (fun _ -> Signal.emit `div what) ] [ text "div" ] + ; button [ on Ev.click (fun _ -> Signal.emit `empty1 what) ] [ text "empty1" ] + ; button [ on Ev.click (fun _ -> Signal.emit `empty2 what) ] [ text "empty2" ] + ; button [ on Ev.click (fun _ -> Signal.emit `complex1 what) ] [ text "complex1" ] + ; button [ on Ev.click (fun _ -> Signal.emit `complex2 what) ] [ text "complex2" ] + ] + ; what |> show (fun what -> match what with | `text -> text "Hello!" | `fragment1 -> fragment - [ - div [] [ text "elem 1.1" ]; - div [] [ text "elem 1.2" ]; - div [] [ text "elem 1.3" ]; + [ div [] [ text "elem 1.1" ] + ; div [] [ text "elem 1.2" ] + ; div [] [ text "elem 1.3" ] ] | `fragment2 -> fragment - [ - div [] [ text "elem 2.1" ]; - div [] [ text "elem 2.2" ]; - div [] [ text "elem 2.3" ]; + [ div [] [ text "elem 2.1" ] + ; div [] [ text "elem 2.2" ] + ; div [] [ text "elem 2.3" ] ] | `div -> div [] [ text "div 1" ] - | `empty1 -> empty - | `empty2 -> fragment [ empty ] + | `empty1 -> null + | `empty2 -> fragment [ null ] | `complex1 -> complex () | `complex2 -> complex () - ); + ) + ] + +let test_nested_bug_1 () = + let signal = Signal.make 0 in + let open Html in + div [] + [ show ~label:"outer" + (fun x1 -> + show ~label:"inner" + (fun x2 -> text (String.concat "+" [ string_of_int x1; string_of_int x2 ])) + signal + ) + signal + ; br [] + ; button + [ on Ev.click (fun _ -> Signal.update (( + ) 1) signal) ] + [ text "Trigger nested bug 1" ] ] let main () = let open Html in div [] - [ - h2 [] [ text "Show/simple" ]; - test_simple (); - hr []; - h2 [] [ text "Show/updates" ]; - test_updates (); - hr []; - h2 [] [ text "Show/nested" ]; - test_nested (); - hr []; - h2 [] [ text "Show/switcher" ]; - test_switcher (); - h2 [] [ text "Show/nested_bug_1" ]; - test_nested_bug_1 (); + [ h2 [] [ text "Show/simple" ] + ; test_simple () + ; hr [] + ; h2 [] [ text "Show/updates" ] + ; test_updates () + ; hr [] + ; h2 [] [ text "Show/nested" ] + ; test_nested () + ; hr [] + ; h2 [] [ text "Show/switcher" ] + ; test_switcher () + ; h2 [] [ text "Show/nested_bug_1" ] + ; test_nested_bug_1 () ] let () = diff --git a/vendor/html/src/Html.ml b/vendor/html/src/Html.ml index cb797bb..a51c911 100644 --- a/vendor/html/src/Html.ml +++ b/vendor/html/src/Html.ml @@ -1,5 +1,21 @@ open Stdweb +module Ctx = struct + let gen_id = + let i = ref (-1) in + fun () -> + incr i; + (Obj.magic !i : string) + + type t = { id : string; mutable cleanup : (unit -> unit) list; tree : t Stdweb.Dict.t } + + let make () = { id = gen_id (); cleanup = []; tree = Stdweb.Dict.empty () } + let on_cleanup t f = t.cleanup <- f :: t.cleanup + let cleanup t = List.iter (fun c -> c ()) t.cleanup + let link t t2 = Stdweb.Dict.set t.tree t2.id t2 + let unlink t subctx = Stdweb.Dict.del t.tree subctx.id +end + (* Attributes are functions that set "attributes" on elements. Html values are functions that mount and unmount children. @@ -10,44 +26,38 @@ open Stdweb *) module Attr = struct - type state = { - set : unit -> unit; - unset : unit -> unit; - free : (unit -> unit) option; - } + type state = { set : unit -> unit; unset : unit -> unit } + type t = Ctx.t -> Dom.Node.t -> state - type t = Dom.Node.t -> state - - let empty _node = { set = ignore; unset = ignore; free = None } - let on bool attr = if bool then attr else empty + let nop _ctx _node = { set = ignore; unset = ignore } + let on bool attr = if bool then attr else nop let on_some = function - | None -> empty + | None -> nop | Some at -> at let on_ok = function - | Error _ -> empty + | Error _ -> nop | Ok attr -> attr - let string name value node = + let string name value _ctx node = let set () = Dom.Node.set_attr node name value in let unset () = Dom.Node.unset_attr node name in - { set; unset; free = None } + { set; unset } - let bool name bool = if bool then string name "" else empty + let bool name bool = if bool then string name "" else nop let int name i = string name (string_of_int i) - let on_mount f node = + let on_mount f _ctx node = let set () = f node in - { set; unset = ignore; free = None } + { set; unset = ignore } let set attr node = attr node let unset state = state.unset () - let make f = f - let combine a1 a2 node = - let a1_state = a1 node in - let a2_state = a2 node in + let combine a1 a2 ctx node = + let a1_state = a1 ctx node in + let a2_state = a2 ctx node in let set () = a1_state.set (); a2_state.set () @@ -56,23 +66,9 @@ module Attr = struct a1_state.unset (); a2_state.unset () in - let free = - match a1_state.free with - | None -> a2_state.free - | Some a1_free_f -> ( - match a2_state.free with - | None -> a1_state.free - | Some a2_free_f -> - Some - (fun () -> - a1_free_f (); - a2_free_f () - ) - ) - in - { set; unset; free } + { set; unset } - let list attrs = List.fold_left combine empty attrs + let list attrs = List.fold_left combine nop attrs let label = string "label" end @@ -119,10 +115,10 @@ let tabindex value = Attr.int "tabindex" value let title value = Attr.string "title" value let type' value = Attr.string "type" value -let value x node = +let value x _ctx node = let set () = Dom.Node.set_value node x in let unset () = Dom.Node.reset_value node in - { Attr.set; unset; free = None } + { Attr.set; unset } let value_or default opt = match opt with @@ -134,29 +130,25 @@ let width value = Attr.int "width" value let style x = Attr.string "style" x let role x = Attr.string "role" x -let style_list items node = +let style_list items _ctx node = let style = Dom.Node.get_style node in - let set () = - List.iter (fun (name, value) -> Dom.Style.set style name value) items - in - let unset () = - List.iter (fun (name, _value) -> Dom.Style.unset style name) items - in - { Attr.set; unset; free = None } + let set () = List.iter (fun (name, value) -> Dom.Style.set style name value) items in + let unset () = List.iter (fun (name, _value) -> Dom.Style.unset style name) items in + { Attr.set; unset } -let class_list items node = +let class_list items _ctx node = let cl = Dom.Node.get_class_list node in let set () = List.iter (fun name -> Dom.Token_list.add cl name) items in let unset () = List.iter (fun name -> Dom.Token_list.remove cl name) items in - { Attr.set; unset; free = None } + { Attr.set; unset } let class_flags options = - let list = - List.fold_left (fun acc (c, b) -> if b then c :: acc else acc) [] options - in + let list = List.fold_left (fun acc (c, b) -> if b then c :: acc else acc) [] options in class_list list -let on ?(default = true) ?confirm (name : Dom.Event.name) f node = +(* Do we need to unbind the event explicitly? In theory, the browser should + remove the listeners when the node is gc'ed. *) +let on ?(default = true) ?confirm (name : Dom.Event.name) f _ctx node = let f' = match confirm with | None when not default -> @@ -173,9 +165,7 @@ let on ?(default = true) ?confirm (name : Dom.Event.name) f node = in let set () = Dom.Node.bind node name f' in let unset () = Dom.Node.unbind node name f' in - (* Do we need to unbind the event in free? In theory, the browser should - remove the listeners when the node is gc'ed. *) - { Attr.set; unset; free = None } + { Attr.set; unset } let on_change ?confirm handler = on ~default:false ?confirm Dom.Event.change (fun ev -> @@ -192,8 +182,7 @@ let on_input ?confirm handler = handler (Dom.Node.get_value (Dom.Event.target ev)) ) -let on_click ?confirm handler = - on ~default:false ?confirm Dom.Event.click (fun _ -> handler ()) +let on_click ?confirm handler = on ~default:false ?confirm Dom.Event.click (fun _ -> handler ()) let on_double_click ?confirm handler = on ~default:false ?confirm Dom.Event.dblclick (fun _ -> handler ()) @@ -211,10 +200,11 @@ let on_double_click ?confirm handler = (* Extra constructors. *) module Elem = struct - type state = { free : (unit -> unit) option; remove : unit -> unit } - type t = Dom.node -> (Dom.node -> unit) -> state + type state = { unmount : unit -> unit; mount : (Dom.node -> unit) -> unit } + type t = Ctx.t -> Dom.node -> state - let empty _parent _insert = { free = None; remove = (fun () -> ()) } + let null_state = { unmount = ignore; mount = (fun _insert -> ()) } + let null _ctx _parent = null_state (* [NOTE] Invariant @@ -233,125 +223,81 @@ module Elem = struct The `conditional` attribute requires that the node is mounted on a parent. *) - let make name attrs children parent insert = - (* Create elem *) + let make name attrs children ctx parent = let node = Dom.Document.create_element name in - (* Add to parent *) - insert node; - (* Set attrs and collect cleanup actions. *) - let free_attrs = - List.fold_left - (fun acc (attr : Attr.t) -> - let state = attr node in - state.set (); - match state.free with - | None -> acc - | Some f -> f :: acc - ) - [] attrs - in - (* Append childrend and collect cleanup actions. *) - let free = - match - List.fold_left - (fun acc (child : t) -> - let state = child node (Dom.Node.append_child ~parent:node) in - match state.free with - | None -> acc - | Some f -> f :: acc - ) - free_attrs children - with - | [] -> None - | fs -> Some (fun () -> List.iter (fun f -> f ()) fs) - in - let remove () = Dom.Node.remove_child ~parent node in - { free; remove } - - let fragment children parent insert = - let children_states_rev = - List.rev_map (fun (child : t) -> child parent insert) children - in - let free = - match List.filter_map (fun (s : state) -> s.free) children_states_rev with - | [] -> None - | fs -> Some (fun () -> List.iter (fun f -> f ()) fs) - in - let remove () = - List.iter - (fun (child_state : state) -> child_state.remove ()) - children_states_rev - in - { free; remove } + List.iter + (fun (attr : Attr.t) -> + let state = attr ctx node in + state.set () + ) + attrs; + let node_insert = Dom.Node.append_child ~parent:node in + List.iter + (fun (child : t) -> + let child_state = child ctx node in + child_state.mount node_insert + ) + children; + { unmount = (fun () -> Dom.Node.remove_child ~parent node) + ; mount = (fun insert -> insert node) + } - let text data parent insert = + let text data _ctx parent = let node = Dom.Document.create_text_node data in - insert node; - let remove () = Dom.Node.remove_child ~parent node in - { free = None; remove } + { unmount = (fun () -> Dom.Node.remove_child ~parent node) + ; mount = (fun insert -> insert node) + } let of_some to_html option = match option with | Some x -> to_html x - | None -> empty + | None -> null let of_ok to_html result = match result with | Ok x -> to_html x - | Error _ -> empty - - let list f list = fragment (List.map f list) - let list_indexed f list = fragment (List.mapi f list) - - let on_unmount f t parent insert = - let s = t parent insert in - { - s with - free = - ( match s.free with - | None -> Some f - | Some s_free -> - Some - (fun () -> - s_free (); - f () - ) - ); - } + | Error _ -> null - let unsafe name attrs content parent insert = + let on_unmount f elem ctx = + Ctx.on_cleanup ctx f; + elem ctx + + let unsafe name attrs content ctx parent = let node = Dom.Document.create_element name in Dom.Node.set_inner_html node content; - insert node; - let free = - match - List.fold_left - (fun acc (attr : Attr.t) -> - let state = attr node in - state.set (); - match state.free with - | None -> acc - | Some f -> f :: acc - ) - [] attrs - with - | [] -> None - | fs -> Some (fun () -> List.iter (fun f -> f ()) fs) - in - let remove () = Dom.Node.remove_child ~parent node in - { free; remove } + List.iter + (fun (attr : Attr.t) -> + let state = attr ctx node in + state.set () + ) + attrs; + { unmount = (fun () -> Dom.Node.remove_child ~parent node) + ; mount = (fun insert -> insert node) + } - let unmount (state : state) = - Option.iter (fun f -> f ()) state.free; - state.remove () + let fragment children ctx parent = + let frag = Dom.Fragment.make () in + let frag_insert = Dom.Node.append_child ~parent:frag in + let states = + List.map + (fun (child : t) -> + let s = child ctx parent in + s.mount frag_insert; + s + ) + children + in + { unmount = (fun () -> List.iter (fun (s : state) -> s.unmount ()) states) + ; mount = (fun insert -> insert frag) + } end -type elem = Elem.t +type t = Elem.t let elem = Elem.make -let fragment = Elem.fragment let text = Elem.text -let empty = Elem.empty +let null = Elem.null +let fragment = Elem.fragment let int n = text (string_of_int n) let nbsp = text "\u{00A0}" let a attrs children = elem "a" attrs children @@ -458,38 +404,18 @@ let ul attrs children = elem "ul" attrs children let var attrs children = elem "var" attrs children let video attrs children = elem "video" attrs children let wbr attrs = elem "wbr" attrs [] -let text_list l = fragment (List.map text l) -let resource ~init ~free (use : 'a -> Elem.t) parent insert : Elem.state = +let resource ~init ~free (use : 'a -> Elem.t) ctx parent = let r = init () in let html = use r in - let html_state = html parent insert in - let free = - match html_state.free with - | None -> Some (fun () -> free r) - | Some html_free -> - Some - (fun () -> - html_free (); - free r - ) - in - { html_state with free } - -(* -module Head = struct - let title attrs children = elem "title" attrs children - let style attrs children = elem "style" attrs children - let body attrs children = elem "body" attrs children - let link attrs = elem "link" attrs [] - let noscript attrs children = elem "noscript" attrs children - let script attrs children = elem "script" attrs children - let template attrs children = elem "template" attrs children -end -*) + let state = html ctx parent in + Ctx.on_cleanup ctx (fun () -> free r); + state (* DOM helpers *) let mount parent html = - let _html_state = html parent (Dom.Node.append_child ~parent) in - () + let ctx = Ctx.make () in + let state : Elem.state = html ctx parent in + let insert = Dom.Node.append_child ~parent in + state.mount insert diff --git a/vendor/html/src/Html.mli b/vendor/html/src/Html.mli index f5f6e0a..2cb7ac9 100644 --- a/vendor/html/src/Html.mli +++ b/vendor/html/src/Html.mli @@ -2,36 +2,39 @@ open Stdweb +module Ctx : sig + type t + + val make : unit -> t + val link : t -> t -> unit + val unlink : t -> t -> unit + val on_cleanup : t -> (unit -> unit) -> unit + val cleanup : t -> unit +end + (** {1:attr Attributes} See the - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} MDN HTML - attribute reference}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} MDN HTML attribute reference}. *) (** Additional attribute operations. *) module Attr : sig - type state = { - set : unit -> unit; - unset : unit -> unit; - free : (unit -> unit) option; - } + type state = { set : unit -> unit; unset : unit -> unit } - type t = Dom.Node.t -> state + type t = Ctx.t -> Dom.node -> state (** The type for HTML attributes. *) - val empty : t - (** [empty] is an attribute that doesn't get rendered. *) + val nop : t + (** [nop] is an attribute that does nothing. *) val string : string -> string -> t val bool : string -> bool -> t - (** [bool name value] is [attr name ""] if [value] is [true] and {!empty} - otherwise. + (** [bool name value] is [attr name ""] if [value] is [true] and {!empty} otherwise. This sets the {{:https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes} - boolean attribute} [n] to true. The attribute will be omitted if [b] is - false. *) + boolean attribute} [n] to true. The attribute will be omitted if [b] is false. *) val int : string -> int -> t (** [int name value] is [attr name (string_of_int i)]. *) @@ -40,59 +43,48 @@ module Attr : sig (** [on cond attr] is [attr] if [cond] is [true] and {!empty} otherwise. *) val on_some : t option -> t - (** [on_some option] is [attr] if [option] is [Some attr] and {!empty} if - [option] is [None]. *) + (** [on_some option] is [attr] if [option] is [Some attr] and {!empty} if [option] is [None]. *) val on_ok : (t, 'e) result -> t - (** [on_ok result] is [attr] if [result] is [Ok attr] and {!empty} if [result] - is [Error _]. *) + (** [on_ok result] is [attr] if [result] is [Ok attr] and {!empty} if [result] is [Error _]. *) val on_mount : (Dom.node -> unit) -> t - (** [on_mount f] is an HTML attribute that calls [f] with an element this - attribute is added to. *) + (** [on_mount f] is an HTML attribute that calls [f] with an element this attribute is added to. *) (** {2 Low-level operations} *) - val make : (Dom.node -> state) -> t - val set : t -> Dom.node -> state - val unset : state -> unit + (* val set : t -> Dom.node -> state + val unset : state -> unit *) val combine : t -> t -> t val list : t list -> t val label : string -> t (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup#label} - [otgroup#label]}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup#label} [otgroup#label]}. *) end (** Additional element operations. *) module Elem : sig - type state = { free : (unit -> unit) option; remove : unit -> unit } + type state = { unmount : unit -> unit; mount : (Dom.node -> unit) -> unit } - type t = Dom.node -> (Dom.node -> unit) -> state + type t = Ctx.t -> Dom.node -> state (** The type for HTML elements or character data. *) + val null_state : state + val of_some : ('a -> t) -> 'a option -> t - (** [of_some to_html option] is [to_html x] if [option] is [Some x] and - [empty] otherwise. *) + (** [of_some to_html option] is [to_html x] if [option] is [Some x] and [empty] otherwise. *) val of_ok : ('a -> t) -> ('a, 'e) result -> t - (** [of_ok to_html result] is [to_html x] if [result] is [Ok x] and [empty] - otherwise. *) + (** [of_ok to_html result] is [to_html x] if [result] is [Ok x] and [empty] otherwise. *) (** {2 Low-level operations} *) val on_unmount : (unit -> unit) -> t -> t - - (** {2 List transformations} *) - - val list : ('a -> t) -> 'a list -> t - val list_indexed : (int -> 'a -> t) -> 'a list -> t val unsafe : string -> Attr.t list -> string -> t - val unmount : state -> unit end -type elem = Elem.t +type t = Elem.t (** Type alias for HTML elements. *) type attr = Attr.t @@ -102,53 +94,36 @@ val attr : string -> string -> attr (** [attr name v] is an attribute [name] with value [v]. *) val accept : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/accept} - accept}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/accept} accept}. *) val accesskey : string -> attr (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/accesskey} - accesskey}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/accesskey} accesskey}. *) val action : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form#attr-action} - action}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form#attr-action} action}. *) val autocomplete : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/autocomplete} - autocomplete}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/autocomplete} autocomplete}. *) val autofocus : bool -> attr (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autofocus} - autofocus}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/autofocus} autofocus}. *) val charset : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} charset}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} charset}. *) val checked : bool -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input#checked} - checked}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input#checked} checked}. *) val class_name : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/class} - class}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/class} class}. *) val cols : int -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-cols} - cols}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-cols} cols}. *) val content : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta#attr-content} - content}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta#attr-content} content}. *) val contenteditable : bool -> attr (** See @@ -156,68 +131,47 @@ val contenteditable : bool -> attr contenteditable}. *) val defer : bool -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/script#attr-defer} - defer}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/script#attr-defer} defer}. *) val dir : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/dir} - dir}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/dir} dir}. *) val disabled : bool -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/disabled} - disabled}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/disabled} disabled}. *) val draggable : bool -> attr (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/draggable} - draggable}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/draggable} draggable}. *) val for' : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/for} for'}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/for} for'}. *) val formaction : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button#formaction} - formaction}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button#formaction} formaction}. *) val height : int -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} height}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} height}. *) val hidden : bool -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/hidden} - hidden}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/hidden} hidden}. *) val href : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} href}. *) val id : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/id} - id}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/id} id}. *) val lang : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang} - lang}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang} lang}. *) val list : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input#attr-list} - list}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input#attr-list} list}. *) val media : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} media}. *) val method' : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form#attr-method} - method}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form#attr-method} method}. *) val name : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} name}. *) @@ -226,51 +180,36 @@ val open' : bool -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} open}. *) val placeholder : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} - placeholder}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} placeholder}. *) val rel : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel} rel}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/rel} rel}. *) val required : bool -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/required} - required}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/required} required}. *) val rows : int -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-rows} - rows}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-rows} rows}. *) val selected : bool -> attr (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option#attr-selected} - selected}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option#attr-selected} selected}. *) val spellcheck : string -> attr (** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/spellcheck} - spellcheck}. *) + {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/spellcheck} spellcheck}. *) val src : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} src}. *) val style : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/style} - style}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/style} style}. *) val tabindex : int -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/tabindex} - tabindex}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/tabindex} tabindex}. *) val title : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/title} - title}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/title} title}. *) val type' : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} type}. *) @@ -279,20 +218,17 @@ val value : string -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} value}. *) val wrap : string -> attr -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-wrap} - wrap}. *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea#attr-wrap} wrap}. *) val width : int -> attr (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes} width}. *) val class_list : string list -> attr -(** [class_list list] is similar to {!class_name} but accepts a list of class - names. *) +(** [class_list list] is similar to {!class_name} but accepts a list of class names. *) val class_flags : (string * bool) list -> attr -(** [class_flags list] is similar to {!class_list}, but can conditionally omit - class names depending on the boolean values in [list]. *) +(** [class_flags list] is similar to {!class_list}, but can conditionally omit class names depending + on the boolean values in [list]. *) val role : string -> attr val style_list : (string * string) list -> attr @@ -300,463 +236,371 @@ val value_or : string -> string option -> attr (** {2 Event attributes} *) -val on : - ?default:bool -> - ?confirm:string -> - Dom.Event.name -> - (Dom.event -> unit) -> - attr -(** [on ?default ?confirm event_name handler] register an event [handler] for an - event called [event_name]. +val on : ?default:bool -> ?confirm:string -> Dom.Event.name -> (Dom.event -> unit) -> attr +(** [on ?default ?confirm event_name handler] register an event [handler] for an event called + [event_name]. Passing [~default:false] is equivalent to calling - {{:https:// developer.mozilla.org/en-US/docs/Web/API/Event/preventDefault} - [preventDefault()]} in JavaScript. + {{:https:// developer.mozilla.org/en-US/docs/Web/API/Event/preventDefault} [preventDefault()]} + in JavaScript. - [~confirm:msg] will only run [handler] if the user comfirms a browser prompt - with message [msg]. *) + [~confirm:msg] will only run [handler] if the user comfirms a browser prompt with message [msg]. *) val on_change : ?confirm:string -> (string -> unit) -> attr (** [on_change ?confirm handler] reacts to the - {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/change_event} - [change]} event. Passes [event.target.value] to [handler] when triggered. *) + {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/change_event} [change]} event. + Passes [event.target.value] to [handler] when triggered. *) val on_checked : ?confirm:string -> (bool -> unit) -> attr (** [on_checked ?confirm handler] reacts to the - {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/change_event} - [change]} event. Passes [event.target.checked] to [handler] when - triggered. *) + {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/change_event} [change]} event. + Passes [event.target.checked] to [handler] when triggered. *) val on_input : ?confirm:string -> (string -> unit) -> attr (** [on_input ?confirm handler] reacts to the - {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/input_event} - [input]} event. Passes [event.target.value] to [handler] when triggered. *) + {{:https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/input_event} [input]} event. + Passes [event.target.value] to [handler] when triggered. *) val on_click : ?confirm:string -> (unit -> unit) -> attr (** [on_click ?confirm handler] reacts to the - {{:https://developer.mozilla.org/en-US/docs/Web/API/Element/click_event} - [click]} event. *) + {{:https://developer.mozilla.org/en-US/docs/Web/API/Element/click_event} [click]} event. *) val on_double_click : ?confirm:string -> (unit -> unit) -> attr (** [on_double_click ?confirm handler] reacts to the - {{:https://developer.mozilla.org/en-US/docs/Web/API/Element/dblclick_event} - [dblclick]} event. *) + {{:https://developer.mozilla.org/en-US/docs/Web/API/Element/dblclick_event} [dblclick]} event. *) (** {1:elem Elements} *) -val elem : string -> attr list -> elem list -> elem -(** [elem name attrs children] is an HTML element named [name] with attributes - [attr] and [children]. *) +val elem : string -> attr list -> t list -> t +(** [elem name attrs children] is an HTML element named [name] with attributes [attr] and + [children]. *) -val empty : elem -(** [empty] is an empty element that will not be rendered. *) +val null : t +(** [null] is an empty element that will not be rendered. *) -val text : string -> elem +val text : string -> t (** [text s] is character data [s]. [s] will be escaped. *) -val int : int -> elem +val int : int -> t (** [int n] is [text (string_of_int n)]. *) -val nbsp : elem +val nbsp : t (** [nbsp] is [text "\u{00A0}"]. *) -val fragment : elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/API/DocumentFragment} - [DocumentFragment]}. *) +val fragment : t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/API/DocumentFragment} [DocumentFragment]}. *) -val a : attr list -> elem list -> elem +val a : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a} a}. *) -val abbr : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/abbr} abbr}. *) +val abbr : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/abbr} abbr}. *) -val address : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/address} - address}. *) +val address : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/address} address}. *) -val area : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/area} area}. *) +val area : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/area} area}. *) -val article : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/article} - article}. *) +val article : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/article} article}. *) -val aside : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/aside} aside}. *) +val aside : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/aside} aside}. *) -val audio : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/audio} audio}. *) +val audio : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/audio} audio}. *) -val b : attr list -> elem list -> elem +val b : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/b} b}. *) -val base : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/base} base}. *) +val base : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/base} base}. *) -val bdi : attr list -> elem list -> elem +val bdi : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdi} bdi}. *) -val bdo : attr list -> elem list -> elem +val bdo : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo} bdo}. *) -val blockquote : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/blockquote} - blockquote}. *) +val blockquote : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/blockquote} blockquote}. *) -val br : attr list -> elem +val br : attr list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/br} br}. *) -val button : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button} button}. *) +val button : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button} button}. *) -val canvas : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/canvas} canvas}. *) +val canvas : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/canvas} canvas}. *) -val caption : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/caption} - caption}. *) +val caption : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/caption} caption}. *) -val cite : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/cite} cite}. *) +val cite : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/cite} cite}. *) -val code : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/code} code}. *) +val code : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/code} code}. *) -val col : attr list -> elem +val col : attr list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/col} col}. *) -val colgroup : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/colgroup} - colgroup}. *) +val colgroup : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/colgroup} colgroup}. *) -val command : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/command} - command}. *) +val command : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/command} command}. *) -val datalist : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/datalist} - datalist}. *) +val datalist : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/datalist} datalist}. *) -val dd : attr list -> elem list -> elem +val dd : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dd} dd}. *) -val del : attr list -> elem list -> elem +val del : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/del} del}. *) -val details : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details} - details}. *) +val details : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details} details}. *) -val dfn : attr list -> elem list -> elem +val dfn : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dfn} dfn}. *) -val div : attr list -> elem list -> elem +val div : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/div} div}. *) -val dl : attr list -> elem list -> elem +val dl : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dl} dl}. *) -val dt : attr list -> elem list -> elem +val dt : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dt} dt}. *) -val em : attr list -> elem list -> elem +val em : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/em} em}. *) -val embed : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/embed} embed}. *) +val embed : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/embed} embed}. *) -val fieldset : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/fieldset} - fieldset}. *) +val fieldset : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/fieldset} fieldset}. *) -val figcaption : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figcaption} - figcaption}. *) +val figcaption : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figcaption} figcaption}. *) -val figure : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figure} figure}. *) +val figure : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figure} figure}. *) -val footer : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/footer} footer}. *) +val footer : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/footer} footer}. *) -val form : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form} form}. *) +val form : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form} form}. *) -val h1 : attr list -> elem list -> elem +val h1 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h1} h1}. *) -val h2 : attr list -> elem list -> elem +val h2 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h2} h2}. *) -val h3 : attr list -> elem list -> elem +val h3 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h3} h3}. *) -val h4 : attr list -> elem list -> elem +val h4 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h4} h4}. *) -val h5 : attr list -> elem list -> elem +val h5 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h5} h5}. *) -val h6 : attr list -> elem list -> elem +val h6 : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h6} h6}. *) -val head : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/head} head}. *) +val head : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/head} head}. *) -val header : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/header} header}. *) +val header : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/header} header}. *) -val hgroup : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hgroup} hgroup}. *) +val hgroup : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hgroup} hgroup}. *) -val hr : attr list -> elem +val hr : attr list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hr} hr}. *) -(* val html : attr list -> elem list -> elem *) -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/html} html}. *) +(* val html : attr list -> t list -> t *) +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/html} html}. *) -val i : attr list -> elem list -> elem +val i : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/i} i}. *) -val iframe : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/iframe} iframe}. *) +val iframe : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/iframe} iframe}. *) -val img : attr list -> elem +val img : attr list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/img} img}. *) -val input : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input} input}. *) +val input : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input} input}. *) -val ins : attr list -> elem list -> elem +val ins : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ins} ins}. *) -val kbd : attr list -> elem list -> elem +val kbd : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/kbd} kbd}. *) -val keygen : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/keygen} keygen}. *) +val keygen : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/keygen} keygen}. *) -val label : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/label} label}. *) +val label : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/label} label}. *) -val legend : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/legend} legend}. *) +val legend : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/legend} legend}. *) -val li : attr list -> elem list -> elem +val li : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/li} li}. *) -val main : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/main} main}. *) +val main : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/main} main}. *) -val map : attr list -> elem list -> elem +val map : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/map} map}. *) -val mark : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/mark} mark}. *) +val mark : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/mark} mark}. *) -val menu : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/menu} menu}. *) +val menu : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/menu} menu}. *) -val meta : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta} meta}. *) +val meta : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta} meta}. *) -val meter : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meter} meter}. *) +val meter : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meter} meter}. *) -val nav : attr list -> elem list -> elem +val nav : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/nav} nav}. *) -val object' : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/object} object}. *) +val object' : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/object} object}. *) -val ol : attr list -> elem list -> elem +val ol : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ol} ol}. *) -val optgroup : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup} - optgroup}. *) +val optgroup : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup} optgroup}. *) -val option : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option} option}. *) +val option : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option} option}. *) -val output : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/output} output}. *) +val output : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/output} output}. *) -val p : attr list -> elem list -> elem +val p : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/p} p}. *) -val param : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/param} param}. *) +val param : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/param} param}. *) -val pre : attr list -> elem list -> elem +val pre : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/pre} pre}. *) -val progress : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/progress} - progress}. *) +val progress : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/progress} progress}. *) -val q : attr list -> elem list -> elem +val q : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/q} q}. *) -val rp : attr list -> elem list -> elem +val rp : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rp} rp}. *) -val rt : attr list -> elem list -> elem +val rt : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rt} rt}. *) -val ruby : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ruby} ruby}. *) +val ruby : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ruby} ruby}. *) -val s : attr list -> elem list -> elem +val s : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/s} s}. *) -val samp : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/samp} samp}. *) +val samp : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/samp} samp}. *) -val section : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/section} - section}. *) +val section : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/section} section}. *) -val select : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/select} select}. *) +val select : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/select} select}. *) -val small : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/small} small}. *) +val small : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/small} small}. *) -val source : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/source} source}. *) +val source : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/source} source}. *) -val span : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/span} span}. *) +val span : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/span} span}. *) -val strong : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/strong} strong}. *) +val strong : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/strong} strong}. *) -val sub : attr list -> elem list -> elem +val sub : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sub} sub}. *) -val summary : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/summary} - summary}. *) +val summary : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/summary} summary}. *) -val sup : attr list -> elem list -> elem +val sup : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sup} sup}. *) -val table : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/table} table}. *) +val table : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/table} table}. *) -val tbody : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tbody} tbody}. *) +val tbody : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tbody} tbody}. *) -val td : attr list -> elem list -> elem +val td : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/td} td}. *) -val textarea : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea} - textarea}. *) +val textarea : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea} textarea}. *) -val tfoot : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tfoot} tfoot}. *) +val tfoot : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tfoot} tfoot}. *) -val th : attr list -> elem list -> elem +val th : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/th} th}. *) -val thead : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/thead} thead}. *) +val thead : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/thead} thead}. *) -val time : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/time} time}. *) +val time : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/time} time}. *) -val tr : attr list -> elem list -> elem +val tr : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tr} tr}. *) -val track : attr list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/track} track}. *) +val track : attr list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/track} track}. *) -val u : attr list -> elem list -> elem +val u : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/u} u}. *) -val ul : attr list -> elem list -> elem +val ul : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ul} ul}. *) -val var : attr list -> elem list -> elem +val var : attr list -> t list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/var} var}. *) -val video : attr list -> elem list -> elem -(** See - {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/video} video}. *) +val video : attr list -> t list -> t +(** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/video} video}. *) -val wbr : attr list -> elem +val wbr : attr list -> t (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/wbr} wbr}. *) -val text_list : string list -> elem - -val resource : - init:(unit -> 'resource) -> - free:('resource -> unit) -> - ('resource -> elem) -> - elem +val resource : init:(unit -> 'resource) -> free:('resource -> unit) -> ('resource -> t) -> t (** {2 DOM helpers} *) -val mount : Dom.node -> elem -> unit +val mount : Dom.node -> t -> unit diff --git a/vendor/jx/src/jx/Jx.ml b/vendor/jx/src/jx/Jx.ml index 83d7a79..13ddb03 100644 --- a/vendor/jx/src/jx/Jx.ml +++ b/vendor/jx/src/jx/Jx.ml @@ -6,6 +6,7 @@ type js = Jx_ffi.t let null = Jx_ffi.null let undefined = Jx_ffi.undefined let equal = Jx_ffi.equal +let strict_equal = Jx_ffi.strict_equal let debugger = Jx_ffi.debugger let is_null v = v == null let is_undefined v = v == undefined diff --git a/vendor/jx/src/jx/Jx.mli b/vendor/jx/src/jx/Jx.mli index 51be366..0bc74ba 100644 --- a/vendor/jx/src/jx/Jx.mli +++ b/vendor/jx/src/jx/Jx.mli @@ -79,6 +79,7 @@ val instance_of : js -> constr:js -> bool (** {1 Equality} *) val equal : js -> js -> bool +val strict_equal : js -> js -> bool (** {1 Global values} *) diff --git a/vendor/stdweb/src/Stdweb.mli b/vendor/stdweb/src/Stdweb.mli index d179dbc..2bd9fd0 100644 --- a/vendor/stdweb/src/Stdweb.mli +++ b/vendor/stdweb/src/Stdweb.mli @@ -119,7 +119,7 @@ module Map : sig val make : unit -> 'a t val clear : 'a t -> unit val set : 'a t -> Jx.t -> 'a -> unit - val get : 'a t -> Jx.t -> 'a + val get : 'a t -> Jx.t -> 'a option val delete : 'a t -> Jx.t -> unit val keys : 'a t -> Jx.t Iterator.t val size : 'a t -> int diff --git a/vendor/stdweb/src/Stdweb_map.ml b/vendor/stdweb/src/Stdweb_map.ml index cbb05a8..bc746d2 100644 --- a/vendor/stdweb/src/Stdweb_map.ml +++ b/vendor/stdweb/src/Stdweb_map.ml @@ -8,7 +8,7 @@ let of_js t = t let make () = Jx.Obj.new0 t let clear t = Jx.Obj.call_js_unit t "clear" [||] let set t k v = Jx.Obj.call_js_unit t "set" [| k; Jx.Encoder.any v |] -let get t k = Jx.Decoder.any (Jx.Obj.call_js t "get" [| k |]) +let get t k = Jx.Decoder.optional Jx.Decoder.any (Jx.Obj.call_js t "get" [| k |]) let delete t k = Jx.Obj.call_js_unit t "delete" [| k |] let keys t = Jx.Obj.call_js t "keys" [||] let size t = Jx.Obj.get t "size" Jx.Decoder.int From b2f8b87c9b352d0157efe832d6015d6cf99520bf Mon Sep 17 00:00:00 2001 From: Rizo I Date: Mon, 9 Sep 2024 20:20:37 +0100 Subject: [PATCH 06/12] Improve Todomvc; formatting --- .ocamlformat | 6 +- examples/todomvc-jsoo-ml/Todomvc.ml | 188 ++++++++++------------------ examples/todomvc-jsoo-ml/Todos.ml | 45 ++++--- 3 files changed, 98 insertions(+), 141 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 3c399de..48d2133 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -11,8 +11,8 @@ break-cases = fit-or-vertical break-infix = fit-or-vertical break-collection-expressions = fit-or-vertical -break-separators = after +break-separators = before space-around-lists = true -dock-collection-brackets = true +dock-collection-brackets = false wrap-fun-args = true -indicate-multiline-delimiters = closing-on-separate-line +#indicate-multiline-delimiters = closing-on-separate-line diff --git a/examples/todomvc-jsoo-ml/Todomvc.ml b/examples/todomvc-jsoo-ml/Todomvc.ml index 3befc84..7c2df36 100644 --- a/examples/todomvc-jsoo-ml/Todomvc.ml +++ b/examples/todomvc-jsoo-ml/Todomvc.ml @@ -1,158 +1,102 @@ -open struct - module Event = Stdweb.Dom.Event - module Document = Stdweb.Dom.Document - module Node = Stdweb.Dom.Node -end - +module Event = Stdweb.Dom.Event +module Node = Stdweb.Dom.Node open Helix -open Signal.Syntax let main () = let todos = Signal.make Todos.empty in - (* let filteredTodos = - Signal.map2 - (fun todos path -> - match path with - | [ "remaining" ] -> Todos.set_filter `remaining todos - | [ "completed" ] -> Todos.set_filter `completed todos - | _ -> todos - ) - todos Helix.History.hash_path - in *) let remaining = Signal.map Todos.count_remaining todos in - let on_todo_input ev = let key = Event.key ev in let target = Event.target ev in let title = Node.get_value target in - if String.equal "Enter" key && String.length title > 0 then ( - Signal.update (Todos.add (title, false)) todos; - Node.set_value target "" - ) + Signal.update (Todos.add title) todos; + Node.set_value target "") in - let open Html in section [ class_list [ "todoapp" ] ] - [ - header + [ header [ class_list [ "header" ] ] - [ - h1 [] [ text "todos" ]; - input - [ - class_name "new-todo"; - autofocus true; - placeholder "What is to be done?"; - on Event.keydown on_todo_input; - ]; - ]; - conditional + [ h1 [] [ text "todos" ] + ; input + [ class_name "new-todo" + ; autofocus true + ; placeholder "What is to be done?" + ; on Event.keydown on_todo_input + ] + ] + ; conditional ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos) (section [ class_list [ "main" ] ] - [ - input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ]; - label [ for' "toggle-all" ] [ text "Toggle all" ]; - ul + [ input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ] + ; label [ for' "toggle-all" ] [ text "Toggle all" ] + ; ul [ class_name "todo-list" ] - [ - todos + [ todos |> Signal.map Todos.filtered - |> each (fun (title, completed) -> + |> each (fun (todo_id, { Todos.title; completed }) -> li [ class_name "todo" ] - [ - div + [ div [ class_name "view" ] - [ - input - [ - class_name "toggle"; - type' "checkbox"; - Attr.on completed (checked true); - on Event.click (fun _ -> - Signal.update (Todos.toggle title) todos - ); - ]; - label [] [ text title ]; - button - [ - class_name "destroy"; - on Event.click (fun _ -> - Signal.update (Todos.remove title) todos - ); + [ input + [ class_name "toggle" + ; type' "checkbox" + ; checked completed + ; on_click (fun () -> Signal.update (Todos.toggle todo_id) todos) + ] + ; label [] [ text title ] + ; button + [ class_name "destroy" + ; on_click (fun () -> Signal.update (Todos.remove todo_id) todos) ] - []; - ]; - ] - ); - ]; - ] - ); - footer + [] + ] + ]) + ] + ]) + ; footer [ class_name "footer" ] - [ - span + [ span [ class_name "todo-count" ] - [ - strong [] - [ - (let$ n = remaining in + [ strong [] + [ (let$ n = remaining in [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] |> String.concat " " - |> text - ); + |> text) ] - (* [ show - (fun n -> - [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] - |> String.concat " " - |> text - ) - remaining - ] *); - ]; - ul + ] + ; ul [ class_name "filters" ] - [ - li [] - [ - a - [ on Event.click (fun _ -> Signal.update (Todos.set_filter `all) todos) ] - [ text "All" ]; - ]; - li [] - [ - a - [ on Event.click (fun _ -> Signal.update (Todos.set_filter `remaining) todos) ] - [ text "Remaining" ]; - ]; - li [] - [ - a - [ on Event.click (fun _ -> Signal.update (Todos.set_filter `completed) todos) ] - [ text "Completed" ]; - ]; - ]; - conditional - ~on: - (let+ todos and+ remaining in + [ li [] + [ a [ on_click (fun () -> Signal.update (Todos.filter `all) todos) ] [ text "All" ] + ] + ; li [] + [ a + [ on_click (fun () -> Signal.update (Todos.filter `remaining) todos) ] + [ text "Remaining" ] + ] + ; li [] + [ a + [ on_click (fun () -> Signal.update (Todos.filter `completed) todos) ] + [ text "Completed" ] + ] + ] + ; button + [ class_name "clear-completed" + ; on Event.click (fun _ -> Signal.update Todos.clear todos) + ; (let@ todos and@ remaining in let len = Todos.length todos in - len > 0 && len - remaining > 0 - ) - (button - [ - class_name "clear-completed"; - on Event.click (fun _ -> Signal.update Todos.clear todos); - ] - [ text "Clear completed" ] - ); - ]; + if len > 0 && len - remaining > 0 then Attr.nop + else style_list [ ("display", "none") ]) + ] + [ text "Clear completed" ] + ] ] let () = - match Document.get_element_by_id "root" with + match Stdweb.Dom.Document.get_element_by_id "root" with | Some root -> Html.mount root (main ()) | None -> failwith "no #app" diff --git a/examples/todomvc-jsoo-ml/Todos.ml b/examples/todomvc-jsoo-ml/Todos.ml index abb3e20..0029186 100644 --- a/examples/todomvc-jsoo-ml/Todos.ml +++ b/examples/todomvc-jsoo-ml/Todos.ml @@ -1,31 +1,44 @@ -type t = { items : (string * bool) list; filter : [ `all | `completed | `remaining ] } +module Todos = Map.Make (Int) -let empty = { items = []; filter = `all } -let add todo todos = { todos with items = todo :: todos.items } -let length todos = List.length todos.items -let remove title todos = { todos with items = List.remove_assq title todos.items } +let gen_id = + let i = ref (-1) in + fun () -> + incr i; + !i -let toggle target todos = +type item = { title : string; completed : bool } +type t = { items : item Todos.t; filter : [ `all | `completed | `remaining ] } + +let empty = { items = Todos.empty; filter = `all } + +let add title todos = + { todos with items = Todos.add (gen_id ()) { title; completed = false } todos.items } + +let length todos = Todos.cardinal todos.items +let remove id todos = { todos with items = Todos.remove id todos.items } + +let toggle id todos = { todos with items = - List.map - (fun (title, completed) -> - if String.equal title target then (title, not completed) else (title, completed) - ) + Todos.update id + (function + | None -> None + | Some item -> Some { item with completed = not item.completed } + ) todos.items; } let clear todos = - { todos with items = List.filter (fun (_, completed) -> not completed) todos.items } + { todos with items = Todos.filter (fun _ { completed; _ } -> not completed) todos.items } let count_remaining todos = - List.fold_left (fun n (_, completed) -> if completed then n else n + 1) 0 todos.items + Todos.fold (fun _id { completed; _ } n -> if completed then n else n + 1) todos.items 0 -let set_filter filter todos = { todos with filter } +let filter filter todos = { todos with filter } let filtered { items; filter } = match filter with - | `all -> items - | `completed -> List.filter (fun (_, completed) -> completed) items - | `remaining -> List.filter (fun (_, completed) -> not completed) items + | `all -> Todos.to_list items + | `completed -> Todos.to_list (Todos.filter (fun _id { completed; _ } -> completed) items) + | `remaining -> Todos.to_list (Todos.filter (fun _id { completed; _ } -> not completed) items) From bdd1d589dc2d0df2658983eefa7e6848726a7fef Mon Sep 17 00:00:00 2001 From: Rizo Date: Tue, 10 Sep 2024 17:27:50 +0100 Subject: [PATCH 07/12] Improve examples --- .ocamlformat | 4 +- TODO.md | 2 + examples/7guis/Index.ml | 55 +++-- examples/7guis/index.html | 8 +- examples/composition/Index.ml | 160 ++++++------ examples/composition/index.html | 10 +- examples/demo-jsoo/Demo.ml | 182 ++++++-------- examples/todomvc-jsoo-ml/Todomvc.ml | 148 ++++++----- examples/uplot-example/Uplot.ml | 2 +- src/helix-docs/Docs.ml | 12 +- src/helix/Helix.ml | 2 +- src/helix/Helix.mli | 141 +++++------ src/helix/Router.ml | 51 ++-- src/helix/View.ml | 67 ++--- tests/test_conditional.ml | 127 +++++----- tests/test_each.ml | 370 +++++++++++++++------------- vendor/html/src/Html.ml | 43 ++-- vendor/html/src/Html.mli | 224 ++++++++--------- 18 files changed, 776 insertions(+), 832 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 48d2133..09f2b92 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -11,8 +11,8 @@ break-cases = fit-or-vertical break-infix = fit-or-vertical break-collection-expressions = fit-or-vertical -break-separators = before +break-separators = after space-around-lists = true -dock-collection-brackets = false +dock-collection-brackets = true wrap-fun-args = true #indicate-multiline-delimiters = closing-on-separate-line diff --git a/TODO.md b/TODO.md index 9a86f0c..67417c0 100644 --- a/TODO.md +++ b/TODO.md @@ -30,6 +30,8 @@ - [ ] BUG? Sharing html references leads to problems (See shared_ref) - [ ] Consider structuring each router segment as "path?opts" to allow passing extra params to intermediate views. - [ ] Unmounting should NOT free. Because remounting is acceptable. Test for this. +- [ ] Signals should have cleanup: for example, Time.timer should cleanup interval. +- [ ] Fix rendering/remounting order. See uplot example. ## shared_ref diff --git a/examples/7guis/Index.ml b/examples/7guis/Index.ml index 0491117..a2c5b4b 100644 --- a/examples/7guis/Index.ml +++ b/examples/7guis/Index.ml @@ -7,9 +7,9 @@ let ( >> ) g f x = f (g x) let view_counter () = let count = Signal.make 0 in let open Html in - fragment + fieldset [] [ - h2 [] [ text "Counter" ]; + legend [] [ h2 [] [ text "Counter" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Increment or decrement a number by 1." ]; @@ -37,9 +37,9 @@ let view_temp_conv () = Signal.emit value' signal in let open Html in - fragment + fieldset [] [ - h2 [] [ text "Temperature Converter" ]; + legend [] [ h2 [] [ text "Temperature Converter" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Bidirectional temperature converter." ]; @@ -58,21 +58,20 @@ let view_flight_booker () = let flight_type = Signal.make "oneway" in let dates = Signal.make ("2023-01-01", "2023-01-01") in let msg_signal = Signal.make "" in - let click_submit _ = + let click_submit () = let d1, d2 = Signal.get dates in let ft = Signal.get flight_type in let msg = String.concat " " - ( if String.equal ft "oneway" then [ "You have booked a one-way flight on"; d1 ] - else [ "You have booked a return flight on"; d1; "and"; d2 ] - ) + (if String.equal ft "oneway" then [ "You have booked a one-way flight on"; d1 ] + else [ "You have booked a return flight on"; d1; "and"; d2 ]) in Signal.emit msg msg_signal in let open Html in - fragment + fieldset [] [ - h2 [] [ text "Flight Booker" ]; + legend [] [ h2 [] [ text "Flight Booker" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Demonstrates constraints." ]; div [ @@ -85,10 +84,9 @@ let view_flight_booker () = select [ name "flight_type"; - on Event.change (fun ev -> + on_change (fun value -> Signal.emit "" msg_signal; - Signal.emit (Event.target ev |> Node.get_value) flight_type - ); + Signal.emit value flight_type); ] [ option [ value "oneway" ] [ text "one-way flight" ]; @@ -101,26 +99,26 @@ let view_flight_booker () = on_input (fun value -> Signal.update (fun (_, d2) -> (value, d2)) dates); toggle ~on:(fun (d1, _) -> not (is_valid_date d1)) - (style_list [ "outline" => "1px solid red" ]) - dates; + dates + (style_list [ "outline" => "1px solid red" ]); ]; input [ placeholder "YYYY-MM-DD"; value (snd (Signal.get dates)); on_input (fun value -> Signal.update (fun (d1, _) -> (d1, value)) dates); - toggle ~on:(String.equal "oneway") (disabled true) flight_type; + toggle ~on:(String.equal "oneway") flight_type (disabled true); toggle ~on:(fun ((_, d2), ft) -> String.equal "return" ft && not (is_valid_date d2)) - (style_list [ "outline" => "1px solid red" ]) - (Signal.pair dates flight_type); + (Signal.pair dates flight_type) + (style_list [ "outline" => "1px solid red" ]); ]; button [ - on Event.click click_submit; + on_click click_submit; toggle ~on:(fun (dates, ft) -> not (is_valid_book dates ft)) - (disabled true) (Signal.pair dates flight_type); + (Signal.pair dates flight_type) (disabled true); ] [ text "Book" ]; show text msg_signal; @@ -130,9 +128,9 @@ let view_flight_booker () = (* [TODO] Incomplete impl. *) let view_timer () = let open Html in - fragment + fieldset [] [ - h2 [] [ text "Timer" ]; + legend [] [ h2 [] [ text "Timer" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Concurrency." ]; div [ @@ -169,16 +167,19 @@ let view_timer () = let main () = let open Html in - div - [ class_list [ "w-full" ] ] + div [] [ h1 [] [ text "Helix 7 GUIs" ]; + blockquote [] + [ + text "See: "; + a + [ href "https://eugenkiss.github.io/7guis/tasks" ] + [ text "https://eugenkiss.github.io/7guis/tasks" ]; + ]; view_counter (); - (* hr []; *) view_temp_conv (); - (* hr []; *) view_flight_booker (); - (* hr []; *) view_timer (); ] diff --git a/examples/7guis/index.html b/examples/7guis/index.html index b3f65a0..ce7f9ad 100644 --- a/examples/7guis/index.html +++ b/examples/7guis/index.html @@ -4,12 +4,8 @@ Helix - 7 GUIs diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index d1fc66b..30a1e2a 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -1,109 +1,108 @@ module Document = Stdweb.Dom.Document open Helix -module Test_01_component = struct - let component ~label:lbl ~by () = - let state = Signal.make 0 in +module Counter = struct + let make ~label:lbl ?(init = 0) ?(by = Signal.make 1) () = + let state = Signal.make init in let html = let open Html in - div [] + div + [ style_list [ ("display", "flex"); ("gap", "5px"); ("align-items", "center") ] ] [ - span [] [ text (lbl ^ ": ") ]; - button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ]; + span + [ style_list [ ("display", "inline-block"); ("width", "100px") ] ] + [ text (lbl ^ ": ") ]; + button + [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] + [ text "-" ]; + button + [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] + [ text "+" ]; span [] [ show int state ]; - button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ]; ] in (html, state) +end +module Test_01_component = struct let make () = - let html, _ = component ~label:"counter" ~by:1 () in - Html.div [] [ Html.h2 [] [ Html.text "01 - Components" ]; html ] + let html, _ = Counter.make ~label:"counter" () in + let open Html in + fieldset [] [ legend [] [ h2 [] [ text "01. Single" ] ]; html ] end module Test_02_parallel = struct - let component ~label:lbl ~by () = - let state = Signal.make 0 in - let html = - let open Html in - div [] - [ - span [] [ text (lbl ^ ": ") ]; - button [ on_click (fun () -> Signal.update (fun n -> n - by) state) ] [ text "-" ]; - span [] [ show int state ]; - button [ on_click (fun () -> Signal.update (fun n -> n + by) state) ] [ text "+" ]; - ] - in - (html, state) - let make () = - let first, _ = component ~label:"first" ~by:1 () in - let second, _ = component ~label:"second" ~by:1 () in - Html.div [] [ Html.h2 [] [ Html.text "02 - Parallel Composition" ]; first; second ] + let first, _ = Counter.make ~label:"first" () in + let second, _ = Counter.make ~label:"second" () in + let open Html in + fieldset + [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + [ legend [] [ h2 [] [ text "02. Parallel" ] ]; first; second ] end module Test_03_sequential = struct - let component ~label:lbl ?(by = Signal.make 1) () = - let state = Signal.make 0 in - let html = - let open Html in - div [] - [ - span [] [ text (lbl ^ ": ") ]; - button - [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] - [ text "-" ]; - span [] [ show int state ]; - button - [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] - [ text "+" ]; - ] - in - (html, state) - let make () = - let first, by = component ~label:"first" () in - let second, _ = component ~label:"second" ~by () in - Html.div [] [ Html.h2 [] [ Html.text "03 - Sequential" ]; first; second ] + let first, by = Counter.make ~label:"first" () in + let second, _ = Counter.make ~label:"second" ~by () in + let open Html in + fieldset + [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + [ legend [] [ h2 [] [ text "03. Sequential" ] ]; first; second ] end module Test_04_multiplicity = struct - let component ~label:lbl ?(by = Signal.make 1) () = - let state = Signal.make 0 in - let html = - let open Html in - div [] - [ - span [] [ text (lbl ^ ": ") ]; - button - [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] - [ text "-" ]; - span [] [ show int state ]; - button - [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] - [ text "+" ]; - ] - in - (html, state) - let make () = - let counter_view, how_many = component ~label:"how many" () in - Html.div [] + let counter_view, how_many = Counter.make ~label:"how many" () in + let open Html in + fieldset + [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] [ - Html.h2 [] [ Html.text "04 - Multiplicity" ]; + legend [] [ h2 [] [ text "04. Multiplicity" ] ]; counter_view; how_many |> Signal.map (fun n -> List.init n (fun i -> string_of_int i)) - |> each (fun label -> fst (component ~label ())); + |> each (fun label -> fst (Counter.make ~label ())); + ] +end + +module Test_05_inception = struct + let make () = + let counter_view, how_many = Counter.make ~label:"how deep" () in + + let items = + how_many + |> Signal.reduce + (fun (acc, n) n' -> + let label = string_of_int n in + let delta = if n' - n > 0 then `add else `del in + match (delta, acc) with + | `add, [] -> + let html, state = Counter.make ~label () in + ([ (label, html, state) ], n') + | `add, (_, _, prev_state) :: _ -> + let html, state = Counter.make ~label ~by:prev_state () in + ((label, html, state) :: acc, n') + | `del, [] -> ([], n') + | `del, _ -> (List.tl acc, n')) + ([], Signal.get how_many) + |> Signal.map (fun (acc, _) -> List.rev acc) + in + let open Html in + fieldset + [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + [ + legend [] [ h2 [] [ text "05. Inception" ] ]; + counter_view; + each ~key:(fun (lbl, _, _) -> lbl) (fun (_, html, _) -> html) items; ] end let main () = let open Html in - div - [ class_list [ "w-full" ] ] + div [] [ - h1 [] [ text "Composition" ]; + h1 [] [ text "Component composition" ]; blockquote [] [ text "See: "; @@ -111,14 +110,15 @@ let main () = [ href "https://github.com/TyOverby/composition-comparison" ] [ text "https://github.com/TyOverby/composition-comparison" ]; ]; - hr []; - Test_01_component.make (); - hr []; - Test_02_parallel.make (); - hr []; - Test_03_sequential.make (); - hr []; - Test_04_multiplicity.make (); + section + [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "45px") ] ] + [ + Test_01_component.make (); + Test_02_parallel.make (); + Test_03_sequential.make (); + Test_04_multiplicity.make (); + Test_05_inception.make (); + ]; ] let () = diff --git a/examples/composition/index.html b/examples/composition/index.html index 1b6d419..7c21e23 100644 --- a/examples/composition/index.html +++ b/examples/composition/index.html @@ -5,15 +5,7 @@ Helix - Composition diff --git a/examples/demo-jsoo/Demo.ml b/examples/demo-jsoo/Demo.ml index 7206dea..4e07cfe 100644 --- a/examples/demo-jsoo/Demo.ml +++ b/examples/demo-jsoo/Demo.ml @@ -9,179 +9,141 @@ let view_mouse () = (* Mouse position at 60fps *) let mouse = Mouse.position () - |> Signal.sample ~on:(Time.tick ~ms:(1000 / 60)) - |> Signal.map (fun (x, y) -> - "x = " ^ string_of_float x ^ ", y = " ^ string_of_float y - ) + |> Signal.sample ~on:(Time.tick ~ms:(1000 / 10)) + |> Signal.map (fun (x, y) -> "x = " ^ string_of_float x ^ ", y = " ^ string_of_float y) in let open Html in - fragment + fieldset [] [ - h2 - [ style_list [ "font-family" => "monospace" ] ] - [ text "Mouse.position" ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Mouse.position" ] ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Render mouse position." ]; + show text mouse; + ] + +let view_visibility () = + let editing_state = Signal.make (false, "Edit me!") in + let open Html in + fieldset [] + [ + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.visible" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Render mouse position." ]; - show text mouse; + [ text "Set visibility based on signal value." ]; + button + [ on_click (fun () -> Signal.update (fun (editing, x) -> (not editing, x)) editing_state) ] + [ + show text + (Signal.map (fun (editing, text) -> if editing then "Save!" else text) editing_state); + ]; + input + [ + visible ~on:fst editing_state; + style_list [ "margin-left" => "5px" ]; + on Event.input (fun ev -> + let target = Event.target ev in + Signal.update (fun (editing, _) -> (editing, Node.get_value target)) editing_state); + ]; + ] + +let view_visibility_simple () = + let is_visible = Signal.make false in + let open Html in + fieldset [] + [ + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.visible" ] ]; + button + [ on_click (fun () -> Signal.update not is_visible) ] + [ show text (Signal.map (bool "Hide" "Show") is_visible) ]; + span [ visible ~on:Fun.id is_visible ] [ text "HELLO" ]; ] let view_timer () = - (* [TODO] pass custom equal to prevent dedup *) - (* let timer = Time.tick ~ms:333 |> Signal.const 1 |> Signal.reduce ( + ) 0 in *) + let active = Signal.make true in let timer = Time.tick ~ms:333 |> Signal.reduce (fun t () -> t + 1) 0 in + let timer = + Signal.pair timer active + |> Signal.filter_map ~seed:(Signal.get timer) (fun (t, a) -> if a then Some t else None) + in let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Time.tick" ]; - div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Render a timer." ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Time.tick" ] ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Render a timer." ]; + button [ on_click (fun () -> Signal.update not active) ] [ text "Toggle" ]; show int timer; ] let view_input_bind () = let input_signal = Signal.make "--" in let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.emit" ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.emit" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Sync input content with two elements." ]; input [ placeholder "Type something amazing..."; - on Event.input (fun ev -> - Signal.emit (ev |> Event.target |> Node.get_value) input_signal - ); + on_input (fun value -> Signal.emit value input_signal); ]; ul [] [ li [] [ show text input_signal ]; - li [] - [ show text (input_signal |> Signal.map String.uppercase_ascii) ]; + li [] [ show text (input_signal |> Signal.map String.uppercase_ascii) ]; ]; ] let view_counter () = let count = Signal.make 0 in let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "counter" ]; - div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Compute a count." ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "counter" ] ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Compute a count." ]; div [] [ - button - [ on Event.click (fun _ -> Signal.update (fun n -> n + 1) count) ] - [ text "+" ]; - button - [ on Event.click (fun _ -> Signal.update (fun n -> n - 1) count) ] - [ text "-" ]; + button [ on_click (fun () -> Signal.update (fun n -> n + 1) count) ] [ text "+" ]; + button [ on_click (fun () -> Signal.update (fun n -> n - 1) count) ] [ text "-" ]; span [ style_list [ "margin-left" => "5px" ] ] [ show int count ]; ]; ] let view_show () = let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.show" ]; - div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Render signal value with function." ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.show" ] ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "Render signal value with function." ]; div [] [ show int (Signal.make 5) ]; ] let view_toggle () = let stylish = Signal.make true in let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.toggle" ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.toggle" ] ]; + div [ style_list [ "margin-bottom" => "20px" ] ] [ text "show attributes." ]; + button [ on_click (fun () -> Signal.update not stylish) ] [ text "Style/unstyle element!" ]; div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "show attributes." ]; - button - [ on Event.click (fun _ -> Signal.update not stylish) ] - [ text "Style/unstyle element!" ]; - div - [ - toggle ~on:Fun.id - (style_list [ "background-color" => "cyan" ]) - stylish; - ] + [ toggle ~on:Fun.id stylish (style_list [ "background-color" => "cyan" ]) ] [ text "This element has show attributes!" ]; ] -let view_visibility () = - let editing_state = Signal.make (false, "Edit me!") in - let open Html in - fragment - [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.visible" ]; - div - [ style_list [ "margin-bottom" => "20px" ] ] - [ text "Set visibility based on signal value." ]; - button - [ - on Event.click (fun _ -> - Signal.update (fun (editing, x) -> (not editing, x)) editing_state - ); - ] - [ - show text - (Signal.map - (fun (editing, text) -> if editing then "Save!" else text) - editing_state - ); - ]; - input - [ - visible ~on:(Signal.map fst editing_state); - style_list [ "margin-left" => "5px" ]; - on Event.input (fun ev -> - let target = Event.target ev in - Signal.update - (fun (editing, _) -> (editing, Node.get_value target)) - editing_state - ); - ]; - ] - -let view_visibility_simple () = - let is_visible = Signal.make false in - let open Html in - fragment - [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.visible" ]; - button - [ on Event.click (fun _ -> Signal.update not is_visible) ] - [ show text (Signal.map (bool "Hide" "Show") is_visible) ]; - span [ visible ~on:is_visible ] [ text "HELLO" ]; - ] - let view_each () = let items = - Time.tick ~ms:1000 - |> Signal.map (fun () -> List.init (1 + Random.int 10) string_of_int) + Time.tick ~ms:1000 |> Signal.map (fun () -> List.init (1 + Random.int 10) string_of_int) in let open Html in - fragment + fieldset [] [ - h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.each" ]; + legend [] [ h2 [ style_list [ "font-family" => "monospace" ] ] [ text "Html.each" ] ]; div [ style_list [ "margin-bottom" => "20px" ] ] [ text "show lists." ]; ul [ style_list - [ - "outline" => "1px solid pink"; - "height" => "200px"; - "overflow-y" => "scroll"; - ]; + [ "outline" => "1px solid pink"; "height" => "200px"; "overflow-y" => "scroll" ]; ] [ li [] [ Html.text "fixed li before 1" ]; @@ -194,7 +156,7 @@ let view_each () = let main () = let open Html in div - [ class_list [ "w-full" ] ] + [ style_list [ "display" => "flex"; "flex-direction" => "column"; "gap" => "45px" ] ] [ h1 [] [ text "Helix Demo" ]; view_mouse (); diff --git a/examples/todomvc-jsoo-ml/Todomvc.ml b/examples/todomvc-jsoo-ml/Todomvc.ml index 7c2df36..31f3f7f 100644 --- a/examples/todomvc-jsoo-ml/Todomvc.ml +++ b/examples/todomvc-jsoo-ml/Todomvc.ml @@ -16,84 +16,100 @@ let main () = let open Html in section [ class_list [ "todoapp" ] ] - [ header + [ + header [ class_list [ "header" ] ] - [ h1 [] [ text "todos" ] - ; input - [ class_name "new-todo" - ; autofocus true - ; placeholder "What is to be done?" - ; on Event.keydown on_todo_input - ] + [ + h1 [] [ text "todos" ]; + input + [ + class_name "new-todo"; + autofocus true; + placeholder "What is to be done?"; + on Event.keydown on_todo_input; + ]; + ]; + section + [ class_list [ "main" ] ] + [ + input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ]; + label [ for' "toggle-all" ] [ text "Toggle all" ]; + ul + [ class_name "todo-list" ] + [ + todos + |> Signal.map Todos.filtered + |> each (fun (todo_id, { Todos.title; completed }) -> + li + [ class_name "todo" ] + [ + div + [ class_name "view" ] + [ + input + [ + class_name "toggle"; + type' "checkbox"; + checked completed; + on_click (fun () -> Signal.update (Todos.toggle todo_id) todos); + ]; + label [] [ text title ]; + button + [ + class_name "destroy"; + on_click (fun () -> Signal.update (Todos.remove todo_id) todos); + ] + []; + ]; + ]); + ]; ] - ; conditional - ~on:(Signal.map (fun todos -> Todos.length todos > 0) todos) - (section - [ class_list [ "main" ] ] - [ input [ id "toggle-all"; type' "checkbox"; class_list [ "toggle-all" ] ] - ; label [ for' "toggle-all" ] [ text "Toggle all" ] - ; ul - [ class_name "todo-list" ] - [ todos - |> Signal.map Todos.filtered - |> each (fun (todo_id, { Todos.title; completed }) -> - li - [ class_name "todo" ] - [ div - [ class_name "view" ] - [ input - [ class_name "toggle" - ; type' "checkbox" - ; checked completed - ; on_click (fun () -> Signal.update (Todos.toggle todo_id) todos) - ] - ; label [] [ text title ] - ; button - [ class_name "destroy" - ; on_click (fun () -> Signal.update (Todos.remove todo_id) todos) - ] - [] - ] - ]) - ] - ]) - ; footer + |> conditional ~on:(fun todos -> Todos.length todos > 0) todos; + footer [ class_name "footer" ] - [ span + [ + span [ class_name "todo-count" ] - [ strong [] - [ (let$ n = remaining in + [ + strong [] + [ + (let$ n = remaining in [ string_of_int n; (if n = 1 then "item" else "items"); "left" ] |> String.concat " " - |> text) - ] - ] - ; ul + |> text); + ]; + ]; + ul [ class_name "filters" ] - [ li [] - [ a [ on_click (fun () -> Signal.update (Todos.filter `all) todos) ] [ text "All" ] - ] - ; li [] - [ a + [ + li [] + [ + a [ on_click (fun () -> Signal.update (Todos.filter `all) todos) ] [ text "All" ]; + ]; + li [] + [ + a [ on_click (fun () -> Signal.update (Todos.filter `remaining) todos) ] - [ text "Remaining" ] - ] - ; li [] - [ a + [ text "Remaining" ]; + ]; + li [] + [ + a [ on_click (fun () -> Signal.update (Todos.filter `completed) todos) ] - [ text "Completed" ] - ] - ] - ; button - [ class_name "clear-completed" - ; on Event.click (fun _ -> Signal.update Todos.clear todos) - ; (let@ todos and@ remaining in + [ text "Completed" ]; + ]; + ]; + button + [ + class_name "clear-completed"; + on Event.click (fun _ -> Signal.update Todos.clear todos); + (let@ todos and@ remaining in let len = Todos.length todos in if len > 0 && len - remaining > 0 then Attr.nop - else style_list [ ("display", "none") ]) + else style_list [ ("display", "none") ]); ] - [ text "Clear completed" ] - ] + [ text "Clear completed" ]; + ]; ] let () = diff --git a/examples/uplot-example/Uplot.ml b/examples/uplot-example/Uplot.ml index 355191c..c563850 100644 --- a/examples/uplot-example/Uplot.ml +++ b/examples/uplot-example/Uplot.ml @@ -19,4 +19,4 @@ let set_size ~w ~h uplot = [ ("width", Jx.Encoder.int w); ("height", Jx.Encoder.int h) ] let mount ~options ~data uplot_ref = - Html.Attr.on_mount (fun el -> uplot_ref := Some (make ~options ~data el)) + Html.Attr.on_mount (fun node -> uplot_ref := Some (make ~options ~data node)) diff --git a/src/helix-docs/Docs.ml b/src/helix-docs/Docs.ml index b4094e0..dad996a 100644 --- a/src/helix-docs/Docs.ml +++ b/src/helix-docs/Docs.ml @@ -15,23 +15,21 @@ let view_function_docs ~signature ~description ~example ?preview ?console func_t p [] description; h3 [] [ text "Example" ]; pre [] [ code [ class_name "language-ocaml" ] [ text example ] ]; - ( match preview with + (match preview with | None -> null | Some preview -> fragment [ h3 [] [ text "Preview" ]; div [ style_list [ ("padding", "0.5em"); ("background-color", "#F0F0F0") ] ] preview; - ] - ); - ( match console with + ]); + (match console with | None -> null | Some console -> fragment [ h3 [] [ text "Console" ]; div [] [ pre [] [ code [ class_name "plaintext" ] console ] ]; - ] - ); + ]); ] module Doc = struct @@ -66,7 +64,7 @@ div [] ~preview: [ button [ on Event.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle" ]; - div [ toggle ~on:Fun.id (style_list [ ("color", "red") ]) is_visible ] [ text "HELLO" ]; + div [ toggle ~on:Fun.id is_visible (style_list [ ("color", "red") ]) ] [ text "HELLO" ]; ] end diff --git a/src/helix/Helix.ml b/src/helix/Helix.ml index d5110b7..dec7bf7 100644 --- a/src/helix/Helix.ml +++ b/src/helix/Helix.ml @@ -1,4 +1,4 @@ -type html = Html.t +type html = Html.html type attr = Html.attr type 'a signal = 'a Signal.t diff --git a/src/helix/Helix.mli b/src/helix/Helix.mli index 40fd1d9..58c980c 100644 --- a/src/helix/Helix.mli +++ b/src/helix/Helix.mli @@ -16,20 +16,15 @@ div [] [ text "Compute a count." ]; div [] [ - button - [ on_click (fun _ -> Signal.update (fun n -> n + 1) count) ] - [ text "+" ]; - button - [ on_click (fun _ -> Signal.update (fun n -> n - 1) count) ] - [ text "-" ]; + button [ on_click (fun _ -> Signal.update (fun n -> n + 1) count) ] [ text "+" ]; + button [ on_click (fun _ -> Signal.update (fun n -> n - 1) count) ] [ text "-" ]; div [ style_list [ ("font-size", "32px") ]; bind (fun n -> if n < 0 then style_list [ ("color", "red") ] - else style_list [ ("color", "blue") ] - ) + else style_list [ ("color", "blue") ]) count; ] [ show (fun n -> text (string_of_int n)) count ]; @@ -42,8 +37,8 @@ | None -> failwith "No #root element found" ]}*) -type html = Html.t -(** An alias for {!type:Html.t}. *) +type html = Html.html +(** An alias for {!type:Html.html}. *) type attr = Html.attr (** An alias for {!type:Html.attr}. *) @@ -57,18 +52,17 @@ val signal : ?equal:('a -> 'a -> bool) -> ?label:string -> 'a -> 'a signal (** {1 Reactive views} *) val show : ?label:string -> ('a -> html) -> 'a signal -> html -(** [show to_html signal] is a dynamic HTML node created from [signal] values - using [to_html]. *) +(** [show to_html signal] is a dynamic HTML node created from [signal] values using [to_html]. *) val show_some : ?label:string -> ('a -> html) -> 'a option signal -> html -(** [show_some] is similar to {!val:show}, but operates on reactive option - values. When the signal's value is [None], {!val:Html.empty} is rendered. *) +(** [show_some] is similar to {!val:show}, but operates on reactive option values. When the signal's + value is [None], {!val:Html.empty} is rendered. *) val show_ok : ?label:string -> ('a -> html) -> ('a, _) result signal -> html -(** [show_ok] is similar to {!val:show}, but operates on reactive result values. - When the signal's value is [Error _], {!val:Html.empty} is rendered. *) +(** [show_ok] is similar to {!val:show}, but operates on reactive result values. When the signal's + value is [Error _], {!val:Html.empty} is rendered. *) -val each : ('a -> html) -> 'a list signal -> html +val each : ?key:('a -> string) -> ('a -> html) -> 'a list signal -> html (** [each to_html signal] reactively renders items from [signal] with [to_html]. {[ @@ -79,8 +73,7 @@ val each : ('a -> html) -> 'a list signal -> html (** {1 Dynamic attributes} *) val bind : ('a -> Html.attr) -> 'a Signal.t -> Html.attr -(** [bind to_attr signal] is a dynamic HTML attribute created from [signal] - values using [to_attr]. +(** [bind to_attr signal] is a dynamic HTML attribute created from [signal] values using [to_attr]. {[ let style = Signal.make [ ("color", "red") ] in @@ -88,25 +81,23 @@ val bind : ('a -> Html.attr) -> 'a Signal.t -> Html.attr ]} *) val bind_some : ('a -> Html.attr) -> 'a option Signal.t -> Html.attr -(** [bind_some] is similar to {!val:bind}, but operates on reactive option - values. When the signal's value is [None], an empty attribute is produced. *) +(** [bind_some] is similar to {!val:bind}, but operates on reactive option values. When the signal's + value is [None], an empty attribute is produced. *) val bind_ok : ('a -> Html.attr) -> ('a, _) result Signal.t -> Html.attr -(** [bind_ok] is similar to {!val:bind}, but operates on reactive result values. - When the signal's value is [Error _], an empty attribute is produced. *) +(** [bind_ok] is similar to {!val:bind}, but operates on reactive result values. When the signal's + value is [Error _], an empty attribute is produced. *) -val toggle : on:('a -> bool) -> Html.attr -> 'a Signal.t -> Html.attr -(** [toggle ~on:pred attr s] is [attr] if [pred x] is [true] and - {!val:Html.empty} otherwise, where [x] is the value of [s]. *) +val toggle : on:('a -> bool) -> 'a Signal.t -> Html.attr -> Html.attr +(** [toggle ~on:pred attr s] is [attr] if [pred x] is [true] and {!val:Html.empty} otherwise, where + [x] is the value of [s]. *) -val conditional : on:bool Signal.t -> Html.t -> Html.t -(** [conditional on:signal] an attribute that shows the element if [signal] is - [true]. *) +val conditional : on:('a -> bool) -> 'a Signal.t -> Html.html -> Html.html +(** [conditional on:signal] an attribute that shows the element if [signal] is [true]. *) -val visible : on:bool Signal.t -> Html.attr -(** [visible ~on:signal] is a reactive attribute that controls the [display] - style of HTML elements. When [signal] is [false] this attribute is - [display: none]. *) +val visible : on:('a -> bool) -> 'a Signal.t -> Html.attr +(** [visible ~on:signal] is a reactive attribute that controls the [display] style of HTML elements. + When [signal] is [false] this attribute is [display: none]. *) module Mouse : sig (** Mouse signals. *) @@ -125,11 +116,9 @@ module Http : sig type error = | Fetch_error of Jx.t (** An error occurred during fetch request. *) - | Unsuccessful of Stdweb.Fetch.Response.t - (** A non-200 response from the server. *) + | Unsuccessful of Stdweb.Fetch.Response.t (** A non-200 response from the server. *) | Decoding_error of exn (** Error when decoding payload. *) - | Handling_error of exn - (** Error when handling successful response payload. *) + | Handling_error of exn (** Error when handling successful response payload. *) val string_of_error : error -> string @@ -279,8 +268,8 @@ end - upstream variable-to-hash update *) module Router : sig type t - (** Represents the current routing state and can be used to create links and - dispatch routes to views. *) + (** Represents the current routing state and can be used to create links and dispatch routes to + views. *) val make : ?prefix:string list signal -> string list signal -> t (** [make path_signal] is a router scope given the current path. *) @@ -289,8 +278,7 @@ module Router : sig (** Assigns a path to a view to be rendered on match. *) type 'a var - (** Variables found in routing paths. For exmaple, ["/users/:int"] contains a - int variable. *) + (** Variables found in routing paths. For exmaple, ["/users/:int"] contains a int variable. *) val var : of_string:(string -> 'a option) -> @@ -311,16 +299,15 @@ module Router : sig {{:https://developer.mozilla.org/en-US/docs/Web/API/URLSearchParams/URLSearchParams} [query parameters]} (e.g. [name=ferret&count=purple]). *) - (** Represents paths that can be used to (1) dispatch routing state to views, - and (2) to generate dynamic links. + (** Represents paths that can be used to (1) dispatch routing state to views, and (2) to generate + dynamic links. - A path is either a constatn segment, a variable or a special wildcard - "rest" segment. Constant segments are matched verbatim, variable segments - will capture a typed value from the path and dispatch it to the view - function and, finally, rest segments represent nested router scopes. + A path is either a constatn segment, a variable or a special wildcard "rest" segment. Constant + segments are matched verbatim, variable segments will capture a typed value from the path and + dispatch it to the view function and, finally, rest segments represent nested router scopes. - Note: path types with type [('a, 'a, 'a) path] represent static paths, - i.e., complete paths without variables. *) + Note: path types with type [('a, 'a, 'a) path] represent static paths, i.e., complete paths + without variables. *) type ('view, 'link, 'a) path = | Const : string * ('view, 'link, 'a) path -> ('view, 'link, 'a) path | Var : @@ -339,40 +326,34 @@ module Router : sig t -> ('view, 'link, Html.attr) path -> 'link - (** [link ?absolute ?up ?active ?exact ?alias router path vars...] is an HTML - [href] attribute that binds a link described by [path] and any [vars] - contained in it (or none, if it's a const only path). A link relative to - [router] will be created (with the level adjusted by [up]), unless - [absolute] is [true], in which case the [router] is ignored. + (** [link ?absolute ?up ?active ?exact ?alias router path vars...] is an HTML [href] attribute + that binds a link described by [path] and any [vars] contained in it (or none, if it's a const + only path). A link relative to [router] will be created (with the level adjusted by [up]), + unless [absolute] is [true], in which case the [router] is ignored. - If [active] attribute is provided, in addition to binding [href], [active] - will be bound in case the current path is active, otherwise [inactive] is - bound (if provided). + If [active] attribute is provided, in addition to binding [href], [active] will be bound in + case the current path is active, otherwise [inactive] is bound (if provided). - By default, a path is considered active if it is a prefix of the current - path. If [exact] is [true], the path is only considered active when it is - equal to the current path. Additionally, the path is considered active if - it is equal to [alias]. *) + By default, a path is considered active if it is a prefix of the current path. If [exact] is + [true], the path is only considered active when it is equal to the current path. Additionally, + the path is considered active if it is equal to [alias]. *) val route : ('view, 'link, html) path -> 'view -> route (** Create a route by assigning a path to a view. *) val alias : (unit -> 'a, 'a, 'a) path -> ('view, 'link, route) path -> 'link - (** [alias src dst vars...] creates a route by aliasing a static [src] path to - a [dst] path that may contain [vars]. The [dst] path is always interpreted - as a relative path. + (** [alias src dst vars...] creates a route by aliasing a static [src] path to a [dst] path that + may contain [vars]. The [dst] path is always interpreted as a relative path. - Note: an alias route does not automatically update the location in the - browser. *) + Note: an alias route does not automatically update the location in the browser. *) val go : ?absolute:bool -> ?up:int -> t -> (_, 'link, unit) path -> 'link - (** [go ?absolute ?up path vars...] navigates to [path] by updating browser's - hash, which will trigger a routing event. *) + (** [go ?absolute ?up path vars...] navigates to [path] by updating browser's hash, which will + trigger a routing event. *) val dispatch : ?label:string -> ?default:html -> t -> route list -> html - (** [dispatch router routes] the current routing state described by [router] - to [routes] rendering a view that matches the current path. If no matches - are found, render [default]. *) + (** [dispatch router routes] the current routing state described by [router] to [routes] rendering + a view that matches the current path. If no matches are found, render [default]. *) val prefix : t -> string list signal (** The prefix of this, potentially nested, router. *) @@ -386,8 +367,7 @@ end (** {1 Syntax} - [let] operators are provided to simplify rendering signals to HTML: [(let$)] - and [(and$)]. + [let] operators are provided to simplify rendering signals to HTML: [(let$)] and [(and$)]. Example: @@ -407,12 +387,7 @@ end show (fun (user_id, todo_title) -> let open Html in - div [] - [ - h2 [] [ text "User id: "; text user_id ]; - h3 [] [ text "Todo: "; todo_title ]; - ] - ) + div [] [ h2 [] [ text "User id: "; text user_id ]; h3 [] [ text "Todo: "; todo_title ] ]) (Signal.pair user_id todo_title) ]} @@ -428,14 +403,12 @@ val ( and@ ) : 'a signal -> 'b signal -> ('a * 'b) signal val enable_debug : bool -> unit (** Set to [true] to activate visual debugging details. - If enabled, all reactive elements will be annoated with rendering details. - The following format is used: - [show:{elem_count}/{elem_label?}#{update_count}], where: + If enabled, all reactive elements will be annoated with rendering details. The following format + is used: [show:{elem_count}/{elem_label?}#{update_count}], where: - [{elem_count}] is the sequential count assigned to each [show] element; - [{elem_label}] is the optional user-provided label for the [show] element; - - [{update_count}] is the sequential count of re-renders of the same [show] - element. + - [{update_count}] is the sequential count of re-renders of the same [show] element. Note that the [update_count] is, in practice, the number of signal emits. diff --git a/src/helix/Router.ml b/src/helix/Router.ml index 5f1c759..d4278fe 100644 --- a/src/helix/Router.ml +++ b/src/helix/Router.ml @@ -19,8 +19,7 @@ open struct | p0 :: p' -> ( match l with | l0 :: l' when equal p0 l0 -> list_starts_with ~equal ~prefix:p' l' - | _ -> false - ) + | _ -> false) end type 'a var = { @@ -44,8 +43,7 @@ let query = of_string = (fun str -> Some (Stdweb.Url_search_params.of_string str)); equal = (fun x1 x2 -> - String.equal (Stdweb.Url_search_params.to_string x1) (Stdweb.Url_search_params.to_string x2) - ); + String.equal (Stdweb.Url_search_params.to_string x1) (Stdweb.Url_search_params.to_string x2)); } type t = { prefix : string list signal; rest : string list signal } @@ -59,7 +57,7 @@ type ('view, 'link, 'a) path = | End : (unit -> 'a, 'a, 'a) path type route = - | Route : ('view, 'link, Html.t) path * 'view -> route + | Route : ('view, 'link, Html.html) path * 'view -> route | Alias : (unit -> 'a, 'a, 'a) path * string list -> route type lookup = { route : route; matched : string list; args : string list } @@ -148,11 +146,9 @@ module Table = struct (* If we have a backtracking continuation, try that before failing. *) match bt with | None -> Error (Incomplete_match input0) - | Some bt -> bt () - ) + | Some bt -> bt ()) | Match route -> Ok { route; matched = List.rev matched; args = List.rev args } - | Partial route -> Ok { route; matched = List.rev matched; args = List.rev args } - ) + | Partial route -> Ok { route; matched = List.rev matched; args = List.rev args }) | input_hd :: input' -> ( let bt () = match node.capture with @@ -160,16 +156,14 @@ module Table = struct | _ -> ( match String_map.find_opt ":" node.children with | Some node' -> loop node' input' (input_hd :: matched) (input_hd :: args) - | None -> Error (No_match input0) - ) + | None -> Error (No_match input0)) in (* Follow Const. If not defined, check for Rest and Var. In addition to checking this now, we create a "backtracking" continuation that might attempt the Rest/Var match if Const fails. *) match String_map.find_opt input_hd node.children with | Some node' -> loop ~bt node' input' (input_hd :: matched) args - | None -> bt () - ) + | None -> bt ()) in loop table0 input0 [] [] @@ -218,16 +212,14 @@ let go ?(absolute = false) ?(up = 0) (router : t) path = eval_path (fun str_path -> let prefix = if absolute then [] else go_up up (Signal.get router.prefix) in - location_set_path (prefix @ str_path) - ) + location_set_path (prefix @ str_path)) path let pick_qpath segments = List.map (function | Either.Left const -> const - | Right var_sig -> Signal.get var_sig - ) + | Right var_sig -> Signal.get var_sig) segments let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.nop) ?(inactive = Html.Attr.nop) @@ -256,8 +248,7 @@ let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.nop) ?(inactive = Ht else List.equal String.equal p1 p2 && List.equal String.equal s1 s2 - && List.equal String.equal r1 r2 - ) + && List.equal String.equal r1 r2) |> View.bind (fun ((link_prefix, link_suffix), rest) -> let path_str = String.concat "/" (("#" :: link_prefix) @ link_suffix) in let href_attr = Html.href path_str in @@ -266,9 +257,7 @@ let link ?(absolute = false) ?(up = 0) ?(active = Html.Attr.nop) ?(inactive = Ht else if check_is_active link_suffix rest then active else inactive in - Html.Attr.combine href_attr user_attr - ) - ) + Html.Attr.combine href_attr user_attr)) path0 type emits = { @@ -294,9 +283,9 @@ let apply emits ~prefix:absprefix0 ~matched ~args:args0 = string list -> _ list -> (string, string signal) Either.t list -> - (view, link, Html.t) path -> + (view, link, Html.html) path -> view -> - (Html.t * (string, string signal) Either.t list, string) result = + (Html.html * (string, string signal) Either.t list, string) result = fun args args_emits rev_qualified_path path view -> match (path, args) with | Rest, _ -> @@ -359,7 +348,7 @@ let render_lookup_error ~prefix ?alias ~label ~default err = (* TODO: must be lazy initialized similar to View.show. *) (* TODO: improve exn context logging. *) -let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.t = +let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.html = fun parent insert -> let label = match label with @@ -372,8 +361,7 @@ let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.t = ~equal:(fun res1 res2 -> match (res1, res2) with | Ok { route = r1; _ }, Ok { route = r2; _ } -> r1 == r2 - | _ -> false - ) + | _ -> false) lookup_sig in (* Do we need to clean up emits in unmount? *) @@ -417,8 +405,7 @@ let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.t = html | Error err -> Html.text (label ^ ": " ^ err) end - | Error err -> render_lookup_error ~prefix ~label ~default err - ) + | Error err -> render_lookup_error ~prefix ~label ~default err) lookup_route_sig in let unsub = @@ -437,11 +424,9 @@ let dispatch_table ?label ?default ({ prefix; rest } : t) table : Html.t = arg_emit ~notify arg; loop arg_emits' args' in - loop emits.emit_args args0 - ) + loop emits.emit_args args0) | Ok ({ route = Alias _; _ } : lookup) -> () - | Error _ -> () - ) + | Error _ -> ()) lookup_sig in let html' = Html.Elem.on_unmount unsub html in diff --git a/src/helix/View.ml b/src/helix/View.ml index 1d46742..79cccc5 100644 --- a/src/helix/View.ml +++ b/src/helix/View.ml @@ -62,7 +62,7 @@ let real_debug_html = html; ] -let debug_html : (int -> string -> Html.t -> Html.t) ref = ref fake_debug_html +let debug_html : (int -> string -> Html.html -> Html.html) ref = ref fake_debug_html let enable_debug flag = debug_html := if flag then real_debug_html else fake_debug_html let gen_show_id = @@ -73,13 +73,12 @@ let gen_show_id = [ "show:"; string_of_int !i; - ( match label with + (match label with | None -> "" - | Some x -> "/" ^ x - ); + | Some x -> "/" ^ x); ] -let show ?label (to_html : 'a -> Html.t) signal : Html.t = +let show ?label (to_html : 'a -> Html.html) signal : Html.html = fun ctx parent -> let count = ref 0 in let comment_data = gen_show_id label in @@ -101,8 +100,7 @@ let show ?label (to_html : 'a -> Html.t) signal : Html.t = let next_state = html this_ctx parent in !curr_state.unmount (); next_state.mount insert; - curr_state := next_state - ) + curr_state := next_state) signal in Html.Ctx.on_cleanup this_ctx unsub; @@ -123,16 +121,14 @@ let show_some ?label to_html opt_signal = show ?label (function | None -> Html.null - | Some x -> to_html x - ) + | Some x -> to_html x) opt_signal let show_ok ?label to_html res_signal = show ?label (function | Error _ -> Html.null - | Ok x -> to_html x - ) + | Ok x -> to_html x) res_signal (* Conditional *) @@ -143,9 +139,8 @@ let gen_conditional_id = incr i; "conditional:" ^ string_of_int !i -(* [TODO] on should be a pred fn. *) -let conditional ~on:active_sig html : Html.t = - show ~label:"conditional" (fun active -> if active then html else Html.null) active_sig +let conditional ~on:pred signal html : Html.html = + show ~label:"conditional" (fun x -> if pred x then html else Html.null) signal (* Each *) @@ -204,8 +199,7 @@ end = struct |> Iterator.iter (fun (slots : slots) -> let states = Map.values slots in Iterator.iter (fun (s : Html.Elem.state) -> s.unmount ()) states; - Map.clear slots - ) + Map.clear slots) end let gen_each_id = @@ -214,7 +208,9 @@ let gen_each_id = incr i; "each:" ^ string_of_int !i -let each (to_html : 'a -> Html.t) items_signal : Html.t = +external default_key : 'a -> string = "%identity" + +let each ?key:(to_key = default_key) (to_html : 'a -> Html.html) items_signal : Html.html = fun ctx parent -> let anchor = Comment.make (gen_each_id ()) in let frag = Fragment.make () in @@ -226,10 +222,10 @@ let each (to_html : 'a -> Html.t) items_signal : Html.t = let next_cache = Each_cache.make () in List.iteri (fun j item -> - let key = Each_cache.key item in + let key = Each_cache.key (to_key item) in match Each_cache.get !curr_cache ~key with | None -> - let html : Html.t = to_html item in + let html : Html.html = to_html item in let state = html this_ctx parent in state.mount (Node.append_child ~parent:frag); Each_cache.add_slot next_cache ~key j state @@ -237,13 +233,11 @@ let each (to_html : 'a -> Html.t) items_signal : Html.t = let i, i_state = Each_cache.get_first_slot old_slots in i_state.mount (Node.append_child ~parent:frag); Each_cache.del_slot !curr_cache ~key old_slots i; - Each_cache.add_slot next_cache ~key j i_state - ) + Each_cache.add_slot next_cache ~key j i_state) new_items; Each_cache.clear !curr_cache; Node.insert_after ~parent ~reference:anchor frag; - curr_cache := next_cache - ) + curr_cache := next_cache) items_signal in Html.Ctx.on_cleanup this_ctx unsub; @@ -252,12 +246,11 @@ let each (to_html : 'a -> Html.t) items_signal : Html.t = let items = Signal.get items_signal in List.iteri (fun i item -> - let html : Html.t = to_html item in + let html : Html.html = to_html item in let state = html this_ctx parent in state.mount (Node.append_child ~parent:frag); let key = Each_cache.key item in - Each_cache.add_slot !curr_cache ~key i state - ) + Each_cache.add_slot !curr_cache ~key i state) items; Node.insert_after ~parent ~reference:anchor frag; Html.Ctx.link ctx this_ctx @@ -280,8 +273,7 @@ let bind to_attr signal ctx node = let next_attr : Html.attr = to_attr x in let next_state = next_attr ctx node in next_state.set (); - curr_state := next_state - ) + curr_state := next_state) signal in Html.Ctx.on_cleanup ctx unsub; @@ -298,31 +290,28 @@ let bind_some to_attr opt_signal = bind (function | None -> Html.Attr.nop - | Some x -> to_attr x - ) + | Some x -> to_attr x) opt_signal let bind_ok to_attr res_signal = bind (function | Error _ -> Html.Attr.nop - | Ok x -> to_attr x - ) + | Ok x -> to_attr x) res_signal (* Toggle *) -let toggle' ~on:active_sig attr : Html.attr = +let toggle ~on:pred signal attr : Html.attr = fun ctx node -> - let active_sig = Signal.uniq ~equal:( == ) active_sig in + let active_sig = Signal.uniq ~equal:( == ) (Signal.map pred signal) in let state : Html.Attr.state = attr ctx node in let is_active = ref false in let unsub = Signal.use' (fun active -> if active then state.set () else state.unset (); - is_active := active - ) + is_active := active) active_sig in Html.Ctx.on_cleanup ctx unsub; @@ -333,9 +322,7 @@ let toggle' ~on:active_sig attr : Html.attr = let unset () = if !is_active then state.unset () in { Html.Attr.set; unset } -let toggle ~on:pred attr s = toggle' ~on:(Signal.map pred s) attr - (* Visible *) -let visible ~on:cond : Html.Attr.t = - toggle' ~on:(Signal.map not cond) (Html.style_list [ ("display", "none") ]) +let visible ~on:pred signal : Html.Attr.t = + toggle ~on:(fun x -> not (pred x)) signal (Html.style_list [ ("display", "none") ]) diff --git a/tests/test_conditional.ml b/tests/test_conditional.ml index efa58a8..e41ebf0 100644 --- a/tests/test_conditional.ml +++ b/tests/test_conditional.ml @@ -4,16 +4,18 @@ open Helix let test_simple () = let open Html in div [] - [ conditional ~on:(Signal.make true) (div [] [ text "present" ]) - ; conditional ~on:(Signal.make false) (footer [] [ text "missing" ]) + [ + conditional ~on:Fun.id (Signal.make true) (div [] [ text "present" ]); + conditional ~on:Fun.id (Signal.make false) (footer [] [ text "missing" ]); ] let test_toggle_simple () = let is_present = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not is_present) ] [ text "Toggle present" ] - ; ul [] [ li [] [ conditional ~on:is_present (span [] [ text "HELLO" ]) ] ] + [ + button [ on Ev.click (fun _ -> Signal.update not is_present) ] [ text "Toggle present" ]; + ul [] [ li [] [ conditional ~on:Fun.id is_present (span [] [ text "HELLO" ]) ] ]; ] let test_toggle_siblings () = @@ -21,67 +23,76 @@ let test_toggle_siblings () = let bye = Signal.make false in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not hello) ] [ text "Toggle HELLO" ] - ; button [ on Ev.click (fun _ -> Signal.update not bye) ] [ text "Toggle BYE" ] - ; button - [ on Ev.click (fun _ -> + [ + button [ on Ev.click (fun _ -> Signal.update not hello) ] [ text "Toggle HELLO" ]; + button [ on Ev.click (fun _ -> Signal.update not bye) ] [ text "Toggle BYE" ]; + button + [ + on Ev.click (fun _ -> Signal.update not hello; - Signal.update not bye - ) - ] - [ text "Toggle BOTH" ] - ; ul [] - [ li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] - ] - ; ul [] - [ li [] [ span [] [ text "before 1" ] ] - ; li [] [ span [] [ text "before 2" ] ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO" ]) ] - ; li [] [ span [] [ text "after 1" ] ] - ; li [] [ span [] [ text "after 2" ] ] - ] - ; ul [] - [ li [] [ span [] [ text "before 1" ] ] - ; li [] [ span [] [ text "before 2" ] ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] - ; li [] [ span [] [ text "after 1" ] ] - ; li [] [ span [] [ text "after 2" ] ] - ] - ; ul [] - [ li [] [ span [] [ text "before 1" ] ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] - ] - ; ul [] - [ li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] - ; li [] [ span [] [ text "after 1" ] ] - ] - ; ul [] - [ li [] [ conditional ~on:hello (span [] [ text "HELLO" ]) ] - ; li [] [ conditional ~on:bye (span [] [ text "BYE" ]) ] - ] - ; ul [] - [ li [] [ span [] [ text "before 1" ] ] - ; li [] [ conditional ~on:bye (span [] [ text "BYE 1" ]) ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 1" ]) ] - ; li [] [ conditional ~on:hello (span [] [ text "HELLO 2" ]) ] - ; li [] [ conditional ~on:bye (span [] [ text "BYE 2" ]) ] - ; li [] [ span [] [ text "after 1" ] ] + Signal.update not bye); ] + [ text "Toggle BOTH" ]; + ul [] + [ + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 1" ]) ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 2" ]) ]; + ]; + ul [] + [ + li [] [ span [] [ text "before 1" ] ]; + li [] [ span [] [ text "before 2" ] ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO" ]) ]; + li [] [ span [] [ text "after 1" ] ]; + li [] [ span [] [ text "after 2" ] ]; + ]; + ul [] + [ + li [] [ span [] [ text "before 1" ] ]; + li [] [ span [] [ text "before 2" ] ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 1" ]) ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 2" ]) ]; + li [] [ span [] [ text "after 1" ] ]; + li [] [ span [] [ text "after 2" ] ]; + ]; + ul [] + [ + li [] [ span [] [ text "before 1" ] ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 1" ]) ]; + ]; + ul [] + [ + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 1" ]) ]; + li [] [ span [] [ text "after 1" ] ]; + ]; + ul [] + [ + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO" ]) ]; + li [] [ conditional ~on:Fun.id bye (span [] [ text "BYE" ]) ]; + ]; + ul [] + [ + li [] [ span [] [ text "before 1" ] ]; + li [] [ conditional ~on:Fun.id bye (span [] [ text "BYE 1" ]) ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 1" ]) ]; + li [] [ conditional ~on:Fun.id hello (span [] [ text "HELLO 2" ]) ]; + li [] [ conditional ~on:Fun.id bye (span [] [ text "BYE 2" ]) ]; + li [] [ span [] [ text "after 1" ] ]; + ]; ] let main () = let open Html in div [] - [ h2 [] [ text "test_simple" ] - ; test_simple () - ; hr [] - ; h2 [] [ text "test_togglsimple" ] - ; test_toggle_simple () - ; hr [] - ; h2 [] [ text "test_toggle_siblings" ] - ; test_toggle_siblings () + [ + h2 [] [ text "test_simple" ]; + test_simple (); + hr []; + h2 [] [ text "test_togglsimple" ]; + test_toggle_simple (); + hr []; + h2 [] [ text "test_toggle_siblings" ]; + test_toggle_siblings (); ] let () = diff --git a/tests/test_each.ml b/tests/test_each.ml index bc18abc..79751cb 100644 --- a/tests/test_each.ml +++ b/tests/test_each.ml @@ -15,12 +15,14 @@ let test_swap_1 () = let flag = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] let test_swap_2 () = @@ -29,12 +31,14 @@ let test_swap_2 () = let flag = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] let test_swap_3 () = @@ -43,12 +47,14 @@ let test_swap_3 () = let flag = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] let test_swap_4 () = @@ -57,12 +63,14 @@ let test_swap_4 () = let flag = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] let test_swap_5 () = @@ -71,12 +79,14 @@ let test_swap_5 () = let flag = Signal.make true in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] let test_swap_6 () = @@ -85,25 +95,26 @@ let test_swap_6 () = let l1 = [ "same" ] in let l2 = "new" :: l1 in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] + |> each (fun item -> li [] [ text item ]); + ]; ] -let to_string x = Jx.Fun.call1 (Jx.global "toString") ~return:Jx.Decoder.string Jx.Encoder.any x - let test_swap_7 () = let flag = Signal.make true in let open Html in let l1 = [ input [ placeholder "same" ] ] in let l2 = input [ placeholder "new" ] :: l1 in div [] - [ button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ] - ; ul [] - [ flag |> Signal.map (fun b -> if b then l1 else l2) |> each (fun item -> li [] [ item ]) ] + [ + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap" ]; + ul [] + [ flag |> Signal.map (fun b -> if b then l1 else l2) |> each (fun item -> li [] [ item ]) ]; ] let test_append () = @@ -111,35 +122,36 @@ let test_append () = let items = Signal.make [] in let open Html in div [] - [ button - [ on Ev.click (fun _ -> + [ + button + [ + on Ev.click (fun _ -> Signal.update (fun items -> incr n; - List.append items [ !n ] - ) - items - ) + List.append items [ !n ]) + items); ] - [ text "Add" ] - ; button - [ on Ev.click (fun _ -> + [ text "Add" ]; + button + [ + on Ev.click (fun _ -> n := -1; - Signal.emit [] items - ) + Signal.emit [] items); ] - [ text "Clear" ] - ; ul [] [ items |> each (fun item -> li [] [ int item ]) ] + [ text "Clear" ]; + ul [] [ items |> each (fun item -> li [] [ int item ]) ]; ] let test_append_same () = let items = Signal.make [ 0 ] in let open Html in div [] - [ button + [ + button [ on Ev.click (fun _ -> Signal.update (fun items -> List.append items [ 0 ]) items) ] - [ text "Add" ] - ; ul [] [ items |> each (fun item -> li [] [ int item ]) ] + [ text "Add" ]; + ul [] [ items |> each (fun item -> li [] [ int item ]) ]; ] let test_conditional_1 () = @@ -149,15 +161,16 @@ let test_conditional_1 () = let l2 = [ "b"; "d"; "e" ] in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ] - ; button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ] - ; conditional ~on:is_visible + [ + button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ]; + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ]; + conditional ~on:Fun.id is_visible (ul [] - [ flag + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] - ) + |> each (fun item -> li [] [ text item ]); + ]); ] let test_conditional_2 () = @@ -167,15 +180,16 @@ let test_conditional_2 () = let l2 = [ "b"; "d"; "e" ] in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ] - ; button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ] - ; conditional ~on:is_visible + [ + button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle show" ]; + button [ on Ev.click (fun _ -> Signal.update not flag) ] [ text "Swap list" ]; + conditional ~on:Fun.id is_visible (ul [] - [ flag + [ + flag |> Signal.map (fun b -> if b then l1 else l2) - |> each (fun item -> li [] [ text item ]) - ] - ) + |> each (fun item -> li [] [ text item ]); + ]); ] let test_conditional_3 () = @@ -183,14 +197,15 @@ let test_conditional_3 () = let items = Signal.make [ "a"; "b"; "X"; "c" ] in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle X" ] - ; ul [] - [ items + [ + button [ on Ev.click (fun _ -> Signal.update not is_visible) ] [ text "Toggle X" ]; + ul [] + [ + items |> each (fun item -> - if item = "X" then conditional ~on:is_visible (li [] [ text item ]) - else li [] [ text item ] - ) - ] + if item = "X" then conditional ~on:Fun.id is_visible (li [] [ text item ]) + else li [] [ text item ]); + ]; ] let test_show_1 () = @@ -200,17 +215,18 @@ let test_show_1 () = let items = Signal.make [ `a; `b; `c ] in let open Html in div [] - [ button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ] - ; button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ] - ; button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ] - ; ul [] - [ items + [ + button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ]; + button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ]; + button [ on Ev.click (fun _ -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ]; + ul [] + [ + items |> each (function | `a -> show (fun n -> li [] [ text "a: "; int n ]) count_a | `b -> show (fun n -> li [] [ text "b: "; int n ]) count_b - | `c -> show (fun n -> li [] [ text "c: "; int n ]) count_c - ) - ] + | `c -> show (fun n -> li [] [ text "c: "; int n ]) count_c); + ]; ] let test_show_2 () = @@ -220,126 +236,134 @@ let test_show_2 () = let items = Signal.make [ "a"; "b"; "c" ] in let open Html in div [] - [ button - [ on_click (fun () -> + [ + button + [ + on_click (fun () -> Signal.update (fun xs -> if List.length xs = 3 then [ "a"; "c" ] else [ "a"; "b"; "c" ]) - items - ) + items); ] - [ text "Toggle b" ] - ; br [] - ; button [ on_click (fun () -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ] - ; button [ on_click (fun () -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ] - ; button [ on_click (fun () -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ] - ; ul [] - [ items + [ text "Toggle b" ]; + br []; + button [ on_click (fun () -> Signal.update (( + ) 1) count_a) ] [ text "Increment a" ]; + button [ on_click (fun () -> Signal.update (( + ) 1) count_b) ] [ text "Increment b" ]; + button [ on_click (fun () -> Signal.update (( + ) 1) count_c) ] [ text "Increment c" ]; + ul [] + [ + items |> each (function | "a" -> show (fun n -> li [] [ text "a: "; int n ]) count_a | "b" -> show ~label:"b" (fun n -> li [] [ text "b: "; int n ]) count_b | "c" -> show (fun n -> li [] [ text "c: "; int n ]) count_c - | _ -> assert false - ) - ] + | _ -> assert false); + ]; ] let test_random () = let items = Signal.make (List.init 7 string_of_int) in let open Html in div [] - [ button + [ + button [ on Ev.click (fun _ -> Signal.emit (List.init (1 + Random.int 10) string_of_int) items) ] - [ text "Generate" ] - ; ul [] [ items |> each (fun item -> li [] [ text item ]) ] + [ text "Generate" ]; + ul [] [ items |> each (fun item -> li [] [ text item ]) ]; ] let test_interleave () = let items = Signal.make (List.init 7 string_of_int) in let open Html in div [] - [ button + [ + button [ on Ev.click (fun _ -> Signal.emit (List.init (1 + Random.int 10) string_of_int) items) ] - [ text "Generate" ] - ; div + [ text "Generate" ]; + div [ style_list [ ("display", "flex"); ("flex-direction", "row") ] ] - [ ul [] - [ li [] [ Html.text "before 1" ]; each (fun item -> li [] [ Html.text item ]) items ] - ; ul [] [ each (fun item -> li [] [ Html.text item ]) items; li [] [ Html.text "after 1" ] ] - ; ul [] - [ li [] [ Html.text "before 1" ] - ; each (fun item -> li [] [ Html.text item ]) items - ; li [] [ Html.text "after 1" ] - ] - ; ul [] - [ li [] [ Html.text "before 1" ] - ; each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items - ; each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items - ; li [] [ Html.text "after 1" ] - ] - ; ul [] - [ each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items - ; li [] [ Html.text "middle 1" ] - ; each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items - ; li [] [ Html.text "after 1" ] - ] - ] + [ + ul [] + [ li [] [ Html.text "before 1" ]; each (fun item -> li [] [ Html.text item ]) items ]; + ul [] [ each (fun item -> li [] [ Html.text item ]) items; li [] [ Html.text "after 1" ] ]; + ul [] + [ + li [] [ Html.text "before 1" ]; + each (fun item -> li [] [ Html.text item ]) items; + li [] [ Html.text "after 1" ]; + ]; + ul [] + [ + li [] [ Html.text "before 1" ]; + each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items; + each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items; + li [] [ Html.text "after 1" ]; + ]; + ul [] + [ + each (fun item -> li [] [ Html.text ("1: " ^ item) ]) items; + li [] [ Html.text "middle 1" ]; + each (fun item -> li [] [ Html.text ("2: " ^ item) ]) items; + li [] [ Html.text "after 1" ]; + ]; + ]; ] let main () = let open Html in div [] - [ h2 [] [ text "simple" ] - ; test_simple () - ; hr [] - ; h2 [] [ text "simple_same" ] - ; test_simple_same () - ; hr [] - ; h2 [] [ text "swap_1" ] - ; test_swap_1 () - ; hr [] - ; h2 [] [ text "swap_2" ] - ; test_swap_2 () - ; hr [] - ; h2 [] [ text "swap_3" ] - ; test_swap_3 () - ; hr [] - ; h2 [] [ text "swap_4" ] - ; test_swap_4 () - ; hr [] - ; h2 [] [ text "swap_5" ] - ; test_swap_5 () - ; hr [] - ; h2 [] [ text "swap_6" ] - ; test_swap_6 () - ; hr [] - ; h2 [] [ text "swap_7" ] - ; test_swap_7 () - ; hr [] - ; h2 [] [ text "conditional_1" ] - ; test_conditional_1 () - ; hr [] - ; h2 [] [ text "conditional_2" ] - ; test_conditional_2 () - ; hr [] - ; h2 [] [ text "conditional_3" ] - ; test_conditional_3 () - ; hr [] - ; h2 [] [ text "show_1" ] - ; test_show_1 () - ; hr [] - ; h2 [] [ text "show_2" ] - ; test_show_2 () - ; hr [] - ; h2 [] [ text "append" ] - ; test_append () - ; h2 [] [ text "append_same" ] - ; test_append_same () - ; hr [] - ; h2 [] [ text "random" ] - ; test_random () - ; hr [] - ; h2 [] [ text "interleave" ] - ; test_interleave () + [ + h2 [] [ text "simple" ]; + test_simple (); + hr []; + h2 [] [ text "simple_same" ]; + test_simple_same (); + hr []; + h2 [] [ text "swap_1" ]; + test_swap_1 (); + hr []; + h2 [] [ text "swap_2" ]; + test_swap_2 (); + hr []; + h2 [] [ text "swap_3" ]; + test_swap_3 (); + hr []; + h2 [] [ text "swap_4" ]; + test_swap_4 (); + hr []; + h2 [] [ text "swap_5" ]; + test_swap_5 (); + hr []; + h2 [] [ text "swap_6" ]; + test_swap_6 (); + hr []; + h2 [] [ text "swap_7" ]; + test_swap_7 (); + hr []; + h2 [] [ text "conditional_1" ]; + test_conditional_1 (); + hr []; + h2 [] [ text "conditional_2" ]; + test_conditional_2 (); + hr []; + h2 [] [ text "conditional_3" ]; + test_conditional_3 (); + hr []; + h2 [] [ text "show_1" ]; + test_show_1 (); + hr []; + h2 [] [ text "show_2" ]; + test_show_2 (); + hr []; + h2 [] [ text "append" ]; + test_append (); + h2 [] [ text "append_same" ]; + test_append_same (); + hr []; + h2 [] [ text "random" ]; + test_random (); + hr []; + h2 [] [ text "interleave" ]; + test_interleave (); ] let () = diff --git a/vendor/html/src/Html.ml b/vendor/html/src/Html.ml index a51c911..1742929 100644 --- a/vendor/html/src/Html.ml +++ b/vendor/html/src/Html.ml @@ -169,18 +169,15 @@ let on ?(default = true) ?confirm (name : Dom.Event.name) f _ctx node = let on_change ?confirm handler = on ~default:false ?confirm Dom.Event.change (fun ev -> - handler (Dom.Node.get_value (Dom.Event.target ev)) - ) + handler (Dom.Node.get_value (Dom.Event.target ev))) let on_checked ?confirm handler = on ~default:false ?confirm Dom.Event.change (fun ev -> - handler (Dom.Node.get_checked (Dom.Event.target ev)) - ) + handler (Dom.Node.get_checked (Dom.Event.target ev))) let on_input ?confirm handler = on ~default:false ?confirm Dom.Event.input (fun ev -> - handler (Dom.Node.get_value (Dom.Event.target ev)) - ) + handler (Dom.Node.get_value (Dom.Event.target ev))) let on_click ?confirm handler = on ~default:false ?confirm Dom.Event.click (fun _ -> handler ()) @@ -228,24 +225,24 @@ module Elem = struct List.iter (fun (attr : Attr.t) -> let state = attr ctx node in - state.set () - ) + state.set ()) attrs; let node_insert = Dom.Node.append_child ~parent:node in List.iter (fun (child : t) -> let child_state = child ctx node in - child_state.mount node_insert - ) + child_state.mount node_insert) children; - { unmount = (fun () -> Dom.Node.remove_child ~parent node) - ; mount = (fun insert -> insert node) + { + unmount = (fun () -> Dom.Node.remove_child ~parent node); + mount = (fun insert -> insert node); } let text data _ctx parent = let node = Dom.Document.create_text_node data in - { unmount = (fun () -> Dom.Node.remove_child ~parent node) - ; mount = (fun insert -> insert node) + { + unmount = (fun () -> Dom.Node.remove_child ~parent node); + mount = (fun insert -> insert node); } let of_some to_html option = @@ -268,11 +265,11 @@ module Elem = struct List.iter (fun (attr : Attr.t) -> let state = attr ctx node in - state.set () - ) + state.set ()) attrs; - { unmount = (fun () -> Dom.Node.remove_child ~parent node) - ; mount = (fun insert -> insert node) + { + unmount = (fun () -> Dom.Node.remove_child ~parent node); + mount = (fun insert -> insert node); } let fragment children ctx parent = @@ -283,16 +280,16 @@ module Elem = struct (fun (child : t) -> let s = child ctx parent in s.mount frag_insert; - s - ) + s) children in - { unmount = (fun () -> List.iter (fun (s : state) -> s.unmount ()) states) - ; mount = (fun insert -> insert frag) + { + unmount = (fun () -> List.iter (fun (s : state) -> s.unmount ()) states); + mount = (fun insert -> insert frag); } end -type t = Elem.t +type html = Elem.t let elem = Elem.make let text = Elem.text diff --git a/vendor/html/src/Html.mli b/vendor/html/src/Html.mli index 2cb7ac9..3df9351 100644 --- a/vendor/html/src/Html.mli +++ b/vendor/html/src/Html.mli @@ -84,7 +84,7 @@ module Elem : sig val unsafe : string -> Attr.t list -> string -> t end -type t = Elem.t +type html = Elem.t (** Type alias for HTML elements. *) type attr = Attr.t @@ -271,336 +271,336 @@ val on_double_click : ?confirm:string -> (unit -> unit) -> attr (** {1:elem Elements} *) -val elem : string -> attr list -> t list -> t +val elem : string -> attr list -> html list -> html (** [elem name attrs children] is an HTML element named [name] with attributes [attr] and [children]. *) -val null : t +val null : html (** [null] is an empty element that will not be rendered. *) -val text : string -> t +val text : string -> html (** [text s] is character data [s]. [s] will be escaped. *) -val int : int -> t +val int : int -> html (** [int n] is [text (string_of_int n)]. *) -val nbsp : t +val nbsp : html (** [nbsp] is [text "\u{00A0}"]. *) -val fragment : t list -> t +val fragment : html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/API/DocumentFragment} [DocumentFragment]}. *) -val a : attr list -> t list -> t +val a : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a} a}. *) -val abbr : attr list -> t list -> t +val abbr : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/abbr} abbr}. *) -val address : attr list -> t list -> t +val address : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/address} address}. *) -val area : attr list -> t +val area : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/area} area}. *) -val article : attr list -> t list -> t +val article : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/article} article}. *) -val aside : attr list -> t list -> t +val aside : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/aside} aside}. *) -val audio : attr list -> t list -> t +val audio : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/audio} audio}. *) -val b : attr list -> t list -> t +val b : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/b} b}. *) -val base : attr list -> t +val base : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/base} base}. *) -val bdi : attr list -> t list -> t +val bdi : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdi} bdi}. *) -val bdo : attr list -> t list -> t +val bdo : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo} bdo}. *) -val blockquote : attr list -> t list -> t +val blockquote : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/blockquote} blockquote}. *) -val br : attr list -> t +val br : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/br} br}. *) -val button : attr list -> t list -> t +val button : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/button} button}. *) -val canvas : attr list -> t list -> t +val canvas : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/canvas} canvas}. *) -val caption : attr list -> t list -> t +val caption : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/caption} caption}. *) -val cite : attr list -> t list -> t +val cite : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/cite} cite}. *) -val code : attr list -> t list -> t +val code : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/code} code}. *) -val col : attr list -> t +val col : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/col} col}. *) -val colgroup : attr list -> t list -> t +val colgroup : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/colgroup} colgroup}. *) -val command : attr list -> t list -> t +val command : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/command} command}. *) -val datalist : attr list -> t list -> t +val datalist : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/datalist} datalist}. *) -val dd : attr list -> t list -> t +val dd : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dd} dd}. *) -val del : attr list -> t list -> t +val del : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/del} del}. *) -val details : attr list -> t list -> t +val details : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details} details}. *) -val dfn : attr list -> t list -> t +val dfn : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dfn} dfn}. *) -val div : attr list -> t list -> t +val div : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/div} div}. *) -val dl : attr list -> t list -> t +val dl : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dl} dl}. *) -val dt : attr list -> t list -> t +val dt : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dt} dt}. *) -val em : attr list -> t list -> t +val em : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/em} em}. *) -val embed : attr list -> t +val embed : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/embed} embed}. *) -val fieldset : attr list -> t list -> t +val fieldset : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/fieldset} fieldset}. *) -val figcaption : attr list -> t list -> t +val figcaption : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figcaption} figcaption}. *) -val figure : attr list -> t list -> t +val figure : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/figure} figure}. *) -val footer : attr list -> t list -> t +val footer : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/footer} footer}. *) -val form : attr list -> t list -> t +val form : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/form} form}. *) -val h1 : attr list -> t list -> t +val h1 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h1} h1}. *) -val h2 : attr list -> t list -> t +val h2 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h2} h2}. *) -val h3 : attr list -> t list -> t +val h3 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h3} h3}. *) -val h4 : attr list -> t list -> t +val h4 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h4} h4}. *) -val h5 : attr list -> t list -> t +val h5 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h5} h5}. *) -val h6 : attr list -> t list -> t +val h6 : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/h6} h6}. *) -val head : attr list -> t list -> t +val head : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/head} head}. *) -val header : attr list -> t list -> t +val header : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/header} header}. *) -val hgroup : attr list -> t list -> t +val hgroup : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hgroup} hgroup}. *) -val hr : attr list -> t +val hr : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/hr} hr}. *) -(* val html : attr list -> t list -> t *) +(* val html : attr list -> html list -> html *) (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/html} html}. *) -val i : attr list -> t list -> t +val i : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/i} i}. *) -val iframe : attr list -> t list -> t +val iframe : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/iframe} iframe}. *) -val img : attr list -> t +val img : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/img} img}. *) -val input : attr list -> t +val input : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input} input}. *) -val ins : attr list -> t list -> t +val ins : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ins} ins}. *) -val kbd : attr list -> t list -> t +val kbd : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/kbd} kbd}. *) -val keygen : attr list -> t list -> t +val keygen : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/keygen} keygen}. *) -val label : attr list -> t list -> t +val label : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/label} label}. *) -val legend : attr list -> t list -> t +val legend : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/legend} legend}. *) -val li : attr list -> t list -> t +val li : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/li} li}. *) -val main : attr list -> t list -> t +val main : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/main} main}. *) -val map : attr list -> t list -> t +val map : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/map} map}. *) -val mark : attr list -> t list -> t +val mark : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/mark} mark}. *) -val menu : attr list -> t list -> t +val menu : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/menu} menu}. *) -val meta : attr list -> t +val meta : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta} meta}. *) -val meter : attr list -> t list -> t +val meter : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meter} meter}. *) -val nav : attr list -> t list -> t +val nav : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/nav} nav}. *) -val object' : attr list -> t list -> t +val object' : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/object} object}. *) -val ol : attr list -> t list -> t +val ol : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ol} ol}. *) -val optgroup : attr list -> t list -> t +val optgroup : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/optgroup} optgroup}. *) -val option : attr list -> t list -> t +val option : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/option} option}. *) -val output : attr list -> t list -> t +val output : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/output} output}. *) -val p : attr list -> t list -> t +val p : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/p} p}. *) -val param : attr list -> t +val param : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/param} param}. *) -val pre : attr list -> t list -> t +val pre : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/pre} pre}. *) -val progress : attr list -> t list -> t +val progress : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/progress} progress}. *) -val q : attr list -> t list -> t +val q : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/q} q}. *) -val rp : attr list -> t list -> t +val rp : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rp} rp}. *) -val rt : attr list -> t list -> t +val rt : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/rt} rt}. *) -val ruby : attr list -> t list -> t +val ruby : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ruby} ruby}. *) -val s : attr list -> t list -> t +val s : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/s} s}. *) -val samp : attr list -> t list -> t +val samp : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/samp} samp}. *) -val section : attr list -> t list -> t +val section : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/section} section}. *) -val select : attr list -> t list -> t +val select : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/select} select}. *) -val small : attr list -> t list -> t +val small : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/small} small}. *) -val source : attr list -> t +val source : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/source} source}. *) -val span : attr list -> t list -> t +val span : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/span} span}. *) -val strong : attr list -> t list -> t +val strong : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/strong} strong}. *) -val sub : attr list -> t list -> t +val sub : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sub} sub}. *) -val summary : attr list -> t list -> t +val summary : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/summary} summary}. *) -val sup : attr list -> t list -> t +val sup : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/sup} sup}. *) -val table : attr list -> t list -> t +val table : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/table} table}. *) -val tbody : attr list -> t list -> t +val tbody : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tbody} tbody}. *) -val td : attr list -> t list -> t +val td : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/td} td}. *) -val textarea : attr list -> t list -> t +val textarea : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/textarea} textarea}. *) -val tfoot : attr list -> t list -> t +val tfoot : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tfoot} tfoot}. *) -val th : attr list -> t list -> t +val th : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/th} th}. *) -val thead : attr list -> t list -> t +val thead : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/thead} thead}. *) -val time : attr list -> t list -> t +val time : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/time} time}. *) -val tr : attr list -> t list -> t +val tr : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/tr} tr}. *) -val track : attr list -> t +val track : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/track} track}. *) -val u : attr list -> t list -> t +val u : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/u} u}. *) -val ul : attr list -> t list -> t +val ul : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/ul} ul}. *) -val var : attr list -> t list -> t +val var : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/var} var}. *) -val video : attr list -> t list -> t +val video : attr list -> html list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/video} video}. *) -val wbr : attr list -> t +val wbr : attr list -> html (** See {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/wbr} wbr}. *) -val resource : init:(unit -> 'resource) -> free:('resource -> unit) -> ('resource -> t) -> t +val resource : init:(unit -> 'a) -> free:('a -> unit) -> ('a -> html) -> html (** {2 DOM helpers} *) -val mount : Dom.node -> t -> unit +val mount : Dom.node -> html -> unit From f9046f6a4063748d4c85e7316b9955a30d7c3cbc Mon Sep 17 00:00:00 2001 From: Rizo Date: Tue, 10 Sep 2024 17:43:54 +0100 Subject: [PATCH 08/12] Refactor composition example --- examples/composition/Index.ml | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index 30a1e2a..bdf3faf 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -70,24 +70,29 @@ module Test_05_inception = struct let make () = let counter_view, how_many = Counter.make ~label:"how deep" () in + (* Compute add/delete deltas from the counter signal *) + let deltas = + Signal.reduce (fun (n, _) n' -> (n', n' - n > 0)) (Signal.get how_many, false) how_many + in + let items = - how_many + deltas |> Signal.reduce - (fun (acc, n) n' -> + (fun acc (n, delta) -> let label = string_of_int n in - let delta = if n' - n > 0 then `add else `del in match (delta, acc) with - | `add, [] -> + | true, [] -> let html, state = Counter.make ~label () in - ([ (label, html, state) ], n') - | `add, (_, _, prev_state) :: _ -> + [ (label, html, state) ] + | true, (_, _, prev_state) :: _ -> let html, state = Counter.make ~label ~by:prev_state () in - ((label, html, state) :: acc, n') - | `del, [] -> ([], n') - | `del, _ -> (List.tl acc, n')) - ([], Signal.get how_many) - |> Signal.map (fun (acc, _) -> List.rev acc) + (label, html, state) :: acc + | false, [] -> [] + | false, _ -> List.tl acc) + [] + |> Signal.map (fun acc -> List.rev acc) in + let open Html in fieldset [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] From 04d6aab719896ad6ac6e7922a91d331462931141 Mon Sep 17 00:00:00 2001 From: Rizo I Date: Thu, 12 Sep 2024 21:09:21 +0100 Subject: [PATCH 09/12] Update --- examples/composition/Index.ml | 35 +++++++++++++++++---------------- examples/composition/index.html | 2 +- examples/demo-jsoo/Demo.ml | 8 +++++++- src/helix/Time.ml | 2 +- vendor/stdweb/src/Stdweb.mli | 2 +- vendor/stdweb/src/Stdweb_dom.ml | 4 ++-- 6 files changed, 30 insertions(+), 23 deletions(-) diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index bdf3faf..ac2269e 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -1,24 +1,21 @@ -module Document = Stdweb.Dom.Document open Helix module Counter = struct - let make ~label:lbl ?(init = 0) ?(by = Signal.make 1) () = - let state = Signal.make init in + let make ~label:lbl ?(by = Signal.make 1) () = + let state = Signal.make 0 in let html = let open Html in div - [ style_list [ ("display", "flex"); ("gap", "5px"); ("align-items", "center") ] ] + [ style "display: flex; gap: 5px; align-items: center" ] [ - span - [ style_list [ ("display", "inline-block"); ("width", "100px") ] ] - [ text (lbl ^ ": ") ]; + span [ style "display: inline-block; width: 10ex" ] [ text lbl ]; button [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] [ text "-" ]; button [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] [ text "+" ]; - span [] [ show int state ]; + span [ toggle ~on:(fun n -> n < 0) state (style "color: magenta") ] [ show int state ]; ] in (html, state) @@ -37,7 +34,7 @@ module Test_02_parallel = struct let second, _ = Counter.make ~label:"second" () in let open Html in fieldset - [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + [ style "display: flex; flex-direction: column; gap: 5px" ] [ legend [] [ h2 [] [ text "02. Parallel" ] ]; first; second ] end @@ -53,15 +50,17 @@ end module Test_04_multiplicity = struct let make () = - let counter_view, how_many = Counter.make ~label:"how many" () in + let count_html, how_many = Counter.make ~label:"how many" () in let open Html in fieldset [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] [ legend [] [ h2 [] [ text "04. Multiplicity" ] ]; - counter_view; + count_html; how_many + |> Signal.map (fun n -> if n < 0 then 0 else n) |> Signal.map (fun n -> List.init n (fun i -> string_of_int i)) + |> Signal.tap (fun xs -> Jx.log (String.concat ", " xs)) |> each (fun label -> fst (Counter.make ~label ())); ] end @@ -74,6 +73,7 @@ module Test_05_inception = struct let deltas = Signal.reduce (fun (n, _) n' -> (n', n' - n > 0)) (Signal.get how_many, false) how_many in + Signal.sub Jx.log deltas; let items = deltas @@ -105,7 +105,8 @@ end let main () = let open Html in - div [] + div + [ style "min-height: 1000px" ] [ h1 [] [ text "Component composition" ]; blockquote [] @@ -118,15 +119,15 @@ let main () = section [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "45px") ] ] [ - Test_01_component.make (); - Test_02_parallel.make (); - Test_03_sequential.make (); - Test_04_multiplicity.make (); + (* Test_01_component.make (); *) + (* Test_02_parallel.make (); *) + (* Test_03_sequential.make (); *) + (* Test_04_multiplicity.make (); *) Test_05_inception.make (); ]; ] let () = - match Document.get_element_by_id "root" with + match Stdweb.Dom.Document.get_element_by_id "root" with | Some root -> Html.mount root (main ()) | None -> failwith "No #root element found" diff --git a/examples/composition/index.html b/examples/composition/index.html index 7c21e23..4b5b803 100644 --- a/examples/composition/index.html +++ b/examples/composition/index.html @@ -5,7 +5,7 @@ Helix - Composition diff --git a/examples/demo-jsoo/Demo.ml b/examples/demo-jsoo/Demo.ml index 4e07cfe..4576b32 100644 --- a/examples/demo-jsoo/Demo.ml +++ b/examples/demo-jsoo/Demo.ml @@ -57,7 +57,7 @@ let view_visibility_simple () = span [ visible ~on:Fun.id is_visible ] [ text "HELLO" ]; ] -let view_timer () = +let view_timer_ () = let active = Signal.make true in let timer = Time.tick ~ms:333 |> Signal.reduce (fun t () -> t + 1) 0 in let timer = @@ -73,6 +73,12 @@ let view_timer () = show int timer; ] +let view_timer () = + let count = Signal.make 0 in + let init () = Window.set_interval (fun () -> Signal.update (( + ) 1) count) 1000 in + let free = Window.clear_timeout in + Html.resource ~init ~free (fun _ -> Html.h1 [] [ show Html.int count ]) + let view_input_bind () = let input_signal = Signal.make "--" in let open Html in diff --git a/src/helix/Time.ml b/src/helix/Time.ml index 0ae4742..dd49a49 100644 --- a/src/helix/Time.ml +++ b/src/helix/Time.ml @@ -2,5 +2,5 @@ module Window = Stdweb.Dom.Window let tick ~ms = let s = Signal.make ~equal:(fun _ _ -> false) () in - Window.set_interval (fun () -> Signal.emit () s) ms; + let _ = Window.set_interval (fun () -> Signal.emit () s) ms in s diff --git a/vendor/stdweb/src/Stdweb.mli b/vendor/stdweb/src/Stdweb.mli index 2bd9fd0..ab4f0b5 100644 --- a/vendor/stdweb/src/Stdweb.mli +++ b/vendor/stdweb/src/Stdweb.mli @@ -479,7 +479,7 @@ module Dom : sig val this : t val location : Location.t - val set_interval : (unit -> unit) -> int -> unit + val set_interval : (unit -> unit) -> int -> int val set_timeout : (unit -> unit) -> int -> int val clear_timeout : int -> unit val confirm : string -> bool diff --git a/vendor/stdweb/src/Stdweb_dom.ml b/vendor/stdweb/src/Stdweb_dom.ml index a502156..557a5a5 100644 --- a/vendor/stdweb/src/Stdweb_dom.ml +++ b/vendor/stdweb/src/Stdweb_dom.ml @@ -361,8 +361,8 @@ module Window = struct let location = Jx.Obj.get this "location" Jx.Decoder.js let set_interval f ms = - Jx.Obj.call_js_unit Global.window "setInterval" - [| Jx.Encoder.fun1 f; Jx.Encoder.int ms |] + Jx.Obj.call2 Global.window "setInterval" ~return:Jx.Decoder.int + Jx.Encoder.fun1 Jx.Encoder.int f ms let set_timeout f ms = Jx.Obj.call2 Global.window "setTimeout" ~return:Jx.Decoder.int From 4878a264d84105022e6227c619dd2d0154c921c1 Mon Sep 17 00:00:00 2001 From: Rizo I Date: Sun, 15 Sep 2024 20:21:48 +0200 Subject: [PATCH 10/12] Update --- examples/composition/Index.ml | 37 ++++++++++++--------------------- examples/composition/index.html | 23 ++++++++++++++++++++ 2 files changed, 36 insertions(+), 24 deletions(-) diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index ac2269e..f8dc866 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -5,17 +5,16 @@ module Counter = struct let state = Signal.make 0 in let html = let open Html in - div - [ style "display: flex; gap: 5px; align-items: center" ] + div [] [ - span [ style "display: inline-block; width: 10ex" ] [ text lbl ]; + span [] [ text lbl ]; button [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] [ text "-" ]; button [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] [ text "+" ]; - span [ toggle ~on:(fun n -> n < 0) state (style "color: magenta") ] [ show int state ]; + span [] [ show int state ]; ] in (html, state) @@ -33,9 +32,7 @@ module Test_02_parallel = struct let first, _ = Counter.make ~label:"first" () in let second, _ = Counter.make ~label:"second" () in let open Html in - fieldset - [ style "display: flex; flex-direction: column; gap: 5px" ] - [ legend [] [ h2 [] [ text "02. Parallel" ] ]; first; second ] + fieldset [] [ legend [] [ h2 [] [ text "02. Parallel" ] ]; first; second ] end module Test_03_sequential = struct @@ -43,24 +40,19 @@ module Test_03_sequential = struct let first, by = Counter.make ~label:"first" () in let second, _ = Counter.make ~label:"second" ~by () in let open Html in - fieldset - [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] - [ legend [] [ h2 [] [ text "03. Sequential" ] ]; first; second ] + fieldset [] [ legend [] [ h2 [] [ text "03. Sequential" ] ]; first; second ] end module Test_04_multiplicity = struct let make () = let count_html, how_many = Counter.make ~label:"how many" () in let open Html in - fieldset - [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + fieldset [] [ legend [] [ h2 [] [ text "04. Multiplicity" ] ]; count_html; how_many - |> Signal.map (fun n -> if n < 0 then 0 else n) |> Signal.map (fun n -> List.init n (fun i -> string_of_int i)) - |> Signal.tap (fun xs -> Jx.log (String.concat ", " xs)) |> each (fun label -> fst (Counter.make ~label ())); ] end @@ -73,7 +65,6 @@ module Test_05_inception = struct let deltas = Signal.reduce (fun (n, _) n' -> (n', n' - n > 0)) (Signal.get how_many, false) how_many in - Signal.sub Jx.log deltas; let items = deltas @@ -94,8 +85,7 @@ module Test_05_inception = struct in let open Html in - fieldset - [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "5px") ] ] + fieldset [] [ legend [] [ h2 [] [ text "05. Inception" ] ]; counter_view; @@ -105,8 +95,7 @@ end let main () = let open Html in - div - [ style "min-height: 1000px" ] + div [] [ h1 [] [ text "Component composition" ]; blockquote [] @@ -117,12 +106,12 @@ let main () = [ text "https://github.com/TyOverby/composition-comparison" ]; ]; section - [ style_list [ ("display", "flex"); ("flex-direction", "column"); ("gap", "45px") ] ] + [ id "main" ] [ - (* Test_01_component.make (); *) - (* Test_02_parallel.make (); *) - (* Test_03_sequential.make (); *) - (* Test_04_multiplicity.make (); *) + Test_01_component.make (); + Test_02_parallel.make (); + Test_03_sequential.make (); + Test_04_multiplicity.make (); Test_05_inception.make (); ]; ] diff --git a/examples/composition/index.html b/examples/composition/index.html index 4b5b803..c943f97 100644 --- a/examples/composition/index.html +++ b/examples/composition/index.html @@ -7,6 +7,29 @@ body { font-family: sans-serif; } + blockquote { + font-size: 8pt; + } + #main { + display: flex; + flex-direction: column; + gap: 45px; + padding-bottom: 200px; + } + #main fieldset { + display: flex; + flex-direction: column; + gap: 5px; + } + #main fieldset > div { + display: flex; + gap: 5px; + align-items: center; + } + #main fieldset div > span { + display: inline-block; + width: 10ex; + } From 28d5f4c249315bb0dc55c8e76c8677606f2ba9f6 Mon Sep 17 00:00:00 2001 From: Rizo I Date: Sun, 15 Sep 2024 20:31:04 +0200 Subject: [PATCH 11/12] Update --- examples/composition/Index.ml | 42 ++++++++++++++++----------------- examples/composition/index.html | 3 +++ 2 files changed, 24 insertions(+), 21 deletions(-) diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index f8dc866..f0313d8 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -1,51 +1,51 @@ open Helix module Counter = struct - let make ~label:lbl ?(by = Signal.make 1) () = - let state = Signal.make 0 in + let make ?(by = Signal.make 1) lbl = + let count = Signal.make 0 in let html = let open Html in div [] [ span [] [ text lbl ]; button - [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) state) ] + [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) count) ] [ text "-" ]; button - [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) state) ] + [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) count) ] [ text "+" ]; - span [] [ show int state ]; + span [] [ show int count ]; ] in - (html, state) + (html, count) end module Test_01_component = struct let make () = - let html, _ = Counter.make ~label:"counter" () in + let html, _ = Counter.make "counter" in let open Html in fieldset [] [ legend [] [ h2 [] [ text "01. Single" ] ]; html ] end module Test_02_parallel = struct let make () = - let first, _ = Counter.make ~label:"first" () in - let second, _ = Counter.make ~label:"second" () in + let first, _ = Counter.make "first" in + let second, _ = Counter.make "second" in let open Html in fieldset [] [ legend [] [ h2 [] [ text "02. Parallel" ] ]; first; second ] end module Test_03_sequential = struct let make () = - let first, by = Counter.make ~label:"first" () in - let second, _ = Counter.make ~label:"second" ~by () in + let first, by = Counter.make "first" in + let second, _ = Counter.make ~by "second" in let open Html in fieldset [] [ legend [] [ h2 [] [ text "03. Sequential" ] ]; first; second ] end module Test_04_multiplicity = struct let make () = - let count_html, how_many = Counter.make ~label:"how many" () in + let count_html, how_many = Counter.make "how many" in let open Html in fieldset [] [ @@ -53,13 +53,13 @@ module Test_04_multiplicity = struct count_html; how_many |> Signal.map (fun n -> List.init n (fun i -> string_of_int i)) - |> each (fun label -> fst (Counter.make ~label ())); + |> each (fun label -> fst (Counter.make label)); ] end module Test_05_inception = struct let make () = - let counter_view, how_many = Counter.make ~label:"how deep" () in + let counter_view, how_many = Counter.make "how deep" in (* Compute add/delete deltas from the counter signal *) let deltas = @@ -73,10 +73,10 @@ module Test_05_inception = struct let label = string_of_int n in match (delta, acc) with | true, [] -> - let html, state = Counter.make ~label () in + let html, state = Counter.make label in [ (label, html, state) ] | true, (_, _, prev_state) :: _ -> - let html, state = Counter.make ~label ~by:prev_state () in + let html, state = Counter.make ~by:prev_state label in (label, html, state) :: acc | false, [] -> [] | false, _ -> List.tl acc) @@ -97,7 +97,7 @@ let main () = let open Html in div [] [ - h1 [] [ text "Component composition" ]; + h1 [] [ text "Composition demo" ]; blockquote [] [ text "See: "; @@ -109,10 +109,10 @@ let main () = [ id "main" ] [ Test_01_component.make (); - Test_02_parallel.make (); - Test_03_sequential.make (); - Test_04_multiplicity.make (); - Test_05_inception.make (); + (* Test_02_parallel.make (); *) + (* Test_03_sequential.make (); *) + (* Test_04_multiplicity.make (); *) + (* Test_05_inception.make (); *) ]; ] diff --git a/examples/composition/index.html b/examples/composition/index.html index c943f97..a7952e1 100644 --- a/examples/composition/index.html +++ b/examples/composition/index.html @@ -10,6 +10,9 @@ blockquote { font-size: 8pt; } + button { + width: 3ex; + } #main { display: flex; flex-direction: column; From 49ca98f7b99b244c71c621b8cd158c74e03b1607 Mon Sep 17 00:00:00 2001 From: Rizo I Date: Mon, 16 Sep 2024 10:06:50 +0200 Subject: [PATCH 12/12] Update --- examples/composition/Counter.ml | 21 +++++++++++++++++++++ examples/composition/Index.ml | 31 +++++-------------------------- examples/composition/index.html | 6 +++--- 3 files changed, 29 insertions(+), 29 deletions(-) create mode 100644 examples/composition/Counter.ml diff --git a/examples/composition/Counter.ml b/examples/composition/Counter.ml new file mode 100644 index 0000000..7bf41fa --- /dev/null +++ b/examples/composition/Counter.ml @@ -0,0 +1,21 @@ +open Helix + +let make ?(by = Signal.make 1) lbl = + let count = Signal.make 0 in + + let html = + let open Html in + div [] + [ + span [] [ text lbl ]; + button [ on_click (fun () -> Signal.emit 0 count) ] [ text "Reset" ]; + button + [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) count) ] + [ text "−" ]; + button + [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) count) ] + [ text "+" ]; + span [] [ show int count ]; + ] + in + (html, count) diff --git a/examples/composition/Index.ml b/examples/composition/Index.ml index f0313d8..bc7f8a2 100644 --- a/examples/composition/Index.ml +++ b/examples/composition/Index.ml @@ -1,25 +1,5 @@ open Helix -module Counter = struct - let make ?(by = Signal.make 1) lbl = - let count = Signal.make 0 in - let html = - let open Html in - div [] - [ - span [] [ text lbl ]; - button - [ on_click (fun () -> Signal.update (fun n -> n - Signal.get by) count) ] - [ text "-" ]; - button - [ on_click (fun () -> Signal.update (fun n -> n + Signal.get by) count) ] - [ text "+" ]; - span [] [ show int count ]; - ] - in - (html, count) -end - module Test_01_component = struct let make () = let html, _ = Counter.make "counter" in @@ -37,8 +17,8 @@ end module Test_03_sequential = struct let make () = - let first, by = Counter.make "first" in - let second, _ = Counter.make ~by "second" in + let first, count = Counter.make "first" in + let second, _ = Counter.make ~by:count "second" in let open Html in fieldset [] [ legend [] [ h2 [] [ text "03. Sequential" ] ]; first; second ] end @@ -98,9 +78,8 @@ let main () = div [] [ h1 [] [ text "Composition demo" ]; - blockquote [] + p [] [ - text "See: "; a [ href "https://github.com/TyOverby/composition-comparison" ] [ text "https://github.com/TyOverby/composition-comparison" ]; @@ -108,11 +87,11 @@ let main () = section [ id "main" ] [ - Test_01_component.make (); + (* Test_01_component.make (); *) (* Test_02_parallel.make (); *) (* Test_03_sequential.make (); *) (* Test_04_multiplicity.make (); *) - (* Test_05_inception.make (); *) + Test_05_inception.make (); ]; ] diff --git a/examples/composition/index.html b/examples/composition/index.html index a7952e1..d4ea1c9 100644 --- a/examples/composition/index.html +++ b/examples/composition/index.html @@ -7,11 +7,11 @@ body { font-family: sans-serif; } - blockquote { + p { font-size: 8pt; } button { - width: 3ex; + min-width: 3ex; } #main { display: flex; @@ -31,7 +31,7 @@ } #main fieldset div > span { display: inline-block; - width: 10ex; + width: 14ex; }