From e5242019d92296b89e7edf9a6e3bec9bcb983e74 Mon Sep 17 00:00:00 2001 From: public-release Date: Wed, 30 Aug 2023 10:23:16 +0100 Subject: [PATCH] v0.17~preview.128.37+01 --- .ocamlformat | 1 + bench/example/main.ml | 6 +- bench/src/cleanup.ml | 10 +- bench/src/config.ml | 20 +- bench/src/profile.ml | 40 +- bench/src/runner.ml | 18 +- bindings/dygraph/src/area.ml | 38 +- bindings/dygraph/src/area.mli | 2 +- .../src/canvas_rendering_context_2D.ml | 6 +- .../src/canvas_rendering_context_2D.mli | 2 +- bindings/dygraph/src/color.ml | 2 +- bindings/dygraph/src/color.mli | 2 +- bindings/dygraph/src/data.ml | 26 +- bindings/dygraph/src/data.mli | 6 +- bindings/dygraph/src/default_legend.ml | 80 +- bindings/dygraph/src/default_legend.mli | 20 +- bindings/dygraph/src/dygraph.ml | 32 +- bindings/dygraph/src/gen_js_api.ml | 2 +- bindings/dygraph/src/granularity.ml | 194 +- bindings/dygraph/src/granularity.mli | 60 +- bindings/dygraph/src/graph.ml | 70 +- bindings/dygraph/src/graph.mli | 52 +- bindings/dygraph/src/html_or_number.ml | 12 +- bindings/dygraph/src/html_or_number.mli | 5 +- bindings/dygraph/src/js_date.ml | 6 +- bindings/dygraph/src/js_date.mli | 2 +- bindings/dygraph/src/js_obj.ml | 8 +- bindings/dygraph/src/js_obj_intf.ml | 4 +- bindings/dygraph/src/legend_data.ml | 128 +- bindings/dygraph/src/legend_data.mli | 24 +- bindings/dygraph/src/native_node.ml | 6 +- bindings/dygraph/src/native_node.mli | 2 +- bindings/dygraph/src/number_or_js_date.ml | 8 +- bindings/dygraph/src/number_or_js_date.mli | 5 +- bindings/dygraph/src/options.ml | 2076 ++++++++--------- bindings/dygraph/src/options.mli | 101 +- bindings/dygraph/src/per_series_info.ml | 4 +- bindings/dygraph/src/per_series_info.mli | 2 +- bindings/dygraph/src/plotter.ml | 27 +- bindings/dygraph/src/plotter.mli | 10 +- bindings/dygraph/src/point.ml | 51 +- bindings/dygraph/src/point.mli | 10 +- bindings/dygraph/src/range.ml | 8 +- bindings/dygraph/src/range.mli | 4 +- bindings/dygraph/src/raw_html.mli | 4 +- bindings/dygraph/src/update_options.ml | 2 +- bindings/dygraph/src/update_options.mli | 4 +- bindings/dygraph/src/which_y_axis.ml | 28 +- bindings/dygraph/src/which_y_axis.mli | 4 +- bindings/dygraph/src/with_bonsai.ml | 98 +- bindings/dygraph/src/with_bonsai.mli | 14 +- bindings/dygraph/src/x_axis_mapping.ml | 62 +- bindings/dygraph/src/x_axis_mapping.mli | 8 +- examples/animation/main.ml | 6 +- examples/bonsai_guide_code/css_examples.ml | 44 +- examples/bonsai_guide_code/edge_examples.ml | 10 +- examples/bonsai_guide_code/flow_examples.ml | 20 +- examples/bonsai_guide_code/form_examples.ml | 6 +- examples/bonsai_guide_code/rpc_examples.ml | 6 +- examples/bonsai_guide_code/state_examples.ml | 6 +- examples/bonsai_view/main.ml | 138 +- examples/clock_every/main.ml | 18 +- examples/codicons/main.ml | 4 +- .../lib/bonsai_web_counters_example.ml | 8 +- examples/dagviz/main.ml | 14 +- .../lib/bonsai_drag_and_drop_example.ml | 10 +- examples/drag_and_drop_list/main.ml | 6 +- examples/dygraph/custom_points.ml | 28 +- examples/dygraph/hide_overnights.ml | 4 +- examples/dygraph/stock_chart.ml | 2 +- examples/element_size_util/main.ml | 6 +- examples/element_size_util/style.ml | 6 +- examples/feather_icons/controls.ml | 20 +- examples/feather_icons/icon_grid.ml | 6 +- examples/feather_icons/import.ml | 6 +- examples/feather_icons/main.ml | 7 +- examples/feather_icons/search_bar.ml | 10 +- examples/font_hosting/main.ml | 6 +- examples/forms/big_form.ml | 12 +- examples/forms/list_form.ml | 6 +- examples/forms/main.ml | 6 +- examples/freeform_multiselect/main.ml | 2 +- examples/gauge/main.ml | 10 +- examples/inline_css/main.ml | 26 +- examples/inline_css_private_appending/main.ml | 2 +- examples/inline_css_with_var/main.ml | 8 +- .../inside_incr_dom/my_bonsai_component.ml | 52 +- examples/keyboard/keyboard_code.ml | 1 - examples/keyboard/keyboard_code.mli | 6 +- examples/keyboard/main.ml | 2 +- examples/modal/main.ml | 16 +- examples/mouse_position/client/src/app.ml | 6 +- .../mouse_position/client/test/app_test.ml | 1 - .../bonsai_examples_mouse_position_common.ml | 14 +- .../bonsai_examples_mouse_position_native.ml | 2 +- examples/multi_select/main.ml | 18 +- examples/node_with_map_children/attr.ml | 10 +- examples/node_with_map_children/automator.ml | 3 +- examples/node_with_map_children/color_list.ml | 6 +- examples/node_with_map_children/stepper.ml | 54 +- examples/node_with_map_children/style.ml | 4 +- examples/node_with_map_children/tag.ml | 8 +- examples/notifications/main.ml | 60 +- examples/notifications_test/main.ml | 16 +- examples/oklab/knobs.ml | 6 +- examples/oklab/main.ml | 6 +- examples/open_source/rpc_chat/client/main.ml | 10 +- examples/panels/main.ml | 2 +- .../bonsai_partial_render_table_example.ml | 16 +- examples/partial_render_table/src/row.ml | 4 +- .../polling_state_rpc_stress_test/main.ml | 24 +- examples/popover_test/main.ml | 4 +- examples/query_box/main.ml | 16 +- examples/rpc_chat/client/src/app.ml | 6 +- .../rpc_chat/client/src/compose_message.ml | 6 +- .../rpc_chat/client/src/room_list_panel.ml | 6 +- .../rpc_chat/server/src/bonsai_chat_native.ml | 2 +- .../rpgdice/bin/dice_spec_clicker_input.ml | 22 +- examples/rpgdice/bin/roller.ml | 26 +- examples/rpgdice/src/roll_spec.ml | 2 +- examples/search_bar/main.ml | 1 - examples/sexp_grammar/main.ml | 2 +- examples/snips/main.ml | 56 +- .../src/bonsai_web_ui_split_pane_example.ml | 10 +- examples/styled_components/main.ml | 6 +- examples/styled_components_internal/main.ml | 26 +- examples/timetravel/spacetime.ml | 96 +- examples/todomvc/main.ml | 10 +- examples/treemapviz/main.ml | 10 +- examples/typeahead/main.ml | 8 +- examples/url_var/bin/main.ml | 6 +- examples/url_var/lib/url_example.ml | 528 ++--- .../lib/all_url_var_features_example.ml | 38 +- examples/vdom_input_widgets_int_repro/main.ml | 12 +- examples/vdom_keyboard/main.ml | 10 +- examples/visibility/main.ml | 6 +- examples/widget/main.ml | 2 +- .../src/bonsai_experimental_animation.ml | 55 +- experimental/dagviz/src/to_vdom.ml | 170 +- experimental/dagviz/src/transform.ml | 150 +- experimental/dagviz/src/types.ml | 80 +- .../form/src/bonsai_form_experimental.ml | 2 +- .../form/src/bonsai_form_experimental.mli | 3 +- experimental/form/src/combine.ml | 36 +- experimental/form/src/combine.mli | 10 +- .../src/bonsai_experimental_table_form.ml | 21 +- extra/bonsai_extra.ml | 112 +- extra/bonsai_extra.mli | 1 - jsoo_weak_collections/src/gen_js_api.ml | 2 +- jsoo_weak_collections/src/weak_map.ml | 43 +- jsoo_weak_collections/src/weak_set.ml | 27 +- .../src/expander/ppx_bonsai_expander.ml | 10 +- ppx_bonsai/test/test.ml | 4 +- src/bonsai.mli | 48 +- src/constant_fold.ml | 14 +- src/driver/bonsai_driver.ml | 52 +- src/eval.ml | 284 +-- src/eval_sub.ml | 260 +-- src/fix_transform.ml | 8 +- src/fix_transform_intf.ml | 5 +- src/flatten_values.ml | 16 +- src/graph_info.ml | 28 +- src/graph_info.mli | 1 - src/instrumentation.ml | 42 +- src/legacy_api.ml | 26 +- src/legacy_api.mli | 2 +- src/map0.ml | 70 +- src/map0.mli | 16 +- src/meta.ml | 52 +- src/meta.mli | 1 - src/module_types.ml | 21 +- src/node_path.ml | 4 +- src/path.ml | 8 +- src/proc.ml | 219 +- src/proc_min.ml | 118 +- src/proc_min.mli | 6 +- src/skeleton.ml | 5 +- src/to_dot.ml | 4 +- src/transform.ml | 4 +- src/transform.mli | 9 +- src/value.ml | 13 +- test/driver.ml | 10 +- test/driver.mli | 1 - test/helpers.ml | 14 +- test/import.ml | 6 +- test/path_test.ml | 12 +- test/proc.ml | 42 +- test/proc.mli | 6 +- test/test_constant_fold.ml | 4 +- test/test_dot/src/test_instrumentation.ml | 20 +- test/test_effect_throttling.ml | 37 +- test/test_legacy_bonsai.ml | 24 +- test/test_one_at_a_time.ml | 1 - test/test_proc_bonsai.ml | 638 ++--- test/test_value_stability.ml | 292 +-- uri_parsing/src/uri_parsing.ml | 1126 ++++----- uri_parsing/src/uri_parsing.mli | 2 +- uri_parsing/test/uri_parsing_test.ml | 146 +- web/forward_performance_entries.ml | 42 +- web/persistent_var.mli | 3 - web/rpc_effect.ml | 373 ++- web/start.ml | 126 +- web/start.mli | 9 +- web/to_incr_dom.ml | 66 +- web/util.ml | 13 +- web_test/external_event.ml | 6 +- web_test/helpers.ml | 40 +- web_test/helpers_intf.ml | 37 +- web_test/proc.ml | 78 +- web_test/proc.mli | 4 +- web_test/rpc_effect_tests.ml | 66 +- .../accordion/src/bonsai_web_ui_accordion.ml | 14 +- .../src/bonsai_web_ui_auto_generated.ml | 218 +- web_ui/auto_generated/src/render_form.ml | 52 +- .../test/bonsai_web_ui_auto_generated_test.ml | 76 +- .../bonsai_web_ui_common_components.ml | 50 +- .../src/bonsai_web_ui_drag_and_drop.ml | 174 +- .../src/bonsai_web_ui_drag_and_drop.mli | 1 - .../src/bulk_size_tracker.ml | 16 +- web_ui/element_size_hooks/src/freeze.ml | 8 +- web_ui/element_size_hooks/src/gen_js_api.ml | 2 +- web_ui/element_size_hooks/src/import.ml | 1 - .../src/position_tracker.ml | 10 +- .../element_size_hooks/src/resize_to_fit.ml | 10 +- .../element_size_hooks/src/resize_to_fit.mli | 1 - web_ui/element_size_hooks/src/resizer.mli | 2 - .../element_size_hooks/src/scroll_tracker.ml | 10 +- .../src/visibility_tracker.ml | 40 +- web_ui/extendy/src/bonsai_web_ui_extendy.ml | 4 +- .../bonsai_web_ui_file_from_web_file.ml | 88 +- web_ui/file/src/bonsai_web_ui_file.ml | 26 +- web_ui/file/src/bonsai_web_ui_file.mli | 2 +- web_ui/file/test/test_bonsai_web_ui_file.ml | 1 - web_ui/form/src/bonsai_web_ui_form.ml | 1 - web_ui/form/src/elements.ml | 536 ++--- web_ui/form/src/elements.mli | 6 +- web_ui/form/src/form.ml | 121 +- web_ui/form/src/form.mli | 2 - web_ui/form/src/record_builder_intf.ml | 4 +- web_ui/form/src/typed.ml | 33 +- web_ui/form/src/typed.mli | 4 +- web_ui/form/src/view.ml | 4 +- web_ui/form/test/bonsai_web_ui_form_test.ml | 104 +- .../src/freeform_multiselect.ml | 28 +- .../src/freeform_multiselect.mli | 1 - .../test/freeform_multiselect.ml | 8 +- web_ui/gauge/src/bonsai_web_ui_gauge.ml | 6 +- .../multi_select/focus_ring/src/focus_ring.ml | 22 +- .../focus_ring/src/focus_ring.mli | 8 +- .../src/bonsai_web_ui_multi_select.ml | 2 +- web_ui/multi_select/src/multi_factor.ml | 52 +- web_ui/multi_select/src/multi_factor_intf.ml | 22 +- web_ui/multi_select/src/selection_status.ml | 2 +- web_ui/multi_select/src/single_factor.ml | 151 +- web_ui/multi_select/src/single_factor_intf.ml | 38 +- web_ui/multi_select/test/test_multi_factor.ml | 50 +- .../multi_select/test/test_single_factor.ml | 119 +- ...bonsai_web_ui_not_connected_warning_box.ml | 6 +- .../src/bonsai_web_ui_notifications.ml | 140 +- .../src/bonsai_web_ui_notifications.mli | 1 - web_ui/partial_render_table/bench/bin/main.ml | 24 +- ...onsai_web_ui_partial_render_table_bench.ml | 26 +- ...ai_web_ui_partial_render_table_protocol.ml | 8 +- .../src/bonsai_web_ui_partial_render_table.ml | 264 +-- .../bonsai_web_ui_partial_render_table.mli | 47 +- web_ui/partial_render_table/src/column.ml | 61 +- web_ui/partial_render_table/src/focus.ml | 22 +- web_ui/partial_render_table/src/focus.mli | 2 +- .../src/sortable_header.ml | 6 +- web_ui/partial_render_table/src/style_intf.ml | 4 +- web_ui/partial_render_table/src/table_body.ml | 24 +- .../partial_render_table/src/table_header.ml | 9 +- .../partial_render_table/src/table_header.mli | 2 +- .../test/ansi_table_tests.ml | 69 +- web_ui/partial_render_table/test/shared.ml | 32 +- .../test/vdom_based_tests.ml | 14 +- web_ui/popover/src/bonsai_web_ui_popover.ml | 29 +- web_ui/popover/src/bonsai_web_ui_popover.mli | 4 +- web_ui/popover/src/reposition_hook.ml | 120 +- .../test/bonsai_web_ui_popover_test.ml | 42 +- .../query_box/src/bonsai_web_ui_query_box.ml | 281 ++- .../query_box/src/bonsai_web_ui_query_box.mli | 31 +- .../test/test_collate_map_with_score.ml | 18 +- .../src/bonsai_web_ui_reorderable_list.ml | 178 +- .../src/bonsai_web_ui_reorderable_list.mli | 30 +- .../bonsai_web_ui_reorderable_list_test.ml | 4 +- .../bonsai_web_ui_scroll_utilities.ml | 2 +- .../src/bonsai_web_ui_search_bar.ml | 110 +- .../src/bonsai_web_ui_search_bar.mli | 12 +- .../test/test_bonsai_web_ui_search_bar.ml | 20 +- web_ui/tabs/src/bonsai_web_ui_tabs.ml | 16 +- web_ui/tabs/src/bonsai_web_ui_tabs.mli | 1 - web_ui/toggle/src/bonsai_web_ui_toggle.ml | 6 +- web_ui/typeahead/src/styles.ml | 2 +- web_ui/typeahead/src/styles.mli | 4 +- web_ui/typeahead/src/typeahead.ml | 200 +- web_ui/typeahead/src/typeahead.mli | 6 +- web_ui/typeahead/test/typeahead.ml | 20 +- web_ui/typeahead/test/typeahead_multi.ml | 18 +- web_ui/url_var/src/bonsai_web_ui_url_var.ml | 68 +- web_ui/url_var/src/bonsai_web_ui_url_var.mli | 1 - .../vdom_node_with_map_children.ml | 14 +- .../vdom_node_with_map_children.mli | 1 - web_ui/view/form/bonsai_web_ui_form_view.ml | 6 +- web_ui/view/kado/cards.ml | 18 +- web_ui/view/kado/kado.ml | 13 +- web_ui/view/kado/kado.mli | 2 +- web_ui/view/src/bonsai_web_ui_view.ml | 106 +- web_ui/view/src/bonsai_web_ui_view.mli | 3 +- web_ui/view/src/expert.ml | 88 +- web_ui/view/src/form.ml | 56 +- web_ui/view/src/layout.ml | 24 +- web_ui/view/src/table.ml | 34 +- web_ui/view/src/tooltip.ml | 18 +- web_ui/visibility/bonsai_web_ui_visibility.ml | 6 +- web_ui/widget/src/bonsai_web_ui_widget.ml | 8 +- web_ui/widget/src/bonsai_web_ui_widget.mli | 4 +- 317 files changed, 7447 insertions(+), 7523 deletions(-) create mode 100644 .ocamlformat diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 00000000..3b217634 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1 @@ +profile=janestreet diff --git a/bench/example/main.ml b/bench/example/main.ml index b62d5197..8ac217ac 100644 --- a/bench/example/main.ml +++ b/bench/example/main.ml @@ -35,9 +35,9 @@ module State_machine = struct ~sexp_of_action:[%sexp_of: Action.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - match action with - | Incr -> model + 1 - | Decr -> model - 1) + match action with + | Incr -> model + 1 + | Decr -> model - 1) ;; let incr = Interaction.inject Action.Incr diff --git a/bench/src/cleanup.ml b/bench/src/cleanup.ml index cc183880..8d4ea949 100644 --- a/bench/src/cleanup.ml +++ b/bench/src/cleanup.ml @@ -9,9 +9,9 @@ let invalidate_observers = Core_bench_js.Test.create_with_initialization ~name:"cleaning up observers..." (fun `init -> - (match !most_recent_driver with - | None -> () - | Some (T driver) -> Runner.invalidate_observers driver); - most_recent_driver := None; - fun () -> ()) + (match !most_recent_driver with + | None -> () + | Some (T driver) -> Runner.invalidate_observers driver); + most_recent_driver := None; + fun () -> ()) ;; diff --git a/bench/src/config.ml b/bench/src/config.ml index a4b84c05..eb7fb1d9 100644 --- a/bench/src/config.ml +++ b/bench/src/config.ml @@ -12,21 +12,21 @@ type ('a, 'r) unpacked = type t = T : (_, _) unpacked -> t let create - ?(clock = Bonsai.Time_source.create ~start:Time_ns.epoch) - ~name - ~component - ~get_inject - interaction + ?(clock = Bonsai.Time_source.create ~start:Time_ns.epoch) + ~name + ~component + ~get_inject + interaction = T { clock; name; component; get_inject; interaction } ;; let create_with_resetter - ?(clock = Bonsai.Time_source.create ~start:Time_ns.epoch) - ~name - ~component - ~get_inject - interaction + ?(clock = Bonsai.Time_source.create ~start:Time_ns.epoch) + ~name + ~component + ~get_inject + interaction = T { clock diff --git a/bench/src/profile.ml b/bench/src/profile.ml index 5e934600..d5a39097 100644 --- a/bench/src/profile.ml +++ b/bench/src/profile.ml @@ -83,8 +83,8 @@ module Accumulated_measurement = struct [@@deriving sexp] let compare - { kind; total_duration; _ } - { kind = kind'; total_duration = total_duration'; _ } + { kind; total_duration; _ } + { kind = kind'; total_duration = total_duration'; _ } = match kind, kind' with | Named _, Named _ -> Float.descending total_duration total_duration' @@ -135,12 +135,12 @@ let create_snapshot_table data ~incremental_time = ; Column.create "Total time (ms)" (fun { Accumulated_measurement.total_duration; _ } -> - Float.to_string total_duration) + Float.to_string total_duration) ; Column.create "Percent of incremental time" (fun { Accumulated_measurement.total_duration; _ } -> - Percent.Always_percentage.to_string - (Percent.of_percentage (total_duration /. incremental_time *. 100.))) + Percent.Always_percentage.to_string + (Percent.of_percentage (total_duration /. incremental_time *. 100.))) ] in to_string_noattr columns data ~limit_width_to:Int.max_value ~bars:`Unicode @@ -177,8 +177,8 @@ let print_statistics data = ;; let accumulate_measurements - ~(source_locations : Graph_info.Node_info.t Bonsai.Private.Node_path.Map.t) - measurements + ~(source_locations : Graph_info.Node_info.t Bonsai.Private.Node_path.Map.t) + measurements = let with_ids, without_ids = List.map measurements ~f:(fun measurement -> @@ -199,14 +199,14 @@ let accumulate_measurements |> List.fold ~init:(Int.Map.empty, Measurement.Kind.Map.empty) ~f:(fun (with_ids, without_ids) measurement -> - let accumulate_measurements = function - | None -> Accumulated_measurement.of_measurement measurement - | Some accumulated -> Accumulated_measurement.add accumulated ~measurement - in - match measurement.id with - | None -> - with_ids, Map.update without_ids measurement.kind ~f:accumulate_measurements - | Some id -> Map.update with_ids id ~f:accumulate_measurements, without_ids) + let accumulate_measurements = function + | None -> Accumulated_measurement.of_measurement measurement + | Some accumulated -> Accumulated_measurement.add accumulated ~measurement + in + match measurement.id with + | None -> + with_ids, Map.update without_ids measurement.kind ~f:accumulate_measurements + | Some id -> Map.update with_ids id ~f:accumulate_measurements, without_ids) in Map.fold without_ids ~init:with_ids ~f:(fun ~key:_ ~data:measurement acc -> let id = @@ -258,7 +258,7 @@ let profile (T { clock; component; get_inject; interaction; name } : Config.t) = let label = Js.to_string entry##.name in let duration = entry##.duration in performance_entries - := Measurement.create ~label ~duration :: !performance_entries)) + := Measurement.create ~label ~duration :: !performance_entries)) else failwith "PerformanceObserver could not be found. Please reach out to webdev-public on \ @@ -275,10 +275,10 @@ let profile (T { clock; component; get_inject; interaction; name } : Config.t) = ~wrap_driver_creation: { f = (fun create_driver -> - Measurement.mark_before Startup; - let driver = create_driver () in - Measurement.mark_after_and_measure Startup; - driver) + Measurement.mark_before Startup; + let driver = create_driver () in + Measurement.mark_after_and_measure Startup; + driver) } ~clock ~component diff --git a/bench/src/runner.ml b/bench/src/runner.ml index 60dffff3..34c4107d 100644 --- a/bench/src/runner.ml +++ b/bench/src/runner.ml @@ -45,12 +45,12 @@ let dedup_stabilizations interactions = [Stabilize]s don't add anything to benchmarks and would add a function call of overhead. *) let initialize - ~filter_profiles - ~wrap_driver_creation - ~clock - ~component - ~get_inject - ~interaction + ~filter_profiles + ~wrap_driver_creation + ~clock + ~component + ~get_inject + ~interaction = let driver = wrap_driver_creation.f (fun () -> Bonsai_driver.create ~clock component) in let inject_action action = @@ -68,9 +68,9 @@ let initialize ] |> flatten_interactions_to_list |> List.filter ~f:(fun interaction -> - match filter_profiles, interaction with - | true, Profile _ -> false - | _ -> true) + match filter_profiles, interaction with + | true, Profile _ -> false + | _ -> true) |> dedup_stabilizations |> Array.of_list in diff --git a/bindings/dygraph/src/area.ml b/bindings/dygraph/src/area.ml index 89fa9113..62345992 100644 --- a/bindings/dygraph/src/area.ml +++ b/bindings/dygraph/src/area.ml @@ -1,25 +1,31 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api -type t = { - x: int ; - y: int ; - w: int ; - h: int } + +type t = + { x : int + ; y : int + ; w : int + ; h : int + } + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> - { - x = (Ojs.int_of_js (Ojs.get_prop_ascii x2 "x")); - y = (Ojs.int_of_js (Ojs.get_prop_ascii x2 "y")); - w = (Ojs.int_of_js (Ojs.get_prop_ascii x2 "w")); - h = (Ojs.int_of_js (Ojs.get_prop_ascii x2 "h")) - } + { x = Ojs.int_of_js (Ojs.get_prop_ascii x2 "x") + ; y = Ojs.int_of_js (Ojs.get_prop_ascii x2 "y") + ; w = Ojs.int_of_js (Ojs.get_prop_ascii x2 "w") + ; h = Ojs.int_of_js (Ojs.get_prop_ascii x2 "h") + } + and t_to_js : t -> Ojs.t = fun (x1 : t) -> - Ojs.obj - [|("x", (Ojs.int_to_js x1.x));("y", (Ojs.int_to_js x1.y));("w", - (Ojs.int_to_js - x1.w)); - ("h", (Ojs.int_to_js x1.h))|] + Ojs.obj + [| "x", Ojs.int_to_js x1.x + ; "y", Ojs.int_to_js x1.y + ; "w", Ojs.int_to_js x1.w + ; "h", Ojs.int_to_js x1.h + |] +;; diff --git a/bindings/dygraph/src/area.mli b/bindings/dygraph/src/area.mli index f6000ca7..ded1809f 100644 --- a/bindings/dygraph/src/area.mli +++ b/bindings/dygraph/src/area.mli @@ -1,6 +1,6 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** An object with {x,y,w,h} properties describing the drawing area, for use in [underlayCallback]. All units are in pixels (I think). *) diff --git a/bindings/dygraph/src/canvas_rendering_context_2D.ml b/bindings/dygraph/src/canvas_rendering_context_2D.ml index 9c31d11a..ba59005c 100644 --- a/bindings/dygraph/src/canvas_rendering_context_2D.ml +++ b/bindings/dygraph/src/canvas_rendering_context_2D.ml @@ -1,6 +1,6 @@ open! Core -open Import +open Import include Js_obj.Make (struct - type t = Dom_html.canvasRenderingContext2D - end) + type t = Dom_html.canvasRenderingContext2D +end) diff --git a/bindings/dygraph/src/canvas_rendering_context_2D.mli b/bindings/dygraph/src/canvas_rendering_context_2D.mli index 4bbf240d..96797820 100644 --- a/bindings/dygraph/src/canvas_rendering_context_2D.mli +++ b/bindings/dygraph/src/canvas_rendering_context_2D.mli @@ -1,3 +1,3 @@ open! Core -open Import +open Import include Js_obj.S with type t = Dom_html.canvasRenderingContext2D Js.t diff --git a/bindings/dygraph/src/color.ml b/bindings/dygraph/src/color.ml index 1c428078..f03a7985 100644 --- a/bindings/dygraph/src/color.ml +++ b/bindings/dygraph/src/color.ml @@ -1,6 +1,6 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = Css_gen.Color.t [@@deriving sexp] diff --git a/bindings/dygraph/src/color.mli b/bindings/dygraph/src/color.mli index 761d891f..23b77deb 100644 --- a/bindings/dygraph/src/color.mli +++ b/bindings/dygraph/src/color.mli @@ -1,6 +1,6 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = Css_gen.Color.t [@@deriving sexp] diff --git a/bindings/dygraph/src/data.ml b/bindings/dygraph/src/data.ml index a57c8c71..c9a7c789 100644 --- a/bindings/dygraph/src/data.ml +++ b/bindings/dygraph/src/data.ml @@ -5,8 +5,8 @@ open Gen_js_api type t = Ojs.t -let t_to_js x = x -let create data = Ojs.array_to_js (Ojs.array_to_js Ojs.float_to_js) data +let t_to_js x = x +let create data = Ojs.array_to_js (Ojs.array_to_js Ojs.float_to_js) data let create' data ~x_to_js ~y_to_js = let row_to_js (x, data) = @@ -55,11 +55,11 @@ let create_from_independent_series' ~min ~equal series = let next_x () = Array.fold2_exn ~init:None current_idxes series ~f:(fun earliest_x idx series -> match safe_get series ~idx with - | None -> earliest_x + | None -> earliest_x | Some (x, _) -> Some (match earliest_x with - | None -> x + | None -> x | Some earliest_x -> min x earliest_x)) in (* This loop will make an array (in chronological order) of: @@ -69,13 +69,13 @@ let create_from_independent_series' ~min ~equal series = *) let rec loop ~data_acc = match next_x () with - | None -> Array.of_list_rev data_acc + | None -> Array.of_list_rev data_acc | Some next_x -> let next_row = Array.mapi series ~f:(fun i series -> let idx = current_idxes.(i) in match safe_get series ~idx with - | None -> None + | None -> None | Some (x, value) -> if equal x next_x then ( @@ -104,15 +104,15 @@ let create_from_independent_time_series series = ;; let%expect_test "test [create_from_independent_time_series]" = - let t1 = Time_ns.epoch in - let t2 = Time_ns.add t1 Time_ns.Span.day in - let t3 = Time_ns.add t2 Time_ns.Span.day in - let t4 = Time_ns.add t3 Time_ns.Span.day in - let ts1 = [| t1, 1.; t3, 3. |] in - let ts2 = [| t2, 2.; t3, 3.; t4, 4. |] in + let t1 = Time_ns.epoch in + let t2 = Time_ns.add t1 Time_ns.Span.day in + let t3 = Time_ns.add t2 Time_ns.Span.day in + let t4 = Time_ns.add t3 Time_ns.Span.day in + let ts1 = [| t1, 1.; t3, 3. |] in + let ts2 = [| t2, 2.; t3, 3.; t4, 4. |] in create_from_independent_time_series' [| ts1; ts2 |] |> Array.iter ~f:(fun row -> - [%sexp_of: Time_ns.Alternate_sexp.t * float option array] row |> print_s); + [%sexp_of: Time_ns.Alternate_sexp.t * float option array] row |> print_s); [%expect {| ("1970-01-01 00:00:00Z" ((1) ())) diff --git a/bindings/dygraph/src/data.mli b/bindings/dygraph/src/data.mli index 74994a5c..1107262d 100644 --- a/bindings/dygraph/src/data.mli +++ b/bindings/dygraph/src/data.mli @@ -20,10 +20,10 @@ val create_option : (float * float option array) array -> t Remember to include the following script when using the Timezone libaray: *) -val create_date : (Date.t * float array) array -> zone:Timezone.t -> t +val create_date : (Date.t * float array) array -> zone:Timezone.t -> t (** [create_time_ns] is for when your x-values are times. *) -val create_time_ns : (Time_ns.t * float array) array -> t +val create_time_ns : (Time_ns.t * float array) array -> t (** [create_time_ns_option] is for when your x-values are times and your y-values are options. *) val create_time_ns_option : (Time_ns.t * float option array) array -> t @@ -40,5 +40,5 @@ val create_time_ns_option : (Time_ns.t * float option array) array -> t [Ts_server_protocol_kernel.Time_series_data.transpose]. *) -val create_from_independent_series : (float * float) array array -> t +val create_from_independent_series : (float * float) array array -> t val create_from_independent_time_series : (Time_ns.t * float) array array -> t diff --git a/bindings/dygraph/src/default_legend.ml b/bindings/dygraph/src/default_legend.ml index 845a2091..0cae0684 100644 --- a/bindings/dygraph/src/default_legend.ml +++ b/bindings/dygraph/src/default_legend.ml @@ -4,11 +4,11 @@ open Import module Model = struct module Series = struct type t = - { label : string - ; value : Raw_html.t option - ; dash : Raw_html.t option - ; color : string option - ; is_visible : bool + { label : string + ; value : Raw_html.t option + ; dash : Raw_html.t option + ; color : string option + ; is_visible : bool ; is_highlighted : bool } [@@deriving equal, fields ~getters, sexp] @@ -18,12 +18,12 @@ module Model = struct let view { label; value; dash; color; is_visible; is_highlighted } ~on_toggle = let dash = match dash with - | None -> Vdom.Node.none + | None -> Vdom.Node.none | Some html -> Raw_html.view ~tag:"span" html in let value = match value with - | None -> Vdom.Node.none + | None -> Vdom.Node.none | Some html -> Raw_html.view ~tag:"span" html in let create_style l = List.filter_opt l |> Css_gen.concat |> Vdom.Attr.style in @@ -61,23 +61,23 @@ module Model = struct end type t = - { x_label : string - ; x_value : Raw_html.t option - ; series : Series.t list + { x_label : string + ; x_value : Raw_html.t option + ; series : Series.t list ; past_series : Series.t Map.M(String).t } [@@deriving equal, sexp] let view - { x_label; x_value; series; past_series = _ } - ~on_toggle - ~select_all - ~select_none + { x_label; x_value; series; past_series = _ } + ~on_toggle + ~select_all + ~select_none = let x = let value = match x_value with - | None -> Vdom.Node.none + | None -> Vdom.Node.none | Some html -> Raw_html.view ~tag:"span" html in Vdom.Node.label [ Vdom.Node.textf "%s: " x_label; value ] @@ -109,7 +109,7 @@ module Model = struct select_all_or_none :: x :: List.map series ~f:(fun series -> - Series.view series ~on_toggle:(fun () -> on_toggle series.label)) + Series.view series ~on_toggle:(fun () -> on_toggle series.label)) in (* Mostly copied from vdom_input_widgets *) Vdom.Node.div @@ -126,7 +126,7 @@ end module Action = struct type t = - | From_graph of Legend_data.t + | From_graph of Legend_data.t | Toggle_visibility of string | Select_none | Select_all @@ -134,9 +134,9 @@ module Action = struct end let apply_action - (_ : _ Bonsai.Apply_action_context.t) - (model : Model.t) - (action : Action.t) + (_ : _ Bonsai.Apply_action_context.t) + (model : Model.t) + (action : Action.t) = let map_series ~f = { model with series = List.map model.series ~f } in match action with @@ -146,16 +146,16 @@ let apply_action match List.find legend_data.series ~f:(fun s -> String.equal series.label s.label) with - | None -> series + | None -> series | Some legend_data -> let { Legend_data.Series.dashHTML ; isHighlighted ; color ; yHTML - ; label = _ + ; label = _ ; labelHTML = _ ; isVisible = _ - ; y = _ + ; y = _ } = legend_data @@ -165,20 +165,20 @@ let apply_action Option.first_some color series.color in { series with - dash = Some dashHTML + dash = Some dashHTML ; color - ; value = yHTML + ; value = yHTML ; is_highlighted = Option.value ~default:false isHighlighted }) in let x_value = Option.map legend_data.xHTML ~f:(function - | `number f -> Float.to_string f |> Raw_html.of_string + | `number f -> Float.to_string f |> Raw_html.of_string | `html raw_html -> raw_html) in { model with x_value; series } | Select_none -> map_series ~f:(fun series -> { series with is_visible = false }) - | Select_all -> map_series ~f:(fun series -> { series with is_visible = true }) + | Select_all -> map_series ~f:(fun series -> { series with is_visible = true }) | Toggle_visibility label -> map_series ~f:(fun series -> if String.(series.label = label) @@ -188,11 +188,11 @@ let apply_action let series_from_info { Per_series_info.label; visible_by_default } = { Model.Series.label - ; is_visible = visible_by_default + ; is_visible = visible_by_default ; is_highlighted = false - ; value = None - ; dash = None - ; color = None + ; value = None + ; dash = None + ; color = None } ;; @@ -200,20 +200,20 @@ let create ~x_label ~per_series_info : (Model.t * Vdom.Node.t * (Action.t -> unit Vdom.Effect.t)) Bonsai.Computation.t = let create_model = - let%map.Bonsai x_label = x_label - and per_series_info = per_series_info in + let%map.Bonsai x_label = x_label + and per_series_info = per_series_info in function | None -> { Model.x_label - ; x_value = None - ; series = List.map per_series_info ~f:series_from_info + ; x_value = None + ; series = List.map per_series_info ~f:series_from_info ; past_series = String.Map.empty } | Some (model : Model.t) -> - let existing_y_labels = List.map model.series ~f:Model.Series.label in - let model_y_labels = List.map per_series_info ~f:Per_series_info.label in - if [%equal: string ] model.x_label x_label - && [%equal: string list] model_y_labels existing_y_labels + let existing_y_labels = List.map model.series ~f:Model.Series.label in + let model_y_labels = List.map per_series_info ~f:Per_series_info.label in + if [%equal: string] model.x_label x_label + && [%equal: string list] model_y_labels existing_y_labels then { model with x_label } else ( let past_series = @@ -230,7 +230,7 @@ let create ~x_label ~per_series_info List.map per_series_info ~f:(fun per_series_info -> let { Per_series_info.label; visible_by_default = _ } = per_series_info in match Map.find past_series label with - | None -> series_from_info per_series_info + | None -> series_from_info per_series_info | Some series -> series) in { model with x_label; series; past_series }) diff --git a/bindings/dygraph/src/default_legend.mli b/bindings/dygraph/src/default_legend.mli index 7645097c..8a3301f9 100644 --- a/bindings/dygraph/src/default_legend.mli +++ b/bindings/dygraph/src/default_legend.mli @@ -12,22 +12,22 @@ open! Import module Model : sig module Series : sig type t = - { label : string - ; value : Raw_html.t option - ; dash : Raw_html.t option - ; color : string option - ; is_visible : bool + { label : string + ; value : Raw_html.t option + ; dash : Raw_html.t option + ; color : string option + ; is_visible : bool ; is_highlighted : bool } [@@deriving equal, fields ~getters, sexp] end type t = - { x_label : string - ; x_value : Raw_html.t option - ; series : Series.t list + { x_label : string + ; x_value : Raw_html.t option + ; series : Series.t list ; past_series : Series.t Map.M(String).t - (** [past_series] remembers all the series (by series label) that we've ever seen. + (** [past_series] remembers all the series (by series label) that we've ever seen. This means that if someone makes a change to a particular series (e.g. toggles visibility), moves to a graph without that series, and then moves back to the original graph, the information will not be lost. @@ -41,7 +41,7 @@ end module Action : sig type t = - | From_graph of Legend_data.t + | From_graph of Legend_data.t | Toggle_visibility of string | Select_none | Select_all diff --git a/bindings/dygraph/src/dygraph.ml b/bindings/dygraph/src/dygraph.ml index c94bd40d..f04c1a82 100644 --- a/bindings/dygraph/src/dygraph.ml +++ b/bindings/dygraph/src/dygraph.ml @@ -1,19 +1,19 @@ (* With names like "Raw" and "Options", open Dygraph at your own peril. Fully qualified names are likely the way to go *) -module Area = Area -module Data = Data -module Default_legend = Default_legend -module Granularity = Granularity -module Graph = Graph -module Html_or_number = Html_or_number -module Legend_data = Legend_data -module Options = Options -module Per_series_info = Per_series_info -module Plotter = Plotter -module Point = Point -module Range = Range -module Raw_html = Raw_html -module Update_options = Update_options -module X_axis_mapping = X_axis_mapping -module With_bonsai = With_bonsai +module Area = Area +module Data = Data +module Default_legend = Default_legend +module Granularity = Granularity +module Graph = Graph +module Html_or_number = Html_or_number +module Legend_data = Legend_data +module Options = Options +module Per_series_info = Per_series_info +module Plotter = Plotter +module Point = Point +module Range = Range +module Raw_html = Raw_html +module Update_options = Update_options +module X_axis_mapping = X_axis_mapping +module With_bonsai = With_bonsai module Number_or_js_date = Number_or_js_date diff --git a/bindings/dygraph/src/gen_js_api.ml b/bindings/dygraph/src/gen_js_api.ml index 678914a6..b18a978a 100644 --- a/bindings/dygraph/src/gen_js_api.ml +++ b/bindings/dygraph/src/gen_js_api.ml @@ -1,2 +1,2 @@ -module Ojs = Ojs +module Ojs = Ojs module Ojs_exn = Ojs_exn diff --git a/bindings/dygraph/src/granularity.ml b/bindings/dygraph/src/granularity.ml index 9612deaf..b2a45711 100644 --- a/bindings/dygraph/src/granularity.ml +++ b/bindings/dygraph/src/granularity.ml @@ -1,104 +1,110 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open! Gen_js_api + type t = - | MILLISECONDLY - | TWO_MILLISECONDLY - | FIVE_MILLISECONDLY - | TEN_MILLISECONDLY - | FIFTY_MILLISECONDLY - | HUNDRED_MILLISECONDLY - | FIVE_HUNDRED_MILLISECONDLY - | SECONDLY - | TWO_SECONDLY - | FIVE_SECONDLY - | TEN_SECONDLY - | THIRTY_SECONDLY - | MINUTELY - | TWO_MINUTELY - | FIVE_MINUTELY - | TEN_MINUTELY - | THIRTY_MINUTELY - | HOURLY - | TWO_HOURLY - | SIX_HOURLY - | DAILY - | TWO_DAILY - | WEEKLY - | MONTHLY - | QUARTERLY - | BIANNUAL - | ANNUAL - | DECADAL - | CENTENNIAL - | NUM_GRANULARITIES [@@deriving (compare, sexp)] + | MILLISECONDLY + | TWO_MILLISECONDLY + | FIVE_MILLISECONDLY + | TEN_MILLISECONDLY + | FIFTY_MILLISECONDLY + | HUNDRED_MILLISECONDLY + | FIVE_HUNDRED_MILLISECONDLY + | SECONDLY + | TWO_SECONDLY + | FIVE_SECONDLY + | TEN_SECONDLY + | THIRTY_SECONDLY + | MINUTELY + | TWO_MINUTELY + | FIVE_MINUTELY + | TEN_MINUTELY + | THIRTY_MINUTELY + | HOURLY + | TWO_HOURLY + | SIX_HOURLY + | DAILY + | TWO_DAILY + | WEEKLY + | MONTHLY + | QUARTERLY + | BIANNUAL + | ANNUAL + | DECADAL + | CENTENNIAL + | NUM_GRANULARITIES +[@@deriving compare, sexp] + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> - let x3 = x2 in - match Ojs.int_of_js x3 with - | 0 -> MILLISECONDLY - | 1 -> TWO_MILLISECONDLY - | 2 -> FIVE_MILLISECONDLY - | 3 -> TEN_MILLISECONDLY - | 4 -> FIFTY_MILLISECONDLY - | 5 -> HUNDRED_MILLISECONDLY - | 6 -> FIVE_HUNDRED_MILLISECONDLY - | 7 -> SECONDLY - | 8 -> TWO_SECONDLY - | 9 -> FIVE_SECONDLY - | 10 -> TEN_SECONDLY - | 11 -> THIRTY_SECONDLY - | 12 -> MINUTELY - | 13 -> TWO_MINUTELY - | 14 -> FIVE_MINUTELY - | 15 -> TEN_MINUTELY - | 16 -> THIRTY_MINUTELY - | 17 -> HOURLY - | 18 -> TWO_HOURLY - | 19 -> SIX_HOURLY - | 20 -> DAILY - | 21 -> TWO_DAILY - | 22 -> WEEKLY - | 23 -> MONTHLY - | 24 -> QUARTERLY - | 25 -> BIANNUAL - | 26 -> ANNUAL - | 27 -> DECADAL - | 28 -> CENTENNIAL - | 29 -> NUM_GRANULARITIES - | _ -> assert false + let x3 = x2 in + match Ojs.int_of_js x3 with + | 0 -> MILLISECONDLY + | 1 -> TWO_MILLISECONDLY + | 2 -> FIVE_MILLISECONDLY + | 3 -> TEN_MILLISECONDLY + | 4 -> FIFTY_MILLISECONDLY + | 5 -> HUNDRED_MILLISECONDLY + | 6 -> FIVE_HUNDRED_MILLISECONDLY + | 7 -> SECONDLY + | 8 -> TWO_SECONDLY + | 9 -> FIVE_SECONDLY + | 10 -> TEN_SECONDLY + | 11 -> THIRTY_SECONDLY + | 12 -> MINUTELY + | 13 -> TWO_MINUTELY + | 14 -> FIVE_MINUTELY + | 15 -> TEN_MINUTELY + | 16 -> THIRTY_MINUTELY + | 17 -> HOURLY + | 18 -> TWO_HOURLY + | 19 -> SIX_HOURLY + | 20 -> DAILY + | 21 -> TWO_DAILY + | 22 -> WEEKLY + | 23 -> MONTHLY + | 24 -> QUARTERLY + | 25 -> BIANNUAL + | 26 -> ANNUAL + | 27 -> DECADAL + | 28 -> CENTENNIAL + | 29 -> NUM_GRANULARITIES + | _ -> assert false + and t_to_js : t -> Ojs.t = fun (x1 : t) -> - match x1 with - | MILLISECONDLY -> Ojs.int_to_js 0 - | TWO_MILLISECONDLY -> Ojs.int_to_js 1 - | FIVE_MILLISECONDLY -> Ojs.int_to_js 2 - | TEN_MILLISECONDLY -> Ojs.int_to_js 3 - | FIFTY_MILLISECONDLY -> Ojs.int_to_js 4 - | HUNDRED_MILLISECONDLY -> Ojs.int_to_js 5 - | FIVE_HUNDRED_MILLISECONDLY -> Ojs.int_to_js 6 - | SECONDLY -> Ojs.int_to_js 7 - | TWO_SECONDLY -> Ojs.int_to_js 8 - | FIVE_SECONDLY -> Ojs.int_to_js 9 - | TEN_SECONDLY -> Ojs.int_to_js 10 - | THIRTY_SECONDLY -> Ojs.int_to_js 11 - | MINUTELY -> Ojs.int_to_js 12 - | TWO_MINUTELY -> Ojs.int_to_js 13 - | FIVE_MINUTELY -> Ojs.int_to_js 14 - | TEN_MINUTELY -> Ojs.int_to_js 15 - | THIRTY_MINUTELY -> Ojs.int_to_js 16 - | HOURLY -> Ojs.int_to_js 17 - | TWO_HOURLY -> Ojs.int_to_js 18 - | SIX_HOURLY -> Ojs.int_to_js 19 - | DAILY -> Ojs.int_to_js 20 - | TWO_DAILY -> Ojs.int_to_js 21 - | WEEKLY -> Ojs.int_to_js 22 - | MONTHLY -> Ojs.int_to_js 23 - | QUARTERLY -> Ojs.int_to_js 24 - | BIANNUAL -> Ojs.int_to_js 25 - | ANNUAL -> Ojs.int_to_js 26 - | DECADAL -> Ojs.int_to_js 27 - | CENTENNIAL -> Ojs.int_to_js 28 - | NUM_GRANULARITIES -> Ojs.int_to_js 29 + match x1 with + | MILLISECONDLY -> Ojs.int_to_js 0 + | TWO_MILLISECONDLY -> Ojs.int_to_js 1 + | FIVE_MILLISECONDLY -> Ojs.int_to_js 2 + | TEN_MILLISECONDLY -> Ojs.int_to_js 3 + | FIFTY_MILLISECONDLY -> Ojs.int_to_js 4 + | HUNDRED_MILLISECONDLY -> Ojs.int_to_js 5 + | FIVE_HUNDRED_MILLISECONDLY -> Ojs.int_to_js 6 + | SECONDLY -> Ojs.int_to_js 7 + | TWO_SECONDLY -> Ojs.int_to_js 8 + | FIVE_SECONDLY -> Ojs.int_to_js 9 + | TEN_SECONDLY -> Ojs.int_to_js 10 + | THIRTY_SECONDLY -> Ojs.int_to_js 11 + | MINUTELY -> Ojs.int_to_js 12 + | TWO_MINUTELY -> Ojs.int_to_js 13 + | FIVE_MINUTELY -> Ojs.int_to_js 14 + | TEN_MINUTELY -> Ojs.int_to_js 15 + | THIRTY_MINUTELY -> Ojs.int_to_js 16 + | HOURLY -> Ojs.int_to_js 17 + | TWO_HOURLY -> Ojs.int_to_js 18 + | SIX_HOURLY -> Ojs.int_to_js 19 + | DAILY -> Ojs.int_to_js 20 + | TWO_DAILY -> Ojs.int_to_js 21 + | WEEKLY -> Ojs.int_to_js 22 + | MONTHLY -> Ojs.int_to_js 23 + | QUARTERLY -> Ojs.int_to_js 24 + | BIANNUAL -> Ojs.int_to_js 25 + | ANNUAL -> Ojs.int_to_js 26 + | DECADAL -> Ojs.int_to_js 27 + | CENTENNIAL -> Ojs.int_to_js 28 + | NUM_GRANULARITIES -> Ojs.int_to_js 29 +;; diff --git a/bindings/dygraph/src/granularity.mli b/bindings/dygraph/src/granularity.mli index 52212987..e0ba3eb9 100644 --- a/bindings/dygraph/src/granularity.mli +++ b/bindings/dygraph/src/granularity.mli @@ -7,36 +7,36 @@ open! Gen_js_api See https://github.com/danvk/dygraphs/blob/da2a028fc41e5573868358b3d9eda9826211d217/src/dygraph-tickers.js#L222 *) type t = - | MILLISECONDLY [@js 0] - | TWO_MILLISECONDLY [@js 1] - | FIVE_MILLISECONDLY [@js 2] - | TEN_MILLISECONDLY [@js 3] - | FIFTY_MILLISECONDLY [@js 4] - | HUNDRED_MILLISECONDLY [@js 5] - | FIVE_HUNDRED_MILLISECONDLY [@js 6] - | SECONDLY [@js 7] - | TWO_SECONDLY [@js 8] - | FIVE_SECONDLY [@js 9] - | TEN_SECONDLY [@js 10] - | THIRTY_SECONDLY [@js 11] - | MINUTELY [@js 12] - | TWO_MINUTELY [@js 13] - | FIVE_MINUTELY [@js 14] - | TEN_MINUTELY [@js 15] - | THIRTY_MINUTELY [@js 16] - | HOURLY [@js 17] - | TWO_HOURLY [@js 18] - | SIX_HOURLY [@js 19] - | DAILY [@js 20] - | TWO_DAILY [@js 21] - | WEEKLY [@js 22] - | MONTHLY [@js 23] - | QUARTERLY [@js 24] - | BIANNUAL [@js 25] - | ANNUAL [@js 26] - | DECADAL [@js 27] - | CENTENNIAL [@js 28] - | NUM_GRANULARITIES [@js 29] + | MILLISECONDLY [@js 0] + | TWO_MILLISECONDLY [@js 1] + | FIVE_MILLISECONDLY [@js 2] + | TEN_MILLISECONDLY [@js 3] + | FIFTY_MILLISECONDLY [@js 4] + | HUNDRED_MILLISECONDLY [@js 5] + | FIVE_HUNDRED_MILLISECONDLY [@js 6] + | SECONDLY [@js 7] + | TWO_SECONDLY [@js 8] + | FIVE_SECONDLY [@js 9] + | TEN_SECONDLY [@js 10] + | THIRTY_SECONDLY [@js 11] + | MINUTELY [@js 12] + | TWO_MINUTELY [@js 13] + | FIVE_MINUTELY [@js 14] + | TEN_MINUTELY [@js 15] + | THIRTY_MINUTELY [@js 16] + | HOURLY [@js 17] + | TWO_HOURLY [@js 18] + | SIX_HOURLY [@js 19] + | DAILY [@js 20] + | TWO_DAILY [@js 21] + | WEEKLY [@js 22] + | MONTHLY [@js 23] + | QUARTERLY [@js 24] + | BIANNUAL [@js 25] + | ANNUAL [@js 26] + | DECADAL [@js 27] + | CENTENNIAL [@js 28] + | NUM_GRANULARITIES [@js 29] [@@js.enum] [@@deriving compare, sexp] val t_of_js : Ojs.t -> t diff --git a/bindings/dygraph/src/graph.ml b/bindings/dygraph/src/graph.ml index 981e691e..1616b40c 100644 --- a/bindings/dygraph/src/graph.ml +++ b/bindings/dygraph/src/graph.ml @@ -1,50 +1,70 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api + type t = Ojs.t + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let (create : Native_node.t -> Data.t -> Options.t -> t) = fun (x3 : Native_node.t) (x4 : Data.t) (x5 : Options.t) -> - t_of_js - (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Dygraph") - [|(Native_node.t_to_js x3);(Data.t_to_js x4);(Options.t_to_js x5)|]) -let (destroy : t -> unit) = - fun (x6 : t) -> ignore (Ojs.call (t_to_js x6) "destroy" [||]) -let (resize : t -> unit) = - fun (x7 : t) -> ignore (Ojs.call (t_to_js x7) "resize" [||]) + t_of_js + (Ojs.new_obj + (Ojs.get_prop_ascii Ojs.global "Dygraph") + [| Native_node.t_to_js x3; Data.t_to_js x4; Options.t_to_js x5 |]) +;; + +let (destroy : t -> unit) = fun (x6 : t) -> ignore (Ojs.call (t_to_js x6) "destroy" [||]) +let (resize : t -> unit) = fun (x7 : t) -> ignore (Ojs.call (t_to_js x7) "resize" [||]) + let (resize_explicit : t -> width:int -> height:int -> unit) = fun (x10 : t) ~width:(x8 : int) ~height:(x9 : int) -> - ignore - (Ojs.call (t_to_js x10) "resize" - [|(Ojs.int_to_js x8);(Ojs.int_to_js x9)|]) + ignore (Ojs.call (t_to_js x10) "resize" [| Ojs.int_to_js x8; Ojs.int_to_js x9 |]) +;; + let (updateOptions : t -> Update_options.t -> unit) = fun (x12 : t) (x11 : Update_options.t) -> - ignore - (Ojs.call (t_to_js x12) "updateOptions" - [|(Update_options.t_to_js x11)|]) + ignore (Ojs.call (t_to_js x12) "updateOptions" [| Update_options.t_to_js x11 |]) +;; + let (getArea : t -> Area.t) = fun (x13 : t) -> Area.t_of_js (Ojs.call (t_to_js x13) "getArea" [||]) +;; + let (isZoomed : t -> bool) = fun (x14 : t) -> Ojs.bool_of_js (Ojs.call (t_to_js x14) "isZoomed" [||]) +;; + let (resetZoom : t -> unit) = fun (x15 : t) -> ignore (Ojs.call (t_to_js x15) "resetZoom" [||]) +;; + let (primary_context : t -> Canvas_rendering_context_2D.t) = fun (x16 : t) -> - Canvas_rendering_context_2D.t_of_js - (Ojs.get_prop_ascii (t_to_js x16) "hidden_ctx_") + Canvas_rendering_context_2D.t_of_js (Ojs.get_prop_ascii (t_to_js x16) "hidden_ctx_") +;; + let (overlay_context : t -> Canvas_rendering_context_2D.t) = fun (x17 : t) -> - Canvas_rendering_context_2D.t_of_js - (Ojs.get_prop_ascii (t_to_js x17) "canvas_ctx_") -let toDomCoords ?(axis= `y1) ~x:(x : float) ~y:(y : float) (t : t) = + Canvas_rendering_context_2D.t_of_js (Ojs.get_prop_ascii (t_to_js x17) "canvas_ctx_") +;; + +let toDomCoords ?(axis = `y1) ~(x : float) ~(y : float) (t : t) = let coords = - Ojs.call (t_to_js t) "toDomCoords" - [|(Ojs.float_to_js x);(Ojs.float_to_js y);(Ojs.int_to_js - (match axis with - | `y1 -> 0 - | `y2 -> 1))|] in - ((Ojs.float_of_js (Ojs.array_get coords 0)), - (Ojs.float_of_js (Ojs.array_get coords 1))) + Ojs.call + (t_to_js t) + "toDomCoords" + [| Ojs.float_to_js x + ; Ojs.float_to_js y + ; Ojs.int_to_js + (match axis with + | `y1 -> 0 + | `y2 -> 1) + |] + in + Ojs.float_of_js (Ojs.array_get coords 0), Ojs.float_of_js (Ojs.array_get coords 1) +;; diff --git a/bindings/dygraph/src/graph.mli b/bindings/dygraph/src/graph.mli index 391d4ff5..9861ac3f 100644 --- a/bindings/dygraph/src/graph.mli +++ b/bindings/dygraph/src/graph.mli @@ -1,31 +1,31 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** API: http://dygraphs.com/jsdoc/symbols/Dygraph.html *) type t -val create : Native_node.t -> Data.t -> Options.t -> t [@@js.new "Dygraph"] -val destroy : t -> unit [@@js.call] -val resize : t -> unit [@@js.call] +val create : Native_node.t -> Data.t -> Options.t -> t [@@js.new "Dygraph"] +val destroy : t -> unit [@@js.call] +val resize : t -> unit [@@js.call] val resize_explicit : t -> width:int -> height:int -> unit [@@js.call "resize"] -val updateOptions : t -> Update_options.t -> unit [@@js.call] -val getArea : t -> Area.t [@@js.call] -val isZoomed : t -> bool [@@js.call] -val resetZoom : t -> unit [@@js.call] +val updateOptions : t -> Update_options.t -> unit [@@js.call] +val getArea : t -> Area.t [@@js.call] +val isZoomed : t -> bool [@@js.call] +val resetZoom : t -> unit [@@js.call] (** [primary_context] is the rendering context to which Dygraphs draws data points and axes and underlays -- everything except the interactive highlights drawn to [overlay_context]. *) val primary_context : t -> Canvas_rendering_context_2D.t -[@@js.get "hidden_ctx_"] + [@@js.get "hidden_ctx_"] (** [overlay_context] is the rendering context for temporary overlays that change interactively, such as the highlighted point on mouse hover or the selected zoom region during a drag event. The separate canvas allows Dygraphs to quickly clear and redraw those overlays without having to re-render the entire graph. *) val overlay_context : t -> Canvas_rendering_context_2D.t -[@@js.get "canvas_ctx_"] + [@@js.get "canvas_ctx_"] (** Despite the name of the function, this returns a point in the coordinate space of the graph's canvas element. This function is suitable for finding drawing coordinates when @@ -35,22 +35,22 @@ val overlay_context : t -> Canvas_rendering_context_2D.t have to exist in any data series on the graph. But if you are using a multi-series graph with multiple Y axes, make sure that you pass the correct [axis]. *) val toDomCoords : ?axis:Which_y_axis.t -> x:float -> y:float -> t -> float * float -[@@js.custom - let toDomCoords ?(axis = `y1) ~(x : float) ~(y : float) (t : t) = - let coords = - Ojs.call - (t_to_js t) - "toDomCoords" - [| Ojs.float_to_js x - ; Ojs.float_to_js y - ; Ojs.int_to_js - (match axis with - | `y1 -> 0 - | `y2 -> 1) - |] - in - Ojs.float_of_js (Ojs.array_get coords 0), Ojs.float_of_js (Ojs.array_get coords 1) - ;;] + [@@js.custom + let toDomCoords ?(axis = `y1) ~(x : float) ~(y : float) (t : t) = + let coords = + Ojs.call + (t_to_js t) + "toDomCoords" + [| Ojs.float_to_js x + ; Ojs.float_to_js y + ; Ojs.int_to_js + (match axis with + | `y1 -> 0 + | `y2 -> 1) + |] + in + Ojs.float_of_js (Ojs.array_get coords 0), Ojs.float_of_js (Ojs.array_get coords 1) + ;;] val t_to_js : t -> Ojs.t val t_of_js : Ojs.t -> t diff --git a/bindings/dygraph/src/html_or_number.ml b/bindings/dygraph/src/html_or_number.ml index a54060b6..c8b11164 100644 --- a/bindings/dygraph/src/html_or_number.ml +++ b/bindings/dygraph/src/html_or_number.ml @@ -1,20 +1,20 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = - [ `html of Raw_html.t + [ `html of Raw_html.t | `number of float ] [@@deriving compare, equal, sexp] let t_to_js = function - | `html s -> Raw_html.t_to_js s - | `number f -> Ojs.float_to_js f + | `html s -> Raw_html.t_to_js s + | `number f -> Ojs.float_to_js f ;; let t_of_js ojs = if String.equal "number" (Ojs.type_of ojs) - then `number (Ojs.float_of_js ojs) - else `html (Raw_html.t_of_js ojs) + then `number (Ojs.float_of_js ojs) + else `html (Raw_html.t_of_js ojs) ;; diff --git a/bindings/dygraph/src/html_or_number.mli b/bindings/dygraph/src/html_or_number.mli index 45eaa83f..a3b69d0d 100644 --- a/bindings/dygraph/src/html_or_number.mli +++ b/bindings/dygraph/src/html_or_number.mli @@ -1,10 +1,9 @@ open! Core open! Import -open Gen_js_api - +open Gen_js_api type t = - [ `html of Raw_html.t + [ `html of Raw_html.t | `number of float ] [@@deriving compare, equal, sexp] diff --git a/bindings/dygraph/src/js_date.ml b/bindings/dygraph/src/js_date.ml index 9f9bedf2..d5bb7407 100644 --- a/bindings/dygraph/src/js_date.ml +++ b/bindings/dygraph/src/js_date.ml @@ -1,6 +1,6 @@ open! Core -open Import +open Import include Js_obj.Make (struct - type t = Js.date - end) + type t = Js.date +end) diff --git a/bindings/dygraph/src/js_date.mli b/bindings/dygraph/src/js_date.mli index a893f138..2b02e0a3 100644 --- a/bindings/dygraph/src/js_date.mli +++ b/bindings/dygraph/src/js_date.mli @@ -1,3 +1,3 @@ open! Core -open Import +open Import include Js_obj.S with type t = Js.date Js.t diff --git a/bindings/dygraph/src/js_obj.ml b/bindings/dygraph/src/js_obj.ml index ab46e47a..9e5a533c 100644 --- a/bindings/dygraph/src/js_obj.ml +++ b/bindings/dygraph/src/js_obj.ml @@ -1,11 +1,11 @@ open! Base -open Import -open Gen_js_api +open Import +open Gen_js_api include Js_obj_intf module Make (M : T) = struct type t = M.t Js.t - let t_of_js : Ojs.t -> t = Stdlib.Obj.magic - let t_to_js : t -> Ojs.t = Stdlib.Obj.magic + let t_of_js : Ojs.t -> t = Stdlib.Obj.magic + let t_to_js : t -> Ojs.t = Stdlib.Obj.magic end diff --git a/bindings/dygraph/src/js_obj_intf.ml b/bindings/dygraph/src/js_obj_intf.ml index e4fdab36..3ede3fac 100644 --- a/bindings/dygraph/src/js_obj_intf.ml +++ b/bindings/dygraph/src/js_obj_intf.ml @@ -1,6 +1,6 @@ open! Base -open Import -open Gen_js_api +open Import +open Gen_js_api module type S = sig type t diff --git a/bindings/dygraph/src/legend_data.ml b/bindings/dygraph/src/legend_data.ml index 4c73e28c..8ccbf704 100644 --- a/bindings/dygraph/src/legend_data.ml +++ b/bindings/dygraph/src/legend_data.ml @@ -1,78 +1,70 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api -module Series = - struct - type t = - { - dashHTML: Raw_html.t ; - label: string ; - labelHTML: Raw_html.t ; - isVisible: bool ; - isHighlighted: bool option ; - color: string option ; - y: float option ; - yHTML: Raw_html.t option }[@@deriving (equal, sexp)] - let rec t_of_js : Ojs.t -> t = - fun (x6 : Ojs.t) -> - { - dashHTML = (Raw_html.t_of_js (Ojs.get_prop_ascii x6 "dashHTML")); - label = (Ojs.string_of_js (Ojs.get_prop_ascii x6 "label")); - labelHTML = (Raw_html.t_of_js (Ojs.get_prop_ascii x6 "labelHTML")); - isVisible = (Ojs.bool_of_js (Ojs.get_prop_ascii x6 "isVisible")); - isHighlighted = - (Ojs.option_of_js Ojs.bool_of_js - (Ojs.get_prop_ascii x6 "isHighlighted")); - color = - (Ojs.option_of_js Ojs.string_of_js - (Ojs.get_prop_ascii x6 "color")); - y = (Ojs.option_of_js Ojs.float_of_js (Ojs.get_prop_ascii x6 "y")); - yHTML = - (Ojs.option_of_js Raw_html.t_of_js - (Ojs.get_prop_ascii x6 "yHTML")) - } - and t_to_js : t -> Ojs.t = - fun (x1 : t) -> - Ojs.obj - [|("dashHTML", (Raw_html.t_to_js x1.dashHTML));("label", - (Ojs.string_to_js - x1.label)); - ("labelHTML", (Raw_html.t_to_js x1.labelHTML));("isVisible", - (Ojs.bool_to_js - x1.isVisible)); - ("isHighlighted", - (Ojs.option_to_js Ojs.bool_to_js x1.isHighlighted));("color", - ( - Ojs.option_to_js - Ojs.string_to_js - x1.color)); - ("y", (Ojs.option_to_js Ojs.float_to_js x1.y));("yHTML", - (Ojs.option_to_js - Raw_html.t_to_js - x1.yHTML))|] - end + +module Series = struct + type t = + { dashHTML : Raw_html.t + ; label : string + ; labelHTML : Raw_html.t + ; isVisible : bool + ; isHighlighted : bool option + ; color : string option + ; y : float option + ; yHTML : Raw_html.t option + } + [@@deriving equal, sexp] + + let rec t_of_js : Ojs.t -> t = + fun (x6 : Ojs.t) -> + { dashHTML = Raw_html.t_of_js (Ojs.get_prop_ascii x6 "dashHTML") + ; label = Ojs.string_of_js (Ojs.get_prop_ascii x6 "label") + ; labelHTML = Raw_html.t_of_js (Ojs.get_prop_ascii x6 "labelHTML") + ; isVisible = Ojs.bool_of_js (Ojs.get_prop_ascii x6 "isVisible") + ; isHighlighted = + Ojs.option_of_js Ojs.bool_of_js (Ojs.get_prop_ascii x6 "isHighlighted") + ; color = Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop_ascii x6 "color") + ; y = Ojs.option_of_js Ojs.float_of_js (Ojs.get_prop_ascii x6 "y") + ; yHTML = Ojs.option_of_js Raw_html.t_of_js (Ojs.get_prop_ascii x6 "yHTML") + } + + and t_to_js : t -> Ojs.t = + fun (x1 : t) -> + Ojs.obj + [| "dashHTML", Raw_html.t_to_js x1.dashHTML + ; "label", Ojs.string_to_js x1.label + ; "labelHTML", Raw_html.t_to_js x1.labelHTML + ; "isVisible", Ojs.bool_to_js x1.isVisible + ; "isHighlighted", Ojs.option_to_js Ojs.bool_to_js x1.isHighlighted + ; "color", Ojs.option_to_js Ojs.string_to_js x1.color + ; "y", Ojs.option_to_js Ojs.float_to_js x1.y + ; "yHTML", Ojs.option_to_js Raw_html.t_to_js x1.yHTML + |] + ;; +end + type t = - { - x: float option ; - xHTML: Html_or_number.t option ; - series: Series.t list }[@@deriving (equal, sexp)] + { x : float option + ; xHTML : Html_or_number.t option + ; series : Series.t list + } +[@@deriving equal, sexp] + let rec t_of_js : Ojs.t -> t = fun (x15 : Ojs.t) -> - { - x = (Ojs.option_of_js Ojs.float_of_js (Ojs.get_prop_ascii x15 "x")); - xHTML = - (Ojs.option_of_js Html_or_number.t_of_js - (Ojs.get_prop_ascii x15 "xHTML")); - series = - (Ojs.list_of_js Series.t_of_js (Ojs.get_prop_ascii x15 "series")) - } + { x = Ojs.option_of_js Ojs.float_of_js (Ojs.get_prop_ascii x15 "x") + ; xHTML = Ojs.option_of_js Html_or_number.t_of_js (Ojs.get_prop_ascii x15 "xHTML") + ; series = Ojs.list_of_js Series.t_of_js (Ojs.get_prop_ascii x15 "series") + } + and t_to_js : t -> Ojs.t = fun (x11 : t) -> - Ojs.obj - [|("x", (Ojs.option_to_js Ojs.float_to_js x11.x));("xHTML", - (Ojs.option_to_js - Html_or_number.t_to_js - x11.xHTML)); - ("series", (Ojs.list_to_js Series.t_to_js x11.series))|] + Ojs.obj + [| "x", Ojs.option_to_js Ojs.float_to_js x11.x + ; "xHTML", Ojs.option_to_js Html_or_number.t_to_js x11.xHTML + ; "series", Ojs.list_to_js Series.t_to_js x11.series + |] +;; diff --git a/bindings/dygraph/src/legend_data.mli b/bindings/dygraph/src/legend_data.mli index 4e864fcf..20bb2ae8 100644 --- a/bindings/dygraph/src/legend_data.mli +++ b/bindings/dygraph/src/legend_data.mli @@ -1,20 +1,20 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** Legend_data is what you receive on the legendFormatter callback, as described here: https://github.com/danvk/dygraphs/pull/683 *) module Series : sig type t = - { dashHTML : Raw_html.t - ; label : string - ; labelHTML : Raw_html.t - ; isVisible : bool + { dashHTML : Raw_html.t + ; label : string + ; labelHTML : Raw_html.t + ; isVisible : bool ; isHighlighted : bool option - ; color : string option - ; y : float option - ; yHTML : Raw_html.t option + ; color : string option + ; y : float option + ; yHTML : Raw_html.t option } [@@deriving equal, sexp] @@ -23,11 +23,11 @@ module Series : sig end type t = - { x : float option - ; xHTML : Html_or_number.t option - (** Empirically, it seems that xHTML comes back as html (a string) for date/time-based + { x : float option + ; xHTML : Html_or_number.t option + (** Empirically, it seems that xHTML comes back as html (a string) for date/time-based x-axes and a number for number-based x-axes. *) - ; series : Series.t list + ; series : Series.t list } [@@deriving equal, sexp] diff --git a/bindings/dygraph/src/native_node.ml b/bindings/dygraph/src/native_node.ml index 41592d04..25ffc110 100644 --- a/bindings/dygraph/src/native_node.ml +++ b/bindings/dygraph/src/native_node.ml @@ -1,6 +1,6 @@ open! Core -open Import +open Import include Js_obj.Make (struct - type t = Dom_html.element - end) + type t = Dom_html.element +end) diff --git a/bindings/dygraph/src/native_node.mli b/bindings/dygraph/src/native_node.mli index 5bd5d0db..6f245a75 100644 --- a/bindings/dygraph/src/native_node.mli +++ b/bindings/dygraph/src/native_node.mli @@ -1,3 +1,3 @@ open! Core -open Import +open Import include Js_obj.S with type t = Dom_html.element Js.t diff --git a/bindings/dygraph/src/number_or_js_date.ml b/bindings/dygraph/src/number_or_js_date.ml index 2afa8b29..89d97a6e 100644 --- a/bindings/dygraph/src/number_or_js_date.ml +++ b/bindings/dygraph/src/number_or_js_date.ml @@ -1,19 +1,19 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = [ `number of float - | `date of Js_date.t + | `date of Js_date.t ] let t_to_js = function | `number f -> Ojs.float_to_js f - | `date d -> Js_date.t_to_js d + | `date d -> Js_date.t_to_js d ;; let t_of_js ojs = if String.equal "number" (Ojs.type_of ojs) then `number (Ojs.float_of_js ojs) - else `date (Js_date.t_of_js ojs) + else `date (Js_date.t_of_js ojs) ;; diff --git a/bindings/dygraph/src/number_or_js_date.mli b/bindings/dygraph/src/number_or_js_date.mli index ae837fed..a1d47e65 100644 --- a/bindings/dygraph/src/number_or_js_date.mli +++ b/bindings/dygraph/src/number_or_js_date.mli @@ -1,11 +1,10 @@ open! Core open! Import -open Gen_js_api - +open Gen_js_api type t = [ `number of float - | `date of Js_date.t + | `date of Js_date.t ] val t_to_js : t -> Ojs.t diff --git a/bindings/dygraph/src/options.ml b/bindings/dygraph/src/options.ml index bb749676..defdd12f 100644 --- a/bindings/dygraph/src/options.ml +++ b/bindings/dygraph/src/options.ml @@ -1,1111 +1,1039 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api -module Line_pattern = - struct - type t = int array - let rec t_of_js : Ojs.t -> t = - fun (x3 : Ojs.t) -> Ojs.array_of_js Ojs.int_of_js x3 - and t_to_js : t -> Ojs.t = - fun (x1 : int array) -> Ojs.array_to_js Ojs.int_to_js x1 - let dashed = [|7;2|] - end -module Legend = - struct - type t = [ `always | `follow | `never | `onmouseover ] - let rec t_of_js : Ojs.t -> t = - fun (x6 : Ojs.t) -> - let x7 = x6 in - match Ojs.string_of_js x7 with - | "always" -> `always - | "follow" -> `follow - | "never" -> `never - | "onmouseover" -> `onmouseover - | _ -> assert false - and t_to_js : t -> Ojs.t = - fun (x5 : [ `always | `follow | `never | `onmouseover ]) -> - match x5 with - | `always -> Ojs.string_to_js "always" - | `follow -> Ojs.string_to_js "follow" - | `never -> Ojs.string_to_js "never" - | `onmouseover -> Ojs.string_to_js "onmouseover" - end -module Series_options = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x9 : Ojs.t) -> x9 - and t_to_js : t -> Ojs.t = fun (x8 : Ojs.t) -> x8 - let (create : - ?axis:Which_y_axis.t -> - ?color:Color.t -> - ?drawPoints:bool -> - ?drawHighlightPointCallback:(graph:Ojs.t -> - seriesName:string option -> - context:Canvas_rendering_context_2D.t - -> - cx:float -> - cy:float -> - color:Ojs.t -> - pointSize:int -> - idx:int -> unit) - -> - ?drawPointCallback:(graph:Ojs.t -> - seriesName:string option -> - context:Canvas_rendering_context_2D.t - -> - cx:float -> - cy:float -> - color:Ojs.t -> - pointSize:int -> - idx:int -> unit) - -> - ?plotter:Plotter.t -> - ?plotterFinishedCallback:(context:Canvas_rendering_context_2D.t - -> unit) - -> - ?showInRangeSelector:bool -> - ?stepPlot:bool -> - ?strokePattern:Line_pattern.t -> - ?strokeWidth:float -> unit -> t) - = - fun ?axis:(x10 : Which_y_axis.t option) ?color:(x11 : Color.t option) + +module Line_pattern = struct + type t = int array + + let rec t_of_js : Ojs.t -> t = fun (x3 : Ojs.t) -> Ojs.array_of_js Ojs.int_of_js x3 + and t_to_js : t -> Ojs.t = fun (x1 : int array) -> Ojs.array_to_js Ojs.int_to_js x1 + + let dashed = [| 7; 2 |] +end + +module Legend = struct + type t = + [ `always + | `follow + | `never + | `onmouseover + ] + + let rec t_of_js : Ojs.t -> t = + fun (x6 : Ojs.t) -> + let x7 = x6 in + match Ojs.string_of_js x7 with + | "always" -> `always + | "follow" -> `follow + | "never" -> `never + | "onmouseover" -> `onmouseover + | _ -> assert false + + and t_to_js : t -> Ojs.t = + fun (x5 : [ `always | `follow | `never | `onmouseover ]) -> + match x5 with + | `always -> Ojs.string_to_js "always" + | `follow -> Ojs.string_to_js "follow" + | `never -> Ojs.string_to_js "never" + | `onmouseover -> Ojs.string_to_js "onmouseover" + ;; +end + +module Series_options = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x9 : Ojs.t) -> x9 + and t_to_js : t -> Ojs.t = fun (x8 : Ojs.t) -> x8 + + let (create : + ?axis:Which_y_axis.t + -> ?color:Color.t + -> ?drawPoints:bool + -> ?drawHighlightPointCallback: + (graph:Ojs.t + -> seriesName:string option + -> context:Canvas_rendering_context_2D.t + -> cx:float + -> cy:float + -> color:Ojs.t + -> pointSize:int + -> idx:int + -> unit) + -> ?drawPointCallback: + (graph:Ojs.t + -> seriesName:string option + -> context:Canvas_rendering_context_2D.t + -> cx:float + -> cy:float + -> color:Ojs.t + -> pointSize:int + -> idx:int + -> unit) + -> ?plotter:Plotter.t + -> ?plotterFinishedCallback:(context:Canvas_rendering_context_2D.t -> unit) + -> ?showInRangeSelector:bool + -> ?stepPlot:bool + -> ?strokePattern:Line_pattern.t + -> ?strokeWidth:float + -> unit + -> t) + = + fun ?axis:(x10 : Which_y_axis.t option) + ?color:(x11 : Color.t option) ?drawPoints:(x12 : bool option) - ?drawHighlightPointCallback:(x13 : - (graph:Ojs.t -> - seriesName:string option -> - context:Canvas_rendering_context_2D.t - -> - cx:float -> - cy:float -> - color:Ojs.t -> - pointSize:int -> - idx:int -> unit) - option) - ?drawPointCallback:(x14 : - (graph:Ojs.t -> - seriesName:string option -> - context:Canvas_rendering_context_2D.t -> - cx:float -> - cy:float -> - color:Ojs.t -> - pointSize:int -> idx:int -> unit) - option) + ?drawHighlightPointCallback: + (x13 : + (graph:Ojs.t + -> seriesName:string option + -> context:Canvas_rendering_context_2D.t + -> cx:float + -> cy:float + -> color:Ojs.t + -> pointSize:int + -> idx:int + -> unit) + option) + ?drawPointCallback: + (x14 : + (graph:Ojs.t + -> seriesName:string option + -> context:Canvas_rendering_context_2D.t + -> cx:float + -> cy:float + -> color:Ojs.t + -> pointSize:int + -> idx:int + -> unit) + option) ?plotter:(x15 : Plotter.t option) - ?plotterFinishedCallback:(x16 : - (context:Canvas_rendering_context_2D.t -> - unit) - option) + ?plotterFinishedCallback: + (x16 : (context:Canvas_rendering_context_2D.t -> unit) option) ?showInRangeSelector:(x17 : bool option) ?stepPlot:(x18 : bool option) ?strokePattern:(x19 : Line_pattern.t option) - ?strokeWidth:(x20 : float option) () -> - let x21 = Ojs.empty_obj () in - (match x10 with - | Some x51 -> - Ojs.set_prop_ascii x21 "axis" (Which_y_axis.t_to_js x51) - | None -> ()); - (match x11 with - | Some x50 -> Ojs.set_prop_ascii x21 "color" (Color.t_to_js x50) - | None -> ()); - (match x12 with - | Some x49 -> - Ojs.set_prop_ascii x21 "drawPoints" (Ojs.bool_to_js x49) - | None -> ()); - (match x13 with - | Some x39 -> - Ojs.set_prop_ascii x21 "drawHighlightPointCallback" - (Ojs.fun_to_js 8 - (fun (x40 : Ojs.t) (x41 : Ojs.t) (x43 : Ojs.t) - (x44 : Ojs.t) (x45 : Ojs.t) (x46 : Ojs.t) (x47 : Ojs.t) - (x48 : Ojs.t) -> - x39 ~graph:x40 - ~seriesName:(Ojs.option_of_js Ojs.string_of_js x41) - ~context:(Canvas_rendering_context_2D.t_of_js x43) - ~cx:(Ojs.float_of_js x44) ~cy:(Ojs.float_of_js x45) - ~color:x46 ~pointSize:(Ojs.int_of_js x47) - ~idx:(Ojs.int_of_js x48))) - | None -> ()); - (match x14 with - | Some x29 -> - Ojs.set_prop_ascii x21 "drawPointCallback" - (Ojs.fun_to_js 8 - (fun (x30 : Ojs.t) (x31 : Ojs.t) (x33 : Ojs.t) - (x34 : Ojs.t) (x35 : Ojs.t) (x36 : Ojs.t) (x37 : Ojs.t) - (x38 : Ojs.t) -> - x29 ~graph:x30 - ~seriesName:(Ojs.option_of_js Ojs.string_of_js x31) - ~context:(Canvas_rendering_context_2D.t_of_js x33) - ~cx:(Ojs.float_of_js x34) ~cy:(Ojs.float_of_js x35) - ~color:x36 ~pointSize:(Ojs.int_of_js x37) - ~idx:(Ojs.int_of_js x38))) - | None -> ()); - (match x15 with - | Some x28 -> Ojs.set_prop_ascii x21 "plotter" (Plotter.t_to_js x28) - | None -> ()); - (match x16 with - | Some x26 -> - Ojs.set_prop_ascii x21 "plotterFinishedCallback" - (Ojs.fun_to_js 1 - (fun (x27 : Ojs.t) -> - x26 ~context:(Canvas_rendering_context_2D.t_of_js x27))) - | None -> ()); - (match x17 with - | Some x25 -> - Ojs.set_prop_ascii x21 "showInRangeSelector" - (Ojs.bool_to_js x25) - | None -> ()); - (match x18 with - | Some x24 -> Ojs.set_prop_ascii x21 "stepPlot" (Ojs.bool_to_js x24) - | None -> ()); - (match x19 with - | Some x23 -> - Ojs.set_prop_ascii x21 "strokePattern" - (Line_pattern.t_to_js x23) - | None -> ()); - (match x20 with - | Some x22 -> - Ojs.set_prop_ascii x21 "strokeWidth" (Ojs.float_to_js x22) - | None -> ()); - t_of_js x21 - end -module Series = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x53 : Ojs.t) -> x53 - and t_to_js : t -> Ojs.t = fun (x52 : Ojs.t) -> x52 - let create data = - ((data |> (List.Assoc.map ~f:Series_options.t_to_js)) |> Array.of_list) - |> Ojs.obj - end -module Opts = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x55 : Ojs.t) -> x55 - and t_to_js : t -> Ojs.t = fun (x54 : Ojs.t) -> x54 - end -module Axis_options = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x57 : Ojs.t) -> x57 - and t_to_js : t -> Ojs.t = fun (x56 : Ojs.t) -> x56 - let (create : - ?axisLabelFormatter:(Number_or_js_date.t -> - Granularity.t -> Opts.t -> string) - -> - ?valueFormatter:(float -> Opts.t -> string) -> - ?axisLabelWidth:int -> - ?axisLineColor:Color.t -> - ?axisLineWidth:float -> - ?axisTickSize:float -> - ?drawAxis:bool -> - ?includeZero:bool -> - ?independentTicks:bool -> - ?logscale:bool -> - ?pixelsPerLabel:int -> - ?valueRange:Range.Spec.t -> - ?drawGrid:bool -> - ?gridLineColor:Color.t -> - ?gridLinePattern:Line_pattern.t -> - ?gridLineWidth:float -> - ?pixelsPerLabel:int -> unit -> t) - = - fun - ?axisLabelFormatter:(x58 : - (Number_or_js_date.t -> - Granularity.t -> Opts.t -> string) - option) + ?strokeWidth:(x20 : float option) + () -> + let x21 = Ojs.empty_obj () in + (match x10 with + | Some x51 -> Ojs.set_prop_ascii x21 "axis" (Which_y_axis.t_to_js x51) + | None -> ()); + (match x11 with + | Some x50 -> Ojs.set_prop_ascii x21 "color" (Color.t_to_js x50) + | None -> ()); + (match x12 with + | Some x49 -> Ojs.set_prop_ascii x21 "drawPoints" (Ojs.bool_to_js x49) + | None -> ()); + (match x13 with + | Some x39 -> + Ojs.set_prop_ascii + x21 + "drawHighlightPointCallback" + (Ojs.fun_to_js + 8 + (fun + (x40 : Ojs.t) + (x41 : Ojs.t) + (x43 : Ojs.t) + (x44 : Ojs.t) + (x45 : Ojs.t) + (x46 : Ojs.t) + (x47 : Ojs.t) + (x48 : Ojs.t) + -> + x39 + ~graph:x40 + ~seriesName:(Ojs.option_of_js Ojs.string_of_js x41) + ~context:(Canvas_rendering_context_2D.t_of_js x43) + ~cx:(Ojs.float_of_js x44) + ~cy:(Ojs.float_of_js x45) + ~color:x46 + ~pointSize:(Ojs.int_of_js x47) + ~idx:(Ojs.int_of_js x48))) + | None -> ()); + (match x14 with + | Some x29 -> + Ojs.set_prop_ascii + x21 + "drawPointCallback" + (Ojs.fun_to_js + 8 + (fun + (x30 : Ojs.t) + (x31 : Ojs.t) + (x33 : Ojs.t) + (x34 : Ojs.t) + (x35 : Ojs.t) + (x36 : Ojs.t) + (x37 : Ojs.t) + (x38 : Ojs.t) + -> + x29 + ~graph:x30 + ~seriesName:(Ojs.option_of_js Ojs.string_of_js x31) + ~context:(Canvas_rendering_context_2D.t_of_js x33) + ~cx:(Ojs.float_of_js x34) + ~cy:(Ojs.float_of_js x35) + ~color:x36 + ~pointSize:(Ojs.int_of_js x37) + ~idx:(Ojs.int_of_js x38))) + | None -> ()); + (match x15 with + | Some x28 -> Ojs.set_prop_ascii x21 "plotter" (Plotter.t_to_js x28) + | None -> ()); + (match x16 with + | Some x26 -> + Ojs.set_prop_ascii + x21 + "plotterFinishedCallback" + (Ojs.fun_to_js 1 (fun (x27 : Ojs.t) -> + x26 ~context:(Canvas_rendering_context_2D.t_of_js x27))) + | None -> ()); + (match x17 with + | Some x25 -> Ojs.set_prop_ascii x21 "showInRangeSelector" (Ojs.bool_to_js x25) + | None -> ()); + (match x18 with + | Some x24 -> Ojs.set_prop_ascii x21 "stepPlot" (Ojs.bool_to_js x24) + | None -> ()); + (match x19 with + | Some x23 -> Ojs.set_prop_ascii x21 "strokePattern" (Line_pattern.t_to_js x23) + | None -> ()); + (match x20 with + | Some x22 -> Ojs.set_prop_ascii x21 "strokeWidth" (Ojs.float_to_js x22) + | None -> ()); + t_of_js x21 + ;; +end + +module Series = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x53 : Ojs.t) -> x53 + and t_to_js : t -> Ojs.t = fun (x52 : Ojs.t) -> x52 + + let create data = + data |> List.Assoc.map ~f:Series_options.t_to_js |> Array.of_list |> Ojs.obj + ;; +end + +module Opts = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x55 : Ojs.t) -> x55 + and t_to_js : t -> Ojs.t = fun (x54 : Ojs.t) -> x54 +end + +module Axis_options = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x57 : Ojs.t) -> x57 + and t_to_js : t -> Ojs.t = fun (x56 : Ojs.t) -> x56 + + let (create : + ?axisLabelFormatter:(Number_or_js_date.t -> Granularity.t -> Opts.t -> string) + -> ?valueFormatter:(float -> Opts.t -> string) + -> ?axisLabelWidth:int + -> ?axisLineColor:Color.t + -> ?axisLineWidth:float + -> ?axisTickSize:float + -> ?drawAxis:bool + -> ?includeZero:bool + -> ?independentTicks:bool + -> ?logscale:bool + -> ?pixelsPerLabel:int + -> ?valueRange:Range.Spec.t + -> ?drawGrid:bool + -> ?gridLineColor:Color.t + -> ?gridLinePattern:Line_pattern.t + -> ?gridLineWidth:float + -> ?pixelsPerLabel:int + -> unit + -> t) + = + fun ?axisLabelFormatter: + (x58 : (Number_or_js_date.t -> Granularity.t -> Opts.t -> string) option) ?valueFormatter:(x59 : (float -> Opts.t -> string) option) ?axisLabelWidth:(x60 : int option) ?axisLineColor:(x61 : Color.t option) ?axisLineWidth:(x62 : float option) - ?axisTickSize:(x63 : float option) ?drawAxis:(x64 : bool option) + ?axisTickSize:(x63 : float option) + ?drawAxis:(x64 : bool option) ?includeZero:(x65 : bool option) - ?independentTicks:(x66 : bool option) ?logscale:(x67 : bool option) + ?independentTicks:(x66 : bool option) + ?logscale:(x67 : bool option) ?pixelsPerLabel:(x68 : int option) - ?valueRange:(x69 : Range.Spec.t option) ?drawGrid:(x70 : bool option) + ?valueRange:(x69 : Range.Spec.t option) + ?drawGrid:(x70 : bool option) ?gridLineColor:(x71 : Color.t option) ?gridLinePattern:(x72 : Line_pattern.t option) ?gridLineWidth:(x73 : float option) - ?pixelsPerLabel:(x74 : int option) () -> - let x75 = Ojs.empty_obj () in - (match x58 with - | Some x94 -> - Ojs.set_prop_ascii x75 "axisLabelFormatter" - (Ojs.fun_to_js 3 - (fun (x95 : Ojs.t) (x96 : Ojs.t) (x97 : Ojs.t) -> - Ojs.string_to_js - (x94 (Number_or_js_date.t_of_js x95) - (Granularity.t_of_js x96) (Opts.t_of_js x97)))) - | None -> ()); - (match x59 with - | Some x91 -> - Ojs.set_prop_ascii x75 "valueFormatter" - (Ojs.fun_to_js 2 - (fun (x92 : Ojs.t) (x93 : Ojs.t) -> - Ojs.string_to_js - (x91 (Ojs.float_of_js x92) (Opts.t_of_js x93)))) - | None -> ()); - (match x60 with - | Some x90 -> - Ojs.set_prop_ascii x75 "axisLabelWidth" (Ojs.int_to_js x90) - | None -> ()); - (match x61 with - | Some x89 -> - Ojs.set_prop_ascii x75 "axisLineColor" (Color.t_to_js x89) - | None -> ()); - (match x62 with - | Some x88 -> - Ojs.set_prop_ascii x75 "axisLineWidth" (Ojs.float_to_js x88) - | None -> ()); - (match x63 with - | Some x87 -> - Ojs.set_prop_ascii x75 "axisTickSize" (Ojs.float_to_js x87) - | None -> ()); - (match x64 with - | Some x86 -> Ojs.set_prop_ascii x75 "drawAxis" (Ojs.bool_to_js x86) - | None -> ()); - (match x65 with - | Some x85 -> - Ojs.set_prop_ascii x75 "includeZero" (Ojs.bool_to_js x85) - | None -> ()); - (match x66 with - | Some x84 -> - Ojs.set_prop_ascii x75 "independentTicks" (Ojs.bool_to_js x84) - | None -> ()); - (match x67 with - | Some x83 -> Ojs.set_prop_ascii x75 "logscale" (Ojs.bool_to_js x83) - | None -> ()); - (match x68 with - | Some x82 -> - Ojs.set_prop_ascii x75 "pixelsPerLabel" (Ojs.int_to_js x82) - | None -> ()); - (match x69 with - | Some x81 -> - Ojs.set_prop_ascii x75 "valueRange" (Range.Spec.t_to_js x81) - | None -> ()); - (match x70 with - | Some x80 -> Ojs.set_prop_ascii x75 "drawGrid" (Ojs.bool_to_js x80) - | None -> ()); - (match x71 with - | Some x79 -> - Ojs.set_prop_ascii x75 "gridLineColor" (Color.t_to_js x79) - | None -> ()); - (match x72 with - | Some x78 -> - Ojs.set_prop_ascii x75 "gridLinePattern" - (Line_pattern.t_to_js x78) - | None -> ()); - (match x73 with - | Some x77 -> - Ojs.set_prop_ascii x75 "gridLineWidth" (Ojs.float_to_js x77) - | None -> ()); - (match x74 with - | Some x76 -> - Ojs.set_prop_ascii x75 "pixelsPerLabel" (Ojs.int_to_js x76) - | None -> ()); - t_of_js x75 - end -module Axes = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x99 : Ojs.t) -> x99 - and t_to_js : t -> Ojs.t = fun (x98 : Ojs.t) -> x98 - let (create : - ?x:Axis_options.t -> - ?y:Axis_options.t -> ?y2:Axis_options.t -> unit -> t) - = - fun ?x:(x100 : Axis_options.t option) ?y:(x101 : Axis_options.t option) - ?y2:(x102 : Axis_options.t option) () -> - let x103 = Ojs.empty_obj () in - (match x100 with - | Some x106 -> - Ojs.set_prop_ascii x103 "x" (Axis_options.t_to_js x106) - | None -> ()); - (match x101 with - | Some x105 -> - Ojs.set_prop_ascii x103 "y" (Axis_options.t_to_js x105) - | None -> ()); - (match x102 with - | Some x104 -> - Ojs.set_prop_ascii x103 "y2" (Axis_options.t_to_js x104) - | None -> ()); - t_of_js x103 - end -module Highlight_series_options = - struct - type t = Ojs.t - let rec t_of_js : Ojs.t -> t = fun (x108 : Ojs.t) -> x108 - and t_to_js : t -> Ojs.t = fun (x107 : Ojs.t) -> x107 - let (create : - ?highlightCircleSize:int -> - ?strokeWidth:float -> ?strokeBorderWidth:float -> unit -> t) - = - fun ?highlightCircleSize:(x109 : int option) + ?pixelsPerLabel:(x74 : int option) + () -> + let x75 = Ojs.empty_obj () in + (match x58 with + | Some x94 -> + Ojs.set_prop_ascii + x75 + "axisLabelFormatter" + (Ojs.fun_to_js 3 (fun (x95 : Ojs.t) (x96 : Ojs.t) (x97 : Ojs.t) -> + Ojs.string_to_js + (x94 + (Number_or_js_date.t_of_js x95) + (Granularity.t_of_js x96) + (Opts.t_of_js x97)))) + | None -> ()); + (match x59 with + | Some x91 -> + Ojs.set_prop_ascii + x75 + "valueFormatter" + (Ojs.fun_to_js 2 (fun (x92 : Ojs.t) (x93 : Ojs.t) -> + Ojs.string_to_js (x91 (Ojs.float_of_js x92) (Opts.t_of_js x93)))) + | None -> ()); + (match x60 with + | Some x90 -> Ojs.set_prop_ascii x75 "axisLabelWidth" (Ojs.int_to_js x90) + | None -> ()); + (match x61 with + | Some x89 -> Ojs.set_prop_ascii x75 "axisLineColor" (Color.t_to_js x89) + | None -> ()); + (match x62 with + | Some x88 -> Ojs.set_prop_ascii x75 "axisLineWidth" (Ojs.float_to_js x88) + | None -> ()); + (match x63 with + | Some x87 -> Ojs.set_prop_ascii x75 "axisTickSize" (Ojs.float_to_js x87) + | None -> ()); + (match x64 with + | Some x86 -> Ojs.set_prop_ascii x75 "drawAxis" (Ojs.bool_to_js x86) + | None -> ()); + (match x65 with + | Some x85 -> Ojs.set_prop_ascii x75 "includeZero" (Ojs.bool_to_js x85) + | None -> ()); + (match x66 with + | Some x84 -> Ojs.set_prop_ascii x75 "independentTicks" (Ojs.bool_to_js x84) + | None -> ()); + (match x67 with + | Some x83 -> Ojs.set_prop_ascii x75 "logscale" (Ojs.bool_to_js x83) + | None -> ()); + (match x68 with + | Some x82 -> Ojs.set_prop_ascii x75 "pixelsPerLabel" (Ojs.int_to_js x82) + | None -> ()); + (match x69 with + | Some x81 -> Ojs.set_prop_ascii x75 "valueRange" (Range.Spec.t_to_js x81) + | None -> ()); + (match x70 with + | Some x80 -> Ojs.set_prop_ascii x75 "drawGrid" (Ojs.bool_to_js x80) + | None -> ()); + (match x71 with + | Some x79 -> Ojs.set_prop_ascii x75 "gridLineColor" (Color.t_to_js x79) + | None -> ()); + (match x72 with + | Some x78 -> Ojs.set_prop_ascii x75 "gridLinePattern" (Line_pattern.t_to_js x78) + | None -> ()); + (match x73 with + | Some x77 -> Ojs.set_prop_ascii x75 "gridLineWidth" (Ojs.float_to_js x77) + | None -> ()); + (match x74 with + | Some x76 -> Ojs.set_prop_ascii x75 "pixelsPerLabel" (Ojs.int_to_js x76) + | None -> ()); + t_of_js x75 + ;; +end + +module Axes = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x99 : Ojs.t) -> x99 + and t_to_js : t -> Ojs.t = fun (x98 : Ojs.t) -> x98 + + let (create : ?x:Axis_options.t -> ?y:Axis_options.t -> ?y2:Axis_options.t -> unit -> t) + = + fun ?x:(x100 : Axis_options.t option) + ?y:(x101 : Axis_options.t option) + ?y2:(x102 : Axis_options.t option) + () -> + let x103 = Ojs.empty_obj () in + (match x100 with + | Some x106 -> Ojs.set_prop_ascii x103 "x" (Axis_options.t_to_js x106) + | None -> ()); + (match x101 with + | Some x105 -> Ojs.set_prop_ascii x103 "y" (Axis_options.t_to_js x105) + | None -> ()); + (match x102 with + | Some x104 -> Ojs.set_prop_ascii x103 "y2" (Axis_options.t_to_js x104) + | None -> ()); + t_of_js x103 + ;; +end + +module Highlight_series_options = struct + type t = Ojs.t + + let rec t_of_js : Ojs.t -> t = fun (x108 : Ojs.t) -> x108 + and t_to_js : t -> Ojs.t = fun (x107 : Ojs.t) -> x107 + + let (create : + ?highlightCircleSize:int + -> ?strokeWidth:float + -> ?strokeBorderWidth:float + -> unit + -> t) + = + fun ?highlightCircleSize:(x109 : int option) ?strokeWidth:(x110 : float option) - ?strokeBorderWidth:(x111 : float option) () -> - let x112 = Ojs.empty_obj () in - (match x109 with - | Some x115 -> - Ojs.set_prop_ascii x112 "highlightCircleSize" - (Ojs.int_to_js x115) - | None -> ()); - (match x110 with - | Some x114 -> - Ojs.set_prop_ascii x112 "strokeWidth" (Ojs.float_to_js x114) - | None -> ()); - (match x111 with - | Some x113 -> - Ojs.set_prop_ascii x112 "strokeBorderWidth" - (Ojs.float_to_js x113) - | None -> ()); - t_of_js x112 - end + ?strokeBorderWidth:(x111 : float option) + () -> + let x112 = Ojs.empty_obj () in + (match x109 with + | Some x115 -> Ojs.set_prop_ascii x112 "highlightCircleSize" (Ojs.int_to_js x115) + | None -> ()); + (match x110 with + | Some x114 -> Ojs.set_prop_ascii x112 "strokeWidth" (Ojs.float_to_js x114) + | None -> ()); + (match x111 with + | Some x113 -> Ojs.set_prop_ascii x112 "strokeBorderWidth" (Ojs.float_to_js x113) + | None -> ()); + t_of_js x112 + ;; +end + type t = Ojs.t + let rec t_of_js : Ojs.t -> t = fun (x117 : Ojs.t) -> x117 and t_to_js : t -> Ojs.t = fun (x116 : Ojs.t) -> x116 + let (create : - ?axisLabelFontSize:int -> - ?axisLabelWidth:int -> - ?axisLineColor:Color.t -> - ?axisLineWidth:float -> - ?axisTickSize:float -> - ?dateWindow:Range.t -> - ?drawAxesAtZero:bool -> - ?drawAxis:bool -> - ?includeZero:bool -> - ?logscale:bool -> - ?panEdgeFraction:float -> - ?valueRange:Range.Spec.t -> - ?xAxisHeight:int -> - ?xRangePad:float -> - ?yRangePad:float -> - ?customBars:bool -> - ?errorBars:bool -> - ?fractions:bool -> - ?title:string -> - ?titleHeight:int -> - ?xLabelHeight:int -> - ?xlabel:string -> - ?y2label:string -> - ?yLabelWidth:int -> - ?ylabel:string -> - ?axes:Axes.t -> - ?connectSeparatedPoints:bool - -> - ?drawGapEdgePoints:bool - -> - ?drawPoints:bool -> - ?fillGraph:bool - -> - ?pointSize:int - -> - ?stackedGraph:bool - -> - ?stackedGraphNaNFill:string - -> - ?stepPlot:bool - -> - ?strokeBorderColor:Color.t - -> - ?strokeBorderWidth:float - -> - ?strokePattern:Line_pattern.t - -> - ?strokeWidth:float - -> - ?visibility:bool - list -> - ?colorSaturation:float - -> - ?colorValue:float - -> - ?colors:Color.t - array -> - ?fillAlpha:float - -> - ?rollPeriod:int - -> - ?sigma:float - -> - ?wilsonInterval:bool - -> - ?drawGrid:bool - -> - ?gridLineColor:Color.t - -> - ?gridLinePattern:Line_pattern.t - -> - ?gridLineWidth:float - -> - ?animatedZooms:bool - -> - ?hideOverlayOnMouseOut:bool - -> - ?highlightCircleSize:int - -> - ?highlightSeriesBackgroundAlpha:float - -> - ?highlightSeriesBackgroundColor:Color.t - -> - ?highlightSeriesOpts:Highlight_series_options.t - -> - ?showLabelsOnHighlight:bool - -> - ?showRoller:bool - -> - ?hideOverlayOnMouseOut:bool - -> - ?labels:string - list -> - ?labelsDiv_string:string - -> - ?labelsDiv_el:Native_node.t - -> - ?labelsSeparateLines:bool - -> - ?labelsShowZeroValues:bool - -> - ?legend:Legend.t - -> - ?legendFormatter:( - Legend_data.t - -> - string) - -> - ?showLabelsOnHighlight:bool - -> - ?height:int - -> - ?clickCallback:( - evt:Ojs.t - -> - x:float - -> - points:Point.t - array -> - unit) -> - ?highlightCallback:( - evt:Ojs.t - -> - x:float - -> - points:Point.t - array -> - row:int - -> - seriesName:string - option -> - unit) -> - ?unhighlightCallback:( - evt:Ojs.t - -> - unit) -> - ?pointClickCallback:( - evt:Ojs.t - -> - point:Point.t - -> - unit) -> - ?underlayCallback:( - context:Canvas_rendering_context_2D.t - -> - area:Area.t - -> - dygraph:Ojs.t - -> - unit) -> - ?drawCallback:( - graph:Ojs.t - -> - isInitial:bool - -> - unit) -> - ?zoomCallback:( - xmin:float - -> - xmax:float - -> - yRanges:Range.t - array -> - unit) -> - ?pixelRatio:float - -> - ?plotter:Plotter.t - list -> - ?rightGap:int - -> - ?width:int - -> - ?rangeSelectorAlpha:float - -> - ?rangeSelectorBackgroundLineWidth:float - -> - ?rangeSelectorBackgroundStrokeColor:Color.t - -> - ?rangeSelectorForegroundLineWidth:float - -> - ?rangeSelectorForegroundStrokeColor:Color.t - -> - ?rangeSelectorHeight:int - -> - ?rangeSelectorPlotFillColor:Color.t - -> - ?rangeSelectorPlotFillGradientColor:Color.t - -> - ?rangeSelectorPlotLineWidth:float - -> - ?rangeSelectorPlotStrokeColor:Color.t - -> - ?showRangeSelector:bool - -> - ?series:Series.t - -> - ?digitsAfterDecimal:int - -> - ?labelsKMB:bool - -> - ?labelsKMG2:bool - -> - ?labelsUTC:bool - -> - ?maxNumberWidth:int - -> - ?sigFigs:int - -> - unit -> t) + ?axisLabelFontSize:int + -> ?axisLabelWidth:int + -> ?axisLineColor:Color.t + -> ?axisLineWidth:float + -> ?axisTickSize:float + -> ?dateWindow:Range.t + -> ?drawAxesAtZero:bool + -> ?drawAxis:bool + -> ?includeZero:bool + -> ?logscale:bool + -> ?panEdgeFraction:float + -> ?valueRange:Range.Spec.t + -> ?xAxisHeight:int + -> ?xRangePad:float + -> ?yRangePad:float + -> ?customBars:bool + -> ?errorBars:bool + -> ?fractions:bool + -> ?title:string + -> ?titleHeight:int + -> ?xLabelHeight:int + -> ?xlabel:string + -> ?y2label:string + -> ?yLabelWidth:int + -> ?ylabel:string + -> ?axes:Axes.t + -> ?connectSeparatedPoints:bool + -> ?drawGapEdgePoints:bool + -> ?drawPoints:bool + -> ?fillGraph:bool + -> ?pointSize:int + -> ?stackedGraph:bool + -> ?stackedGraphNaNFill:string + -> ?stepPlot:bool + -> ?strokeBorderColor:Color.t + -> ?strokeBorderWidth:float + -> ?strokePattern:Line_pattern.t + -> ?strokeWidth:float + -> ?visibility:bool list + -> ?colorSaturation:float + -> ?colorValue:float + -> ?colors:Color.t array + -> ?fillAlpha:float + -> ?rollPeriod:int + -> ?sigma:float + -> ?wilsonInterval:bool + -> ?drawGrid:bool + -> ?gridLineColor:Color.t + -> ?gridLinePattern:Line_pattern.t + -> ?gridLineWidth:float + -> ?animatedZooms:bool + -> ?hideOverlayOnMouseOut:bool + -> ?highlightCircleSize:int + -> ?highlightSeriesBackgroundAlpha:float + -> ?highlightSeriesBackgroundColor:Color.t + -> ?highlightSeriesOpts:Highlight_series_options.t + -> ?showLabelsOnHighlight:bool + -> ?showRoller:bool + -> ?hideOverlayOnMouseOut:bool + -> ?labels:string list + -> ?labelsDiv_string:string + -> ?labelsDiv_el:Native_node.t + -> ?labelsSeparateLines:bool + -> ?labelsShowZeroValues:bool + -> ?legend:Legend.t + -> ?legendFormatter:(Legend_data.t -> string) + -> ?showLabelsOnHighlight:bool + -> ?height:int + -> ?clickCallback:(evt:Ojs.t -> x:float -> points:Point.t array -> unit) + -> ?highlightCallback: + (evt:Ojs.t + -> x:float + -> points:Point.t array + -> row:int + -> seriesName:string option + -> unit) + -> ?unhighlightCallback:(evt:Ojs.t -> unit) + -> ?pointClickCallback:(evt:Ojs.t -> point:Point.t -> unit) + -> ?underlayCallback: + (context:Canvas_rendering_context_2D.t -> area:Area.t -> dygraph:Ojs.t -> unit) + -> ?drawCallback:(graph:Ojs.t -> isInitial:bool -> unit) + -> ?zoomCallback:(xmin:float -> xmax:float -> yRanges:Range.t array -> unit) + -> ?pixelRatio:float + -> ?plotter:Plotter.t list + -> ?rightGap:int + -> ?width:int + -> ?rangeSelectorAlpha:float + -> ?rangeSelectorBackgroundLineWidth:float + -> ?rangeSelectorBackgroundStrokeColor:Color.t + -> ?rangeSelectorForegroundLineWidth:float + -> ?rangeSelectorForegroundStrokeColor:Color.t + -> ?rangeSelectorHeight:int + -> ?rangeSelectorPlotFillColor:Color.t + -> ?rangeSelectorPlotFillGradientColor:Color.t + -> ?rangeSelectorPlotLineWidth:float + -> ?rangeSelectorPlotStrokeColor:Color.t + -> ?showRangeSelector:bool + -> ?series:Series.t + -> ?digitsAfterDecimal:int + -> ?labelsKMB:bool + -> ?labelsKMG2:bool + -> ?labelsUTC:bool + -> ?maxNumberWidth:int + -> ?sigFigs:int + -> unit + -> t) = fun ?axisLabelFontSize:(x118 : int option) - ?axisLabelWidth:(x119 : int option) - ?axisLineColor:(x120 : Color.t option) - ?axisLineWidth:(x121 : float option) ?axisTickSize:(x122 : float option) - ?dateWindow:(x123 : Range.t option) ?drawAxesAtZero:(x124 : bool option) - ?drawAxis:(x125 : bool option) ?includeZero:(x126 : bool option) - ?logscale:(x127 : bool option) ?panEdgeFraction:(x128 : float option) - ?valueRange:(x129 : Range.Spec.t option) ?xAxisHeight:(x130 : int option) - ?xRangePad:(x131 : float option) ?yRangePad:(x132 : float option) - ?customBars:(x133 : bool option) ?errorBars:(x134 : bool option) - ?fractions:(x135 : bool option) ?title:(x136 : string option) - ?titleHeight:(x137 : int option) ?xLabelHeight:(x138 : int option) - ?xlabel:(x139 : string option) ?y2label:(x140 : string option) - ?yLabelWidth:(x141 : int option) ?ylabel:(x142 : string option) - ?axes:(x143 : Axes.t option) ?connectSeparatedPoints:(x144 : bool option) - ?drawGapEdgePoints:(x145 : bool option) ?drawPoints:(x146 : bool option) - ?fillGraph:(x147 : bool option) ?pointSize:(x148 : int option) - ?stackedGraph:(x149 : bool option) - ?stackedGraphNaNFill:(x150 : string option) - ?stepPlot:(x151 : bool option) ?strokeBorderColor:(x152 : Color.t option) - ?strokeBorderWidth:(x153 : float option) - ?strokePattern:(x154 : Line_pattern.t option) - ?strokeWidth:(x155 : float option) ?visibility:(x156 : bool list option) - ?colorSaturation:(x157 : float option) ?colorValue:(x158 : float option) - ?colors:(x159 : Color.t array option) ?fillAlpha:(x160 : float option) - ?rollPeriod:(x161 : int option) ?sigma:(x162 : float option) - ?wilsonInterval:(x163 : bool option) ?drawGrid:(x164 : bool option) - ?gridLineColor:(x165 : Color.t option) - ?gridLinePattern:(x166 : Line_pattern.t option) - ?gridLineWidth:(x167 : float option) ?animatedZooms:(x168 : bool option) - ?hideOverlayOnMouseOut:(x169 : bool option) - ?highlightCircleSize:(x170 : int option) - ?highlightSeriesBackgroundAlpha:(x171 : float option) - ?highlightSeriesBackgroundColor:(x172 : Color.t option) - ?highlightSeriesOpts:(x173 : Highlight_series_options.t option) - ?showLabelsOnHighlight:(x174 : bool option) - ?showRoller:(x175 : bool option) - ?hideOverlayOnMouseOut:(x176 : bool option) - ?labels:(x177 : string list option) - ?labelsDiv_string:(x178 : string option) - ?labelsDiv_el:(x179 : Native_node.t option) - ?labelsSeparateLines:(x180 : bool option) - ?labelsShowZeroValues:(x181 : bool option) - ?legend:(x182 : Legend.t option) - ?legendFormatter:(x183 : (Legend_data.t -> string) option) - ?showLabelsOnHighlight:(x184 : bool option) ?height:(x185 : int option) - ?clickCallback:(x186 : - (evt:Ojs.t -> x:float -> points:Point.t array -> unit) - option) - ?highlightCallback:(x187 : - (evt:Ojs.t -> - x:float -> - points:Point.t array -> - row:int -> seriesName:string option -> unit) - option) - ?unhighlightCallback:(x188 : (evt:Ojs.t -> unit) option) - ?pointClickCallback:(x189 : (evt:Ojs.t -> point:Point.t -> unit) option) - ?underlayCallback:(x190 : - (context:Canvas_rendering_context_2D.t -> - area:Area.t -> dygraph:Ojs.t -> unit) - option) - ?drawCallback:(x191 : (graph:Ojs.t -> isInitial:bool -> unit) option) - ?zoomCallback:(x192 : - (xmin:float -> - xmax:float -> yRanges:Range.t array -> unit) - option) - ?pixelRatio:(x193 : float option) ?plotter:(x194 : Plotter.t list option) - ?rightGap:(x195 : int option) ?width:(x196 : int option) - ?rangeSelectorAlpha:(x197 : float option) - ?rangeSelectorBackgroundLineWidth:(x198 : float option) - ?rangeSelectorBackgroundStrokeColor:(x199 : Color.t option) - ?rangeSelectorForegroundLineWidth:(x200 : float option) - ?rangeSelectorForegroundStrokeColor:(x201 : Color.t option) - ?rangeSelectorHeight:(x202 : int option) - ?rangeSelectorPlotFillColor:(x203 : Color.t option) - ?rangeSelectorPlotFillGradientColor:(x204 : Color.t option) - ?rangeSelectorPlotLineWidth:(x205 : float option) - ?rangeSelectorPlotStrokeColor:(x206 : Color.t option) - ?showRangeSelector:(x207 : bool option) ?series:(x208 : Series.t option) - ?digitsAfterDecimal:(x209 : int option) ?labelsKMB:(x210 : bool option) - ?labelsKMG2:(x211 : bool option) ?labelsUTC:(x212 : bool option) - ?maxNumberWidth:(x213 : int option) ?sigFigs:(x214 : int option) () -> - let x215 = Ojs.empty_obj () in - (match x118 with - | Some x340 -> - Ojs.set_prop_ascii x215 "axisLabelFontSize" (Ojs.int_to_js x340) - | None -> ()); - (match x119 with - | Some x339 -> - Ojs.set_prop_ascii x215 "axisLabelWidth" (Ojs.int_to_js x339) - | None -> ()); - (match x120 with - | Some x338 -> - Ojs.set_prop_ascii x215 "axisLineColor" (Color.t_to_js x338) - | None -> ()); - (match x121 with - | Some x337 -> - Ojs.set_prop_ascii x215 "axisLineWidth" (Ojs.float_to_js x337) - | None -> ()); - (match x122 with - | Some x336 -> - Ojs.set_prop_ascii x215 "axisTickSize" (Ojs.float_to_js x336) - | None -> ()); - (match x123 with - | Some x335 -> Ojs.set_prop_ascii x215 "dateWindow" (Range.t_to_js x335) - | None -> ()); - (match x124 with - | Some x334 -> - Ojs.set_prop_ascii x215 "drawAxesAtZero" (Ojs.bool_to_js x334) - | None -> ()); - (match x125 with - | Some x333 -> Ojs.set_prop_ascii x215 "drawAxis" (Ojs.bool_to_js x333) - | None -> ()); - (match x126 with - | Some x332 -> - Ojs.set_prop_ascii x215 "includeZero" (Ojs.bool_to_js x332) - | None -> ()); - (match x127 with - | Some x331 -> Ojs.set_prop_ascii x215 "logscale" (Ojs.bool_to_js x331) - | None -> ()); - (match x128 with - | Some x330 -> - Ojs.set_prop_ascii x215 "panEdgeFraction" (Ojs.float_to_js x330) - | None -> ()); - (match x129 with - | Some x329 -> - Ojs.set_prop_ascii x215 "valueRange" (Range.Spec.t_to_js x329) - | None -> ()); - (match x130 with - | Some x328 -> - Ojs.set_prop_ascii x215 "xAxisHeight" (Ojs.int_to_js x328) - | None -> ()); - (match x131 with - | Some x327 -> - Ojs.set_prop_ascii x215 "xRangePad" (Ojs.float_to_js x327) - | None -> ()); - (match x132 with - | Some x326 -> - Ojs.set_prop_ascii x215 "yRangePad" (Ojs.float_to_js x326) - | None -> ()); - (match x133 with - | Some x325 -> - Ojs.set_prop_ascii x215 "customBars" (Ojs.bool_to_js x325) - | None -> ()); - (match x134 with - | Some x324 -> Ojs.set_prop_ascii x215 "errorBars" (Ojs.bool_to_js x324) - | None -> ()); - (match x135 with - | Some x323 -> Ojs.set_prop_ascii x215 "fractions" (Ojs.bool_to_js x323) - | None -> ()); - (match x136 with - | Some x322 -> Ojs.set_prop_ascii x215 "title" (Ojs.string_to_js x322) - | None -> ()); - (match x137 with - | Some x321 -> - Ojs.set_prop_ascii x215 "titleHeight" (Ojs.int_to_js x321) - | None -> ()); - (match x138 with - | Some x320 -> - Ojs.set_prop_ascii x215 "xLabelHeight" (Ojs.int_to_js x320) - | None -> ()); - (match x139 with - | Some x319 -> Ojs.set_prop_ascii x215 "xlabel" (Ojs.string_to_js x319) - | None -> ()); - (match x140 with - | Some x318 -> Ojs.set_prop_ascii x215 "y2label" (Ojs.string_to_js x318) - | None -> ()); - (match x141 with - | Some x317 -> - Ojs.set_prop_ascii x215 "yLabelWidth" (Ojs.int_to_js x317) - | None -> ()); - (match x142 with - | Some x316 -> Ojs.set_prop_ascii x215 "ylabel" (Ojs.string_to_js x316) - | None -> ()); - (match x143 with - | Some x315 -> Ojs.set_prop_ascii x215 "axes" (Axes.t_to_js x315) - | None -> ()); - (match x144 with - | Some x314 -> - Ojs.set_prop_ascii x215 "connectSeparatedPoints" - (Ojs.bool_to_js x314) - | None -> ()); - (match x145 with - | Some x313 -> - Ojs.set_prop_ascii x215 "drawGapEdgePoints" (Ojs.bool_to_js x313) - | None -> ()); - (match x146 with - | Some x312 -> - Ojs.set_prop_ascii x215 "drawPoints" (Ojs.bool_to_js x312) - | None -> ()); - (match x147 with - | Some x311 -> Ojs.set_prop_ascii x215 "fillGraph" (Ojs.bool_to_js x311) - | None -> ()); - (match x148 with - | Some x310 -> Ojs.set_prop_ascii x215 "pointSize" (Ojs.int_to_js x310) - | None -> ()); - (match x149 with - | Some x309 -> - Ojs.set_prop_ascii x215 "stackedGraph" (Ojs.bool_to_js x309) - | None -> ()); - (match x150 with - | Some x308 -> - Ojs.set_prop_ascii x215 "stackedGraphNaNFill" - (Ojs.string_to_js x308) - | None -> ()); - (match x151 with - | Some x307 -> Ojs.set_prop_ascii x215 "stepPlot" (Ojs.bool_to_js x307) - | None -> ()); - (match x152 with - | Some x306 -> - Ojs.set_prop_ascii x215 "strokeBorderColor" (Color.t_to_js x306) - | None -> ()); - (match x153 with - | Some x305 -> - Ojs.set_prop_ascii x215 "strokeBorderWidth" (Ojs.float_to_js x305) - | None -> ()); - (match x154 with - | Some x304 -> - Ojs.set_prop_ascii x215 "strokePattern" (Line_pattern.t_to_js x304) - | None -> ()); - (match x155 with - | Some x303 -> - Ojs.set_prop_ascii x215 "strokeWidth" (Ojs.float_to_js x303) - | None -> ()); - (match x156 with - | Some x301 -> - Ojs.set_prop_ascii x215 "visibility" - (Ojs.list_to_js Ojs.bool_to_js x301) - | None -> ()); - (match x157 with - | Some x300 -> - Ojs.set_prop_ascii x215 "colorSaturation" (Ojs.float_to_js x300) - | None -> ()); - (match x158 with - | Some x299 -> - Ojs.set_prop_ascii x215 "colorValue" (Ojs.float_to_js x299) - | None -> ()); - (match x159 with - | Some x297 -> - Ojs.set_prop_ascii x215 "colors" - (Ojs.array_to_js Color.t_to_js x297) - | None -> ()); - (match x160 with - | Some x296 -> - Ojs.set_prop_ascii x215 "fillAlpha" (Ojs.float_to_js x296) - | None -> ()); - (match x161 with - | Some x295 -> Ojs.set_prop_ascii x215 "rollPeriod" (Ojs.int_to_js x295) - | None -> ()); - (match x162 with - | Some x294 -> Ojs.set_prop_ascii x215 "sigma" (Ojs.float_to_js x294) - | None -> ()); - (match x163 with - | Some x293 -> - Ojs.set_prop_ascii x215 "wilsonInterval" (Ojs.bool_to_js x293) - | None -> ()); - (match x164 with - | Some x292 -> Ojs.set_prop_ascii x215 "drawGrid" (Ojs.bool_to_js x292) - | None -> ()); - (match x165 with - | Some x291 -> - Ojs.set_prop_ascii x215 "gridLineColor" (Color.t_to_js x291) - | None -> ()); - (match x166 with - | Some x290 -> - Ojs.set_prop_ascii x215 "gridLinePattern" - (Line_pattern.t_to_js x290) - | None -> ()); - (match x167 with - | Some x289 -> - Ojs.set_prop_ascii x215 "gridLineWidth" (Ojs.float_to_js x289) - | None -> ()); - (match x168 with - | Some x288 -> - Ojs.set_prop_ascii x215 "animatedZooms" (Ojs.bool_to_js x288) - | None -> ()); - (match x169 with - | Some x287 -> - Ojs.set_prop_ascii x215 "hideOverlayOnMouseOut" - (Ojs.bool_to_js x287) - | None -> ()); - (match x170 with - | Some x286 -> - Ojs.set_prop_ascii x215 "highlightCircleSize" (Ojs.int_to_js x286) - | None -> ()); - (match x171 with - | Some x285 -> - Ojs.set_prop_ascii x215 "highlightSeriesBackgroundAlpha" - (Ojs.float_to_js x285) - | None -> ()); - (match x172 with - | Some x284 -> - Ojs.set_prop_ascii x215 "highlightSeriesBackgroundColor" - (Color.t_to_js x284) - | None -> ()); - (match x173 with - | Some x283 -> - Ojs.set_prop_ascii x215 "highlightSeriesOpts" - (Highlight_series_options.t_to_js x283) - | None -> ()); - (match x174 with - | Some x282 -> - Ojs.set_prop_ascii x215 "showLabelsOnHighlight" - (Ojs.bool_to_js x282) - | None -> ()); - (match x175 with - | Some x281 -> - Ojs.set_prop_ascii x215 "showRoller" (Ojs.bool_to_js x281) - | None -> ()); - (match x176 with - | Some x280 -> - Ojs.set_prop_ascii x215 "hideOverlayOnMouseOut" - (Ojs.bool_to_js x280) - | None -> ()); - (match x177 with - | Some x278 -> - Ojs.set_prop_ascii x215 "labels" - (Ojs.list_to_js Ojs.string_to_js x278) - | None -> ()); - (match x178 with - | Some x277 -> - Ojs.set_prop_ascii x215 "labelsDiv" (Ojs.string_to_js x277) - | None -> ()); - (match x179 with - | Some x276 -> - Ojs.set_prop_ascii x215 "labelsDiv" (Native_node.t_to_js x276) - | None -> ()); - (match x180 with - | Some x275 -> - Ojs.set_prop_ascii x215 "labelsSeparateLines" (Ojs.bool_to_js x275) - | None -> ()); - (match x181 with - | Some x274 -> - Ojs.set_prop_ascii x215 "labelsShowZeroValues" (Ojs.bool_to_js x274) - | None -> ()); - (match x182 with - | Some x273 -> Ojs.set_prop_ascii x215 "legend" (Legend.t_to_js x273) - | None -> ()); - (match x183 with - | Some x271 -> - Ojs.set_prop_ascii x215 "legendFormatter" - (Ojs.fun_to_js 1 - (fun (x272 : Ojs.t) -> - Ojs.string_to_js (x271 (Legend_data.t_of_js x272)))) - | None -> ()); - (match x184 with - | Some x270 -> - Ojs.set_prop_ascii x215 "showLabelsOnHighlight" - (Ojs.bool_to_js x270) - | None -> ()); - (match x185 with - | Some x269 -> Ojs.set_prop_ascii x215 "height" (Ojs.int_to_js x269) - | None -> ()); - (match x186 with - | Some x264 -> - Ojs.set_prop_ascii x215 "clickCallback" - (Ojs.fun_to_js 3 - (fun (x265 : Ojs.t) (x266 : Ojs.t) (x267 : Ojs.t) -> - x264 ~evt:x265 ~x:(Ojs.float_of_js x266) - ~points:(Ojs.array_of_js Point.t_of_js x267))) - | None -> ()); - (match x187 with - | Some x256 -> - Ojs.set_prop_ascii x215 "highlightCallback" - (Ojs.fun_to_js 5 - (fun (x257 : Ojs.t) (x258 : Ojs.t) (x259 : Ojs.t) - (x261 : Ojs.t) (x262 : Ojs.t) -> - x256 ~evt:x257 ~x:(Ojs.float_of_js x258) - ~points:(Ojs.array_of_js Point.t_of_js x259) - ~row:(Ojs.int_of_js x261) - ~seriesName:(Ojs.option_of_js Ojs.string_of_js x262))) - | None -> ()); - (match x188 with - | Some x254 -> - Ojs.set_prop_ascii x215 "unhighlightCallback" - (Ojs.fun_to_js 1 (fun (x255 : Ojs.t) -> x254 ~evt:x255)) - | None -> ()); - (match x189 with - | Some x251 -> - Ojs.set_prop_ascii x215 "pointClickCallback" - (Ojs.fun_to_js 2 - (fun (x252 : Ojs.t) (x253 : Ojs.t) -> - x251 ~evt:x252 ~point:(Point.t_of_js x253))) - | None -> ()); - (match x190 with - | Some x247 -> - Ojs.set_prop_ascii x215 "underlayCallback" - (Ojs.fun_to_js 3 - (fun (x248 : Ojs.t) (x249 : Ojs.t) (x250 : Ojs.t) -> - x247 ~context:(Canvas_rendering_context_2D.t_of_js x248) - ~area:(Area.t_of_js x249) ~dygraph:x250)) - | None -> ()); - (match x191 with - | Some x244 -> - Ojs.set_prop_ascii x215 "drawCallback" - (Ojs.fun_to_js 2 - (fun (x245 : Ojs.t) (x246 : Ojs.t) -> - x244 ~graph:x245 ~isInitial:(Ojs.bool_of_js x246))) - | None -> ()); - (match x192 with - | Some x239 -> - Ojs.set_prop_ascii x215 "zoomCallback" - (Ojs.fun_to_js 3 - (fun (x240 : Ojs.t) (x241 : Ojs.t) (x242 : Ojs.t) -> - x239 ~xmin:(Ojs.float_of_js x240) - ~xmax:(Ojs.float_of_js x241) - ~yRanges:(Ojs.array_of_js Range.t_of_js x242))) - | None -> ()); - (match x193 with - | Some x238 -> - Ojs.set_prop_ascii x215 "pixelRatio" (Ojs.float_to_js x238) - | None -> ()); - (match x194 with - | Some x236 -> - Ojs.set_prop_ascii x215 "plotter" - (Ojs.list_to_js Plotter.t_to_js x236) - | None -> ()); - (match x195 with - | Some x235 -> Ojs.set_prop_ascii x215 "rightGap" (Ojs.int_to_js x235) - | None -> ()); - (match x196 with - | Some x234 -> Ojs.set_prop_ascii x215 "width" (Ojs.int_to_js x234) - | None -> ()); - (match x197 with - | Some x233 -> - Ojs.set_prop_ascii x215 "rangeSelectorAlpha" (Ojs.float_to_js x233) - | None -> ()); - (match x198 with - | Some x232 -> - Ojs.set_prop_ascii x215 "rangeSelectorBackgroundLineWidth" - (Ojs.float_to_js x232) - | None -> ()); - (match x199 with - | Some x231 -> - Ojs.set_prop_ascii x215 "rangeSelectorBackgroundStrokeColor" - (Color.t_to_js x231) - | None -> ()); - (match x200 with - | Some x230 -> - Ojs.set_prop_ascii x215 "rangeSelectorForegroundLineWidth" - (Ojs.float_to_js x230) - | None -> ()); - (match x201 with - | Some x229 -> - Ojs.set_prop_ascii x215 "rangeSelectorForegroundStrokeColor" - (Color.t_to_js x229) - | None -> ()); - (match x202 with - | Some x228 -> - Ojs.set_prop_ascii x215 "rangeSelectorHeight" (Ojs.int_to_js x228) - | None -> ()); - (match x203 with - | Some x227 -> - Ojs.set_prop_ascii x215 "rangeSelectorPlotFillColor" - (Color.t_to_js x227) - | None -> ()); - (match x204 with - | Some x226 -> - Ojs.set_prop_ascii x215 "rangeSelectorPlotFillGradientColor" - (Color.t_to_js x226) - | None -> ()); - (match x205 with - | Some x225 -> - Ojs.set_prop_ascii x215 "rangeSelectorPlotLineWidth" - (Ojs.float_to_js x225) - | None -> ()); - (match x206 with - | Some x224 -> - Ojs.set_prop_ascii x215 "rangeSelectorPlotStrokeColor" - (Color.t_to_js x224) - | None -> ()); - (match x207 with - | Some x223 -> - Ojs.set_prop_ascii x215 "showRangeSelector" (Ojs.bool_to_js x223) - | None -> ()); - (match x208 with - | Some x222 -> Ojs.set_prop_ascii x215 "series" (Series.t_to_js x222) - | None -> ()); - (match x209 with - | Some x221 -> - Ojs.set_prop_ascii x215 "digitsAfterDecimal" (Ojs.int_to_js x221) - | None -> ()); - (match x210 with - | Some x220 -> Ojs.set_prop_ascii x215 "labelsKMB" (Ojs.bool_to_js x220) - | None -> ()); - (match x211 with - | Some x219 -> - Ojs.set_prop_ascii x215 "labelsKMG2" (Ojs.bool_to_js x219) - | None -> ()); - (match x212 with - | Some x218 -> Ojs.set_prop_ascii x215 "labelsUTC" (Ojs.bool_to_js x218) - | None -> ()); - (match x213 with - | Some x217 -> - Ojs.set_prop_ascii x215 "maxNumberWidth" (Ojs.int_to_js x217) - | None -> ()); - (match x214 with - | Some x216 -> Ojs.set_prop_ascii x215 "sigFigs" (Ojs.int_to_js x216) - | None -> ()); - t_of_js x215 + ?axisLabelWidth:(x119 : int option) + ?axisLineColor:(x120 : Color.t option) + ?axisLineWidth:(x121 : float option) + ?axisTickSize:(x122 : float option) + ?dateWindow:(x123 : Range.t option) + ?drawAxesAtZero:(x124 : bool option) + ?drawAxis:(x125 : bool option) + ?includeZero:(x126 : bool option) + ?logscale:(x127 : bool option) + ?panEdgeFraction:(x128 : float option) + ?valueRange:(x129 : Range.Spec.t option) + ?xAxisHeight:(x130 : int option) + ?xRangePad:(x131 : float option) + ?yRangePad:(x132 : float option) + ?customBars:(x133 : bool option) + ?errorBars:(x134 : bool option) + ?fractions:(x135 : bool option) + ?title:(x136 : string option) + ?titleHeight:(x137 : int option) + ?xLabelHeight:(x138 : int option) + ?xlabel:(x139 : string option) + ?y2label:(x140 : string option) + ?yLabelWidth:(x141 : int option) + ?ylabel:(x142 : string option) + ?axes:(x143 : Axes.t option) + ?connectSeparatedPoints:(x144 : bool option) + ?drawGapEdgePoints:(x145 : bool option) + ?drawPoints:(x146 : bool option) + ?fillGraph:(x147 : bool option) + ?pointSize:(x148 : int option) + ?stackedGraph:(x149 : bool option) + ?stackedGraphNaNFill:(x150 : string option) + ?stepPlot:(x151 : bool option) + ?strokeBorderColor:(x152 : Color.t option) + ?strokeBorderWidth:(x153 : float option) + ?strokePattern:(x154 : Line_pattern.t option) + ?strokeWidth:(x155 : float option) + ?visibility:(x156 : bool list option) + ?colorSaturation:(x157 : float option) + ?colorValue:(x158 : float option) + ?colors:(x159 : Color.t array option) + ?fillAlpha:(x160 : float option) + ?rollPeriod:(x161 : int option) + ?sigma:(x162 : float option) + ?wilsonInterval:(x163 : bool option) + ?drawGrid:(x164 : bool option) + ?gridLineColor:(x165 : Color.t option) + ?gridLinePattern:(x166 : Line_pattern.t option) + ?gridLineWidth:(x167 : float option) + ?animatedZooms:(x168 : bool option) + ?hideOverlayOnMouseOut:(x169 : bool option) + ?highlightCircleSize:(x170 : int option) + ?highlightSeriesBackgroundAlpha:(x171 : float option) + ?highlightSeriesBackgroundColor:(x172 : Color.t option) + ?highlightSeriesOpts:(x173 : Highlight_series_options.t option) + ?showLabelsOnHighlight:(x174 : bool option) + ?showRoller:(x175 : bool option) + ?hideOverlayOnMouseOut:(x176 : bool option) + ?labels:(x177 : string list option) + ?labelsDiv_string:(x178 : string option) + ?labelsDiv_el:(x179 : Native_node.t option) + ?labelsSeparateLines:(x180 : bool option) + ?labelsShowZeroValues:(x181 : bool option) + ?legend:(x182 : Legend.t option) + ?legendFormatter:(x183 : (Legend_data.t -> string) option) + ?showLabelsOnHighlight:(x184 : bool option) + ?height:(x185 : int option) + ?clickCallback: + (x186 : (evt:Ojs.t -> x:float -> points:Point.t array -> unit) option) + ?highlightCallback: + (x187 : + (evt:Ojs.t + -> x:float + -> points:Point.t array + -> row:int + -> seriesName:string option + -> unit) + option) + ?unhighlightCallback:(x188 : (evt:Ojs.t -> unit) option) + ?pointClickCallback:(x189 : (evt:Ojs.t -> point:Point.t -> unit) option) + ?underlayCallback: + (x190 : + (context:Canvas_rendering_context_2D.t -> area:Area.t -> dygraph:Ojs.t -> unit) + option) + ?drawCallback:(x191 : (graph:Ojs.t -> isInitial:bool -> unit) option) + ?zoomCallback: + (x192 : (xmin:float -> xmax:float -> yRanges:Range.t array -> unit) option) + ?pixelRatio:(x193 : float option) + ?plotter:(x194 : Plotter.t list option) + ?rightGap:(x195 : int option) + ?width:(x196 : int option) + ?rangeSelectorAlpha:(x197 : float option) + ?rangeSelectorBackgroundLineWidth:(x198 : float option) + ?rangeSelectorBackgroundStrokeColor:(x199 : Color.t option) + ?rangeSelectorForegroundLineWidth:(x200 : float option) + ?rangeSelectorForegroundStrokeColor:(x201 : Color.t option) + ?rangeSelectorHeight:(x202 : int option) + ?rangeSelectorPlotFillColor:(x203 : Color.t option) + ?rangeSelectorPlotFillGradientColor:(x204 : Color.t option) + ?rangeSelectorPlotLineWidth:(x205 : float option) + ?rangeSelectorPlotStrokeColor:(x206 : Color.t option) + ?showRangeSelector:(x207 : bool option) + ?series:(x208 : Series.t option) + ?digitsAfterDecimal:(x209 : int option) + ?labelsKMB:(x210 : bool option) + ?labelsKMG2:(x211 : bool option) + ?labelsUTC:(x212 : bool option) + ?maxNumberWidth:(x213 : int option) + ?sigFigs:(x214 : int option) + () -> + let x215 = Ojs.empty_obj () in + (match x118 with + | Some x340 -> Ojs.set_prop_ascii x215 "axisLabelFontSize" (Ojs.int_to_js x340) + | None -> ()); + (match x119 with + | Some x339 -> Ojs.set_prop_ascii x215 "axisLabelWidth" (Ojs.int_to_js x339) + | None -> ()); + (match x120 with + | Some x338 -> Ojs.set_prop_ascii x215 "axisLineColor" (Color.t_to_js x338) + | None -> ()); + (match x121 with + | Some x337 -> Ojs.set_prop_ascii x215 "axisLineWidth" (Ojs.float_to_js x337) + | None -> ()); + (match x122 with + | Some x336 -> Ojs.set_prop_ascii x215 "axisTickSize" (Ojs.float_to_js x336) + | None -> ()); + (match x123 with + | Some x335 -> Ojs.set_prop_ascii x215 "dateWindow" (Range.t_to_js x335) + | None -> ()); + (match x124 with + | Some x334 -> Ojs.set_prop_ascii x215 "drawAxesAtZero" (Ojs.bool_to_js x334) + | None -> ()); + (match x125 with + | Some x333 -> Ojs.set_prop_ascii x215 "drawAxis" (Ojs.bool_to_js x333) + | None -> ()); + (match x126 with + | Some x332 -> Ojs.set_prop_ascii x215 "includeZero" (Ojs.bool_to_js x332) + | None -> ()); + (match x127 with + | Some x331 -> Ojs.set_prop_ascii x215 "logscale" (Ojs.bool_to_js x331) + | None -> ()); + (match x128 with + | Some x330 -> Ojs.set_prop_ascii x215 "panEdgeFraction" (Ojs.float_to_js x330) + | None -> ()); + (match x129 with + | Some x329 -> Ojs.set_prop_ascii x215 "valueRange" (Range.Spec.t_to_js x329) + | None -> ()); + (match x130 with + | Some x328 -> Ojs.set_prop_ascii x215 "xAxisHeight" (Ojs.int_to_js x328) + | None -> ()); + (match x131 with + | Some x327 -> Ojs.set_prop_ascii x215 "xRangePad" (Ojs.float_to_js x327) + | None -> ()); + (match x132 with + | Some x326 -> Ojs.set_prop_ascii x215 "yRangePad" (Ojs.float_to_js x326) + | None -> ()); + (match x133 with + | Some x325 -> Ojs.set_prop_ascii x215 "customBars" (Ojs.bool_to_js x325) + | None -> ()); + (match x134 with + | Some x324 -> Ojs.set_prop_ascii x215 "errorBars" (Ojs.bool_to_js x324) + | None -> ()); + (match x135 with + | Some x323 -> Ojs.set_prop_ascii x215 "fractions" (Ojs.bool_to_js x323) + | None -> ()); + (match x136 with + | Some x322 -> Ojs.set_prop_ascii x215 "title" (Ojs.string_to_js x322) + | None -> ()); + (match x137 with + | Some x321 -> Ojs.set_prop_ascii x215 "titleHeight" (Ojs.int_to_js x321) + | None -> ()); + (match x138 with + | Some x320 -> Ojs.set_prop_ascii x215 "xLabelHeight" (Ojs.int_to_js x320) + | None -> ()); + (match x139 with + | Some x319 -> Ojs.set_prop_ascii x215 "xlabel" (Ojs.string_to_js x319) + | None -> ()); + (match x140 with + | Some x318 -> Ojs.set_prop_ascii x215 "y2label" (Ojs.string_to_js x318) + | None -> ()); + (match x141 with + | Some x317 -> Ojs.set_prop_ascii x215 "yLabelWidth" (Ojs.int_to_js x317) + | None -> ()); + (match x142 with + | Some x316 -> Ojs.set_prop_ascii x215 "ylabel" (Ojs.string_to_js x316) + | None -> ()); + (match x143 with + | Some x315 -> Ojs.set_prop_ascii x215 "axes" (Axes.t_to_js x315) + | None -> ()); + (match x144 with + | Some x314 -> Ojs.set_prop_ascii x215 "connectSeparatedPoints" (Ojs.bool_to_js x314) + | None -> ()); + (match x145 with + | Some x313 -> Ojs.set_prop_ascii x215 "drawGapEdgePoints" (Ojs.bool_to_js x313) + | None -> ()); + (match x146 with + | Some x312 -> Ojs.set_prop_ascii x215 "drawPoints" (Ojs.bool_to_js x312) + | None -> ()); + (match x147 with + | Some x311 -> Ojs.set_prop_ascii x215 "fillGraph" (Ojs.bool_to_js x311) + | None -> ()); + (match x148 with + | Some x310 -> Ojs.set_prop_ascii x215 "pointSize" (Ojs.int_to_js x310) + | None -> ()); + (match x149 with + | Some x309 -> Ojs.set_prop_ascii x215 "stackedGraph" (Ojs.bool_to_js x309) + | None -> ()); + (match x150 with + | Some x308 -> Ojs.set_prop_ascii x215 "stackedGraphNaNFill" (Ojs.string_to_js x308) + | None -> ()); + (match x151 with + | Some x307 -> Ojs.set_prop_ascii x215 "stepPlot" (Ojs.bool_to_js x307) + | None -> ()); + (match x152 with + | Some x306 -> Ojs.set_prop_ascii x215 "strokeBorderColor" (Color.t_to_js x306) + | None -> ()); + (match x153 with + | Some x305 -> Ojs.set_prop_ascii x215 "strokeBorderWidth" (Ojs.float_to_js x305) + | None -> ()); + (match x154 with + | Some x304 -> Ojs.set_prop_ascii x215 "strokePattern" (Line_pattern.t_to_js x304) + | None -> ()); + (match x155 with + | Some x303 -> Ojs.set_prop_ascii x215 "strokeWidth" (Ojs.float_to_js x303) + | None -> ()); + (match x156 with + | Some x301 -> + Ojs.set_prop_ascii x215 "visibility" (Ojs.list_to_js Ojs.bool_to_js x301) + | None -> ()); + (match x157 with + | Some x300 -> Ojs.set_prop_ascii x215 "colorSaturation" (Ojs.float_to_js x300) + | None -> ()); + (match x158 with + | Some x299 -> Ojs.set_prop_ascii x215 "colorValue" (Ojs.float_to_js x299) + | None -> ()); + (match x159 with + | Some x297 -> Ojs.set_prop_ascii x215 "colors" (Ojs.array_to_js Color.t_to_js x297) + | None -> ()); + (match x160 with + | Some x296 -> Ojs.set_prop_ascii x215 "fillAlpha" (Ojs.float_to_js x296) + | None -> ()); + (match x161 with + | Some x295 -> Ojs.set_prop_ascii x215 "rollPeriod" (Ojs.int_to_js x295) + | None -> ()); + (match x162 with + | Some x294 -> Ojs.set_prop_ascii x215 "sigma" (Ojs.float_to_js x294) + | None -> ()); + (match x163 with + | Some x293 -> Ojs.set_prop_ascii x215 "wilsonInterval" (Ojs.bool_to_js x293) + | None -> ()); + (match x164 with + | Some x292 -> Ojs.set_prop_ascii x215 "drawGrid" (Ojs.bool_to_js x292) + | None -> ()); + (match x165 with + | Some x291 -> Ojs.set_prop_ascii x215 "gridLineColor" (Color.t_to_js x291) + | None -> ()); + (match x166 with + | Some x290 -> Ojs.set_prop_ascii x215 "gridLinePattern" (Line_pattern.t_to_js x290) + | None -> ()); + (match x167 with + | Some x289 -> Ojs.set_prop_ascii x215 "gridLineWidth" (Ojs.float_to_js x289) + | None -> ()); + (match x168 with + | Some x288 -> Ojs.set_prop_ascii x215 "animatedZooms" (Ojs.bool_to_js x288) + | None -> ()); + (match x169 with + | Some x287 -> Ojs.set_prop_ascii x215 "hideOverlayOnMouseOut" (Ojs.bool_to_js x287) + | None -> ()); + (match x170 with + | Some x286 -> Ojs.set_prop_ascii x215 "highlightCircleSize" (Ojs.int_to_js x286) + | None -> ()); + (match x171 with + | Some x285 -> + Ojs.set_prop_ascii x215 "highlightSeriesBackgroundAlpha" (Ojs.float_to_js x285) + | None -> ()); + (match x172 with + | Some x284 -> + Ojs.set_prop_ascii x215 "highlightSeriesBackgroundColor" (Color.t_to_js x284) + | None -> ()); + (match x173 with + | Some x283 -> + Ojs.set_prop_ascii x215 "highlightSeriesOpts" (Highlight_series_options.t_to_js x283) + | None -> ()); + (match x174 with + | Some x282 -> Ojs.set_prop_ascii x215 "showLabelsOnHighlight" (Ojs.bool_to_js x282) + | None -> ()); + (match x175 with + | Some x281 -> Ojs.set_prop_ascii x215 "showRoller" (Ojs.bool_to_js x281) + | None -> ()); + (match x176 with + | Some x280 -> Ojs.set_prop_ascii x215 "hideOverlayOnMouseOut" (Ojs.bool_to_js x280) + | None -> ()); + (match x177 with + | Some x278 -> Ojs.set_prop_ascii x215 "labels" (Ojs.list_to_js Ojs.string_to_js x278) + | None -> ()); + (match x178 with + | Some x277 -> Ojs.set_prop_ascii x215 "labelsDiv" (Ojs.string_to_js x277) + | None -> ()); + (match x179 with + | Some x276 -> Ojs.set_prop_ascii x215 "labelsDiv" (Native_node.t_to_js x276) + | None -> ()); + (match x180 with + | Some x275 -> Ojs.set_prop_ascii x215 "labelsSeparateLines" (Ojs.bool_to_js x275) + | None -> ()); + (match x181 with + | Some x274 -> Ojs.set_prop_ascii x215 "labelsShowZeroValues" (Ojs.bool_to_js x274) + | None -> ()); + (match x182 with + | Some x273 -> Ojs.set_prop_ascii x215 "legend" (Legend.t_to_js x273) + | None -> ()); + (match x183 with + | Some x271 -> + Ojs.set_prop_ascii + x215 + "legendFormatter" + (Ojs.fun_to_js 1 (fun (x272 : Ojs.t) -> + Ojs.string_to_js (x271 (Legend_data.t_of_js x272)))) + | None -> ()); + (match x184 with + | Some x270 -> Ojs.set_prop_ascii x215 "showLabelsOnHighlight" (Ojs.bool_to_js x270) + | None -> ()); + (match x185 with + | Some x269 -> Ojs.set_prop_ascii x215 "height" (Ojs.int_to_js x269) + | None -> ()); + (match x186 with + | Some x264 -> + Ojs.set_prop_ascii + x215 + "clickCallback" + (Ojs.fun_to_js 3 (fun (x265 : Ojs.t) (x266 : Ojs.t) (x267 : Ojs.t) -> + x264 + ~evt:x265 + ~x:(Ojs.float_of_js x266) + ~points:(Ojs.array_of_js Point.t_of_js x267))) + | None -> ()); + (match x187 with + | Some x256 -> + Ojs.set_prop_ascii + x215 + "highlightCallback" + (Ojs.fun_to_js + 5 + (fun + (x257 : Ojs.t) + (x258 : Ojs.t) + (x259 : Ojs.t) + (x261 : Ojs.t) + (x262 : Ojs.t) + -> + x256 + ~evt:x257 + ~x:(Ojs.float_of_js x258) + ~points:(Ojs.array_of_js Point.t_of_js x259) + ~row:(Ojs.int_of_js x261) + ~seriesName:(Ojs.option_of_js Ojs.string_of_js x262))) + | None -> ()); + (match x188 with + | Some x254 -> + Ojs.set_prop_ascii + x215 + "unhighlightCallback" + (Ojs.fun_to_js 1 (fun (x255 : Ojs.t) -> x254 ~evt:x255)) + | None -> ()); + (match x189 with + | Some x251 -> + Ojs.set_prop_ascii + x215 + "pointClickCallback" + (Ojs.fun_to_js 2 (fun (x252 : Ojs.t) (x253 : Ojs.t) -> + x251 ~evt:x252 ~point:(Point.t_of_js x253))) + | None -> ()); + (match x190 with + | Some x247 -> + Ojs.set_prop_ascii + x215 + "underlayCallback" + (Ojs.fun_to_js 3 (fun (x248 : Ojs.t) (x249 : Ojs.t) (x250 : Ojs.t) -> + x247 + ~context:(Canvas_rendering_context_2D.t_of_js x248) + ~area:(Area.t_of_js x249) + ~dygraph:x250)) + | None -> ()); + (match x191 with + | Some x244 -> + Ojs.set_prop_ascii + x215 + "drawCallback" + (Ojs.fun_to_js 2 (fun (x245 : Ojs.t) (x246 : Ojs.t) -> + x244 ~graph:x245 ~isInitial:(Ojs.bool_of_js x246))) + | None -> ()); + (match x192 with + | Some x239 -> + Ojs.set_prop_ascii + x215 + "zoomCallback" + (Ojs.fun_to_js 3 (fun (x240 : Ojs.t) (x241 : Ojs.t) (x242 : Ojs.t) -> + x239 + ~xmin:(Ojs.float_of_js x240) + ~xmax:(Ojs.float_of_js x241) + ~yRanges:(Ojs.array_of_js Range.t_of_js x242))) + | None -> ()); + (match x193 with + | Some x238 -> Ojs.set_prop_ascii x215 "pixelRatio" (Ojs.float_to_js x238) + | None -> ()); + (match x194 with + | Some x236 -> Ojs.set_prop_ascii x215 "plotter" (Ojs.list_to_js Plotter.t_to_js x236) + | None -> ()); + (match x195 with + | Some x235 -> Ojs.set_prop_ascii x215 "rightGap" (Ojs.int_to_js x235) + | None -> ()); + (match x196 with + | Some x234 -> Ojs.set_prop_ascii x215 "width" (Ojs.int_to_js x234) + | None -> ()); + (match x197 with + | Some x233 -> Ojs.set_prop_ascii x215 "rangeSelectorAlpha" (Ojs.float_to_js x233) + | None -> ()); + (match x198 with + | Some x232 -> + Ojs.set_prop_ascii x215 "rangeSelectorBackgroundLineWidth" (Ojs.float_to_js x232) + | None -> ()); + (match x199 with + | Some x231 -> + Ojs.set_prop_ascii x215 "rangeSelectorBackgroundStrokeColor" (Color.t_to_js x231) + | None -> ()); + (match x200 with + | Some x230 -> + Ojs.set_prop_ascii x215 "rangeSelectorForegroundLineWidth" (Ojs.float_to_js x230) + | None -> ()); + (match x201 with + | Some x229 -> + Ojs.set_prop_ascii x215 "rangeSelectorForegroundStrokeColor" (Color.t_to_js x229) + | None -> ()); + (match x202 with + | Some x228 -> Ojs.set_prop_ascii x215 "rangeSelectorHeight" (Ojs.int_to_js x228) + | None -> ()); + (match x203 with + | Some x227 -> + Ojs.set_prop_ascii x215 "rangeSelectorPlotFillColor" (Color.t_to_js x227) + | None -> ()); + (match x204 with + | Some x226 -> + Ojs.set_prop_ascii x215 "rangeSelectorPlotFillGradientColor" (Color.t_to_js x226) + | None -> ()); + (match x205 with + | Some x225 -> + Ojs.set_prop_ascii x215 "rangeSelectorPlotLineWidth" (Ojs.float_to_js x225) + | None -> ()); + (match x206 with + | Some x224 -> + Ojs.set_prop_ascii x215 "rangeSelectorPlotStrokeColor" (Color.t_to_js x224) + | None -> ()); + (match x207 with + | Some x223 -> Ojs.set_prop_ascii x215 "showRangeSelector" (Ojs.bool_to_js x223) + | None -> ()); + (match x208 with + | Some x222 -> Ojs.set_prop_ascii x215 "series" (Series.t_to_js x222) + | None -> ()); + (match x209 with + | Some x221 -> Ojs.set_prop_ascii x215 "digitsAfterDecimal" (Ojs.int_to_js x221) + | None -> ()); + (match x210 with + | Some x220 -> Ojs.set_prop_ascii x215 "labelsKMB" (Ojs.bool_to_js x220) + | None -> ()); + (match x211 with + | Some x219 -> Ojs.set_prop_ascii x215 "labelsKMG2" (Ojs.bool_to_js x219) + | None -> ()); + (match x212 with + | Some x218 -> Ojs.set_prop_ascii x215 "labelsUTC" (Ojs.bool_to_js x218) + | None -> ()); + (match x213 with + | Some x217 -> Ojs.set_prop_ascii x215 "maxNumberWidth" (Ojs.int_to_js x217) + | None -> ()); + (match x214 with + | Some x216 -> Ojs.set_prop_ascii x215 "sigFigs" (Ojs.int_to_js x216) + | None -> ()); + t_of_js x215 +;; + let (legendFormatter : t -> (Legend_data.t -> string) option) = fun (x341 : t) -> - Ojs.option_of_js - (fun (x342 : Ojs.t) (x343 : Legend_data.t) -> - Ojs.string_of_js (Ojs.apply x342 [|(Legend_data.t_to_js x343)|])) - (Ojs.get_prop_ascii (t_to_js x341) "legendFormatter") + Ojs.option_of_js + (fun (x342 : Ojs.t) (x343 : Legend_data.t) -> + Ojs.string_of_js (Ojs.apply x342 [| Legend_data.t_to_js x343 |])) + (Ojs.get_prop_ascii (t_to_js x341) "legendFormatter") +;; + let (zoomCallback : - t -> (xmin:float -> xmax:float -> yRanges:Range.t array -> unit) option) = + t -> (xmin:float -> xmax:float -> yRanges:Range.t array -> unit) option) + = fun (x344 : t) -> - Ojs.option_of_js - (fun (x345 : Ojs.t) ~xmin:(x346 : float) ~xmax:(x347 : float) + Ojs.option_of_js + (fun (x345 : Ojs.t) + ~xmin:(x346 : float) + ~xmax:(x347 : float) ~yRanges:(x348 : Range.t array) -> - ignore - (Ojs.apply x345 - [|(Ojs.float_to_js x346);(Ojs.float_to_js x347);(Ojs.array_to_js - Range.t_to_js - x348)|])) - (Ojs.get_prop_ascii (t_to_js x344) "zoomCallback") + ignore + (Ojs.apply + x345 + [| Ojs.float_to_js x346 + ; Ojs.float_to_js x347 + ; Ojs.array_to_js Range.t_to_js x348 + |])) + (Ojs.get_prop_ascii (t_to_js x344) "zoomCallback") +;; + let (height : t -> int option) = fun (x350 : t) -> - Ojs.option_of_js Ojs.int_of_js - (Ojs.get_prop_ascii (t_to_js x350) "height") + Ojs.option_of_js Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x350) "height") +;; + let (width : t -> int option) = fun (x352 : t) -> - Ojs.option_of_js Ojs.int_of_js - (Ojs.get_prop_ascii (t_to_js x352) "width") + Ojs.option_of_js Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x352) "width") +;; + let (merge_internal : t -> prefer:t -> t) = fun (x354 : t) ~prefer:(x355 : t) -> - t_of_js - (Ojs.call (Ojs.get_prop_ascii Ojs.global "_") "merge" - [|(t_to_js x354);(t_to_js x355)|]) -let merge t ~prefer = - ((create ()) |> (merge_internal ~prefer:t)) |> (merge_internal ~prefer) + t_of_js + (Ojs.call + (Ojs.get_prop_ascii Ojs.global "_") + "merge" + [| t_to_js x354; t_to_js x355 |]) +;; + +let merge t ~prefer = create () |> merge_internal ~prefer:t |> merge_internal ~prefer diff --git a/bindings/dygraph/src/options.mli b/bindings/dygraph/src/options.mli index a08e0443..d6a69c12 100644 --- a/bindings/dygraph/src/options.mli +++ b/bindings/dygraph/src/options.mli @@ -1,6 +1,6 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** Options Reference: http://dygraphs.com/options.html @@ -18,7 +18,7 @@ module Line_pattern : sig isn't present in the global namespace when run in node-js, so [@@js.global "Dygraph.DASHED_LINE"] will crash the program. *) val dashed : t - [@@js.custom let dashed = [| 7; 2 |]] + [@@js.custom let dashed = [| 7; 2 |]] val t_of_js : Ojs.t -> t val t_to_js : t -> Ojs.t @@ -31,7 +31,7 @@ module Legend : sig | `never | `onmouseover ] - [@js.enum]) + [@js.enum]) val t_to_js : t -> Ojs.t end @@ -44,7 +44,7 @@ module Series_options : sig val create : ?axis:Which_y_axis.t - (** axis http://dygraphs.com/options.html#axis + (** axis http://dygraphs.com/options.html#axis Set to either 'y1' or 'y2' to assign a series to a y-axis (primary or secondary). Must be set per-series. @@ -53,7 +53,7 @@ module Series_options : sig Default: (none) *) -> ?color:Color.t - (** color http://dygraphs.com/options.html#color + (** color http://dygraphs.com/options.html#color A per-series color definition. Used in conjunction with, and overrides, the colors option. @@ -62,7 +62,7 @@ module Series_options : sig Default: (see description) *) -> ?drawPoints:bool - (** drawPoints http://dygraphs.com/options.html#drawPoints + (** drawPoints http://dygraphs.com/options.html#drawPoints Draw a small dot at each point, in addition to a line going through the point. This makes the individual data points easier to see, but can increase @@ -78,12 +78,11 @@ module Series_options : sig -> context:Canvas_rendering_context_2D.t -> cx:float -> cy:float - -> color: - Ojs.t + -> color:Ojs.t -> pointSize:int -> idx:int -> unit) - (** drawHighlightPointCallback: https://dygraphs.com/options.html#drawHighlightPointCallback + (** drawHighlightPointCallback: https://dygraphs.com/options.html#drawHighlightPointCallback Draw a custom item when a point is highlighted. Default is a small dot matching the series color. This method should constrain drawing to within pointSize pixels from @@ -110,7 +109,7 @@ module Series_options : sig -> pointSize:int -> idx:int -> unit) - (** drawPointCallback: https://dygraphs.com/options.html#drawPointCallback + (** drawPointCallback: https://dygraphs.com/options.html#drawPointCallback Draw a custom item when drawPoints is enabled. Default is a small dot matching the series color. This method should constrain drawing to within pointSize pixels from @@ -128,7 +127,7 @@ module Series_options : sig Default: null *) -> ?plotter:Plotter.t - (** plotter (undocumented) + (** plotter (undocumented) The Dygraph documentation merely says: @@ -138,7 +137,7 @@ module Series_options : sig series-specific plotter must be a single value. *) -> ?plotterFinishedCallback:(context:Canvas_rendering_context_2D.t -> unit) - (** (Jane Street extension) + (** (Jane Street extension) [plotterFinishedCallback] is called every time a plotter finishes rendering this series. @@ -153,7 +152,7 @@ module Series_options : sig but the callback will still fire after the plotter runs. *) -> ?showInRangeSelector:bool - (** showInRangeSelector http://dygraphs.com/options.html#showInRangeSelector + (** showInRangeSelector http://dygraphs.com/options.html#showInRangeSelector Mark this series for inclusion in the range selector. The mini plot curve will be an average of all such series. If this is not specified for any @@ -166,7 +165,7 @@ module Series_options : sig Default: null *) -> ?stepPlot:bool - (** stepPlot https://dygraphs.com/options.html#stepPlot + (** stepPlot https://dygraphs.com/options.html#stepPlot When set, display the graph as a step plot instead of a line plot. This option may either be set for the whole graph or for single series. @@ -175,7 +174,7 @@ module Series_options : sig Default: false *) -> ?strokePattern:Line_pattern.t - (** strokePattern http://dygraphs.com/options.html#strokePattern + (** strokePattern http://dygraphs.com/options.html#strokePattern A custom pattern array where the even index is a draw and odd is a space in pixels. If null then it draws a solid line. The array should have a even @@ -186,7 +185,7 @@ module Series_options : sig Default: null *) -> ?strokeWidth:float - (** strokeWidth http://dygraphs.com/options.html#strokeWidth + (** strokeWidth http://dygraphs.com/options.html#strokeWidth The width of the lines connecting data points. This can be used to increase the contrast or some graphs. @@ -196,7 +195,7 @@ module Series_options : sig *) -> unit -> t - [@@js.builder] + [@@js.builder] end module Series : sig @@ -206,10 +205,10 @@ module Series : sig val t_to_js : t -> Ojs.t val create : (string * Series_options.t) list -> t - [@@js.custom - let create data = - data |> List.Assoc.map ~f:Series_options.t_to_js |> Array.of_list |> Ojs.obj - ;;] + [@@js.custom + let create data = + data |> List.Assoc.map ~f:Series_options.t_to_js |> Array.of_list |> Ojs.obj + ;;] end module Opts : sig @@ -231,7 +230,7 @@ module Axis_options : sig val create : ?axisLabelFormatter:(Number_or_js_date.t -> Granularity.t -> Opts.t -> string) - (** axisLabelFormatter http://dygraphs.com/options.html#axisLabelFormatter + (** axisLabelFormatter http://dygraphs.com/options.html#axisLabelFormatter Function to call to format the tick values that appear along an axis. This is usually set on a per-axis basis. @@ -255,7 +254,7 @@ module Axis_options : sig Other Examples: value-axis-formatters x-axis-formatter *) -> ?valueFormatter:(float -> Opts.t -> string) - (** valueFormatter http://dygraphs.com/options.html#valueFormatter + (** valueFormatter http://dygraphs.com/options.html#valueFormatter Function to provide a custom display format for the values displayed on mouseover. This does not affect the values that appear on tick marks next to the @@ -288,7 +287,7 @@ module Axis_options : sig Other Examples: hairlines labelsKMB multi-scale value-axis-formatters *) -> ?axisLabelWidth:int - (** axisLabelWidth http://dygraphs.com/options.html#axisLabelWidth + (** axisLabelWidth http://dygraphs.com/options.html#axisLabelWidth Width (in pixels) of the containing divs for x- and y-axis labels. For the y-axis, this also controls the width of the y-axis. Note that for the x-axis, @@ -299,7 +298,7 @@ module Axis_options : sig Default: 50 (y-axis), 60 (x-axis) *) -> ?axisLineColor:Color.t - (** axisLineColor http://dygraphs.com/options.html#axisLineColor + (** axisLineColor http://dygraphs.com/options.html#axisLineColor Color of the x- and y-axis lines. Accepts any value which the HTML canvas strokeStyle attribute understands, e.g. 'black' or 'rgb(0, 100, 255)'. @@ -308,7 +307,7 @@ module Axis_options : sig Default: black *) -> ?axisLineWidth:float - (** axisLineWidth http://dygraphs.com/options.html#axisLineWidth + (** axisLineWidth http://dygraphs.com/options.html#axisLineWidth Thickness (in pixels) of the x- and y-axis lines. @@ -316,7 +315,7 @@ module Axis_options : sig Default: 0.3 *) -> ?axisTickSize:float - (** axisTickSize http://dygraphs.com/options.html#axisTickSize + (** axisTickSize http://dygraphs.com/options.html#axisTickSize The size of the line to display next to each tick mark on x- or y-axes. @@ -324,7 +323,7 @@ module Axis_options : sig Default: 3.0 *) -> ?drawAxis:bool - (** drawAxis http://dygraphs.com/options.html#drawAxis + (** drawAxis http://dygraphs.com/options.html#drawAxis Whether to draw the specified axis. This may be set on a per-axis basis to define the visibility of each axis separately. Setting this to false also @@ -335,7 +334,7 @@ module Axis_options : sig Default: true for x and y, false for y2 *) -> ?includeZero:bool - (** includeZero http://dygraphs.com/options.html#includeZero + (** includeZero http://dygraphs.com/options.html#includeZero Usually, dygraphs will use the range of the data plus some padding to set the range of the y-axis. If this option is set, the y-axis will always include zero, @@ -346,7 +345,7 @@ module Axis_options : sig Default: false *) -> ?independentTicks:bool - (** independentTicks http://dygraphs.com/options.html#independentTicks + (** independentTicks http://dygraphs.com/options.html#independentTicks Only valid for y and y2, has no effect on x: This option defines whether the y axes should align their ticks or if they should be independent. Possible @@ -360,7 +359,7 @@ module Axis_options : sig Default: true for y, false for y2 *) -> ?logscale:bool - (** logscale http://dygraphs.com/options.html#logscale + (** logscale http://dygraphs.com/options.html#logscale When set for the y-axis or x-axis, the graph shows that axis in log scale. Any values less than or equal to zero are not displayed. Showing log scale with @@ -372,7 +371,7 @@ module Axis_options : sig Default: false *) -> ?pixelsPerLabel:int - (** pixelsPerLabel http://dygraphs.com/options.html#pixelsPerLabel + (** pixelsPerLabel http://dygraphs.com/options.html#pixelsPerLabel Number of pixels to require between each x- and y-label. Larger values will yield a sparser axis with fewer ticks. This is set on a per-axis basis. @@ -380,7 +379,7 @@ module Axis_options : sig Type: integer Default: 70 (x-axis) or 30 (y-axes) *) -> ?valueRange:Range.Spec.t - (** valueRange http://dygraphs.com/options.html#valueRange + (** valueRange http://dygraphs.com/options.html#valueRange Explicitly set the vertical range of the graph to [low, high]. This may be set on a per-axis basis to define each y-axis separately. If either limit is unspecified, @@ -391,7 +390,7 @@ module Axis_options : sig Default: Full range of the input is shown *) -> ?drawGrid:bool - (** drawGrid http://dygraphs.com/options.html#drawGrid + (** drawGrid http://dygraphs.com/options.html#drawGrid Whether to display gridlines in the chart. This may be set on a per-axis basis to define the visibility of each axis' grid separately. @@ -400,7 +399,7 @@ module Axis_options : sig Default: true for x and y, false for y2 *) -> ?gridLineColor:Color.t - (** gridLineColor http://dygraphs.com/options.html#gridLineColor + (** gridLineColor http://dygraphs.com/options.html#gridLineColor The color of the gridlines. This may be set on a per-axis basis to define each axis' grid separately. @@ -409,7 +408,7 @@ module Axis_options : sig Default: rgb(128,128,128) *) -> ?gridLinePattern:Line_pattern.t - (** gridLinePattern http://dygraphs.com/options.html#gridLinePattern + (** gridLinePattern http://dygraphs.com/options.html#gridLinePattern A custom pattern array where the even index is a draw and odd is a space in pixels. If null then it draws a solid line. The array should have a even @@ -420,7 +419,7 @@ module Axis_options : sig Default: null *) -> ?gridLineWidth:float - (** gridLineWidth http://dygraphs.com/options.html#gridLineWidth + (** gridLineWidth http://dygraphs.com/options.html#gridLineWidth Thickness (in pixels) of the gridlines drawn under the chart. The vertical/horizontal gridlines can be turned off entirely by using the @@ -431,7 +430,7 @@ module Axis_options : sig Default: 0.3 *) -> ?pixelsPerLabel:int - (** pixelsPerLabel http://dygraphs.com/options.html#pixelsPerLabel + (** pixelsPerLabel http://dygraphs.com/options.html#pixelsPerLabel Number of pixels to require between each x- and y-label. Larger values will yield a sparser axis with fewer ticks. This is set on a per-axis basis. @@ -441,7 +440,7 @@ module Axis_options : sig *) -> unit -> t - [@@js.builder] + [@@js.builder] end module Axes : sig @@ -450,8 +449,8 @@ module Axes : sig val t_of_js : Ojs.t -> t val t_to_js : t -> Ojs.t - val create : ?x:Axis_options.t -> ?y:Axis_options.t -> ?y2:Axis_options.t -> unit -> t - [@@js.builder] + val create : ?x:Axis_options.t -> ?y:Axis_options.t -> ?y2:Axis_options.t -> unit -> t + [@@js.builder] end module Highlight_series_options : sig @@ -462,14 +461,14 @@ module Highlight_series_options : sig val create : ?highlightCircleSize:int - (** highlightCircleSize http://dygraphs.com/options.html#highlightCircleSize + (** highlightCircleSize http://dygraphs.com/options.html#highlightCircleSize The size in pixels of the dot drawn over highlighted points. Type: integer Default: 3 *) -> ?strokeWidth:float - (** strokeWidth http://dygraphs.com/options.html#strokeWidth + (** strokeWidth http://dygraphs.com/options.html#strokeWidth The width of the lines connecting data points. This can be used to increase the contrast or some graphs. @@ -478,7 +477,7 @@ module Highlight_series_options : sig Default: 1.0 *) -> ?strokeBorderWidth:float - (** strokeBorderWidth http://dygraphs.com/options.html#strokeBorderWidth + (** strokeBorderWidth http://dygraphs.com/options.html#strokeBorderWidth Draw a border around graph lines to make crossing lines more easily distinguishable. Useful for graphs with many lines. @@ -488,7 +487,7 @@ module Highlight_series_options : sig *) -> unit -> t - [@@js.builder] + [@@js.builder] end type t @@ -1466,19 +1465,19 @@ val create val legendFormatter : t -> (Legend_data.t -> string) option [@@js.get] -val zoomCallback : t -> (xmin:float -> xmax:float -> yRanges:Range.t array -> unit) option -[@@js.get] +val zoomCallback : t -> (xmin:float -> xmax:float -> yRanges:Range.t array -> unit) option + [@@js.get] val height : t -> int option [@@js.get] -val width : t -> int option [@@js.get] +val width : t -> int option [@@js.get] (** This is the lodash.js deep-merge implementation *) val merge_internal : t -> prefer:t -> t -[@@js.global "_.merge"] + [@@js.global "_.merge"] (* [merge_internal] actually mutably changes the first [t] (and returns it) *) (** merge two [t]s, preferring options in [prefer] *) val merge : t -> prefer:t -> t -[@@js.custom - let merge t ~prefer = create () |> merge_internal ~prefer:t |> merge_internal ~prefer] + [@@js.custom + let merge t ~prefer = create () |> merge_internal ~prefer:t |> merge_internal ~prefer] diff --git a/bindings/dygraph/src/per_series_info.ml b/bindings/dygraph/src/per_series_info.ml index bcda2446..e01ceb73 100644 --- a/bindings/dygraph/src/per_series_info.ml +++ b/bindings/dygraph/src/per_series_info.ml @@ -1,8 +1,8 @@ -open Core +open Core open! Import type t = - { label : string + { label : string ; visible_by_default : bool } [@@deriving fields ~getters] diff --git a/bindings/dygraph/src/per_series_info.mli b/bindings/dygraph/src/per_series_info.mli index 1ad00463..cda48516 100644 --- a/bindings/dygraph/src/per_series_info.mli +++ b/bindings/dygraph/src/per_series_info.mli @@ -2,7 +2,7 @@ open! Core open! Import type t = - { label : string + { label : string ; visible_by_default : bool } [@@deriving fields ~getters] diff --git a/bindings/dygraph/src/plotter.ml b/bindings/dygraph/src/plotter.ml index 2f22158d..7cdc89bf 100644 --- a/bindings/dygraph/src/plotter.ml +++ b/bindings/dygraph/src/plotter.ml @@ -1,28 +1,39 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open! Gen_js_api + type t = Ojs.t + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let (line_plotter : t) = t_of_js (Ojs.get_prop_ascii - (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") - "Plotters") "linePlotter") + (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") "Plotters") + "linePlotter") +;; + let (fill_plotter : t) = t_of_js (Ojs.get_prop_ascii - (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") - "Plotters") "fillPlotter") + (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") "Plotters") + "fillPlotter") +;; + let (error_bar_plotter : t) = t_of_js (Ojs.get_prop_ascii - (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") - "Plotters") "errorPlotter") + (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") "Plotters") + "errorPlotter") +;; + let (point_plotter : t) = t_of_js (Ojs.get_prop_ascii - (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") - "Plotters") "pointPlotter") + (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Dygraph") "Plotters") + "pointPlotter") +;; diff --git a/bindings/dygraph/src/plotter.mli b/bindings/dygraph/src/plotter.mli index 6b00b1fb..fd491d33 100644 --- a/bindings/dygraph/src/plotter.mli +++ b/bindings/dygraph/src/plotter.mli @@ -4,9 +4,9 @@ open! Gen_js_api type t -val t_to_js : t -> Ojs.t -val t_of_js : Ojs.t -> t -val line_plotter : t [@@js.global "Dygraph.Plotters.linePlotter"] -val fill_plotter : t [@@js.global "Dygraph.Plotters.fillPlotter"] +val t_to_js : t -> Ojs.t +val t_of_js : Ojs.t -> t +val line_plotter : t [@@js.global "Dygraph.Plotters.linePlotter"] +val fill_plotter : t [@@js.global "Dygraph.Plotters.fillPlotter"] val error_bar_plotter : t [@@js.global "Dygraph.Plotters.errorPlotter"] -val point_plotter : t [@@js.global "Dygraph.Plotters.pointPlotter"] +val point_plotter : t [@@js.global "Dygraph.Plotters.pointPlotter"] diff --git a/bindings/dygraph/src/point.ml b/bindings/dygraph/src/point.ml index 782031d4..94ab4b46 100644 --- a/bindings/dygraph/src/point.ml +++ b/bindings/dygraph/src/point.ml @@ -1,34 +1,37 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api + type t = - { - xval: float ; - yval: float ; - canvasx: float ; - canvasy: float ; - name: string ; - idx: int } + { xval : float + ; yval : float + ; canvasx : float + ; canvasy : float + ; name : string + ; idx : int + } + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> - { - xval = (Ojs.float_of_js (Ojs.get_prop_ascii x2 "xval")); - yval = (Ojs.float_of_js (Ojs.get_prop_ascii x2 "yval")); - canvasx = (Ojs.float_of_js (Ojs.get_prop_ascii x2 "canvasx")); - canvasy = (Ojs.float_of_js (Ojs.get_prop_ascii x2 "canvasy")); - name = (Ojs.string_of_js (Ojs.get_prop_ascii x2 "name")); - idx = (Ojs.int_of_js (Ojs.get_prop_ascii x2 "idx")) - } + { xval = Ojs.float_of_js (Ojs.get_prop_ascii x2 "xval") + ; yval = Ojs.float_of_js (Ojs.get_prop_ascii x2 "yval") + ; canvasx = Ojs.float_of_js (Ojs.get_prop_ascii x2 "canvasx") + ; canvasy = Ojs.float_of_js (Ojs.get_prop_ascii x2 "canvasy") + ; name = Ojs.string_of_js (Ojs.get_prop_ascii x2 "name") + ; idx = Ojs.int_of_js (Ojs.get_prop_ascii x2 "idx") + } + and t_to_js : t -> Ojs.t = fun (x1 : t) -> - Ojs.obj - [|("xval", (Ojs.float_to_js x1.xval));("yval", - (Ojs.float_to_js x1.yval)); - ("canvasx", (Ojs.float_to_js x1.canvasx));("canvasy", - (Ojs.float_to_js - x1.canvasy));("name", - (Ojs.string_to_js - x1.name)); - ("idx", (Ojs.int_to_js x1.idx))|] + Ojs.obj + [| "xval", Ojs.float_to_js x1.xval + ; "yval", Ojs.float_to_js x1.yval + ; "canvasx", Ojs.float_to_js x1.canvasx + ; "canvasy", Ojs.float_to_js x1.canvasy + ; "name", Ojs.string_to_js x1.name + ; "idx", Ojs.int_to_js x1.idx + |] +;; diff --git a/bindings/dygraph/src/point.mli b/bindings/dygraph/src/point.mli index 162cac84..033b8fc7 100644 --- a/bindings/dygraph/src/point.mli +++ b/bindings/dygraph/src/point.mli @@ -1,16 +1,16 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** http://dygraphs.com/options.html#point_properties *) type t = - { xval : float - ; yval : float + { xval : float + ; yval : float ; canvasx : float ; canvasy : float - ; name : string - ; idx : int + ; name : string + ; idx : int } val t_to_js : t -> Ojs.t diff --git a/bindings/dygraph/src/range.ml b/bindings/dygraph/src/range.ml index da76181f..30fb8614 100644 --- a/bindings/dygraph/src/range.ml +++ b/bindings/dygraph/src/range.ml @@ -1,9 +1,9 @@ -open Core +open Core open! Import -open Gen_js_api +open Gen_js_api type t = - { low : float + { low : float ; high : float } [@@deriving sexp, equal] @@ -23,7 +23,7 @@ module Spec = struct [@@deriving sexp, equal] let t_to_js = function - | Infer -> Ojs.null + | Infer -> Ojs.null | Specified t -> t_to_js t ;; end diff --git a/bindings/dygraph/src/range.mli b/bindings/dygraph/src/range.mli index 5275ddae..e6b5178f 100644 --- a/bindings/dygraph/src/range.mli +++ b/bindings/dygraph/src/range.mli @@ -1,11 +1,11 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api (** Ranges in dygraphs are represented as a number array with two elements. This makes them a bit easier to work with. *) type t = - { low : float + { low : float ; high : float } [@@deriving sexp, equal] diff --git a/bindings/dygraph/src/raw_html.mli b/bindings/dygraph/src/raw_html.mli index 675f10e7..20677fec 100644 --- a/bindings/dygraph/src/raw_html.mli +++ b/bindings/dygraph/src/raw_html.mli @@ -1,6 +1,6 @@ open! Core -open Import -open Gen_js_api +open Import +open Gen_js_api (** Dygraphs returns "raw html" as strings in some callbacks (see [Legend_data] and [legendFormatter]). We mint this type so that the types make it more clear which diff --git a/bindings/dygraph/src/update_options.ml b/bindings/dygraph/src/update_options.ml index ab06328b..bbc399e2 100644 --- a/bindings/dygraph/src/update_options.ml +++ b/bindings/dygraph/src/update_options.ml @@ -1,6 +1,6 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = Ojs.t diff --git a/bindings/dygraph/src/update_options.mli b/bindings/dygraph/src/update_options.mli index c54940ca..0bf8ffcd 100644 --- a/bindings/dygraph/src/update_options.mli +++ b/bindings/dygraph/src/update_options.mli @@ -1,9 +1,9 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t val t_to_js : t -> Ojs.t val t_of_js : Ojs.t -> t -val create : ?options:Options.t -> ?data:Data.t -> unit -> t +val create : ?options:Options.t -> ?data:Data.t -> unit -> t diff --git a/bindings/dygraph/src/which_y_axis.ml b/bindings/dygraph/src/which_y_axis.ml index d48b55e0..11b73330 100644 --- a/bindings/dygraph/src/which_y_axis.ml +++ b/bindings/dygraph/src/which_y_axis.ml @@ -1,18 +1,26 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Core open! Import open Gen_js_api -type t = [ `y1 | `y2 ] + +type t = + [ `y1 + | `y2 + ] + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> - let x3 = x2 in - match Ojs.string_of_js x3 with - | "y1" -> `y1 - | "y2" -> `y2 - | _ -> assert false + let x3 = x2 in + match Ojs.string_of_js x3 with + | "y1" -> `y1 + | "y2" -> `y2 + | _ -> assert false + and t_to_js : t -> Ojs.t = - fun (x1 : [ `y1 | `y2 ]) -> - match x1 with - | `y1 -> Ojs.string_to_js "y1" - | `y2 -> Ojs.string_to_js "y2" + fun (x1 : [ `y1 | `y2 ]) -> + match x1 with + | `y1 -> Ojs.string_to_js "y1" + | `y2 -> Ojs.string_to_js "y2" +;; diff --git a/bindings/dygraph/src/which_y_axis.mli b/bindings/dygraph/src/which_y_axis.mli index cb8002d4..01cfcb29 100644 --- a/bindings/dygraph/src/which_y_axis.mli +++ b/bindings/dygraph/src/which_y_axis.mli @@ -1,11 +1,11 @@ open! Core open! Import -open Gen_js_api +open Gen_js_api type t = ([ `y1 | `y2 ] - [@js.enum]) + [@js.enum]) val t_to_js : t -> Ojs.t diff --git a/bindings/dygraph/src/with_bonsai.ml b/bindings/dygraph/src/with_bonsai.ml index b36ffca0..af78199a 100644 --- a/bindings/dygraph/src/with_bonsai.ml +++ b/bindings/dygraph/src/with_bonsai.ml @@ -23,7 +23,7 @@ let id = Type_equal.Id.create ~name:"dygraph" [%sexp_of: opaque] https://dygraphs.com/options.html#height https://dygraphs.com/options.html#width *) -let default_width = 480 +let default_width = 480 let default_height = 320 let widget ?with_graph ?on_zoom data options ~graph_tracker = @@ -37,7 +37,7 @@ let widget ?with_graph ?on_zoom data options ~graph_tracker = let resize_when_inserted_into_the_dom graph _time = Graph.resize graph in let override_zoom_callback ~graph options = match on_zoom with - | None -> options + | None -> options | Some on_zoom -> let zoomCallback = let caller's_zoom_callback = Options.zoomCallback options in @@ -53,24 +53,24 @@ let widget ?with_graph ?on_zoom data options ~graph_tracker = We need to detect when the width/height change and call [Graph.resize_explicit]. https://dygraphs.com/jsdoc/symbols/Dygraph.html#resize *) - let old_width = Options.width old_options in - let old_height = Options.height old_options in - let width = Option.bind options ~f:Options.width in - let height = Option.bind options ~f:Options.height in + let old_width = Options.width old_options in + let old_height = Options.height old_options in + let width = Option.bind options ~f:Options.width in + let height = Option.bind options ~f:Options.height in let pair_with_default w h = match w, h with - | None , None -> None + | None, None -> None | Some w, Some h -> Some (w, h) - | Some w, None -> Some (w, default_height) - | None , Some h -> Some (default_width, h) + | Some w, None -> Some (w, default_height) + | None, Some h -> Some (default_width, h) in let old_width_and_height = pair_with_default old_width old_height in - let new_width_and_height = pair_with_default width height in + let new_width_and_height = pair_with_default width height in match old_width_and_height, new_width_and_height with - | None , None -> () + | None, None -> () | Some old_wh, Some new_wh when [%equal: int * int] old_wh new_wh -> () - | Some _ , None -> Graph.resize graph - | Some _, Some (width, height) | None, Some (width, height) -> + | Some _, None -> Graph.resize graph + | Some _, Some (width, height) | None, Some (width, height) -> Graph.resize_explicit graph ~width ~height in Vdom.Node.widget @@ -84,11 +84,11 @@ let widget ?with_graph ?on_zoom data options ~graph_tracker = being removed, go ahead and cancel the callback. *) Dom_html.window##cancelAnimationFrame animation_id) ~init:(fun () -> - let el = Dom_html.createDiv Dom_html.document in - let graph = Graph.create el data options in + let el = Dom_html.createDiv Dom_html.document in + let graph = Graph.create el data options in let graph_tracker_id = graph_tracker.Mutable_state_tracker.unsafe_init graph in let () = - let options = override_zoom_callback ~graph options in + let options = override_zoom_callback ~graph options in let updateOptions = Update_options.create ~options ?data:None () in Graph.updateOptions graph updateOptions in @@ -101,27 +101,27 @@ let widget ?with_graph ?on_zoom data options ~graph_tracker = ~update: (fun (old_data, old_options, old_on_zoom, graph, animation_id, graph_tracker_id) el -> - let () = - let data = Option.some_if (not (phys_equal old_data data)) data in - let options = - match phys_equal old_options options, phys_equal old_on_zoom on_zoom with - | true, true -> None - | _ -> Some (override_zoom_callback ~graph options) - in - (match data, options with - | None, None -> () - | _, options -> - let updateOptions = Update_options.create ?options ?data () in - Graph.updateOptions graph updateOptions); - resize_if_width_or_height_changed graph ~old_options ~options + let () = + let data = Option.some_if (not (phys_equal old_data data)) data in + let options = + match phys_equal old_options options, phys_equal old_on_zoom on_zoom with + | true, true -> None + | _ -> Some (override_zoom_callback ~graph options) in - (data, options, on_zoom, graph, animation_id, graph_tracker_id), el) + (match data, options with + | None, None -> () + | _, options -> + let updateOptions = Update_options.create ?options ?data () in + Graph.updateOptions graph updateOptions); + resize_if_width_or_height_changed graph ~old_options ~options + in + (data, options, on_zoom, graph, animation_id, graph_tracker_id), el) ;; let create_graph ?with_graph ?on_zoom data options ~graph_tracker = let on_zoom = match on_zoom with - | None -> Bonsai.Value.return None + | None -> Bonsai.Value.return None | Some on_zoom -> Bonsai.Value.map on_zoom ~f:Option.some in let%arr data = data @@ -132,7 +132,7 @@ let create_graph ?with_graph ?on_zoom data options ~graph_tracker = ;; let create_options ~x_label ~y_labels ~visibility ~legendFormatter = - let labels = x_label :: y_labels in + let labels = x_label :: y_labels in (* We create an element but never actually put it anywhere. *) let hidden_legend = Dom_html.createDiv Dom_html.document in Options.create @@ -175,14 +175,14 @@ let format_legend inject_legend_data options data = let build_options options visibility legendFormatter x_label y_labels = let our_options = create_options ~x_label ~y_labels ~visibility ~legendFormatter in match options with - | None -> our_options + | None -> our_options | Some options -> Options.merge options ~prefer:our_options ;; let visibility ~legend_model ~num_series = let visibility = let%map.Bonsai visibility_from_legend = legend_model >>| Legend_model.visibility - and num_series = num_series in + and num_series = num_series in let visibility_len = List.length visibility_from_legend in if visibility_len < num_series then ( @@ -197,21 +197,21 @@ let visibility ~legend_model ~num_series = ;; type t = - { graph_view : Vdom.Node.t + { graph_view : Vdom.Node.t ; modify_graph : (Graph.t -> unit) -> unit Effect.t } let create - ~key - ~x_label - ~per_series_info - ?custom_legend - ?options - ?with_graph - ?on_zoom - ?(extra_attr = Value.return Vdom.Attr.empty) - ~data - () + ~key + ~x_label + ~per_series_info + ?custom_legend + ?options + ?with_graph + ?on_zoom + ?(extra_attr = Value.return Vdom.Attr.empty) + ~data + () = let options = Option.value_map @@ -222,7 +222,7 @@ let create let%sub legend = match custom_legend with | Some legend -> Bonsai.read legend - | None -> create_default_legend ~x_label ~per_series_info + | None -> create_default_legend ~x_label ~per_series_info in let%pattern_bind legend_model, legend_view, inject_legend_data = legend in let inject_legend_data = Bonsai.Value.cutoff inject_legend_data ~equal:phys_equal in @@ -240,10 +240,10 @@ let create let%sub graph_tracker = Mutable_state_tracker.component () in let%sub graph = create_graph ?with_graph ?on_zoom data options ~graph_tracker in let%arr graph = graph - and legend_view = legend_view - and key = key + and legend_view = legend_view + and key = key and graph_tracker = graph_tracker - and extra_attr = extra_attr in + and extra_attr = extra_attr in let graph_view = Vdom.Node.div ~key diff --git a/bindings/dygraph/src/with_bonsai.mli b/bindings/dygraph/src/with_bonsai.mli index 98e351d8..48e872e8 100644 --- a/bindings/dygraph/src/with_bonsai.mli +++ b/bindings/dygraph/src/with_bonsai.mli @@ -1,5 +1,5 @@ open! Core -open Import +open Import (** The recommended way to create dygraphs (with bonsai). *) @@ -16,16 +16,16 @@ val create_default_legend : x_label:string Bonsai.Value.t -> per_series_info:Per_series_info.t list Bonsai.Value.t -> (Legend_model.t * Vdom.Node.t * (Legend_data.t -> unit Ui_effect.t)) - Bonsai.Computation.t + Bonsai.Computation.t type t = - { graph_view : Vdom.Node.t + { graph_view : Vdom.Node.t ; modify_graph : (Graph.t -> unit) -> unit Effect.t } val create : key:string Bonsai.Value.t - (** [key] is a virtualdom concept that allows it to identify which items in a list have + (** [key] is a virtualdom concept that allows it to identify which items in a list have changed. For more information, see https://reactjs.org/docs/lists-and-keys.html#keys. @@ -37,11 +37,11 @@ val create -> per_series_info:Per_series_info.t list Bonsai.Value.t -> ?custom_legend: (Legend_model.t * Vdom.Node.t * (Legend_data.t -> unit Ui_effect.t)) Bonsai.Value.t - (** [custom_legend] defaults to Default_legend. If you don't want that legend, you're + (** [custom_legend] defaults to Default_legend. If you don't want that legend, you're free to pass in your own bonsai computation. *) -> ?options:Options.t Bonsai.Value.t -> ?with_graph:(Graph.t -> unit) - (** This hook may be useful if you want to, for example, bind the graph to some global + (** This hook may be useful if you want to, for example, bind the graph to some global variable on the window. That way you can poke at the graph in the console. *) -> ?on_zoom: (Graph.t @@ -49,7 +49,7 @@ val create -> xmax:float -> yRanges:Range.t array -> unit Vdom.Effect.t) - Bonsai.Value.t + Bonsai.Value.t -> ?extra_attr:Vdom.Attr.t Bonsai.Value.t -> data:Data.t Bonsai.Value.t -> unit diff --git a/bindings/dygraph/src/x_axis_mapping.ml b/bindings/dygraph/src/x_axis_mapping.ml index 919e638a..08084024 100644 --- a/bindings/dygraph/src/x_axis_mapping.ml +++ b/bindings/dygraph/src/x_axis_mapping.ml @@ -48,7 +48,7 @@ let default_axis_label_formatter x gran opts = | `number x -> let number = Js.number_of_float x in dygraphs_number_axis_label_formatter () number gran opts |> Js.to_string - | `date d -> dygraphs_date_axis_label_formatter () d gran opts |> Js.to_string + | `date d -> dygraphs_date_axis_label_formatter () d gran opts |> Js.to_string ;; (* due to the floatness of the piecewise_linear math, timestamps come can out weird. I @@ -56,10 +56,10 @@ let default_axis_label_formatter x gran opts = anyways b/c of dates in javascript), so this rounding feels relatively uncontroversial and makes the output look a lot better. *) let round_time_nearest_ms time ~zone = - let date, ofday = Time_ns.to_date_ofday time ~zone in - let span = Time_ns.Ofday.to_span_since_start_of_day ofday in - let ms = Time_ns.Span.to_ms span |> Float.iround_nearest_exn in - let ofday = Time_ns.Span.of_int_ms ms |> Time_ns.Ofday.of_span_since_start_of_day_exn in + let date, ofday = Time_ns.to_date_ofday time ~zone in + let span = Time_ns.Ofday.to_span_since_start_of_day ofday in + let ms = Time_ns.Span.to_ms span |> Float.iround_nearest_exn in + let ofday = Time_ns.Span.of_int_ms ms |> Time_ns.Ofday.of_span_since_start_of_day_exn in Time_ns.of_date_ofday ~zone date ofday ;; @@ -69,9 +69,9 @@ let default_value_formatter ~zone ms_since_epoch = ;; type t = - { time_to_x_value : Time_ns.t -> Time_ns.t - ; x_value_to_time : Time_ns.t -> Time_ns.t - ; value_formatter : float -> Options.Opts.t -> string + { time_to_x_value : Time_ns.t -> Time_ns.t + ; x_value_to_time : Time_ns.t -> Time_ns.t + ; value_formatter : float -> Options.Opts.t -> string ; axis_label_formatter : Number_or_js_date.t -> Granularity.t -> Options.Opts.t -> string } @@ -84,8 +84,8 @@ module Time_mapping = struct let to_float t = Span.to_ns (to_span_since_epoch t) let of_float f = of_span_since_epoch (Span.of_ns f) - let t_of_sexp = Alternate_sexp.t_of_sexp - let sexp_of_t = Alternate_sexp.sexp_of_t + let t_of_sexp = Alternate_sexp.t_of_sexp + let sexp_of_t = Alternate_sexp.sexp_of_t end (* Our mapping between real time and graph time will be a piecewise_linear invertible @@ -93,9 +93,9 @@ module Time_mapping = struct include Piecewise_linear_kernel.Make_invertible (Time_ns) (Time_ns) let create ~start_time ~end_time ~zone ~ofday_knots ~date_to_weight : t Or_error.t = - let start_date = Time_ns.to_date start_time ~zone in - let end_date = Time_ns.to_date end_time ~zone in - let dates = Date.dates_between ~min:start_date ~max:end_date in + let start_date = Time_ns.to_date start_time ~zone in + let end_date = Time_ns.to_date end_time ~zone in + let dates = Date.dates_between ~min:start_date ~max:end_date in let time date hr min = Time_ns.of_date_ofday ~zone date (Time_ns.Ofday.create ~hr ~min ()) in @@ -125,7 +125,7 @@ module Time_mapping = struct time, x_value_time) in match create knots_in_time with - | Ok t -> Ok t + | Ok t -> Ok t | Error error -> Or_error.error_s [%message @@ -136,13 +136,13 @@ module Time_mapping = struct end let only_display_market_hours - ?(mkt_start_ofday = Time_ns.Ofday.create ~hr:9 ~min:30 ()) - ?(mkt_end_ofday = Time_ns.Ofday.create ~hr:16 ()) - ~start_time - ~end_time - ~view_zone - ?(mkt_zone = view_zone) - () + ?(mkt_start_ofday = Time_ns.Ofday.create ~hr:9 ~min:30 ()) + ?(mkt_end_ofday = Time_ns.Ofday.create ~hr:16 ()) + ~start_time + ~end_time + ~view_zone + ?(mkt_zone = view_zone) + () = let ofday_knots = (* Why do we have a [latest_allowable_mkt_end_of_day]? It's because of the fact that @@ -176,17 +176,17 @@ let only_display_market_hours let%map.Or_error x_axis_mapping = Time_mapping.create ~start_time ~end_time ~zone:mkt_zone ~ofday_knots ~date_to_weight in - let time_to_x_value time = Time_mapping.get x_axis_mapping time in + let time_to_x_value time = Time_mapping.get x_axis_mapping time in let x_value_to_time x_value = Time_mapping.get_inverse x_axis_mapping x_value in let value_formatter ms_since_epoch _opts = let x_value = Time_ns.of_span_since_epoch (Time_ns.Span.of_ms ms_since_epoch) in - let time = x_value_to_time x_value in + let time = x_value_to_time x_value in Time_ns.to_string_trimmed (round_time_nearest_ms time ~zone:view_zone) ~zone:view_zone in let date_axis_label_formatter x_value granularity opts = - let time = x_value_to_time x_value in + let time = x_value_to_time x_value in let ms_since_epoch = Time_ns.Span.to_ms (Time_ns.to_span_since_epoch time) in - let js_date = new%js Js.date_fromTimeValue ms_since_epoch in + let js_date = new%js Js.date_fromTimeValue ms_since_epoch in dygraphs_date_axis_label_formatter () js_date granularity opts |> Js.to_string in let axis_label_formatter x gran opts = @@ -197,18 +197,18 @@ let only_display_market_hours dygraphs_number_axis_label_formatter () (Js.number_of_float x) gran opts |> Js.to_string | `date d -> - let ms_since_epoch : float = d##getTime in - let span = Time_ns.Span.of_ms ms_since_epoch in - let x_value = Time_ns.of_span_since_epoch span in + let ms_since_epoch : float = d##getTime in + let span = Time_ns.Span.of_ms ms_since_epoch in + let x_value = Time_ns.of_span_since_epoch span in date_axis_label_formatter x_value gran opts in { time_to_x_value; x_value_to_time; value_formatter; axis_label_formatter } ;; let default ~zone = - { time_to_x_value = Fn.id - ; x_value_to_time = Fn.id - ; value_formatter = (fun x _opts -> default_value_formatter x ~zone) + { time_to_x_value = Fn.id + ; x_value_to_time = Fn.id + ; value_formatter = (fun x _opts -> default_value_formatter x ~zone) ; axis_label_formatter = default_axis_label_formatter } ;; diff --git a/bindings/dygraph/src/x_axis_mapping.mli b/bindings/dygraph/src/x_axis_mapping.mli index 2059cdb8..41784f5c 100644 --- a/bindings/dygraph/src/x_axis_mapping.mli +++ b/bindings/dygraph/src/x_axis_mapping.mli @@ -1,4 +1,4 @@ -open Core +open Core open! Import (** This module is a helper function designed to make it easy (easier) to make the spacing @@ -32,9 +32,9 @@ open! Import *) type t = - { time_to_x_value : Time_ns.t -> Time_ns.t - ; x_value_to_time : Time_ns.t -> Time_ns.t - ; value_formatter : float -> Options.Opts.t -> string + { time_to_x_value : Time_ns.t -> Time_ns.t + ; x_value_to_time : Time_ns.t -> Time_ns.t + ; value_formatter : float -> Options.Opts.t -> string ; axis_label_formatter : Number_or_js_date.t -> Granularity.t -> Options.Opts.t -> string } diff --git a/examples/animation/main.ml b/examples/animation/main.ml index db5b92ff..54ddecb0 100644 --- a/examples/animation/main.ml +++ b/examples/animation/main.ml @@ -34,14 +34,12 @@ let component = let%bind.Effect forward = match%bind.Effect get_forward with | Active forward -> Effect.return forward - | Inactive -> - Effect.never + | Inactive -> Effect.never in let%bind.Effect interpolator = match%bind.Effect get_interpolator with | Active interpolator -> Effect.return interpolator - | Inactive -> - Effect.never + | Inactive -> Effect.never in let%bind.Effect () = set_forward (not forward) in let target = if forward then 100.0 else 0.0 in diff --git a/examples/bonsai_guide_code/css_examples.ml b/examples/bonsai_guide_code/css_examples.ml index 213622b7..f682d136 100644 --- a/examples/bonsai_guide_code/css_examples.ml +++ b/examples/bonsai_guide_code/css_examples.ml @@ -16,7 +16,7 @@ let basic_table rows = let tbody = rows |> List.map ~f:(fun { id; name; age } -> - tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) + tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) |> tbody in table [ thead; tbody ] @@ -78,13 +78,13 @@ let basic_table_attr rows = let tbody = rows |> List.mapi ~f:(fun i { id; name; age } -> - let tr_style = if Int.( % ) i 2 = 0 then tr_even else tr_odd in - tr - ~attrs:[ Vdom.Attr.style tr_style ] - [ td ~attrs:[ Vdom.Attr.style td_styles ] [ textf "%d" id ] - ; td ~attrs:[ Vdom.Attr.style td_styles ] [ text name ] - ; td ~attrs:[ Vdom.Attr.style td_styles ] [ textf "%d" age ] - ]) + let tr_style = if Int.( % ) i 2 = 0 then tr_even else tr_odd in + tr + ~attrs:[ Vdom.Attr.style tr_style ] + [ td ~attrs:[ Vdom.Attr.style td_styles ] [ textf "%d" id ] + ; td ~attrs:[ Vdom.Attr.style td_styles ] [ text name ] + ; td ~attrs:[ Vdom.Attr.style td_styles ] [ textf "%d" age ] + ]) |> tbody in table ~attrs:[ Vdom.Attr.style table_styles ] [ thead; tbody ] @@ -106,9 +106,9 @@ let () = (* $MDX part-begin=inline_css *) module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| table.politicians { border-collapse: collapse; border: 1px solid brown; @@ -143,7 +143,7 @@ let table_with_ppx_css rows = let tbody = rows |> List.map ~f:(fun { id; name; age } -> - tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) + tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) |> tbody in table ~attrs:[ Style.politicians ] [ thead; tbody ] @@ -168,7 +168,7 @@ let themeable_table ?(theme = Style.default) rows = let tbody = rows |> List.map ~f:(fun { id; name; age } -> - tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) + tr [ td [ textf "%d" id ]; td [ text name ]; td [ textf "%d" age ] ]) |> tbody in table ~attrs:[ Style.politicians ] [ thead; tbody ] @@ -176,9 +176,9 @@ let themeable_table ?(theme = Style.default) rows = (* $MDX part-begin=my_theme *) module My_theme = - [%css - stylesheet - {| +[%css +stylesheet + {| table.politicians { border-collapse: collapse; border: 1px solid black; @@ -217,9 +217,9 @@ let () = Util.run (Bonsai.const (Vdom.Node.div [ table ])) ~id:"themeable-table" module _ = struct (* $MDX part-begin=tomato-square-ppx-css *) module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .square { background-color: tomato; height: 100px; @@ -237,9 +237,9 @@ end module _ = struct module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| :root { --red: #ff5a5a; --green: #5aff5a; diff --git a/examples/bonsai_guide_code/edge_examples.ml b/examples/bonsai_guide_code/edge_examples.ml index 70c603a8..b642bf84 100644 --- a/examples/bonsai_guide_code/edge_examples.ml +++ b/examples/bonsai_guide_code/edge_examples.ml @@ -168,11 +168,11 @@ let _on_change' : _ on_change_function_signature = Bonsai.Edge.on_change' (* $MDX part-begin=on_change_prime *) let on_change' - (type a) - (module M : Bonsai.Model with type t = a) - ~equal - (current_value : a Value.t) - ~(callback : (a option -> a -> unit Effect.t) Value.t) + (type a) + (module M : Bonsai.Model with type t = a) + ~equal + (current_value : a Value.t) + ~(callback : (a option -> a -> unit Effect.t) Value.t) = let%sub previous_value, set_previous_value = Bonsai.state_opt () ~sexp_of_model:[%sexp_of: M.t] ~equal diff --git a/examples/bonsai_guide_code/flow_examples.ml b/examples/bonsai_guide_code/flow_examples.ml index 5cde8832..dcd3c652 100644 --- a/examples/bonsai_guide_code/flow_examples.ml +++ b/examples/bonsai_guide_code/flow_examples.ml @@ -88,10 +88,10 @@ let multiple_counters (input : unit String.Map.t Value.t) = (counters |> Map.to_alist |> List.map ~f:(fun (key, vdom) -> - let open Vdom.Node in - let name = td [ Vdom.Node.text key ] in - let counter = td [ vdom ] in - Vdom.Node.tr [ name; counter ])) + let open Vdom.Node in + let name = td [ Vdom.Node.text key ] in + let counter = td [ vdom ] in + Vdom.Node.tr [ name; counter ])) ;; (* $MDX part-end *) @@ -129,9 +129,9 @@ let people = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Model.default ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - match action with - | Add name -> Map.set model ~key:name ~data:() - | Remove name -> Map.remove model name) + match action with + | Add name -> Map.set model ~key:name ~data:() + | Remove name -> Map.remove model name) ;; let add_new_person_form ~inject_add_person = @@ -142,9 +142,9 @@ let add_new_person_form ~inject_add_person = form |> Form.label "name" |> Form.validate ~f:(fun name -> - if String.for_all name ~f:Char.is_whitespace - then Error (Error.of_string "name must not be empty") - else Ok ()) + if String.for_all name ~f:Char.is_whitespace + then Error (Error.of_string "name must not be empty") + else Ok ()) |> Form.view_as_vdom ~on_submit:(Form.Submit.create ~f:on_submit ()) ;; diff --git a/examples/bonsai_guide_code/form_examples.ml b/examples/bonsai_guide_code/form_examples.ml index 14e83304..04f57954 100644 --- a/examples/bonsai_guide_code/form_examples.ml +++ b/examples/bonsai_guide_code/form_examples.ml @@ -129,9 +129,9 @@ let form_of_v : v Form.t Computation.t = (* provide a form computation for constructor in the variant *) let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | A -> Bonsai.const (Form.return ()) - | B -> Form.Elements.Textbox.int () - | C -> Form.Elements.Textbox.string () + | A -> Bonsai.const (Form.return ()) + | B -> Form.Elements.Textbox.int () + | C -> Form.Elements.Textbox.string () ;; end) ;; diff --git a/examples/bonsai_guide_code/rpc_examples.ml b/examples/bonsai_guide_code/rpc_examples.ml index 05b8df1d..808319f9 100644 --- a/examples/bonsai_guide_code/rpc_examples.ml +++ b/examples/bonsai_guide_code/rpc_examples.ml @@ -98,10 +98,10 @@ let current_time_implementation = ~on_client_and_server_out_of_sync:print_s current_time_rpc (fun _connection_state zone -> - Deferred.return - (Time_ns.to_string_trimmed ~zone:(Timezone.of_string zone) (Time_ns.now ()))) + Deferred.return + (Time_ns.to_string_trimmed ~zone:(Timezone.of_string zone) (Time_ns.now ()))) |> Rpc.Implementation.lift ~f:(fun connection_state -> - connection_state, connection_state) + connection_state, connection_state) ;; (* $MDX part-end *) diff --git a/examples/bonsai_guide_code/state_examples.ml b/examples/bonsai_guide_code/state_examples.ml index 1ced91a5..7a16cd93 100644 --- a/examples/bonsai_guide_code/state_examples.ml +++ b/examples/bonsai_guide_code/state_examples.ml @@ -93,9 +93,9 @@ let counter_state_machine : Vdom.Node.t Computation.t = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - match action with - | Increment -> model + 1 - | Decrement -> model - 1) + match action with + | Increment -> model + 1 + | Decrement -> model - 1) in let%arr state = state and inject = inject in diff --git a/examples/bonsai_view/main.ml b/examples/bonsai_view/main.ml index f2fbddc4..7986984c 100644 --- a/examples/bonsai_view/main.ml +++ b/examples/bonsai_view/main.ml @@ -88,37 +88,37 @@ module Table = struct let view = let%map.Computation theme = View.Theme.current in let module T = - [%demo - [@@@ocamlformat "disable"] + [%demo + [@@@ocamlformat "disable"] - type t = { sym : string ; bid : float ; ask : float } [@@deriving fields ~getters] + type t = { sym : string ; bid : float ; ask : float } [@@deriving fields ~getters] - [@@@ocamlformat "enable"] + [@@@ocamlformat "enable"] - let columns = - let render_text _ string = View.text string in - let render_float _ = Vdom.Node.textf "%.3f" in - [ View.Table.Col.make "sym" ~get:sym ~render:render_text - ; View.Table.Col.make "bid" ~get:bid ~render:render_float - ; View.Table.Col.make "ask" ~get:ask ~render:render_float - ] - ;; + let columns = + let render_text _ string = View.text string in + let render_float _ = Vdom.Node.textf "%.3f" in + [ View.Table.Col.make "sym" ~get:sym ~render:render_text + ; View.Table.Col.make "bid" ~get:bid ~render:render_float + ; View.Table.Col.make "ask" ~get:ask ~render:render_float + ] + ;; - let data = - [ { sym = "aapl"; bid = 1.0; ask = 2.3 } - ; { sym = "msft"; bid = 8.2; ask = 9.8 } - ; { sym = "tsla"; bid = 3.3; ask = 7.2 } - ] - ;; + let data = + [ { sym = "aapl"; bid = 1.0; ask = 2.3 } + ; { sym = "msft"; bid = 8.2; ask = 9.8 } + ; { sym = "tsla"; bid = 3.3; ask = 7.2 } + ] + ;; - let my_table = View.Table.render theme columns data] + let my_table = View.Table.render theme columns data] in let code = (* Get rid of the lines that disable ocamlformat *) T.ppx_demo_string |> Core.String.split_lines |> List.filter ~f:(fun s -> - not (Core.String.is_substring s ~substring:"ocamlformat")) + not (Core.String.is_substring s ~substring:"ocamlformat")) |> String.concat ~sep:"\n" |> String.strip |> String.substr_replace_first ~pattern:"\n\n" ~with_:"\n" @@ -149,17 +149,17 @@ module Table_with_group = struct include [%demo - let columns = - let render_text _ string = View.text string in - let render_float _ = Vdom.Node.textf "%.3f" in - [ View.Table.Col.make "sym" ~get:sym ~render:render_text - ; View.Table.Col.group - "prices" - [ View.Table.Col.make "bid" ~get:bid ~render:render_float - ; View.Table.Col.make "ask" ~get:ask ~render:render_float - ] - ] - ;;] + let columns = + let render_text _ string = View.text string in + let render_float _ = Vdom.Node.textf "%.3f" in + [ View.Table.Col.make "sym" ~get:sym ~render:render_text + ; View.Table.Col.group + "prices" + [ View.Table.Col.make "bid" ~get:bid ~render:render_float + ; View.Table.Col.make "ask" ~get:ask ~render:render_float + ] + ] + ;;] let data = [ { sym = "aapl"; bid = 1.0; ask = 2.3 } @@ -199,19 +199,19 @@ module Table_with_empty_cells = struct include [%demo - let columns = - let render_text _ string = View.text string in - [ View.Table.Col.make "symbol" ~get:sym ~render:render_text - ; View.Table.Col.make_opt "trader" ~get:trader ~render:render_text - ] - ;; + let columns = + let render_text _ string = View.text string in + [ View.Table.Col.make "symbol" ~get:sym ~render:render_text + ; View.Table.Col.make_opt "trader" ~get:trader ~render:render_text + ] + ;; - let data = - [ { sym = "aapl"; trader = None } - ; { sym = "msft"; trader = None } - ; { sym = "tsla"; trader = Some "emusk" } - ] - ;;] + let data = + [ { sym = "aapl"; trader = None } + ; { sym = "msft"; trader = None } + ; { sym = "tsla"; trader = Some "emusk" } + ] + ;;] let my_table = View.Table.render theme columns data end @@ -272,8 +272,8 @@ end let rickroll = Effect.of_sync_fun (fun () -> - let url = Js_of_ocaml.Js.string "https://www.youtube.com/watch?v=dQw4w9WgXcQ" in - Js_of_ocaml.Dom_html.window##.location##assign url) + let url = Js_of_ocaml.Js.string "https://www.youtube.com/watch?v=dQw4w9WgXcQ" in + Js_of_ocaml.Dom_html.window##.location##assign url) () ;; @@ -401,8 +401,8 @@ module Basic_vbox = struct let filter_attrs = Some (fun k _ -> - (not (String.is_substring k ~substring:"width")) - && not (String.is_substring k ~substring:"height")) + (not (String.is_substring k ~substring:"width")) + && not (String.is_substring k ~substring:"height")) ;; end @@ -455,9 +455,9 @@ module Interactive_vbox = struct ;; module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .controls { border-radius: 3px; padding: 1em; @@ -551,12 +551,12 @@ module Interactive_vbox = struct let filter_attrs = Some (fun k v -> - (not (String.equal k "id")) - && (not (String.is_substring k ~substring:"padding")) - && (not (String.is_substring k ~substring:"border")) - && (not (String.is_substring v ~substring:"target")) - && (not (String.is_substring k ~substring:"width")) - && not (String.is_substring k ~substring:"height")) + (not (String.equal k "id")) + && (not (String.is_substring k ~substring:"padding")) + && (not (String.is_substring k ~substring:"border")) + && (not (String.is_substring v ~substring:"target")) + && (not (String.is_substring k ~substring:"width")) + && not (String.is_substring k ~substring:"height")) ;; end @@ -593,19 +593,19 @@ module Enumerable_tabs = struct let view = let%map.Computation theme = View.Theme.current in let module T = - [%demo - module Pages = struct - type t = - | Home - | About - | User_preferences - [@@deriving enumerate, equal, sexp_of] - end - - let tabs = - let on_change ~from:_ ~to_:_ = Effect.Ignore in - View.tabs_enum theme (module Pages) ~active:Home ~on_change - ;;] + [%demo + module Pages = struct + type t = + | Home + | About + | User_preferences + [@@deriving enumerate, equal, sexp_of] + end + + let tabs = + let on_change ~from:_ ~to_:_ = Effect.Ignore in + View.tabs_enum theme (module Pages) ~active:Home ~on_change + ;;] in T.tabs, T.ppx_demo_string ;; diff --git a/examples/clock_every/main.ml b/examples/clock_every/main.ml index 7413f15d..3a078964 100644 --- a/examples/clock_every/main.ml +++ b/examples/clock_every/main.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax module Form = Bonsai_web_ui_form module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| html, body { font-family: 'Open Sans', sans-serif; } @@ -338,12 +338,12 @@ let timeline ~now ~(tracks : Bar.t Fdeque.t Track_id.Map.t Value.t) = ;; let clock - ~trigger_on_activate - ~when_to_start_next_effect - ~title - ~description - ~wait_time - ~delta_time:now + ~trigger_on_activate + ~when_to_start_next_effect + ~title + ~description + ~wait_time + ~delta_time:now = let%sub next_bar_id = Bar_id.component in let%sub { tracks; last_trigger_time; _ }, update_tracks = diff --git a/examples/codicons/main.ml b/examples/codicons/main.ml index 5ccae18b..4f8eba20 100644 --- a/examples/codicons/main.ml +++ b/examples/codicons/main.ml @@ -6,8 +6,8 @@ module Form = Bonsai_web_ui_form module Style = struct include [%css - stylesheet - {| + stylesheet + {| .main { padding: 24px; display: flex; diff --git a/examples/counters/lib/bonsai_web_counters_example.ml b/examples/counters/lib/bonsai_web_counters_example.ml index d620c0c8..2ee08922 100644 --- a/examples/counters/lib/bonsai_web_counters_example.ml +++ b/examples/counters/lib/bonsai_web_counters_example.ml @@ -16,8 +16,8 @@ let add_counter_component = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:Int.Map.empty ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model () -> - let key = Map.length model in - Map.add_exn model ~key ~data:()) + let key = Map.length model in + Map.add_exn model ~key ~data:()) in let%arr state, inject = add_counter_state in let view = @@ -48,8 +48,8 @@ let single_counter = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model -> function - | Action.Increment -> model + 1 - | Action.Decrement -> model - 1) + | Action.Increment -> model + 1 + | Action.Decrement -> model - 1) in let%arr state, inject = counter_state in let button label action = diff --git a/examples/dagviz/main.ml b/examples/dagviz/main.ml index d56538d7..00ee72a6 100644 --- a/examples/dagviz/main.ml +++ b/examples/dagviz/main.ml @@ -16,9 +16,9 @@ module Progress = struct end module Styles = - [%css - stylesheet - {| +[%css +stylesheet + {| .paper { box-shadow: 0 0 8px rgba(0,0,0,0.2); padding: 12px; @@ -346,10 +346,10 @@ let face_point : Position.t -> [ `Top | `Left | `Bottom | `Right ] -> Point.t = ;; let edge_to_svg - ~(direction : [ `Top_down | `Left_to_right ]) - ~(edge : Edge.t Value.t) - ~(from : Position.t Value.t) - ~(to_ : Position.t Value.t) + ~(direction : [ `Top_down | `Left_to_right ]) + ~(edge : Edge.t Value.t) + ~(from : Position.t Value.t) + ~(to_ : Position.t Value.t) = let%arr edge = edge and from = from diff --git a/examples/drag_and_drop/lib/bonsai_drag_and_drop_example.ml b/examples/drag_and_drop/lib/bonsai_drag_and_drop_example.ml index 190fbd07..5cbde1a1 100644 --- a/examples/drag_and_drop/lib/bonsai_drag_and_drop_example.ml +++ b/examples/drag_and_drop/lib/bonsai_drag_and_drop_example.ml @@ -5,9 +5,9 @@ module Drag_and_drop = Bonsai_web_ui_drag_and_drop module Node = Vdom.Node module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .centered { text-align: center; } @@ -197,8 +197,8 @@ let board ?extra_dnd name = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) model (Move { item_id; new_column }) -> - let change_col (contents, _) ~new_column = contents, new_column in - Map.change model item_id ~f:(Option.map ~f:(change_col ~new_column))) + let change_col (contents, _) ~new_column = contents, new_column in + Map.change model item_id ~f:(Option.map ~f:(change_col ~new_column))) in let%sub dnd = Drag_and_drop.create diff --git a/examples/drag_and_drop_list/main.ml b/examples/drag_and_drop_list/main.ml index e39b5fd8..c8978de9 100644 --- a/examples/drag_and_drop_list/main.ml +++ b/examples/drag_and_drop_list/main.ml @@ -5,9 +5,9 @@ module Reorderable_list = Bonsai_web_ui_reorderable_list module Form = Bonsai_web_ui_form module S = - [%css - stylesheet - {| +[%css +stylesheet + {| .item { background-color: green; color: white; diff --git a/examples/dygraph/custom_points.ml b/examples/dygraph/custom_points.ml index 88ded87d..d2cae740 100644 --- a/examples/dygraph/custom_points.ml +++ b/examples/dygraph/custom_points.ml @@ -12,11 +12,11 @@ let data : Dygraph.Data.t = ;; let draw_square - ~(context : Dom_html.canvasRenderingContext2D Js.t) - ~stroke_or_fill - ~cx - ~cy - ~side_length + ~(context : Dom_html.canvasRenderingContext2D Js.t) + ~stroke_or_fill + ~cx + ~cy + ~side_length = let top_left_x_coord = cx -. (side_length /. 2.) in let top_left_y_coord = cy -. (side_length /. 2.) in @@ -39,14 +39,14 @@ let options = ~drawHighlightPointCallback: (fun ~graph:_ ~seriesName:_ ~context ~cx ~cy ~color:_ ~pointSize:_ ~idx -> - let radius = side_lengths.(idx) /. 2. in - draw_circle ~context ~cx ~cy ~radius; - context##fill) + let radius = side_lengths.(idx) /. 2. in + draw_circle ~context ~cx ~cy ~radius; + context##fill) ~drawPointCallback: (fun ~graph:_ ~seriesName:_ ~context ~cx ~cy ~color:_ ~pointSize:_ ~idx -> - let radius = side_lengths.(idx) /. 2. in - draw_circle ~context ~cx ~cy ~radius) + let radius = side_lengths.(idx) /. 2. in + draw_circle ~context ~cx ~cy ~radius) () in let square_series_options = @@ -54,13 +54,13 @@ let options = ~drawHighlightPointCallback: (fun ~graph:_ ~seriesName:_ ~context ~cx ~cy ~color:_ ~pointSize:_ ~idx -> - let side_length = side_lengths.(idx) in - draw_square ~context ~stroke_or_fill:`Fill ~cx ~cy ~side_length) + let side_length = side_lengths.(idx) in + draw_square ~context ~stroke_or_fill:`Fill ~cx ~cy ~side_length) ~drawPointCallback: (fun ~graph:_ ~seriesName:_ ~context ~cx ~cy ~color:_ ~pointSize:_ ~idx -> - let side_length = side_lengths.(idx) in - draw_square ~context ~stroke_or_fill:`Stroke ~cx ~cy ~side_length) + let side_length = side_lengths.(idx) in + draw_square ~context ~stroke_or_fill:`Stroke ~cx ~cy ~side_length) () in let series = diff --git a/examples/dygraph/hide_overnights.ml b/examples/dygraph/hide_overnights.ml index 1933125a..97a33fd1 100644 --- a/examples/dygraph/hide_overnights.ml +++ b/examples/dygraph/hide_overnights.ml @@ -17,8 +17,8 @@ let times : Time_ns.t list = ~compare:Time_ns.compare ~stride:(fun t -> Time_ns.add t (Time_ns.Span.of_min 1.)) |> List.filter ~f:(fun t -> - let ofday = Time_ns.to_ofday t ~zone in - Time_ns.Ofday.( >= ) ofday start_ofday && Time_ns.Ofday.( <= ) ofday stop_ofday) + let ofday = Time_ns.to_ofday t ~zone in + Time_ns.Ofday.( >= ) ofday start_ofday && Time_ns.Ofday.( <= ) ofday stop_ofday) ;; (* a brownian motion *) diff --git a/examples/dygraph/stock_chart.ml b/examples/dygraph/stock_chart.ml index 4d2913cb..1a287169 100644 --- a/examples/dygraph/stock_chart.ml +++ b/examples/dygraph/stock_chart.ml @@ -66,7 +66,7 @@ let app = (y_labels |> Dygraph.Per_series_info.create_all_visible |> Value.return) ~options ~data - (* By setting the graph to global variable "g", I'm able to access the graph in the + (* By setting the graph to global variable "g", I'm able to access the graph in the chrome console and look at things, e.g. g.getOptions("series"). This is purely for debugging/convenience. *) ~with_graph:(fun graph -> Js.Unsafe.set Dom_html.window "g" graph) diff --git a/examples/element_size_util/main.ml b/examples/element_size_util/main.ml index 321a1ed4..ad5511a9 100644 --- a/examples/element_size_util/main.ml +++ b/examples/element_size_util/main.ml @@ -160,9 +160,9 @@ let visibility_component = ~visible_rect_changed:(fun bounds -> Effect.Many [ (match bounds with - | Some bounds -> - Effect.Many [ inject_pos_x bounds.min_x; inject_pos_y bounds.min_y ] - | None -> Effect.Ignore) + | Some bounds -> + Effect.Many [ inject_pos_x bounds.min_x; inject_pos_y bounds.min_y ] + | None -> Effect.Ignore) ; set_visible_rect bounds ]) ~client_rect_changed:(Fn.compose set_client_rect Option.some) diff --git a/examples/element_size_util/style.ml b/examples/element_size_util/style.ml index 0d3192f5..631fb8dd 100644 --- a/examples/element_size_util/style.ml +++ b/examples/element_size_util/style.ml @@ -2,8 +2,8 @@ open! Core include [%css - stylesheet - {| + stylesheet + {| * { box-sizing: border-box; font-family: sans-serif; @@ -75,4 +75,4 @@ include border: 2px solid red; } |} - ~rewrite:[ "--js-form-unfocused-color", "--js-form-unfocused-color" ]] + ~rewrite:[ "--js-form-unfocused-color", "--js-form-unfocused-color" ]] diff --git a/examples/feather_icons/controls.ml b/examples/feather_icons/controls.ml index e6159e62..c7702c57 100644 --- a/examples/feather_icons/controls.ml +++ b/examples/feather_icons/controls.ml @@ -12,9 +12,9 @@ type t = let default = { size = 24; stroke_width = 2.; stroke = `Hex "#000000"; fill = None } module Range = - [%css - stylesheet - {| +[%css +stylesheet + {| .class_ { height: 4px; cursor: pointer; @@ -45,8 +45,8 @@ let stroke_width_slider = ;; module Color_input = - [%css - stylesheet {| +[%css +stylesheet {| .class_ { cursor: pointer; height: 3em; @@ -66,9 +66,9 @@ let color_input ?(display = Value.return true) () = ;; module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .header { display: flex; justify-content: space-between; @@ -106,8 +106,8 @@ module Fill = struct } module Fill = - [%css - stylesheet {| + [%css + stylesheet {| .class_ { display: flex; justify-content: space-between; diff --git a/examples/feather_icons/icon_grid.ml b/examples/feather_icons/icon_grid.ml index 19a847a0..fa06a388 100644 --- a/examples/feather_icons/icon_grid.ml +++ b/examples/feather_icons/icon_grid.ml @@ -2,9 +2,9 @@ open! Core open! Import module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .cards { display: flex; flex-wrap: wrap; diff --git a/examples/feather_icons/import.ml b/examples/feather_icons/import.ml index 03c34da9..cc0ada88 100644 --- a/examples/feather_icons/import.ml +++ b/examples/feather_icons/import.ml @@ -4,9 +4,9 @@ include Bonsai.Let_syntax module Form = Bonsai_web_ui_form module Card_like = - [%css - stylesheet - {| +[%css +stylesheet + {| .class_ { border-radius: 8px; background-color: white; diff --git a/examples/feather_icons/main.ml b/examples/feather_icons/main.ml index f7673dc6..56985f25 100644 --- a/examples/feather_icons/main.ml +++ b/examples/feather_icons/main.ml @@ -23,9 +23,9 @@ h3 { ;; module Left_section = - [%css - stylesheet - {| +[%css +stylesheet + {| .class_ { display: flex; flex: 1 1 auto; @@ -70,7 +70,6 @@ module App = [%css stylesheet {| } |}] - let app = let%sub main = main in let%arr main = main in diff --git a/examples/feather_icons/search_bar.ml b/examples/feather_icons/search_bar.ml index 08cb5a03..a28c10d4 100644 --- a/examples/feather_icons/search_bar.ml +++ b/examples/feather_icons/search_bar.ml @@ -8,8 +8,8 @@ module Search_container = [%css stylesheet {| |}] module Search_icon = - [%css - stylesheet {| +[%css +stylesheet {| .class_ { position: absolute; left: 16px; @@ -18,9 +18,9 @@ module Search_icon = |}] module Search_bar = - [%css - stylesheet - {| +[%css +stylesheet + {| .class_ { width: 100%; height: 40px; diff --git a/examples/font_hosting/main.ml b/examples/font_hosting/main.ml index 92f53a8f..176cf530 100644 --- a/examples/font_hosting/main.ml +++ b/examples/font_hosting/main.ml @@ -2,9 +2,9 @@ open! Core open! Bonsai_web module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| @font-face { font-family: "FiraCode"; src: url(./font.ttf) format("truetype"); diff --git a/examples/forms/big_form.ml b/examples/forms/big_form.ml index 17724c7b..461d2a5a 100644 --- a/examples/forms/big_form.ml +++ b/examples/forms/big_form.ml @@ -6,9 +6,9 @@ module Codemirror_form = Bonsai_web_ui_codemirror_form module E = Form.Elements module Query_box_css = - [%css - stylesheet - {| +[%css +stylesheet + {| .list { background: white; border: solid 1px black; @@ -294,9 +294,9 @@ let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = functio E.Rank.list (module String) (fun ~source item -> - let%arr item = item - and source = source in - Vdom.Node.div ~attrs:[ source ] [ Vdom.Node.text item ]) + let%arr item = item + and source = source in + Vdom.Node.div ~attrs:[ source ] [ Vdom.Node.text item ]) in Form.Dynamic.with_default (Value.return [ "aaaaaa"; "bbbbbb"; "cccccc" ]) rank | Query_box -> diff --git a/examples/forms/list_form.ml b/examples/forms/list_form.ml index a906d33f..a50b741b 100644 --- a/examples/forms/list_form.ml +++ b/examples/forms/list_form.ml @@ -5,9 +5,9 @@ module Form = Bonsai_web_ui_form module E = Form.Elements module S = - [%css - stylesheet - {| +[%css +stylesheet + {| .pill { padding: 2px; background-color: #d0d0d0; diff --git a/examples/forms/main.ml b/examples/forms/main.ml index 99d9121e..9f485596 100644 --- a/examples/forms/main.ml +++ b/examples/forms/main.ml @@ -2,9 +2,9 @@ open! Core open! Bonsai_web module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .container { display: flex; flex-flow: row nowrap; diff --git a/examples/freeform_multiselect/main.ml b/examples/freeform_multiselect/main.ml index df1bd206..0a416d49 100644 --- a/examples/freeform_multiselect/main.ml +++ b/examples/freeform_multiselect/main.ml @@ -10,7 +10,7 @@ let components = let%arr selected, control, (_ : String.Set.t -> unit Ui_effect.t) = control in let have_you_selected_something = match Set.to_list selected with - | [] -> Vdom.Node.none + | [] -> Vdom.Node.none | selected -> Vdom.Node.p [ Vdom.Node.text ("You've selected: " ^ String.concat ~sep:", " selected) ] diff --git a/examples/gauge/main.ml b/examples/gauge/main.ml index ce8806ad..72c155e1 100644 --- a/examples/gauge/main.ml +++ b/examples/gauge/main.ml @@ -5,9 +5,9 @@ module Gauge = Bonsai_web_ui_gauge open Vdom module Styles = - [%css - stylesheet - {| +[%css +stylesheet + {| html { font-family: "Open Sans", "Noto Color Emoji", sans-serif; } @@ -75,7 +75,7 @@ let ticker = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model () -> - (model + 1) % 101) + (model + 1) % 101) in let%sub color_index, increment = Bonsai.state_machine0 @@ -85,7 +85,7 @@ let ticker = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) prev () -> - prev + (1 % Array.length colors)) + prev + (1 % Array.length colors)) in let%sub () = let%sub effect = diff --git a/examples/inline_css/main.ml b/examples/inline_css/main.ml index b953f6b0..a4331a94 100644 --- a/examples/inline_css/main.ml +++ b/examples/inline_css/main.ml @@ -3,9 +3,9 @@ open! Bonsai_web module Boxes = struct module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .container { display: inline-block; } @@ -27,7 +27,7 @@ module Boxes = struct background-color: blue; } |} - (* [ppx_css] appends a hash to the end of each classname to allow you to be able + (* [ppx_css] appends a hash to the end of each classname to allow you to be able to re-use classnames in multiple calls to [%css stylesheet] avoiding sadness for css identifier collisions like in this example where container is used multiple times. @@ -36,7 +36,7 @@ module Boxes = struct classnames for CSS customization, hashing could get in your way, so you can override hashing behavior by using the optional "~rewrite" parameter. *) - ~rewrite:[ "blue", "blue" ]] + ~rewrite:[ "blue", "blue" ]] let component = Vdom.Node.div @@ -50,9 +50,9 @@ end module Themeable = struct module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .container { padding: 1em; border: 1px solid black; @@ -69,10 +69,10 @@ module Themeable = struct font-family: sans-serif; } |} - (* Sometimes it might be useful to be able to use the same class-name + (* Sometimes it might be useful to be able to use the same class-name defined from another call to [%css stylesheet] which you can do using the "~rewrite" optional flag.*) - ~rewrite:[ "container", Boxes.Style.For_referencing.container ]] + ~rewrite:[ "container", Boxes.Style.For_referencing.container ]] let component ?(style = Style.default) () = let module Style = (val style) in @@ -85,9 +85,9 @@ module Themeable = struct end module My_theme = - [%css - stylesheet - {| +[%css +stylesheet + {| .container { border: 1px solid red; display: inline-block; diff --git a/examples/inline_css_private_appending/main.ml b/examples/inline_css_private_appending/main.ml index b57f54b4..3bebd533 100644 --- a/examples/inline_css_private_appending/main.ml +++ b/examples/inline_css_private_appending/main.ml @@ -11,7 +11,7 @@ let component = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) old_model () -> - old_model + 10) + old_model + 10) in let%sub append_effect = let%arr height = height in diff --git a/examples/inline_css_with_var/main.ml b/examples/inline_css_with_var/main.ml index 790d18e5..3e335384 100644 --- a/examples/inline_css_with_var/main.ml +++ b/examples/inline_css_with_var/main.ml @@ -2,9 +2,9 @@ open! Core open! Bonsai_web module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .box { width: 100px; height: 100px; @@ -13,7 +13,7 @@ module Style = border: 3px solid black; } |} - ~rewrite:[ "--my-color", "--my-color"; "--radius", "--radius" ]] + ~rewrite:[ "--my-color", "--my-color"; "--radius", "--radius" ]] let component = let red_box = diff --git a/examples/inside_incr_dom/my_bonsai_component.ml b/examples/inside_incr_dom/my_bonsai_component.ml index 0bdc4978..f9fee95c 100644 --- a/examples/inside_incr_dom/my_bonsai_component.ml +++ b/examples/inside_incr_dom/my_bonsai_component.ml @@ -4,29 +4,29 @@ open Bonsai.Let_syntax include (val Bonsai_web.To_incr_dom.convert (fun (_ : unit Bonsai.Value.t) -> - let%sub counters = Bonsai_web_counters_example.application in - let%sub () = - Bonsai.Edge.lifecycle - () - ~on_activate:(Value.return (Bonsai.Effect.print_s [%message "hi!"])) - in - let%sub () = - Bonsai.Clock.every - ~when_to_start_next_effect:`Every_multiple_of_period_blocking - (Time_ns.Span.of_sec 1.0) - (Value.return (Bonsai.Effect.print_s [%message "tick"])) - in - let%sub wait_after_display = Bonsai.Edge.wait_after_display in - let%sub print_button = - let%arr wait_after_display = wait_after_display in - Vdom.Node.button - ~attrs: - [ Vdom.Attr.on_click (fun _ -> - let%bind.Effect () = wait_after_display in - Effect.print_s [%message "after display"]) - ] - [ Vdom.Node.text "Print after display" ] - in - let%arr counters = counters - and print_button = print_button in - Vdom.Node.div [ counters; print_button ])) + let%sub counters = Bonsai_web_counters_example.application in + let%sub () = + Bonsai.Edge.lifecycle + () + ~on_activate:(Value.return (Bonsai.Effect.print_s [%message "hi!"])) + in + let%sub () = + Bonsai.Clock.every + ~when_to_start_next_effect:`Every_multiple_of_period_blocking + (Time_ns.Span.of_sec 1.0) + (Value.return (Bonsai.Effect.print_s [%message "tick"])) + in + let%sub wait_after_display = Bonsai.Edge.wait_after_display in + let%sub print_button = + let%arr wait_after_display = wait_after_display in + Vdom.Node.button + ~attrs: + [ Vdom.Attr.on_click (fun _ -> + let%bind.Effect () = wait_after_display in + Effect.print_s [%message "after display"]) + ] + [ Vdom.Node.text "Print after display" ] + in + let%arr counters = counters + and print_button = print_button in + Vdom.Node.div [ counters; print_button ])) diff --git a/examples/keyboard/keyboard_code.ml b/examples/keyboard/keyboard_code.ml index d34b110d..bfaa5734 100644 --- a/examples/keyboard/keyboard_code.ml +++ b/examples/keyboard/keyboard_code.ml @@ -1,7 +1,6 @@ open! Core include Js_of_ocaml.Dom_html.Keyboard_code - type nonrec t = t = | Unidentified | KeyA diff --git a/examples/keyboard/keyboard_code.mli b/examples/keyboard/keyboard_code.mli index 8e8de241..b168b59e 100644 --- a/examples/keyboard/keyboard_code.mli +++ b/examples/keyboard/keyboard_code.mli @@ -2,6 +2,6 @@ open! Core include module type of Js_of_ocaml.Dom_html.Keyboard_code include sig - type t [@@deriving equal, sexp] -end -with type t := t + type t [@@deriving equal, sexp] + end + with type t := t diff --git a/examples/keyboard/main.ml b/examples/keyboard/main.ml index 5866f0b2..d04d3f67 100644 --- a/examples/keyboard/main.ml +++ b/examples/keyboard/main.ml @@ -109,7 +109,7 @@ let component = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:[] ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - List.append model [ action ]) + List.append model [ action ]) in let%arr model, inject = model_and_inject in let last_event = List.last model in diff --git a/examples/modal/main.ml b/examples/modal/main.ml index cb36ba97..d0746463 100644 --- a/examples/modal/main.ml +++ b/examples/modal/main.ml @@ -1,7 +1,7 @@ open! Core open! Bonsai_web open! Bonsai.Let_syntax -module Modal = Bonsai_web_ui_modal +module Modal = Bonsai_web_ui_modal module Native_modal = Draft_modal (* original modal *) @@ -42,8 +42,8 @@ let original_app = in let%arr state = state and set_state = set_state - and modal_1 = modal_1 - and modal_2 = modal_2 in + and modal_1 = modal_1 + and modal_2 = modal_2 in Vdom.Node.div [ Vdom.Node.button ~attrs:[ Vdom.Attr.on_click (fun _ -> modal_1.show ()) ] @@ -55,7 +55,7 @@ let original_app = [ Vdom.Attr.on_click (fun _ -> let%bind.Ui_effect () = set_state (state + 1) in modal_2.show state) - ; Vdom.Attr.style (Css_gen.margin_top (`Px 10)) + ; Vdom.Attr.style (Css_gen.margin_top (`Px 10)) ] [ Vdom.Node.text "Click me multiple times!" ] ; modal_2.view @@ -78,7 +78,7 @@ let dialog_contents ?title ?close_button:close_button_on_cancel contents = let title_markup = Option.value_map title ~default:Vdom.Node.none ~f:dialog_title in let close_button_markup = match close_button_on_cancel with - | None -> Vdom.Node.none + | None -> Vdom.Node.none | Some on_click -> Vdom.Node.div ~attrs: @@ -130,7 +130,7 @@ let stacking_example = in let%arr show_outer = show_outer and toggle_outer = toggle_outer - and show_inner = show_inner + and show_inner = show_inner and toggle_inner = toggle_inner in let inner_modal = let contents = dialog_contents (Vdom.Node.text "inner modal") in @@ -244,9 +244,9 @@ let native_app = let%sub add_lots_of_content_markup = add_lots_of_content_markup in let%sub stacking_example = stacking_example in let%arr simple_modal = simple_modal - and side_sheet_modal = side_sheet_modal + and side_sheet_modal = side_sheet_modal and transparent_modal = transparent_modal - and stacking_example = stacking_example + and stacking_example = stacking_example and add_lots_of_content_markup = add_lots_of_content_markup in Vdom.Node.div (List.map diff --git a/examples/mouse_position/client/src/app.ml b/examples/mouse_position/client/src/app.ml index c4c1e50a..9ffb3163 100644 --- a/examples/mouse_position/client/src/app.ml +++ b/examples/mouse_position/client/src/app.ml @@ -58,9 +58,9 @@ let app = Bonsai.Map.filter_mapi rpc_results ~f:(fun ~key:_ ~data:({ last_ok_response; _ }, username) -> - match last_ok_response with - | Some (_, Some mouse_position) -> Some (mouse_position, username) - | None | Some (_, None) -> None) + match last_ok_response with + | Some (_, Some mouse_position) -> Some (mouse_position, username) + | None | Some (_, None) -> None) in let%sub cursor_blocks = Bonsai.assoc diff --git a/examples/mouse_position/client/test/app_test.ml b/examples/mouse_position/client/test/app_test.ml index 640198fa..23413714 100644 --- a/examples/mouse_position/client/test/app_test.ml +++ b/examples/mouse_position/client/test/app_test.ml @@ -3,7 +3,6 @@ open! Bonsai_web_test open! Bonsai_web open Bonsai_examples_mouse_position_lib - let%expect_test "basic page appearance" = let handle = Handle.create (Result_spec.vdom Fn.id) App.app in Handle.show handle; diff --git a/examples/mouse_position/common/bonsai_examples_mouse_position_common.ml b/examples/mouse_position/common/bonsai_examples_mouse_position_common.ml index bbe2eb74..d3b3d181 100644 --- a/examples/mouse_position/common/bonsai_examples_mouse_position_common.ml +++ b/examples/mouse_position/common/bonsai_examples_mouse_position_common.ml @@ -74,19 +74,19 @@ module Rpc_implementations = struct Protocol.Active_users.rpc ~on_client_and_server_out_of_sync (fun _connection_state _query -> - return { Active_users.active_users = !active_users_ref }) + return { Active_users.active_users = !active_users_ref }) |> Rpc.Implementation.lift ~f:(fun ({ Connection_state.connection; _ } as user_state) -> - user_state, connection) + user_state, connection) ;; let set_mouse_position = Rpc.Rpc.implement' Protocol.Set_mouse_position.rpc (fun { Connection_state.user; session; connection = _ } mouse_position -> - last_move_time := Map.set !last_move_time ~key:session ~data:(Time_ns.now ()); - active_users_ref := Map.set !active_users_ref ~key:session ~data:user; - mouse_positions := Map.set !mouse_positions ~key:session ~data:mouse_position) + last_move_time := Map.set !last_move_time ~key:session ~data:(Time_ns.now ()); + active_users_ref := Map.set !active_users_ref ~key:session ~data:user; + mouse_positions := Map.set !mouse_positions ~key:session ~data:mouse_position) ;; let get_mouse_position = @@ -101,9 +101,9 @@ module Rpc_implementations = struct Time_ns.sub (Time_ns.now ()) (Time_ns.Span.of_sec 20.0) in last_move_time - := Map.filter !last_move_time ~f:(fun t -> Time_ns.( > ) t twenty_seconds_ago); + := Map.filter !last_move_time ~f:(fun t -> Time_ns.( > ) t twenty_seconds_ago); active_users_ref - := Map.filter_keys !active_users_ref ~f:(Map.mem !last_move_time); + := Map.filter_keys !active_users_ref ~f:(Map.mem !last_move_time); mouse_positions := Map.filter_keys !mouse_positions ~f:(Map.mem !last_move_time)); [ active_users; set_mouse_position; get_mouse_position ] ;; diff --git a/examples/mouse_position/server/src/bonsai_examples_mouse_position_native.ml b/examples/mouse_position/server/src/bonsai_examples_mouse_position_native.ml index b9542440..f31230ba 100644 --- a/examples/mouse_position/server/src/bonsai_examples_mouse_position_native.ml +++ b/examples/mouse_position/server/src/bonsai_examples_mouse_position_native.ml @@ -30,7 +30,7 @@ let main ~http_settings ~js_file = Csp_monoid.reduce [ Csp_monoid.default_for_clientside ; Csp_monoid.frame_ancestor "https://localhost:*" - (* allow to be iframed in localhost addresses like for local dev *) + (* allow to be iframed in localhost addresses like for local dev *) ; Csp_monoid.frame_ancestor "https://bonsai:*" (* allow to be iframed in https://bonsai/ *) ] diff --git a/examples/multi_select/main.ml b/examples/multi_select/main.ml index 0a060189..798f78d2 100644 --- a/examples/multi_select/main.ml +++ b/examples/multi_select/main.ml @@ -16,7 +16,7 @@ module Attribute = struct include Comparable.Make (T) let name_singular = "attribute" - let name_plural = "attributes" + let name_plural = "attributes" end module Widget = Bonsai_web_ui_multi_select.Multi_factor.Make (String) (Attribute) @@ -24,14 +24,14 @@ module Widget = Bonsai_web_ui_multi_select.Multi_factor.Make (String) (Attribute let subwidgets = Attribute.all |> List.map ~f:(fun attr -> - let all_items = - String.Set.of_list - (match attr with - | Name -> [ "Henry VIII"; "Bill Gates"; "Alan Turing"; "Ada Lovelace" ] - | Department -> [ "Tech"; "The Tudor Court" ] - | Office -> [ "LDN"; "NYC"; "HKG" ]) - in - attr, { Widget.default_selection_status = Selected; all_items }) + let all_items = + String.Set.of_list + (match attr with + | Name -> [ "Henry VIII"; "Bill Gates"; "Alan Turing"; "Ada Lovelace" ] + | Department -> [ "Tech"; "The Tudor Court" ] + | Office -> [ "LDN"; "NYC"; "HKG" ]) + in + attr, { Widget.default_selection_status = Selected; all_items }) |> Attribute.Map.of_alist_exn |> Value.return ;; diff --git a/examples/node_with_map_children/attr.ml b/examples/node_with_map_children/attr.ml index 47ebc64e..dc36a663 100644 --- a/examples/node_with_map_children/attr.ml +++ b/examples/node_with_map_children/attr.ml @@ -16,11 +16,11 @@ let component = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:Vdom.Attr.empty ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) _model () -> - match Random.int 4 with - | 0 -> Vdom.Attr.empty - | 1 -> Vdom.Attr.create "foo" "5" - | 2 -> Vdom.Attr.create "foo" "6" - | _ -> Vdom.Attr.css_var ~name:"test" "foo") + match Random.int 4 with + | 0 -> Vdom.Attr.empty + | 1 -> Vdom.Attr.create "foo" "5" + | 2 -> Vdom.Attr.create "foo" "6" + | _ -> Vdom.Attr.css_var ~name:"test" "foo") in let%arr attr = attr and inject = inject in diff --git a/examples/node_with_map_children/automator.ml b/examples/node_with_map_children/automator.ml index e60463cb..0d64795a 100644 --- a/examples/node_with_map_children/automator.ml +++ b/examples/node_with_map_children/automator.ml @@ -26,8 +26,7 @@ let driver ~reset_all ~step ~is_done ~set_has_error = let%bind.Effect is_done = match%bind.Effect get_is_done with | Active is_done -> Effect.return is_done - | Inactive -> - Effect.never + | Inactive -> Effect.never in if is_done then reset_all else Effect.Ignore)) ;; diff --git a/examples/node_with_map_children/color_list.ml b/examples/node_with_map_children/color_list.ml index 964f31cd..1f25af94 100644 --- a/examples/node_with_map_children/color_list.ml +++ b/examples/node_with_map_children/color_list.ml @@ -51,9 +51,9 @@ let component name = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Int.Map.empty ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - match action with - | Regenerate -> generate_random () - | Remove i -> Map.remove model i) + match action with + | Regenerate -> generate_random () + | Remove i -> Map.remove model i) in let%sub () = Bonsai.Edge.lifecycle diff --git a/examples/node_with_map_children/stepper.ml b/examples/node_with_map_children/stepper.ml index c2855bbd..12044ec0 100644 --- a/examples/node_with_map_children/stepper.ml +++ b/examples/node_with_map_children/stepper.ml @@ -53,9 +53,9 @@ end let generate_diffs ~before ~after = Map.symmetric_diff before after ~data_equal:[%equal: float] |> Sequence.map ~f:(function - | key, `Left v -> Modification.Remove (key, v) - | key, `Right v -> Add (key, v) - | key, `Unequal (l, r) -> Change (key, l, r)) + | key, `Left v -> Modification.Remove (key, v) + | key, `Right v -> Add (key, v) + | key, `Unequal (l, r) -> Change (key, l, r)) |> Sequence.to_list |> List.permute ~random_state:Random.State.default |> List.group ~break:(fun _ _ -> Random.bool ()) @@ -76,30 +76,30 @@ let component ~(before_state : Color_list.t Value.t) ~(after_state : Color_list. input ~default_model:{ cur = Int.Map.empty; diffs = []; pointer = 0 } ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) input model action -> - match input with - | Active { Input.before; after } -> - (match action with - | Set_state model -> model - | Restart -> - let diffs = generate_diffs ~before ~after in - { cur = before; diffs; pointer = 0 } - | Step -> - let packet = - match List.nth model.diffs model.pointer with - | Some packet -> packet - | None -> [] - in - let cur = List.fold packet ~init:model.cur ~f:Modification.apply in - { model with cur; pointer = model.pointer + 1 }) - | Inactive -> - eprint_s - [%message - [%here] - "An action sent to a [state_machine1] has been dropped because its input \ - was not present. This happens when the [state_machine1] is inactive when \ - it receives a message." - (action : Action.t)]; - model) + match input with + | Active { Input.before; after } -> + (match action with + | Set_state model -> model + | Restart -> + let diffs = generate_diffs ~before ~after in + { cur = before; diffs; pointer = 0 } + | Step -> + let packet = + match List.nth model.diffs model.pointer with + | Some packet -> packet + | None -> [] + in + let cur = List.fold packet ~init:model.cur ~f:Modification.apply in + { model with cur; pointer = model.pointer + 1 }) + | Inactive -> + eprint_s + [%message + [%here] + "An action sent to a [state_machine1] has been dropped because its input \ + was not present. This happens when the [state_machine1] is inactive when \ + it receives a message." + (action : Action.t)]; + model) in let%sub () = Bonsai.Edge.on_change diff --git a/examples/node_with_map_children/style.ml b/examples/node_with_map_children/style.ml index 14ed5124..682307fd 100644 --- a/examples/node_with_map_children/style.ml +++ b/examples/node_with_map_children/style.ml @@ -3,8 +3,8 @@ open! Bonsai_web include [%css - stylesheet - {| + stylesheet + {| html, body, .app { diff --git a/examples/node_with_map_children/tag.ml b/examples/node_with_map_children/tag.ml index 7302bdf9..374a1037 100644 --- a/examples/node_with_map_children/tag.ml +++ b/examples/node_with_map_children/tag.ml @@ -16,10 +16,10 @@ let component = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:"div" ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) _model () -> - match Random.int 3 with - | 0 -> "div" - | 1 -> "section" - | _ -> "header") + match Random.int 3 with + | 0 -> "div" + | 1 -> "section" + | _ -> "header") in let%arr tag = tag and inject = inject in diff --git a/examples/notifications/main.ml b/examples/notifications/main.ml index 33ae09dc..368c627a 100644 --- a/examples/notifications/main.ml +++ b/examples/notifications/main.ml @@ -1,6 +1,6 @@ open! Core open! Bonsai_web -open Bonsai.Let_syntax +open Bonsai.Let_syntax module Gallery = Bonsai_web_ui_gallery module User_defined_notification = struct @@ -13,43 +13,43 @@ module User_defined_notification = struct include [%demo - module Notification = struct - type t = - | Success of string - | Error of string - [@@deriving sexp, equal] + module Notification = struct + type t = + | Success of string + | Error of string + [@@deriving sexp, equal] - let render ~close t = - let%sub theme = View.Theme.current in - let%arr close = close - and t = t - and theme = theme in - match t with - | Success message -> - View.card theme ~intent:Success ~on_click:close ~title:"Success" message - | Error error -> - View.card theme ~intent:Error ~on_click:close ~title:"Error" error - ;; - end + let render ~close t = + let%sub theme = View.Theme.current in + let%arr close = close + and t = t + and theme = theme in + match t with + | Success message -> + View.card theme ~intent:Success ~on_click:close ~title:"Success" message + | Error error -> + View.card theme ~intent:Error ~on_click:close ~title:"Error" error + ;; + end - module Notifications = Bonsai_web_ui_notifications + module Notifications = Bonsai_web_ui_notifications - let component = - let%sub notifications = - Notifications.component (module Notification) ~equal:[%equal: Notification.t] - in - let%sub vdom = Notifications.render notifications ~f:Notification.render in - let%arr vdom = vdom - and notifications = notifications in - vdom, Notifications.send_notification notifications - ;;] + let component = + let%sub notifications = + Notifications.component (module Notification) ~equal:[%equal: Notification.t] + in + let%sub vdom = Notifications.render notifications ~f:Notification.render in + let%arr vdom = vdom + and notifications = notifications in + vdom, Notifications.send_notification notifications + ;;] let view = let%sub theme = View.Theme.current in let%sub component, send_notification = component in let%arr component = component and send_notification = send_notification - and theme = theme in + and theme = theme in let vdom = View.hbox ~gap:(`Em 1) @@ -69,7 +69,7 @@ module User_defined_notification = struct vdom, ppx_demo_string ;; - let selector = None + let selector = None let filter_attrs = None end diff --git a/examples/notifications_test/main.ml b/examples/notifications_test/main.ml index e9f0cc6c..d52752fb 100644 --- a/examples/notifications_test/main.ml +++ b/examples/notifications_test/main.ml @@ -13,15 +13,15 @@ there are no changes to the previous API.|} include [%demo - module Notifications = Bonsai_web_ui_notifications + module Notifications = Bonsai_web_ui_notifications - let component = - let%sub notifications = Notifications.Basic.create () in - let%sub vdom = Notifications.Basic.render notifications in - let%arr vdom = vdom - and notifications = notifications in - vdom, notifications - ;;] + let component = + let%sub notifications = Notifications.Basic.create () in + let%sub vdom = Notifications.Basic.render notifications in + let%arr vdom = vdom + and notifications = notifications in + vdom, notifications + ;;] let view = let%sub theme = View.Theme.current in diff --git a/examples/oklab/knobs.ml b/examples/oklab/knobs.ml index 6d2be64f..fb6ed451 100644 --- a/examples/oklab/knobs.ml +++ b/examples/oklab/knobs.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax module Form = Bonsai_web_ui_form module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .form-title { justify-content:center; padding: 3px; diff --git a/examples/oklab/main.ml b/examples/oklab/main.ml index 956271a6..d4d6d80f 100644 --- a/examples/oklab/main.ml +++ b/examples/oklab/main.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax module Knobs = Knobs module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| :root, body, .container { margin: 0; padding: 0; diff --git a/examples/open_source/rpc_chat/client/main.ml b/examples/open_source/rpc_chat/client/main.ml index 5a7cb1a2..9a3edd23 100644 --- a/examples/open_source/rpc_chat/client/main.ml +++ b/examples/open_source/rpc_chat/client/main.ml @@ -31,9 +31,9 @@ let process_message_stream ~conn ~room_state_var = Bonsai.Var.update room_state_var ~f:(fun ({ Room_state.messages; current_room } as prev) -> - if [%equal: Room.t option] current_room (Some message.room) - then { prev with messages = List.append messages [ message ] } - else prev); + if [%equal: Room.t option] current_room (Some message.room) + then { prev with messages = List.append messages [ message ] } + else prev); Deferred.unit) ;; @@ -51,8 +51,8 @@ let send_message ~conn = Rpc.Rpc.dispatch_exn Protocol.Send_message.t conn |> Effect.of_deferred_fun >> Effect.bind ~f:(function - | Ok a -> Effect.return a - | Error _ -> Effect.Ignore) + | Ok a -> Effect.return a + | Error _ -> Effect.Ignore) in fun ~room ~contents -> let contents = obfuscate contents in diff --git a/examples/panels/main.ml b/examples/panels/main.ml index 3dbc350c..efc09d6a 100644 --- a/examples/panels/main.ml +++ b/examples/panels/main.ml @@ -18,7 +18,7 @@ module Ids = struct module Result = struct type t = { ids : unit Id.Map.t - (** A unit map, not a set, to make it easier to plug into [Bonsai.assoc] *) + (** A unit map, not a set, to make it easier to plug into [Bonsai.assoc] *) ; inject_add_with_next_id : unit Ui_effect.t ; inject_remove : Id.t -> unit Ui_effect.t } diff --git a/examples/partial_render_table/src/bonsai_partial_render_table_example.ml b/examples/partial_render_table/src/bonsai_partial_render_table_example.ml index f29a90fb..4bf287ff 100644 --- a/examples/partial_render_table/src/bonsai_partial_render_table_example.ml +++ b/examples/partial_render_table/src/bonsai_partial_render_table_example.ml @@ -15,9 +15,9 @@ module Time_ns_option = struct end module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .form_container { position: fixed; top: 0px; @@ -35,11 +35,11 @@ end module Column = Table.Columns.Dynamic_cells let column_helper - (type a) - (module M : S with type t = a) - ?(disable_sort = false) - ?visible - (field : (_, a) Field.t) + (type a) + (module M : S with type t = a) + ?(disable_sort = false) + ?visible + (field : (_, a) Field.t) = let sort = if disable_sort diff --git a/examples/partial_render_table/src/row.ml b/examples/partial_render_table/src/row.ml index b7da49e9..88f9f546 100644 --- a/examples/partial_render_table/src/row.ml +++ b/examples/partial_render_table/src/row.ml @@ -49,6 +49,6 @@ let random () : t = let many_random n = List.init n ~f:(fun _ -> random ()) |> List.fold ~init:String.Map.empty ~f:(fun acc data -> - let { symbol = key; _ } = data in - Map.set acc ~key ~data) + let { symbol = key; _ } = data in + Map.set acc ~key ~data) ;; diff --git a/examples/polling_state_rpc_stress_test/main.ml b/examples/polling_state_rpc_stress_test/main.ml index 118b00c9..36974af8 100644 --- a/examples/polling_state_rpc_stress_test/main.ml +++ b/examples/polling_state_rpc_stress_test/main.ml @@ -35,13 +35,13 @@ let component = ~sexp_of_action:[%sexp_of: [ `Add | `Remove of int ]] ~default_model:(0, Int.Map.empty) ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) (last_index, map) action -> - match action with - | `Add -> - let map = - if Map.length map > 100 then Map.remove map (fst (Map.min_elt_exn map)) else map - in - last_index + 1, Map.set map ~key:last_index ~data:() - | `Remove i -> last_index, Map.remove map i) + match action with + | `Add -> + let map = + if Map.length map > 100 then Map.remove map (fst (Map.min_elt_exn map)) else map + in + last_index + 1, Map.set map ~key:last_index ~data:() + | `Remove i -> last_index, Map.remove map i) in let%sub items = Bonsai.assoc @@ -86,11 +86,11 @@ let implementation = let t = ref { T.data = Int.Map.empty } in let implementation _ query = t - := { T.data = - Map.update !t.data (query % 100) ~f:(function - | Some count -> count + 1 - | None -> 0) - }; + := { T.data = + Map.update !t.data (query % 100) ~f:(function + | Some count -> count + 1 + | None -> 0) + }; Deferred.return { T.data = Map.map !t.data ~f:Fn.id } in Polling_state_rpc.implement diff --git a/examples/popover_test/main.ml b/examples/popover_test/main.ml index 3b0d1683..651a6ad9 100644 --- a/examples/popover_test/main.ml +++ b/examples/popover_test/main.ml @@ -52,8 +52,8 @@ module Two_left_click_popovers = struct ~close_when_clicked_outside:true ~allow_event_propagation_when_clicked_outside: (Value.return (function - | `Left_click | `Escape -> false - | `Right_click -> true)) + | `Left_click | `Escape -> false + | `Right_click -> true)) ~direction:(Value.return Bonsai_web_ui_popover.Direction.Right) ~alignment:(Value.return Bonsai_web_ui_popover.Alignment.Center) ~popover:popover_content diff --git a/examples/query_box/main.ml b/examples/query_box/main.ml index 21cd6456..5fcba27d 100644 --- a/examples/query_box/main.ml +++ b/examples/query_box/main.ml @@ -6,9 +6,9 @@ module Form = Bonsai_web_ui_form module Query_box = Bonsai_web_ui_query_box module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| .list_container { background: white; border: solid 1px black; @@ -77,7 +77,7 @@ let component = ~sexp_of_action:[%sexp_of: String.t] ~default_model:[] ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) items item -> - item :: items) + item :: items) in let%sub form = Form.Typed.Record.make @@ -139,10 +139,10 @@ let component = let%bind.Effect item = Effect.of_sync_fun (fun () -> - Quickcheck.Generator.generate - Action.quickcheck_generator - ~size:6 - ~random:(Splittable_random.State.create Random.State.default)) + Quickcheck.Generator.generate + Action.quickcheck_generator + ~size:6 + ~random:(Splittable_random.State.create Random.State.default)) () in inject item diff --git a/examples/rpc_chat/client/src/app.ml b/examples/rpc_chat/client/src/app.ml index fdf1f377..6f27f637 100644 --- a/examples/rpc_chat/client/src/app.ml +++ b/examples/rpc_chat/client/src/app.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax open Bonsai_chat_common module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| html, body, .container { height: 100vh; margin:0; diff --git a/examples/rpc_chat/client/src/compose_message.ml b/examples/rpc_chat/client/src/compose_message.ml index 482da8b8..b0140eb1 100644 --- a/examples/rpc_chat/client/src/compose_message.ml +++ b/examples/rpc_chat/client/src/compose_message.ml @@ -4,9 +4,9 @@ open! Bonsai_web open Bonsai.Let_syntax module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .compose { display: flex; flex-direction:row; diff --git a/examples/rpc_chat/client/src/room_list_panel.ml b/examples/rpc_chat/client/src/room_list_panel.ml index 955383e8..a22ddf5e 100644 --- a/examples/rpc_chat/client/src/room_list_panel.ml +++ b/examples/rpc_chat/client/src/room_list_panel.ml @@ -5,9 +5,9 @@ open Bonsai.Let_syntax open Bonsai_chat_common module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .room_list_panel { width: 150px; display:flex; diff --git a/examples/rpc_chat/server/src/bonsai_chat_native.ml b/examples/rpc_chat/server/src/bonsai_chat_native.ml index 03e7e7eb..a6df4dc2 100644 --- a/examples/rpc_chat/server/src/bonsai_chat_native.ml +++ b/examples/rpc_chat/server/src/bonsai_chat_native.ml @@ -10,7 +10,7 @@ let csp = Csp_monoid.reduce [ Csp_monoid.default_for_clientside ; Csp_monoid.frame_ancestor "https://localhost:*" - (* allow to be iframed in localhost addresses for local dev *) + (* allow to be iframed in localhost addresses for local dev *) ; Csp_monoid.frame_ancestor "https://bonsai:*" (* allow to be iframed in https://bonsai/ *) ] diff --git a/examples/rpgdice/bin/dice_spec_clicker_input.ml b/examples/rpgdice/bin/dice_spec_clicker_input.ml index d60e71c1..94c222ed 100644 --- a/examples/rpgdice/bin/dice_spec_clicker_input.ml +++ b/examples/rpgdice/bin/dice_spec_clicker_input.ml @@ -18,7 +18,7 @@ module Model = struct let dice = Map.to_alist dice |> List.map ~f:(fun (num_faces, count) -> - count, Rpgdice.Roll_spec.Die.of_int num_faces) + count, Rpgdice.Roll_spec.Die.of_int num_faces) in Rpgdice.Roll_spec.of_dice_and_const dice const ;; @@ -42,16 +42,16 @@ let component = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Model.init ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model -> function - | Decrement_const -> { model with const = model.const - 1 } - | Increment_const -> { model with const = model.const + 1 } - | Increment { num_faces } -> - { model with - dice = - Map.update model.dice num_faces ~f:(function - | None -> failwith "map keys shouldn't have changed" - | Some v -> v + 1) - } - | Clear -> { const = 0; dice = Map.map model.dice ~f:(Fn.const 0) }) + | Decrement_const -> { model with const = model.const - 1 } + | Increment_const -> { model with const = model.const + 1 } + | Increment { num_faces } -> + { model with + dice = + Map.update model.dice num_faces ~f:(function + | None -> failwith "map keys shouldn't have changed" + | Some v -> v + 1) + } + | Clear -> { const = 0; dice = Map.map model.dice ~f:(Fn.const 0) }) in let%arr model, inject = dice_state in let button = Vdom_input_widgets.Button.simple in diff --git a/examples/rpgdice/bin/roller.ml b/examples/rpgdice/bin/roller.ml index a1e68537..c8565fa0 100644 --- a/examples/rpgdice/bin/roller.ml +++ b/examples/rpgdice/bin/roller.ml @@ -14,19 +14,19 @@ let roller_state = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:None ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) roll_spec model () -> - match roll_spec with - | Active roll_spec -> - (match roll_spec with - | Ok spec -> Some (spec, Rpgdice.Roll_spec.roll spec) - | Error _ -> None) - | Inactive -> - eprint_s - [%message - [%here] - "An action sent to a [state_machine1] has been dropped because its input was \ - not present. This happens when the [state_machine1] is inactive when it \ - receives a message."]; - model) + match roll_spec with + | Active roll_spec -> + (match roll_spec with + | Ok spec -> Some (spec, Rpgdice.Roll_spec.roll spec) + | Error _ -> None) + | Inactive -> + eprint_s + [%message + [%here] + "An action sent to a [state_machine1] has been dropped because its input was \ + not present. This happens when the [state_machine1] is inactive when it \ + receives a message."]; + model) ;; let component roll_spec = diff --git a/examples/rpgdice/src/roll_spec.ml b/examples/rpgdice/src/roll_spec.ml index 1cd5c043..d9e3b1e8 100644 --- a/examples/rpgdice/src/roll_spec.ml +++ b/examples/rpgdice/src/roll_spec.ml @@ -37,7 +37,7 @@ let of_dice_and_const dice const = add ((if const <> 0 then [ Const const ] else []) @ List.filter_map dice ~f:(fun (count, die) -> - if count > 0 then Some (Prim { count; die }) else None)) + if count > 0 then Some (Prim { count; die }) else None)) ;; let rec to_string_hum t = diff --git a/examples/search_bar/main.ml b/examples/search_bar/main.ml index a68250e4..4d0679e6 100644 --- a/examples/search_bar/main.ml +++ b/examples/search_bar/main.ml @@ -2,7 +2,6 @@ open! Core open Bonsai_web open Bonsai.Let_syntax - module User_info = struct type t = { name : string diff --git a/examples/sexp_grammar/main.ml b/examples/sexp_grammar/main.ml index 7e762cbc..2eec7197 100644 --- a/examples/sexp_grammar/main.ml +++ b/examples/sexp_grammar/main.ml @@ -34,7 +34,7 @@ let component = ~sexp_of_action:[%sexp_of: Unit.t] ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) index () -> - (index + 1) mod generation_count) + (index + 1) mod generation_count) in let%arr form = form and view = view diff --git a/examples/snips/main.ml b/examples/snips/main.ml index 6cea4587..ba82d269 100644 --- a/examples/snips/main.ml +++ b/examples/snips/main.ml @@ -7,9 +7,9 @@ open! Snips.Infix module Shared_code = struct module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .container { width: 400px; height: 200px; @@ -158,8 +158,8 @@ module Markup = struct s |> String.lowercase |> String.map ~f:(function - | ('a' .. 'z' | '0' .. '1') as alphanum -> alphanum - | _ -> '_') + | ('a' .. 'z' | '0' .. '1') as alphanum -> alphanum + | _ -> '_') in let link = Vdom.Node.a ~attrs:[ Vdom.Attr.href ("#" ^ id) ] [ Vdom.Node.text s ] in Bonsai.const (Vdom.Node.h2 ~attrs:[ Vdom.Attr.id id ] [ link ]) @@ -181,24 +181,24 @@ module Markup = struct | Ds a -> a |> List.map ~f:(fun (ocaml_label, c) -> - let%sub demo, code = c in - let%sub code = remove_layout_comments code in - let%sub r = - Gallery.make_demo' ~hide_html:true ~ocaml_label:None ~demo ~code () - in - let%arr r = r in - ocaml_label, r) + let%sub demo, code = c in + let%sub code = remove_layout_comments code in + let%sub r = + Gallery.make_demo' ~hide_html:true ~ocaml_label:None ~demo ~code () + in + let%arr r = r in + ocaml_label, r) |> Computation.all |> Computation.map ~f:(fun demos -> - demos - |> List.concat_map ~f:(fun (label, { code; demo }) -> - let pre = - match label with - | None -> [] - | Some label -> [ Vdom.Node.text label; Vdom.Node.div [] ] - in - pre @ [ code; demo ]) - |> Vdom.Node.div ~attrs:[ Shared_code.Style.x2_grid ]) + demos + |> List.concat_map ~f:(fun (label, { code; demo }) -> + let pre = + match label with + | None -> [] + | Some label -> [ Vdom.Node.text label; Vdom.Node.div [] ] + in + pre @ [ code; demo ]) + |> Vdom.Node.div ~attrs:[ Shared_code.Style.x2_grid ]) ;; end @@ -439,7 +439,7 @@ module Splits = struct Snips.top (red "header") |+| Snips.split_h [ Snips.body (blue lorem_ipsum) - (* remove-this-line (for line breaking purposes) *) + (* remove-this-line (for line breaking purposes) *) ; Snips.body (green lorem_ipsum) ] in @@ -546,12 +546,12 @@ let component = (Value.return (Effect.of_sync_fun (fun () -> - let open Js_of_ocaml in - match Js.to_string Dom_html.window##.location##.hash with - | "" -> () - | other -> - Dom_html.window##.location##.hash := Js.string ""; - Dom_html.window##.location##.hash := Js.string other) + let open Js_of_ocaml in + match Js.to_string Dom_html.window##.location##.hash with + | "" -> () + | other -> + Dom_html.window##.location##.hash := Js.string ""; + Dom_html.window##.location##.hash := Js.string other) ())) in View.Theme.set_for_app diff --git a/examples/split_pane/src/bonsai_web_ui_split_pane_example.ml b/examples/split_pane/src/bonsai_web_ui_split_pane_example.ml index 08be81e3..c42a5603 100644 --- a/examples/split_pane/src/bonsai_web_ui_split_pane_example.ml +++ b/examples/split_pane/src/bonsai_web_ui_split_pane_example.ml @@ -6,9 +6,9 @@ module Parameters = Bonsai_web_ui_split_pane.For_testing.Parameters module Form = Bonsai_web_ui_form module Styles = - [%css - stylesheet - {| +[%css +stylesheet + {| .container { display: flex; width: 100%; @@ -90,8 +90,8 @@ let create_parameters_form = ~equal:[%equal: Parameters_or_error.t] (form >>| Form.value) ~condition:(function - | Ok _ -> true - | Error _ -> false) + | Ok _ -> true + | Error _ -> false) in let%arr last_ok = last_ok and form = form in diff --git a/examples/styled_components/main.ml b/examples/styled_components/main.ml index 43a4d89e..c5cbac2d 100644 --- a/examples/styled_components/main.ml +++ b/examples/styled_components/main.ml @@ -159,9 +159,9 @@ module Stylesheet_interpolation = struct let f ~color ~width ~height = [%demo let module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .square { background-color: %{color#Css_gen.Color}; width: %{width#Css_gen.Length}; diff --git a/examples/styled_components_internal/main.ml b/examples/styled_components_internal/main.ml index e0f4787c..097378b8 100644 --- a/examples/styled_components_internal/main.ml +++ b/examples/styled_components_internal/main.ml @@ -30,7 +30,7 @@ let component = Vdom.Node.div ~attrs: [ [%css - {| --color: tomato; + {| --color: tomato; background-color: var(--color); width: 2rem; height: 2rem; |}] @@ -44,7 +44,7 @@ let component = Vdom.Node.div ~attrs: [ [%css - {| --color: tomato; + {| --color: tomato; background-color: var(--color); width: 2rem; height: 2rem; |}] @@ -62,7 +62,7 @@ let component = [ Vdom.Node.div ~attrs: [ [%css - {| --color: tomato; + {| --color: tomato; background-color: var(--color); width: 2rem; height: 2rem; |}] @@ -75,9 +75,9 @@ let component = [%demo let color = `Name "tomato" in let module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .square { background-color: %{color#Css_gen.Color}; width: 2rem; @@ -92,9 +92,9 @@ let component = [%demo let color = `Name "tomato" in let module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| #square { background-color: %{color#Css_gen.Color}; width: 2rem; @@ -109,9 +109,9 @@ let component = [%demo let color = `Name "tomato" in let module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .foo * { background-color: %{color#Css_gen.Color}; width: 2rem; @@ -120,7 +120,7 @@ let component = --beep: 1; } |} - ~dont_hash:[ "foo" ]] + ~dont_hash:[ "foo" ]] in Vdom.Node.div ~attrs:[ Vdom.Attr.class_ "foo" ] diff --git a/examples/timetravel/spacetime.ml b/examples/timetravel/spacetime.ml index 1bf7a43b..82e9e1f7 100644 --- a/examples/timetravel/spacetime.ml +++ b/examples/timetravel/spacetime.ml @@ -55,16 +55,16 @@ let view cursor history ~inject = let create (type i r) (inner_component : (i, r) Bonsai.t) : (i, r * Result.t) Bonsai.t = let (T - { unpacked = inner_unpacked - ; action_type_id = inner_action_type_id - ; model = - { default = inner_default_model - ; equal = inner_model_equal - ; type_id = inner_model_type_id - ; sexp_of = sexp_of_inner_model - ; of_sexp = inner_model_of_sexp - } - }) + { unpacked = inner_unpacked + ; action_type_id = inner_action_type_id + ; model = + { default = inner_default_model + ; equal = inner_model_equal + ; type_id = inner_model_type_id + ; sexp_of = sexp_of_inner_model + ; of_sexp = inner_model_of_sexp + } + }) = inner_component |> Bonsai.to_generic |> Bonsai_lib.Generic.Expert.reveal in @@ -73,8 +73,8 @@ let create (type i r) (inner_component : (i, r) Bonsai.t) : (i, r * Result.t) Bo Type_equal.Id.create ~name:(Source_code_position.to_string [%here]) (function - | Action.Inner a -> Type_equal.Id.to_sexp inner_action_type_id a - | Set_cursor cursor -> [%sexp "Set_cursor", (cursor : Spacetime_tree.Cursor.t)]) + | Action.Inner a -> Type_equal.Id.to_sexp inner_action_type_id a + | Set_cursor cursor -> [%sexp "Set_cursor", (cursor : Spacetime_tree.Cursor.t)]) in let model_type_id = Type_equal.Id.create @@ -92,42 +92,42 @@ let create (type i r) (inner_component : (i, r) Bonsai.t) : (i, r * Result.t) Bo ~sexp_of_model:[%sexp_of: inner_model Model.t] ~model_of_sexp:[%of_sexp: inner_model Model.t] ~f:(fun ~input ~old_model ~model ~inject ~environment ~incr_state:_ -> - let inject_inner a = inject (Action.Inner a) in - let inner_model = model >>| Model.inner in - let inner_old_model = old_model >>| Option.map ~f:Model.inner in - let inner = - Bonsai_lib.Generic.Expert.eval - ~input - ~old_model:inner_old_model - ~model:inner_model - ~inject:inject_inner - ~action_type_id:inner_action_type_id - ~environment - ~incr_state:Incr.State.t - inner_unpacked - in - let apply_action = - let%map model = model - and inner = inner in - fun ~schedule_event -> function - | Action.Inner a -> - let inner = - Bonsai_lib.Generic.Expert.Snapshot.apply_action inner ~schedule_event a - in - let history, cursor = Spacetime_tree.append model.history model.cursor inner in - { Model.inner; history; cursor } - | Action.Set_cursor cursor -> - let inner = Spacetime_tree.find model.history cursor in - { model with inner; cursor } - in - let result = - let%map inner = inner - and view = view ~inject (model >>| Model.cursor) (model >>| Model.history) in - Bonsai_lib.Generic.Expert.Snapshot.result inner, view - in - let%map apply_action = apply_action - and result = result in - Bonsai_lib.Generic.Expert.Snapshot.create ~result ~apply_action) + let inject_inner a = inject (Action.Inner a) in + let inner_model = model >>| Model.inner in + let inner_old_model = old_model >>| Option.map ~f:Model.inner in + let inner = + Bonsai_lib.Generic.Expert.eval + ~input + ~old_model:inner_old_model + ~model:inner_model + ~inject:inject_inner + ~action_type_id:inner_action_type_id + ~environment + ~incr_state:Incr.State.t + inner_unpacked + in + let apply_action = + let%map model = model + and inner = inner in + fun ~schedule_event -> function + | Action.Inner a -> + let inner = + Bonsai_lib.Generic.Expert.Snapshot.apply_action inner ~schedule_event a + in + let history, cursor = Spacetime_tree.append model.history model.cursor inner in + { Model.inner; history; cursor } + | Action.Set_cursor cursor -> + let inner = Spacetime_tree.find model.history cursor in + { model with inner; cursor } + in + let result = + let%map inner = inner + and view = view ~inject (model >>| Model.cursor) (model >>| Model.history) in + Bonsai_lib.Generic.Expert.Snapshot.result inner, view + in + let%map apply_action = apply_action + and result = result in + Bonsai_lib.Generic.Expert.Snapshot.create ~result ~apply_action) |> Bonsai_lib.Generic.Expert.conceal |> Bonsai.of_generic ;; diff --git a/examples/todomvc/main.ml b/examples/todomvc/main.ml index 5f23009b..3ca6e410 100644 --- a/examples/todomvc/main.ml +++ b/examples/todomvc/main.ml @@ -156,8 +156,8 @@ let header_component ~inject = ;; let todo_item_component - (todo : Model.todo Value.t) - ~(inject : (Action.t -> unit Effect.t) Value.t) + (todo : Model.todo Value.t) + ~(inject : (Action.t -> unit Effect.t) Value.t) = let%sub editing, set_editing = Bonsai.state false ~sexp_of_model:[%sexp_of: Bool.t] ~equal:[%equal: Bool.t] @@ -261,7 +261,7 @@ let todo_list (model : Model.t Value.t) ~inject = Attr.many [ Dom_helpers.filtered_attrs [ Style.checked, is_checked ] ; Vdom.Attr.bool_property "checked" is_checked - (* weirdly, todomvc expects this checkbox to have both a class and an id named toggle-all. *) + (* weirdly, todomvc expects this checkbox to have both a class and an id named toggle-all. *) ; Vdom.Attr.id "toggle-all" ; Style.toggle_all ; Attr.type_ "checkbox" @@ -281,8 +281,8 @@ let todo_list (model : Model.t Value.t) ~inject = let pluralize count word = if count > 1 then word ^ "s" else word let footer_component - (state : Model.t Value.t) - ~(inject : (Action.t -> unit Effect.t) Value.t) + (state : Model.t Value.t) + ~(inject : (Action.t -> unit Effect.t) Value.t) = let%arr inject = inject and active, completed = diff --git a/examples/treemapviz/main.ml b/examples/treemapviz/main.ml index 7e4f8962..82747e8e 100644 --- a/examples/treemapviz/main.ml +++ b/examples/treemapviz/main.ml @@ -18,8 +18,8 @@ module Tree = struct ; color : ((* NOTE: [color] color corresponds to the percent move. Roughly 3.0 means green -3 means red and everything in between is a gradient.*) - float - [@quickcheck.generator percent_range_generator]) + float + [@quickcheck.generator percent_range_generator]) ; children : t list } [@@deriving quickcheck] @@ -99,9 +99,9 @@ let stress_elements = ;; module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| * { box-sizing: border-box; } diff --git a/examples/typeahead/main.ml b/examples/typeahead/main.ml index 06489566..958085ad 100644 --- a/examples/typeahead/main.ml +++ b/examples/typeahead/main.ml @@ -60,8 +60,8 @@ let components = favourite_pokemon ~default:Pokemon.all ~f:(fun favourite_pokemon -> - List.filter Pokemon.all ~f:(fun pokemon -> - not (Pokemon.equal favourite_pokemon pokemon))) + List.filter Pokemon.all ~f:(fun pokemon -> + not (Pokemon.equal favourite_pokemon pokemon))) |> inject_all_options) ~to_string:(Bonsai.Value.return Pokemon.to_string) ~placeholder:"Select a pokemon" @@ -116,10 +116,10 @@ let components = typeahead_multi_with_custom_input ~all_options:(Value.return Pokemon.all) in let%arr typeahead_single_vdom = typeahead_single_vdom - and typeahead_multi_vdom = typeahead_multi_vdom + and typeahead_multi_vdom = typeahead_multi_vdom and typeahead_single_with_custom_input_vdom = typeahead_single_with_custom_input_vdom and typeahead_multi_with_empty_options_vdom = typeahead_multi_with_empty_options_vdom - and typeahead_multi_with_custom_input_vdom = typeahead_multi_with_custom_input_vdom in + and typeahead_multi_with_custom_input_vdom = typeahead_multi_with_custom_input_vdom in Vdom.Node.create "main" [ Vdom.Node.section diff --git a/examples/url_var/bin/main.ml b/examples/url_var/bin/main.ml index fffa33e9..b13c726c 100644 --- a/examples/url_var/bin/main.ml +++ b/examples/url_var/bin/main.ml @@ -3,9 +3,9 @@ open! Bonsai_web open Bonsai.Let_syntax module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| .examples_column { display: flex; align-items: flex-start; diff --git a/examples/url_var/lib/url_example.ml b/examples/url_var/lib/url_example.ml index 5e42f969..ab911027 100644 --- a/examples/url_var/lib/url_example.ml +++ b/examples/url_var/lib/url_example.ml @@ -25,9 +25,9 @@ type 'a t = type packed = T : 'a t -> packed module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| .paper { box-shadow: 0 0 8px rgba(0,0,0,0.2); padding: 12px; @@ -138,11 +138,11 @@ let uri_form ~default = (* This form is the one that reads/writes the parsed sexp. *) let typed_url_form - (type a) - ~default - ~parser - (module M : Sexpable with type t = a) - ~fallback + (type a) + ~default + ~parser + (module M : Sexpable with type t = a) + ~fallback = let%sub form = let%sub form = @@ -319,25 +319,25 @@ let component (type a) (t : a t) = ;; module Homepage_and_settings_demo = - [%demo - module Homepage_and_settings = struct - type t = - | Homepage - | Settings of int - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Homepage -> Parser.end_of_path Parser.unit - | Settings -> Parser.from_query_required ~key:"volume" Value_parser.int - ;; - end +[%demo +module Homepage_and_settings = struct + type t = + | Homepage + | Settings of int + [@@deriving typed_variants, sexp, equal] - let parser = Parser.Variant.make (module Homepage_and_settings) + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Homepage -> Parser.end_of_path Parser.unit + | Settings -> Parser.from_query_required ~key:"volume" Value_parser.int + ;; +end - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let parser = Parser.Variant.make (module Homepage_and_settings) + +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌────────────────────────┐ │ All urls │ @@ -345,7 +345,7 @@ module Homepage_and_settings_demo = │ / │ │ /settings?volume= │ └────────────────────────┘ |}] - ;;] +;;] module Homepage_and_settings = Homepage_and_settings_demo.Homepage_and_settings @@ -364,25 +364,25 @@ let home_and_settings : Homepage_and_settings.t t = ;; module Foo_bar_example = - [%demo - module My_url = struct - type t = - | Foo - | Bar - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Foo -> Parser.unit - | Bar -> Parser.unit - ;; - end +[%demo +module My_url = struct + type t = + | Foo + | Bar + [@@deriving typed_variants, sexp, equal] + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Foo -> Parser.unit + | Bar -> Parser.unit + ;; +end - let parser = Parser.Variant.make (module My_url) +let parser = Parser.Variant.make (module My_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌──────────┐ │ All urls │ @@ -390,7 +390,7 @@ module Foo_bar_example = │ /bar │ │ /foo │ └──────────┘ |}] - ;;] +;;] let foo_bar_example = { starting_components = Url_var.Components.create ~path:"foo" ~query:String.Map.empty () @@ -408,81 +408,81 @@ let foo_bar_example = ;; module Partial_match_example = - [%demo - module Book = struct - type t = - | Book_search - | Book_view of string - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Book_search -> Parser.end_of_path Parser.unit - | Book_view -> Parser.with_prefix [] (Parser.from_path Value_parser.string) - ;; - end +[%demo +module Book = struct + type t = + | Book_search + | Book_view of string + [@@deriving typed_variants, sexp, equal] - module Movie = struct - type t = - | Movie_search - | Movie_view of string - [@@deriving typed_variants, sexp, equal] + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Book_search -> Parser.end_of_path Parser.unit + | Book_view -> Parser.with_prefix [] (Parser.from_path Value_parser.string) + ;; +end - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Movie_search -> Parser.end_of_path Parser.unit - | Movie_view -> Parser.with_prefix [] (Parser.from_path Value_parser.string) - ;; - end +module Movie = struct + type t = + | Movie_search + | Movie_view of string + [@@deriving typed_variants, sexp, equal] - module Library = struct - type t = - | Content_search - | Book of Book.t - | Movie of Movie.t - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Content_search -> Parser.end_of_path Parser.unit - | Book -> Parser.with_prefix [ "book" ] (Parser.Variant.make (module Book)) - | Movie -> Parser.with_prefix [ "movie" ] (Parser.Variant.make (module Movie)) - ;; - end + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Movie_search -> Parser.end_of_path Parser.unit + | Movie_view -> Parser.with_prefix [] (Parser.from_path Value_parser.string) + ;; +end - module My_url = struct - type t = - | Library_search - | Library_page of - { library_name : string - ; library_contents : Library.t - } [@typed_fields] - [@@deriving typed_variants, sexp, equal] - - module Anon_library_page = struct - module Typed_field = - Typed_variant.Typed_variant_anonymous_records.Typed_field_of_library_page - - let parser_for_field : type a. a Typed_field.t -> a Parser.t = function - | Library_name -> Parser.from_path Value_parser.string - | Library_contents -> Parser.Variant.make (module Library) - ;; - - module Path_order = Path_order (Typed_field) - - let path_order = Path_order.T [ Library_name; Library_contents ] - end - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Library_search -> Parser.with_remaining_path [ "library" ] Parser.unit - | Library_page -> - Parser.with_prefix [ "library" ] (Parser.Record.make (module Anon_library_page)) - ;; - end +module Library = struct + type t = + | Content_search + | Book of Book.t + | Movie of Movie.t + [@@deriving typed_variants, sexp, equal] + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Content_search -> Parser.end_of_path Parser.unit + | Book -> Parser.with_prefix [ "book" ] (Parser.Variant.make (module Book)) + | Movie -> Parser.with_prefix [ "movie" ] (Parser.Variant.make (module Movie)) + ;; +end + +module My_url = struct + type t = + | Library_search + | Library_page of + { library_name : string + ; library_contents : Library.t + } [@typed_fields] + [@@deriving typed_variants, sexp, equal] + + module Anon_library_page = struct + module Typed_field = + Typed_variant.Typed_variant_anonymous_records.Typed_field_of_library_page + + let parser_for_field : type a. a Typed_field.t -> a Parser.t = function + | Library_name -> Parser.from_path Value_parser.string + | Library_contents -> Parser.Variant.make (module Library) + ;; + + module Path_order = Path_order (Typed_field) + + let path_order = Path_order.T [ Library_name; Library_contents ] + end + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Library_search -> Parser.with_remaining_path [ "library" ] Parser.unit + | Library_page -> + Parser.with_prefix [ "library" ] (Parser.Record.make (module Anon_library_page)) + ;; +end - let parser = Parser.Variant.make (module My_url) +let parser = Parser.Variant.make (module My_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌──────────────────────────────────┐ │ All urls │ @@ -494,7 +494,7 @@ module Partial_match_example = │ /library//movie │ │ /library//movie/ │ └──────────────────────────────────┘ |}] - ;;] +;;] let folder_example : Partial_match_example.My_url.t t = { starting_components = @@ -530,24 +530,24 @@ let folder_example : Partial_match_example.My_url.t t = ;; module Reading_from_query = - [%demo - module My_url = struct - type t = int [@@deriving sexp, equal] +[%demo +module My_url = struct + type t = int [@@deriving sexp, equal] - let parser = Parser.from_query_required ~key:"video" Value_parser.int + let parser = Parser.from_query_required ~key:"video" Value_parser.int - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| + let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌───────────────┐ │ All urls │ ├───────────────┤ │ /?video= │ └───────────────┘ |}] - ;; - end] + ;; +end] let reading_from_query = { starting_components = @@ -564,24 +564,24 @@ let reading_from_query = ;; module Reading_from_path = - [%demo - module My_url = struct - type t = int [@@deriving sexp, equal] +[%demo +module My_url = struct + type t = int [@@deriving sexp, equal] - let parser = Parser.from_path Value_parser.int + let parser = Parser.from_path Value_parser.int - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| + let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌──────────┐ │ All urls │ ├──────────┤ │ / │ └──────────┘ |}] - ;; - end] + ;; +end] let reading_from_path = { starting_components = Url_var.Components.create ~path:"123" () @@ -596,25 +596,25 @@ let reading_from_path = ;; module Search = - [%demo - module My_url = struct - type t = - | Homepage - | Search of string - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Search -> Parser.from_query_required ~key:"q" Value_parser.string - | Homepage -> Parser.unit - ;; - end +[%demo +module My_url = struct + type t = + | Homepage + | Search of string + [@@deriving typed_variants, sexp, equal] + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Search -> Parser.from_query_required ~key:"q" Value_parser.string + | Homepage -> Parser.unit + ;; +end - let parser = Parser.Variant.make (module My_url) +let parser = Parser.Variant.make (module My_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌────────────────────┐ │ All urls │ @@ -622,7 +622,7 @@ module Search = │ /homepage │ │ /search?q= │ └────────────────────┘ |}] - ;;] +;;] let search_example = { starting_components = @@ -641,25 +641,25 @@ let search_example = ;; module Error_message_example = - [%demo - module My_url = struct - type t = - | Foo - | Bar - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Foo -> Parser.with_prefix [ "foo" ] Parser.unit - | Bar -> Parser.with_prefix [ "foo" ] Parser.unit - ;; - end +[%demo +module My_url = struct + type t = + | Foo + | Bar + [@@deriving typed_variants, sexp, equal] + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Foo -> Parser.with_prefix [ "foo" ] Parser.unit + | Bar -> Parser.with_prefix [ "foo" ] Parser.unit + ;; +end - let parser = Parser.Variant.make (module My_url) +let parser = Parser.Variant.make (module My_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| Error with parser. ┌─────────────────────────────────────────────────────────┬──────────────────────────────────────────────────────────────────────────────────────────┐ │ Check name │ Error message │ @@ -670,7 +670,7 @@ module Error_message_example = │ │ ting renames with [with_prefix] or [with_remaining_path]." │ │ │ (duplicate_urls (/foo))) │ └─────────────────────────────────────────────────────────┴──────────────────────────────────────────────────────────────────────────────────────────┘ |}] - ;;] +;;] let error_example_component = let out = @@ -695,37 +695,37 @@ let error_example_component = ;; module Simple_record_example = - [%demo - module My_url = struct - type t = - { foo : int - ; bar : string - } - [@@deriving typed_fields, sexp, equal] - - let parser_for_field : type a. a Typed_field.t -> a Parser.t = function - | Foo -> Parser.from_query_required Value_parser.int - | Bar -> Parser.from_path Value_parser.string - ;; - - module Path_order = Path_order (Typed_field) - - let path_order = Path_order.T [ Bar ] - end +[%demo +module My_url = struct + type t = + { foo : int + ; bar : string + } + [@@deriving typed_fields, sexp, equal] + + let parser_for_field : type a. a Typed_field.t -> a Parser.t = function + | Foo -> Parser.from_query_required Value_parser.int + | Bar -> Parser.from_path Value_parser.string + ;; - let parser = Parser.Record.make (module My_url) + module Path_order = Path_order (Typed_field) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| + let path_order = Path_order.T [ Bar ] +end + +let parser = Parser.Record.make (module My_url) + +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌─────────────────────┐ │ All urls │ ├─────────────────────┤ │ /?foo= │ └─────────────────────┘ |}] - ;;] +;;] let simple_record_example = { starting_components = @@ -744,42 +744,42 @@ let simple_record_example = ;; module Anonymous_record_example = - [%demo - module My_youtube_clone = struct - type t = - | Homepage - | Video of - { video_id : string - ; channel : string - } [@typed_fields] - [@@deriving typed_variants, sexp, equal] - - module Anon_video_record = struct - module Typed_field = - Typed_variant.Typed_variant_anonymous_records.Typed_field_of_video - - let parser_for_field : type a. a Typed_field.t -> a Parser.t = function - | Video_id -> Parser.from_query_required Value_parser.string - | Channel -> Parser.from_query_required Value_parser.string - ;; - - module Path_order = Path_order (Typed_field) - - let path_order = Path_order.T [] - end - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Homepage -> Parser.end_of_path Parser.unit - | Video -> Parser.Record.make ~namespace:[] (module Anon_video_record) - ;; - end +[%demo +module My_youtube_clone = struct + type t = + | Homepage + | Video of + { video_id : string + ; channel : string + } [@typed_fields] + [@@deriving typed_variants, sexp, equal] + + module Anon_video_record = struct + module Typed_field = + Typed_variant.Typed_variant_anonymous_records.Typed_field_of_video + + let parser_for_field : type a. a Typed_field.t -> a Parser.t = function + | Video_id -> Parser.from_query_required Value_parser.string + | Channel -> Parser.from_query_required Value_parser.string + ;; - let parser = Parser.Variant.make (module My_youtube_clone) + module Path_order = Path_order (Typed_field) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| + let path_order = Path_order.T [] + end + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Homepage -> Parser.end_of_path Parser.unit + | Video -> Parser.Record.make ~namespace:[] (module Anon_video_record) + ;; +end + +let parser = Parser.Variant.make (module My_youtube_clone) + +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌───────────────────────────────────────────┐ │ All urls │ @@ -787,7 +787,7 @@ module Anonymous_record_example = │ / │ │ /video?channel=&video_id= │ └───────────────────────────────────────────┘ |}] - ;;] +;;] let anonymous_record_example = { starting_components = @@ -818,33 +818,33 @@ let anonymous_record_example = ;; module Tuple_example = - [%demo - module My_tuple_url = struct - type t = int * string [@@deriving typed_fields, sexp, equal] +[%demo +module My_tuple_url = struct + type t = int * string [@@deriving typed_fields, sexp, equal] - let parser_for_field : type a. a Typed_field.t -> a Parser.t = function - | T_1 -> Parser.from_query_required Value_parser.int - | T_2 -> Parser.from_query_required Value_parser.string - ;; + let parser_for_field : type a. a Typed_field.t -> a Parser.t = function + | T_1 -> Parser.from_query_required Value_parser.int + | T_2 -> Parser.from_query_required Value_parser.string + ;; - module Path_order = Path_order (Typed_field) + module Path_order = Path_order (Typed_field) - let path_order = Path_order.T [] - end + let path_order = Path_order.T [] +end - let parser = Parser.Record.make (module My_tuple_url) +let parser = Parser.Record.make (module My_tuple_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌──────────────────────────┐ │ All urls │ ├──────────────────────────┤ │ /?t_1=&t_2= │ └──────────────────────────┘ |}] - ;;] +;;] let tuple_example = { starting_components = @@ -862,27 +862,27 @@ let tuple_example = ;; module Catchall_url = - [%demo - module Catchall_url = struct - type t = - | Foo of int - | Bar - | Catchall of string - [@@deriving typed_variants, sexp, equal] - - let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function - | Foo -> Parser.from_path Value_parser.int - | Bar -> Parser.unit - | Catchall -> Parser.with_prefix [] (Parser.from_path Value_parser.string) - ;; - end +[%demo +module Catchall_url = struct + type t = + | Foo of int + | Bar + | Catchall of string + [@@deriving typed_variants, sexp, equal] + + let parser_for_variant : type a. a Typed_variant.t -> a Parser.t = function + | Foo -> Parser.from_path Value_parser.int + | Bar -> Parser.unit + | Catchall -> Parser.with_prefix [] (Parser.from_path Value_parser.string) + ;; +end - let parser = Parser.Variant.make (module Catchall_url) +let parser = Parser.Variant.make (module Catchall_url) - let%expect_test _ = - Parser.check_ok_and_print_urls_or_errors parser; - [%expect - {| +let%expect_test _ = + Parser.check_ok_and_print_urls_or_errors parser; + [%expect + {| URL parser looks good! ┌────────────┐ │ All urls │ @@ -891,7 +891,7 @@ module Catchall_url = │ /bar │ │ /foo/ │ └────────────┘ |}] - ;;] +;;] let catchall_example = { starting_components = Url_var.Components.create ~path:"i-am-a-catchall" () diff --git a/examples/url_var_all_features/lib/all_url_var_features_example.ml b/examples/url_var_all_features/lib/all_url_var_features_example.ml index 5db1d55f..7f8469a3 100644 --- a/examples/url_var_all_features/lib/all_url_var_features_example.ml +++ b/examples/url_var_all_features/lib/all_url_var_features_example.ml @@ -123,8 +123,8 @@ module Variant = struct let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Post -> Bonsai.const (Form.return ()) - | Comments -> Bonsai.const (Form.return ()) + | Post -> Bonsai.const (Form.return ()) + | Comments -> Bonsai.const (Form.return ()) ;; let label_for_variant = `Inferred @@ -155,9 +155,9 @@ module Query_variant = struct let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | A -> Form.Elements.Textbox.int () - | B -> Form.Elements.Textbox.float () - | C -> Form.Elements.Textbox.string () + | A -> Form.Elements.Textbox.int () + | B -> Form.Elements.Textbox.float () + | C -> Form.Elements.Textbox.string () ;; let label_for_variant = `Inferred @@ -192,20 +192,20 @@ module T = struct let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Homepage -> Bonsai.const (Form.return ()) - | Some_string_option -> - let%sub text = Form.Elements.Textbox.string () in - let%arr text = text in - Form.optional - text - ~is_some:(function - | "" -> false - | _ -> true) - ~none:"" - | Query_variant -> Query_variant.form_of_t - | Variant -> Variant.form_of_t - | Record -> Record.form_of_t - | Unable_to_parse -> Bonsai.const (Form.return ()) + | Homepage -> Bonsai.const (Form.return ()) + | Some_string_option -> + let%sub text = Form.Elements.Textbox.string () in + let%arr text = text in + Form.optional + text + ~is_some:(function + | "" -> false + | _ -> true) + ~none:"" + | Query_variant -> Query_variant.form_of_t + | Variant -> Variant.form_of_t + | Record -> Record.form_of_t + | Unable_to_parse -> Bonsai.const (Form.return ()) ;; let label_for_variant = `Inferred diff --git a/examples/vdom_input_widgets_int_repro/main.ml b/examples/vdom_input_widgets_int_repro/main.ml index ba32c587..b9e3a7a2 100644 --- a/examples/vdom_input_widgets_int_repro/main.ml +++ b/examples/vdom_input_widgets_int_repro/main.ml @@ -3,12 +3,12 @@ open! Bonsai_web open Bonsai.Let_syntax let component - (type a) - (module M : Bonsai.Model with type t = a) - ~equal - ~name - ~some_constant_value - ~node_creator + (type a) + (module M : Bonsai.Model with type t = a) + ~equal + ~name + ~some_constant_value + ~node_creator = let%sub textbox_state = Bonsai.state_opt () ~sexp_of_model:[%sexp_of: M.t] ~equal in let%arr state, set_state = textbox_state in diff --git a/examples/vdom_keyboard/main.ml b/examples/vdom_keyboard/main.ml index b7c99b36..a4eb9d76 100644 --- a/examples/vdom_keyboard/main.ml +++ b/examples/vdom_keyboard/main.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax open Vdom_keyboard module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| .block { position: absolute; width: 200px; @@ -87,7 +87,7 @@ let component = ~keys:[ key KeyL; key ArrowRight ] ~cond:is_not_text_input (fun _ev -> add_x 5) - (* Big movement *) + (* Big movement *) ; command ~description:"Move block left by 20 pixels" ~keys:[ key ~shift:() KeyH; key ~shift:() ArrowLeft ] @@ -108,7 +108,7 @@ let component = ~keys:[ key ~shift:() KeyL; key ~shift:() ArrowRight ] ~cond:is_not_text_input (fun _ev -> add_x 20) - (* Open and close help text *) + (* Open and close help text *) ; command ~description:"Show keyboard shortcut help" ~keys:[ key ~shift:() Slash ] diff --git a/examples/visibility/main.ml b/examples/visibility/main.ml index 20e78f3f..d27c67c1 100644 --- a/examples/visibility/main.ml +++ b/examples/visibility/main.ml @@ -4,9 +4,9 @@ open! Bonsai.Let_syntax module Vis = Bonsai_web_ui_visibility module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| body { font-family: sans-serif; diff --git a/examples/widget/main.ml b/examples/widget/main.ml index 19774a92..eaf345c4 100644 --- a/examples/widget/main.ml +++ b/examples/widget/main.ml @@ -17,7 +17,7 @@ module T = struct let scale_dpi : Dom_html.canvasElement Js.t -> Dom_html.canvasRenderingContext2D Js.t -> float - -> float -> unit + -> float -> unit = let f = Js.Unsafe.get Js.Unsafe.global (Js.string "scale_canvas") in fun canvas ctx w h -> diff --git a/experimental/animation/src/bonsai_experimental_animation.ml b/experimental/animation/src/bonsai_experimental_animation.ml index 6b3e5102..4fbacd51 100644 --- a/experimental/animation/src/bonsai_experimental_animation.ml +++ b/experimental/animation/src/bonsai_experimental_animation.ml @@ -50,8 +50,8 @@ module Interpolator = struct | Ease_out_quad -> fun t -> t * (2.0 - t) | Ease_in_out_quad -> (function - | t when t < 0.5 -> 2.0 * t * t - | t -> -1.0 + ((4.0 - (2.0 * t)) * t)) + | t when t < 0.5 -> 2.0 * t * t + | t -> -1.0 + ((4.0 - (2.0 * t)) * t)) | Ease_in_cubic -> fun t -> t * t * t | Ease_out_cubic -> fun t -> @@ -59,8 +59,8 @@ module Interpolator = struct (-t * t * t) + 1.0 | Ease_in_out_cubic -> (function - | t when t < 0.5 -> 4.0 * t * t * t - | t -> ((t - 1.0) * ((2.0 * t) - 2.0) * ((2.0 * t) - 2.0)) + 1.0) + | t when t < 0.5 -> 4.0 * t * t * t + | t -> ((t - 1.0) * ((2.0 * t) - 2.0) * ((2.0 * t) - 2.0)) + 1.0) | Ease_in_quart -> fun t -> t * t * t * t | Ease_out_quart -> fun t -> @@ -68,10 +68,10 @@ module Interpolator = struct 1.0 - (t * t * t * t) | Ease_in_out_quart -> (function - | t when t < 0.5 -> 8.0 * t * t * t * t - | t -> - let t = t - 1.0 in - 1.0 - (8.0 * t * t * t * t)) + | t when t < 0.5 -> 8.0 * t * t * t * t + | t -> + let t = t - 1.0 in + 1.0 - (8.0 * t * t * t * t)) | Ease_in_quint -> fun t -> t * t * t * t * t | Ease_out_quint -> fun t -> @@ -79,33 +79,33 @@ module Interpolator = struct 1.0 + (t * t * t * t * t) | Ease_in_out_quint -> (function - | t when t < 0.5 -> 16.0 * t * t * t * t * t - | t -> - let t = t - 1.0 in - 1.0 + (16.0 * t * t * t * t * t)) + | t when t < 0.5 -> 16.0 * t * t * t * t * t + | t -> + let t = t - 1.0 in + 1.0 + (16.0 * t * t * t * t * t)) | Ease_in_sin -> fun t -> 1.0 - cos (t * pi / 2.0) | Ease_out_sin -> fun t -> sin (t * pi / 2.0) | Ease_in_out_sin -> fun t -> -(cos (pi * t) - 1.0) / 2.0 | Ease_in_exp -> (function - | 0.0 -> 0.0 - | t -> 2.0 ** ((10.0 * t) - 10.0)) + | 0.0 -> 0.0 + | t -> 2.0 ** ((10.0 * t) - 10.0)) | Ease_out_exp -> (function - | 1.0 -> 1.0 - | t -> 1.0 - (2.0 ** (-10.0 * t))) + | 1.0 -> 1.0 + | t -> 1.0 - (2.0 ** (-10.0 * t))) | Ease_in_out_exp -> (function - | 0.0 -> 0.0 - | 1.0 -> 1.0 - | t when t < 0.5 -> (2.0 ** ((20.0 * t) - 10.0)) / 2.0 - | t -> 2.0 - ((2.0 ** ((-20.0 * t) + 10.0)) / 2.0)) + | 0.0 -> 0.0 + | 1.0 -> 1.0 + | t when t < 0.5 -> (2.0 ** ((20.0 * t) - 10.0)) / 2.0 + | t -> 2.0 - ((2.0 ** ((-20.0 * t) + 10.0)) / 2.0)) | Ease_in_circ -> fun t -> 1.0 - sqrt (1.0 - (t ** 2.0)) | Ease_out_circ -> fun t -> sqrt (1.0 - ((t - 1.0) ** 2.0)) | Ease_in_out_circ -> (function - | t when t < 0.5 -> (1.0 - sqrt (1.0 - ((2.0 * t) ** 2.0))) / 2.0 - | t -> (sqrt (1.0 - (((-2.0 * t) + 2.0) ** 2.0)) + 1.0) / 2.0) + | t when t < 0.5 -> (1.0 - sqrt (1.0 - ((2.0 * t) ** 2.0))) / 2.0 + | t -> (sqrt (1.0 - (((-2.0 * t) + 2.0) ** 2.0)) + 1.0) / 2.0) | Ease_in_back -> let c1 = 1.70158 in let c3 = c1 + 1.0 in @@ -118,10 +118,10 @@ module Interpolator = struct let c1 = 1.70158 in let c2 = c1 * 1.525 in (function - | t when t < 0.5 -> ((2.0 * t) ** 2.0) * (((c2 + 1.0) * 2.0 * t) - c2) / 2.0 - | t -> - (((((2.0 * t) - 2.0) ** 2.0) * (((c2 + 1.0) * ((t * 2.0) - 2.0)) + c2)) + 2.0) - / 2.0) + | t when t < 0.5 -> ((2.0 * t) ** 2.0) * (((c2 + 1.0) * 2.0 * t) - c2) / 2.0 + | t -> + (((((2.0 * t) - 2.0) ** 2.0) * (((c2 + 1.0) * ((t * 2.0) - 2.0)) + c2)) + 2.0) + / 2.0) ;; end @@ -247,8 +247,7 @@ let make let%bind.Effect value = match%bind.Effect get_value with | Active value -> Effect.return value - | Inactive -> - Effect.never + | Inactive -> Effect.never in let target_time = match time with diff --git a/experimental/dagviz/src/to_vdom.ml b/experimental/dagviz/src/to_vdom.ml index 7b626b32..d4e8d495 100644 --- a/experimental/dagviz/src/to_vdom.ml +++ b/experimental/dagviz/src/to_vdom.ml @@ -41,9 +41,9 @@ module Make (Name : Types.Name) = struct end module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .map { position:relative; backface-visibility: hidden; @@ -277,13 +277,13 @@ module Make (Name : Types.Name) = struct end let rec value_to_html - ~direction - ~here:_ - ~connections_state - ~id_to_vdom - ~point_to - ~trackers - (me : Value.t) + ~direction + ~here:_ + ~connections_state + ~id_to_vdom + ~point_to + ~trackers + (me : Value.t) = let open Connections_state in let id = me.value_id in @@ -355,32 +355,32 @@ module Make (Name : Types.Name) = struct children ~init:([], connections_state) ~f:(fun (children, connections_state) child -> - match child.value_kind with - | Named name -> - children, Connections_state.add_consumer connections_state ~id ~dest:name - | _ -> child :: children, connections_state) + match child.value_kind with + | Named name -> + children, Connections_state.add_consumer connections_state ~id ~dest:name + | _ -> child :: children, connections_state) in let children, connections_state = children |> List.map ~f:(fun v -> - value_to_html - ~direction - ~connections_state - ~id_to_vdom - ~trackers - ~here:v.value_here - ~point_to:me - v) + value_to_html + ~direction + ~connections_state + ~id_to_vdom + ~trackers + ~here:v.value_here + ~point_to:me + v) |> List.reduce_balanced ~f:(fun (a_nodes, state_a) (b_nodes, state_b) -> - let abs, rest = List.zip_with_remainder a_nodes b_nodes in - let abs : Node.t list list = List.map abs ~f:(fun (a, b) -> a @ b) in - let nodes = - match rest with - | None -> abs - | Some (First a) -> abs @ a - | Some (Second b) -> abs @ b - in - nodes, Connections_state.merge state_a state_b) + let abs, rest = List.zip_with_remainder a_nodes b_nodes in + let abs : Node.t list list = List.map abs ~f:(fun (a, b) -> a @ b) in + let nodes = + match rest with + | None -> abs + | Some (First a) -> abs @ a + | Some (Second b) -> abs @ b + in + nodes, Connections_state.merge state_a state_b) |> Option.value ~default:([], connections_state) in let nodes = @@ -406,13 +406,13 @@ module Make (Name : Types.Name) = struct ;; let value_to_html - ~direction - ~here - ~point_to - ~id_to_vdom - ~trackers - ~connections_state - value + ~direction + ~here + ~point_to + ~id_to_vdom + ~trackers + ~connections_state + value = let vbox, hbox = vbox_hbox direction in let children, connections_state = @@ -435,13 +435,13 @@ module Make (Name : Types.Name) = struct ;; let rec computation_to_html - ~direction - ~here - ~(curr_id : Name.Count.t) - ~id_to_vdom - ~point_to - ~connections_state - ~trackers + ~direction + ~here + ~(curr_id : Name.Count.t) + ~id_to_vdom + ~point_to + ~connections_state + ~trackers = let vbox, hbox = vbox_hbox direction in function @@ -473,21 +473,21 @@ module Make (Name : Types.Name) = struct row ~init:curr_id ~f:(fun curr_id { Types.Binding.as_; bound } -> - let here = - match bound.here with - | Some x -> Some x - | None -> here - in - Tuple2.swap - @@ computation_to_html - ~direction - ~connections_state - ~curr_id - ~id_to_vdom - ~trackers - ~here - ~point_to:as_ - bound) + let here = + match bound.here with + | Some x -> Some x + | None -> here + in + Tuple2.swap + @@ computation_to_html + ~direction + ~connections_state + ~curr_id + ~id_to_vdom + ~trackers + ~here + ~point_to:as_ + bound) in ( curr_id , ( vbox (List.map column_and_states ~f:Tuple2.get1) @@ -539,27 +539,27 @@ module Make (Name : Types.Name) = struct ;; let computation_to_html - c - ~direction - ~(curr_id : Name.Count.t) - ~id_to_vdom - ~trackers - ~here + c + ~direction + ~(curr_id : Name.Count.t) + ~id_to_vdom + ~trackers + ~here = let out, curr_id = Name.next curr_id in computation_to_html c ~direction ~curr_id ~id_to_vdom ~point_to:out ~here ~trackers ;; let to_vdom - ~(curr_id : Name.Count.t Bonsai.Value.t) - ~(direction : [ `Left_to_right | `Top_to_bottom ]) - ~(node_to_vdom : Name.t Bonsai.Value.t -> Vdom.Node.t Bonsai.Computation.t) - ~(edge_to_svg : - edge:Edge.t Bonsai.Value.t - -> from:Position.t Bonsai.Value.t - -> to_:Position.t Bonsai.Value.t - -> Vdom.Node.t Bonsai.Computation.t) - (computation : Computation.t Bonsai_web.Value.t) + ~(curr_id : Name.Count.t Bonsai.Value.t) + ~(direction : [ `Left_to_right | `Top_to_bottom ]) + ~(node_to_vdom : Name.t Bonsai.Value.t -> Vdom.Node.t Bonsai.Computation.t) + ~(edge_to_svg : + edge:Edge.t Bonsai.Value.t + -> from:Position.t Bonsai.Value.t + -> to_:Position.t Bonsai.Value.t + -> Vdom.Node.t Bonsai.Computation.t) + (computation : Computation.t Bonsai_web.Value.t) : (Vdom.Node.t * Name.Count.t) Bonsai_web.Computation.t = let open Bonsai.Let_syntax in @@ -783,16 +783,16 @@ module Make (Name : Types.Name) = struct ;; let create - ~(curr_id : Name.Count.t Bonsai.Value.t) - ~(direction : [ `Left_to_right | `Top_to_bottom ]) - ~(node_to_vdom : - Name.t Bonsai.Value.t -> 'a Value.t -> Vdom.Node.t Bonsai.Computation.t) - ~(edge_to_svg : - edge:Edge.t Bonsai.Value.t - -> from:Position.t Bonsai.Value.t - -> to_:Position.t Bonsai.Value.t - -> Vdom.Node.t Bonsai.Computation.t) - (dag : 'a t Bonsai_web.Value.t) + ~(curr_id : Name.Count.t Bonsai.Value.t) + ~(direction : [ `Left_to_right | `Top_to_bottom ]) + ~(node_to_vdom : + Name.t Bonsai.Value.t -> 'a Value.t -> Vdom.Node.t Bonsai.Computation.t) + ~(edge_to_svg : + edge:Edge.t Bonsai.Value.t + -> from:Position.t Bonsai.Value.t + -> to_:Position.t Bonsai.Value.t + -> Vdom.Node.t Bonsai.Computation.t) + (dag : 'a t Bonsai_web.Value.t) = let open Bonsai.Let_syntax in let%sub bindgen = to_bindgen dag in diff --git a/experimental/dagviz/src/transform.ml b/experimental/dagviz/src/transform.ml index 561dbfce..682105f8 100644 --- a/experimental/dagviz/src/transform.ml +++ b/experimental/dagviz/src/transform.ml @@ -18,9 +18,9 @@ module Make (Name : Types.Name) = struct { v with value_kind = kind } and replace_c - ({ kind; free_variables; here } as c : Computation.t) - ~(from : Name.t) - ~(to_ : Name.t) + ({ kind; free_variables; here } as c : Computation.t) + ~(from : Name.t) + ~(to_ : Name.t) : Computation.t = if not (Set.mem free_variables from) @@ -46,8 +46,8 @@ module Make (Name : Types.Name) = struct ;; let compare_bindings_for_sorting - { Binding.as_ = as1; bound = { free_variables = f1; _ } } - { Binding.as_ = as2; bound = { free_variables = f2; _ } } + { Binding.as_ = as1; bound = { free_variables = f1; _ } } + { Binding.as_ = as2; bound = { free_variables = f2; _ } } = match Name.Set.compare f1 f2 with | 0 -> Name.compare as1 as2 @@ -60,7 +60,7 @@ module Make (Name : Types.Name) = struct | [] -> acc | group :: rest -> if List.exists group ~f:(fun member -> - Set.mem member.bound.free_variables item.as_) + Set.mem member.bound.free_variables item.as_) then acc else find_indexes rest item (idx + 1) (idx :: acc) in @@ -83,74 +83,74 @@ module Make (Name : Types.Name) = struct |> List.fold ~init:([], [], Name.Set.empty, curr_id) ~f:(fun (rows, down_row, missing_one_level_down, curr_id) row -> - let provided_here = Name.Set.of_list (List.map row ~f:(fun { as_; _ } -> as_)) in - let gaps = Set.diff missing_one_level_down provided_here in - let missing_here = - Set.union - gaps - (List.fold - row - ~init:Name.Set.empty - ~f:(fun acc { Binding.bound = { free_variables; _ }; _ } -> - Set.union acc free_variables)) - in - let rewrite, curr_id = - Set.fold gaps ~init:(Name.Map.empty, curr_id) ~f:(fun (acc, curr_id) gap -> - let name, curr_id = Name.next curr_id in - Map.set acc ~key:gap ~data:name, curr_id) - in - let down_row = - List.map down_row ~f:(fun binding -> - let bound = - Map.fold rewrite ~init:binding.Binding.bound ~f:(fun ~key ~data acc -> - replace_c acc ~from:key ~to_:data) - in - { binding with bound }) - in - let curr_id, redirections = - let rewritten = Map.to_alist rewrite in - List.fold_map rewritten ~init:curr_id ~f:(fun curr_id (from, to_) -> - let intermediate, curr_id = Name.next curr_id in - let bound_id, curr_id = Name.next curr_id in - let last_body_id, curr_id = Name.next curr_id in - let inner = - { Binding.bound = - { kind = - Kind.Value - { value_kind = Value.Redirect { name = from } - ; value_here = None - ; value_id = bound_id - } - ; free_variables = Name.Set.singleton from - ; here = None + let provided_here = Name.Set.of_list (List.map row ~f:(fun { as_; _ } -> as_)) in + let gaps = Set.diff missing_one_level_down provided_here in + let missing_here = + Set.union + gaps + (List.fold + row + ~init:Name.Set.empty + ~f:(fun acc { Binding.bound = { free_variables; _ }; _ } -> + Set.union acc free_variables)) + in + let rewrite, curr_id = + Set.fold gaps ~init:(Name.Map.empty, curr_id) ~f:(fun (acc, curr_id) gap -> + let name, curr_id = Name.next curr_id in + Map.set acc ~key:gap ~data:name, curr_id) + in + let down_row = + List.map down_row ~f:(fun binding -> + let bound = + Map.fold rewrite ~init:binding.Binding.bound ~f:(fun ~key ~data acc -> + replace_c acc ~from:key ~to_:data) + in + { binding with bound }) + in + let curr_id, redirections = + let rewritten = Map.to_alist rewrite in + List.fold_map rewritten ~init:curr_id ~f:(fun curr_id (from, to_) -> + let intermediate, curr_id = Name.next curr_id in + let bound_id, curr_id = Name.next curr_id in + let last_body_id, curr_id = Name.next curr_id in + let inner = + { Binding.bound = + { kind = + Kind.Value + { value_kind = Value.Redirect { name = from } + ; value_here = None + ; value_id = bound_id + } + ; free_variables = Name.Set.singleton from + ; here = None + } + ; as_ = intermediate + } + in + let last_body = + { Types.Computation.kind = + Kind.Value + { value_kind = Value.Redirect { name = intermediate } + ; value_here = None + ; value_id = last_body_id } - ; as_ = intermediate - } - in - let last_body = - { Types.Computation.kind = - Kind.Value - { value_kind = Value.Redirect { name = intermediate } - ; value_here = None - ; value_id = last_body_id - } - ; free_variables = Name.Set.singleton intermediate - ; here = None - } - in - ( curr_id - , { Binding.bound = - { kind = Kind.Bindings { bindings = [ inner ]; last_body } - ; free_variables = Name.Set.singleton from - ; here = None - } - ; as_ = to_ - } )) - in - let this_row_including_redirections = - redirections @ row |> List.sort ~compare:compare_bindings_for_sorting - in - down_row :: rows, this_row_including_redirections, missing_here, curr_id) + ; free_variables = Name.Set.singleton intermediate + ; here = None + } + in + ( curr_id + , { Binding.bound = + { kind = Kind.Bindings { bindings = [ inner ]; last_body } + ; free_variables = Name.Set.singleton from + ; here = None + } + ; as_ = to_ + } )) + in + let this_row_including_redirections = + redirections @ row |> List.sort ~compare:compare_bindings_for_sorting + in + down_row :: rows, this_row_including_redirections, missing_here, curr_id) |> fun (rows, last_row, _, curr_id) -> last_row :: rows, curr_id ;; @@ -164,8 +164,8 @@ module Make (Name : Types.Name) = struct n.Binding.bound.free_variables |> Set.to_list |> List.filter_map ~f:(fun free -> - List.findi prev ~f:(fun _ { Binding.as_; _ } -> Name.equal as_ free) - |> Option.map ~f:(fun (i, _) -> Float.of_int i)) + List.findi prev ~f:(fun _ { Binding.as_; _ } -> Name.equal as_ free) + |> Option.map ~f:(fun (i, _) -> Float.of_int i)) in let pos = match List.length positions with diff --git a/experimental/dagviz/src/types.ml b/experimental/dagviz/src/types.ml index 481028e0..c7fdb831 100644 --- a/experimental/dagviz/src/types.ml +++ b/experimental/dagviz/src/types.ml @@ -175,59 +175,59 @@ module Make (Name : Name) = struct method value_kind : Value.value_without_position -> 'acc -> 'acc = fun value_kind acc -> - match value_kind with - | Fake -> acc - | Redirect { name } -> self#name name acc - | Named name -> self#name name acc - | Singleton -> acc - | Mapn values -> - List.fold ~init:acc ~f:(fun acc value -> self#value value acc) values + match value_kind with + | Fake -> acc + | Redirect { name } -> self#name name acc + | Named name -> self#name name acc + | Singleton -> acc + | Mapn values -> + List.fold ~init:acc ~f:(fun acc value -> self#value value acc) values method value : Value.t -> 'acc -> 'acc = fun value acc -> - match value with - | { value_kind; value_here; value_id } -> - self#value_kind value_kind acc - |> fun acc -> - Option.value_map - value_here - ~f:(fun value_here -> self#position value_here acc) - ~default:acc - |> self#name value_id + match value with + | { value_kind; value_here; value_id } -> + self#value_kind value_kind acc + |> fun acc -> + Option.value_map + value_here + ~f:(fun value_here -> self#position value_here acc) + ~default:acc + |> self#name value_id method binding : Binding.t -> 'acc -> 'acc = fun binding acc -> - let { bound : computation; as_ : Name.t } = binding in - self#computation bound acc |> self#name as_ + let { bound : computation; as_ : Name.t } = binding in + self#computation bound acc |> self#name as_ method string : string -> 'acc -> 'acc = fun _ acc -> acc method kind : Kind.t -> 'acc -> 'acc = fun kind acc -> - match kind with - | Bindings { bindings; last_body } -> - List.fold ~init:acc bindings ~f:(Fn.flip self#binding) - |> self#computation last_body - | Value value -> self#value value acc - | Wrapping { name; introduces; bodies } -> - self#string name acc - |> fun acc -> - List.fold introduces ~init:acc ~f:(Fn.flip self#name) - |> fun acc -> List.fold bodies ~init:acc ~f:(Fn.flip self#computation) + match kind with + | Bindings { bindings; last_body } -> + List.fold ~init:acc bindings ~f:(Fn.flip self#binding) + |> self#computation last_body + | Value value -> self#value value acc + | Wrapping { name; introduces; bodies } -> + self#string name acc + |> fun acc -> + List.fold introduces ~init:acc ~f:(Fn.flip self#name) + |> fun acc -> List.fold bodies ~init:acc ~f:(Fn.flip self#computation) method computation : Computation.t -> 'acc -> 'acc = fun computation acc -> - let { kind : Kind.t - ; free_variables : Name.Set.t - ; here : Source_code_position.Stable.V1.t option - } - = - computation - in - self#kind kind acc - |> fun acc -> - Set.fold free_variables ~init:acc ~f:(Fn.flip self#name) - |> fun acc -> - Option.value_map here ~f:(fun here -> self#position here acc) ~default:acc + let { kind : Kind.t + ; free_variables : Name.Set.t + ; here : Source_code_position.Stable.V1.t option + } + = + computation + in + self#kind kind acc + |> fun acc -> + Set.fold free_variables ~init:acc ~f:(Fn.flip self#name) + |> fun acc -> + Option.value_map here ~f:(fun here -> self#position here acc) ~default:acc end end diff --git a/experimental/form/src/bonsai_form_experimental.ml b/experimental/form/src/bonsai_form_experimental.ml index cd76dbcb..f6b6d656 100644 --- a/experimental/form/src/bonsai_form_experimental.ml +++ b/experimental/form/src/bonsai_form_experimental.ml @@ -8,7 +8,7 @@ type ('input, 'result, 'parsed) t = default:'parsed -> ( 'input , ('result Or_error.t Product.With_view.t, 'parsed) Product.t ) - Bonsai.Arrow_deprecated.t + Bonsai.Arrow_deprecated.t let form_element (type t) (module M : Bonsai.Model with type t = t) here ~(default : t) = Bonsai.Arrow_deprecated.state_machine diff --git a/experimental/form/src/bonsai_form_experimental.mli b/experimental/form/src/bonsai_form_experimental.mli index b7766225..9d427ccc 100644 --- a/experimental/form/src/bonsai_form_experimental.mli +++ b/experimental/form/src/bonsai_form_experimental.mli @@ -4,12 +4,11 @@ module Validated = Validated open! Core open! Import - type ('input, 'result, 'parsed) t = default:'parsed -> ( 'input , ('result Or_error.t Product.With_view.t, 'parsed) Product.t ) - Bonsai.Arrow_deprecated.t + Bonsai.Arrow_deprecated.t val text_input : default:string -> (_, string Product.Same.t) Bonsai.Arrow_deprecated.t diff --git a/experimental/form/src/combine.ml b/experimental/form/src/combine.ml index 90595255..60486e19 100644 --- a/experimental/form/src/combine.ml +++ b/experimental/form/src/combine.ml @@ -8,24 +8,24 @@ module T = struct ('input, ('result, 'parsed) Product.t) Bonsai.Arrow_deprecated.t include Applicative.Make3_using_map2 (struct - type nonrec ('result, 'input, 'parsed) t = ('result, 'input, 'parsed) t - - let return value = - Product.Fields.create ~value ~set:(const Ui_effect.Ignore) - |> Bonsai.Arrow_deprecated.const - ;; - - let map2 a b ~f = - let open Bonsai.Arrow_deprecated.Let_syntax in - let%map_open a = a - and b = b in - let value = f (Product.value a) (Product.value b) in - let set parsed = Vdom.Effect.Many [ Product.set a parsed; Product.set b parsed ] in - Product.Fields.create ~value ~set - ;; - - let map = `Define_using_map2 - end) + type nonrec ('result, 'input, 'parsed) t = ('result, 'input, 'parsed) t + + let return value = + Product.Fields.create ~value ~set:(const Ui_effect.Ignore) + |> Bonsai.Arrow_deprecated.const + ;; + + let map2 a b ~f = + let open Bonsai.Arrow_deprecated.Let_syntax in + let%map_open a = a + and b = b in + let value = f (Product.value a) (Product.value b) in + let set parsed = Vdom.Effect.Many [ Product.set a parsed; Product.set b parsed ] in + Product.Fields.create ~value ~set + ;; + + let map = `Define_using_map2 + end) end include T diff --git a/experimental/form/src/combine.mli b/experimental/form/src/combine.mli index e6d08236..ac6aa8d3 100644 --- a/experimental/form/src/combine.mli +++ b/experimental/form/src/combine.mli @@ -20,11 +20,11 @@ end include Applicative.S3 - with type ('result, 'input, 'parsed) t := - ('input, ('result, 'parsed) Product.t) Bonsai.Arrow_deprecated.t + with type ('result, 'input, 'parsed) t := + ('input, ('result, 'parsed) Product.t) Bonsai.Arrow_deprecated.t include Applicative.Let_syntax3 - with type ('result, 'input, 'parsed) t := - ('input, ('result, 'parsed) Product.t) Bonsai.Arrow_deprecated.t - with module Open_on_rhs_intf := Open_on_rhs_intf + with type ('result, 'input, 'parsed) t := + ('input, ('result, 'parsed) Product.t) Bonsai.Arrow_deprecated.t + with module Open_on_rhs_intf := Open_on_rhs_intf diff --git a/experimental/table_form/src/bonsai_experimental_table_form.ml b/experimental/table_form/src/bonsai_experimental_table_form.ml index a32779d1..efcdc41d 100644 --- a/experimental/table_form/src/bonsai_experimental_table_form.ml +++ b/experimental/table_form/src/bonsai_experimental_table_form.ml @@ -17,9 +17,9 @@ type ('k, 'cmp) comparator = (module S with type t = 'k and type comparator_witness = 'cmp) module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .key_column { white-space: pre; } @@ -50,11 +50,11 @@ module Column = struct end let table_form - (type k cmp) - ?key_column_initial_width - (key : (k, cmp) comparator) - form_of_t - ~columns + (type k cmp) + ?key_column_initial_width + (key : (k, cmp) comparator) + form_of_t + ~columns = let module Key = (val key) in let module M_map = struct @@ -171,7 +171,7 @@ let table_form forms |> Map.to_alist |> List.map ~f:(fun (k, form) -> - form |> Form.value |> Or_error.map ~f:(fun v -> k, v)) + form |> Form.value |> Or_error.map ~f:(fun v -> k, v)) |> Or_error.combine_errors |> Or_error.map ~f:(Map.of_alist_exn (module Key)) in @@ -180,8 +180,7 @@ let table_form let%bind.Effect forms = match%bind.Effect get_forms with | Active forms -> Effect.return forms - | Inactive -> - Effect.never + | Inactive -> Effect.never in Effect.Many (List.map2_exn (Map.data forms) (Map.data new_data) ~f:(fun form data -> diff --git a/extra/bonsai_extra.ml b/extra/bonsai_extra.ml index 87f74575..7db6f245 100644 --- a/extra/bonsai_extra.ml +++ b/extra/bonsai_extra.ml @@ -18,11 +18,11 @@ let with_inject_fixed_point f = ;; let with_self_effect - (type a) - ?sexp_of_model - ?equal - ~(f : a Bonsai.Computation_status.t Effect.t Value.t -> a Computation.t) - () + (type a) + ?sexp_of_model + ?equal + ~(f : a Bonsai.Computation_status.t Effect.t Value.t -> a Computation.t) + () : a Computation.t = Bonsai.wrap @@ -50,13 +50,13 @@ let with_self_effect ;; let state_machine1_dynamic_model - (type a) - (module A : Bonsai.Action with type t = a) - ?sexp_of_model - ?equal - ~model - ~apply_action - input + (type a) + (module A : Bonsai.Action with type t = a) + ?sexp_of_model + ?equal + ~model + ~apply_action + input = let model_creator = match model with @@ -196,26 +196,26 @@ let pipe (type a) (module A : Bonsai.Model with type t = a) = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Model.default ~apply_action:(fun context model -> function - | Add_action a -> - (match Fdeque.dequeue_front model.queued_receivers with - | None -> - let queued_actions = Fdeque.enqueue_back model.queued_actions a in - { model with queued_actions } - | Some (hd, queued_receivers) -> - Bonsai.Apply_action_context.schedule_event - context - (Effect.Private.Callback.respond_to hd a); - { model with queued_receivers }) - | Add_receiver r -> - (match Fdeque.dequeue_front model.queued_actions with - | None -> - let queued_receivers = Fdeque.enqueue_back model.queued_receivers r in - { model with queued_receivers } - | Some (hd, queued_actions) -> - Bonsai.Apply_action_context.schedule_event - context - (Effect.Private.Callback.respond_to r hd); - { model with queued_actions })) + | Add_action a -> + (match Fdeque.dequeue_front model.queued_receivers with + | None -> + let queued_actions = Fdeque.enqueue_back model.queued_actions a in + { model with queued_actions } + | Some (hd, queued_receivers) -> + Bonsai.Apply_action_context.schedule_event + context + (Effect.Private.Callback.respond_to hd a); + { model with queued_receivers }) + | Add_receiver r -> + (match Fdeque.dequeue_front model.queued_actions with + | None -> + let queued_receivers = Fdeque.enqueue_back model.queued_receivers r in + { model with queued_receivers } + | Some (hd, queued_actions) -> + Bonsai.Apply_action_context.schedule_event + context + (Effect.Private.Callback.respond_to r hd); + { model with queued_actions })) in let%arr inject = inject in let request = @@ -243,14 +243,14 @@ module Id_gen (T : Int_intf.S) () = struct end let mirror' - (type m) - ?sexp_of_model - ~equal - ~(store_set : (m -> unit Effect.t) Value.t) - ~(store_value : m option Value.t) - ~(interactive_set : (m -> unit Effect.t) Value.t) - ~(interactive_value : m option Value.t) - () + (type m) + ?sexp_of_model + ~equal + ~(store_set : (m -> unit Effect.t) Value.t) + ~(store_value : m option Value.t) + ~(interactive_set : (m -> unit Effect.t) Value.t) + ~(interactive_value : m option Value.t) + () = let module M = struct type t = m @@ -341,13 +341,13 @@ let mirror' ;; let mirror - ?sexp_of_model - ~equal - ~store_set - ~store_value - ~interactive_set - ~interactive_value - () + ?sexp_of_model + ~equal + ~store_set + ~store_value + ~interactive_set + ~interactive_value + () = let store_value = store_value >>| Option.some in let interactive_value = interactive_value >>| Option.some in @@ -485,15 +485,15 @@ module One_at_a_time = struct ~sexp_of_action:[%sexp_of: Lock_action.t] ~default_model:Idle ~recv:(fun ~schedule_event:_ model action -> - match action with - | Acquire -> - let response = - match model with - | Busy -> false - | Idle -> true - in - Busy, response - | Release -> Idle, true) + match action with + | Acquire -> + let response = + match model with + | Busy -> false + | Idle -> true + in + Busy, response + | Release -> Idle, true) in let%sub effect = let%arr inject_status = inject_status diff --git a/extra/bonsai_extra.mli b/extra/bonsai_extra.mli index b8d33ad0..e379b569 100644 --- a/extra/bonsai_extra.mli +++ b/extra/bonsai_extra.mli @@ -85,7 +85,6 @@ val state_machine1_dynamic_model -> 'input Value.t -> ('model * ('action -> unit Effect.t)) Computation.t - (** The analog of [Bonsai.state], but with a dynamic model. Read the docs for [state_machine0_dynamic_model] *) val state_dynamic_model diff --git a/jsoo_weak_collections/src/gen_js_api.ml b/jsoo_weak_collections/src/gen_js_api.ml index 678914a6..b18a978a 100644 --- a/jsoo_weak_collections/src/gen_js_api.ml +++ b/jsoo_weak_collections/src/gen_js_api.ml @@ -1,2 +1,2 @@ -module Ojs = Ojs +module Ojs = Ojs module Ojs_exn = Ojs_exn diff --git a/jsoo_weak_collections/src/weak_map.ml b/jsoo_weak_collections/src/weak_map.ml index bbda977a..dee08ab9 100644 --- a/jsoo_weak_collections/src/weak_map.ml +++ b/jsoo_weak_collections/src/weak_map.ml @@ -1,30 +1,39 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Js_of_ocaml open! Gen_js_api + type ('a, 'b) t = Ojs.t -let rec t_of_js : - 'a 'b . (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) t = - fun (type __a) (type __b) (__a_of_js : Ojs.t -> __a) - (__b_of_js : Ojs.t -> __b) (x2 : Ojs.t) -> x2 -and t_to_js : 'a 'b . ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) t -> Ojs.t = - fun (type __a) (type __b) (__a_to_js : __a -> Ojs.t) - (__b_to_js : __b -> Ojs.t) (x1 : Ojs.t) -> x1 + +let rec t_of_js : 'a 'b. (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) t = + fun (type __a __b) (__a_of_js : Ojs.t -> __a) (__b_of_js : Ojs.t -> __b) (x2 : Ojs.t) -> + x2 + +and t_to_js : 'a 'b. ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) t -> Ojs.t = + fun (type __a __b) (__a_to_js : __a -> Ojs.t) (__b_to_js : __b -> Ojs.t) (x1 : Ojs.t) -> + x1 +;; + let (create : unit -> ('a, 'b) t) = fun () -> - t_of_js Obj.magic Obj.magic - (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "WeakMap") [||]) + t_of_js Obj.magic Obj.magic (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "WeakMap") [||]) +;; + let (set : ('a, 'b) t -> 'a -> 'b -> unit) = fun (x7 : ('a, 'b) t) (x5 : 'a) (x6 : 'b) -> - ignore - (Ojs.call (t_to_js Obj.magic Obj.magic x7) "set" - [|(Obj.magic x5);(Obj.magic x6)|]) + ignore + (Ojs.call (t_to_js Obj.magic Obj.magic x7) "set" [| Obj.magic x5; Obj.magic x6 |]) +;; + let (get : ('a, 'b) t -> 'a -> 'b option) = fun (x11 : ('a, 'b) t) (x10 : 'a) -> - Ojs.option_of_js Obj.magic - (Ojs.call (t_to_js Obj.magic Obj.magic x11) "get" [|(Obj.magic x10)|]) + Ojs.option_of_js + Obj.magic + (Ojs.call (t_to_js Obj.magic Obj.magic x11) "get" [| Obj.magic x10 |]) +;; + let (delete : ('a, 'b) t -> 'a -> unit) = fun (x16 : ('a, 'b) t) (x15 : 'a) -> - ignore - (Ojs.call (t_to_js Obj.magic Obj.magic x16) "delete" - [|(Obj.magic x15)|]) + ignore (Ojs.call (t_to_js Obj.magic Obj.magic x16) "delete" [| Obj.magic x15 |]) +;; diff --git a/jsoo_weak_collections/src/weak_set.ml b/jsoo_weak_collections/src/weak_set.ml index bb6d44ea..959de689 100644 --- a/jsoo_weak_collections/src/weak_set.ml +++ b/jsoo_weak_collections/src/weak_set.ml @@ -1,22 +1,33 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] + open! Js_of_ocaml open! Gen_js_api + type 'a t = Ojs.t -let rec t_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a t = + +let rec t_of_js : 'a. (Ojs.t -> 'a) -> Ojs.t -> 'a t = fun (type __a) (__a_of_js : Ojs.t -> __a) (x2 : Ojs.t) -> x2 -and t_to_js : 'a . ('a -> Ojs.t) -> 'a t -> Ojs.t = + +and t_to_js : 'a. ('a -> Ojs.t) -> 'a t -> Ojs.t = fun (type __a) (__a_to_js : __a -> Ojs.t) (x1 : Ojs.t) -> x1 +;; + let (create : unit -> 'a t) = - fun () -> - t_of_js Obj.magic - (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "WeakSet") [||]) + fun () -> t_of_js Obj.magic (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "WeakSet") [||]) +;; + let (add : 'a t -> 'a -> unit) = fun (x5 : 'a t) (x4 : 'a) -> - ignore (Ojs.call (t_to_js Obj.magic x5) "add" [|(Obj.magic x4)|]) + ignore (Ojs.call (t_to_js Obj.magic x5) "add" [| Obj.magic x4 |]) +;; + let (has : 'a t -> 'a -> bool) = fun (x8 : 'a t) (x7 : 'a) -> - Ojs.bool_of_js (Ojs.call (t_to_js Obj.magic x8) "has" [|(Obj.magic x7)|]) + Ojs.bool_of_js (Ojs.call (t_to_js Obj.magic x8) "has" [| Obj.magic x7 |]) +;; + let (delete : 'a t -> 'a -> unit) = fun (x11 : 'a t) (x10 : 'a) -> - ignore (Ojs.call (t_to_js Obj.magic x11) "delete" [|(Obj.magic x10)|]) + ignore (Ojs.call (t_to_js Obj.magic x11) "delete" [| Obj.magic x10 |]) +;; diff --git a/ppx_bonsai/src/expander/ppx_bonsai_expander.ml b/ppx_bonsai/src/expander/ppx_bonsai_expander.ml index bbaa9f87..e0856ac1 100644 --- a/ppx_bonsai/src/expander/ppx_bonsai_expander.ml +++ b/ppx_bonsai/src/expander/ppx_bonsai_expander.ml @@ -226,9 +226,9 @@ module Arr : Ext = struct ;; let maybe_add_cutoff_to_value_binding - ~(loc : location) - ~(modul : longident loc option) - (value_binding : value_binding) + ~(loc : location) + ~(modul : longident loc option) + (value_binding : value_binding) = let loc = { loc with loc_ghost = true } in match ignores_at_least_1_subpattern value_binding.pvb_pat with @@ -238,8 +238,8 @@ module Arr : Ext = struct let wrap_expansion : loc:location -> modul:longident loc option -> value_binding list -> expression - -> expand:(loc:location -> value_binding list -> expression -> expression) - -> expression + -> expand:(loc:location -> value_binding list -> expression -> expression) + -> expression = fun ~loc ~modul value_bindings expression ~expand -> let value_bindings = diff --git a/ppx_bonsai/test/test.ml b/ppx_bonsai/test/test.ml index 28c43f36..efe97ec6 100644 --- a/ppx_bonsai/test/test.ml +++ b/ppx_bonsai/test/test.ml @@ -154,8 +154,8 @@ module Arrow_example = struct match%sub X.return_v (Some "hello") with | (Some ("heyo" : string) : string option) -> return (X.return_v 0.) | ((Some (((case_1_lhs : string X.v) as _x3 : string X.v) : string X.v) as _x : - string option X.v) as _x2 : - string option X.v) -> + string option X.v) as _x2 : + string option X.v) -> let%arr lhs_a = case_1_lhs and lhs_b = X.return_v 2. and lhs_c = X.return_v 3. in diff --git a/src/bonsai.mli b/src/bonsai.mli index 90c3ff4f..27bc2bc1 100644 --- a/src/bonsai.mli +++ b/src/bonsai.mli @@ -261,7 +261,7 @@ end current state, as well as an inject function that updates the state. *) val state : ?reset:('model -> 'model) - (** to learn more about [reset], read the docs on [with_model_resetter] *) + (** to learn more about [reset], read the docs on [with_model_resetter] *) -> ?sexp_of_model:('model -> Sexp.t) -> ?equal:('model -> 'model -> bool) -> 'model @@ -311,7 +311,7 @@ end (It is very common for [inject] and [schedule_event] to be unused) *) val state_machine0 : ?reset:('action Apply_action_context.t -> 'model -> 'model) - (** to learn more about [reset], read the docs on [with_model_resetter] *) + (** to learn more about [reset], read the docs on [with_model_resetter] *) -> ?sexp_of_model:('model -> Sexp.t) -> ?sexp_of_action:('action -> Sexp.t) -> ?equal:('model -> 'model -> bool) @@ -327,7 +327,7 @@ val state_machine0 val state_machine1 : ?sexp_of_action:('action -> Sexp.t) -> ?reset:('action Apply_action_context.t -> 'model -> 'model) - (** to learn more about [reset], read the docs on [with_model_resetter] *) + (** to learn more about [reset], read the docs on [with_model_resetter] *) -> ?sexp_of_model:('model -> Sexp.t) -> ?equal:('model -> 'model -> bool) -> default_model:'model @@ -343,11 +343,11 @@ val state_machine1 (** Identical to [actor1] but it takes 0 inputs instead of 1. *) val actor0 : ?reset: - (inject:('action -> 'return Effect.t) - -> schedule_event:(unit Effect.t -> unit) - -> 'model - -> 'model) - (** to learn more about [reset], read the docs on [with_model_resetter] *) + (inject:('action -> 'return Effect.t) + -> schedule_event:(unit Effect.t -> unit) + -> 'model + -> 'model) + (** to learn more about [reset], read the docs on [with_model_resetter] *) -> ?sexp_of_model:('model -> Sexp.t) -> ?sexp_of_action:('action -> Sexp.t) -> ?equal:('model -> 'model -> bool) @@ -372,7 +372,7 @@ val actor1 -> schedule_event:(unit Effect.t -> unit) -> 'model -> 'model) - (** to learn more about [reset], read the docs on [with_model_resetter] *) + (** to learn more about [reset], read the docs on [with_model_resetter] *) -> ?sexp_of_model:('model -> Sexp.t) -> ?equal:('model -> 'model -> bool) -> default_model:'model @@ -448,7 +448,7 @@ val freeze ... ]} *) val lazy_ : 'a Computation.t Lazy.t -> 'a Computation.t -[@@deprecated "[since 2023-07] Use Bonsai.fix "] + [@@deprecated "[since 2023-07] Use Bonsai.fix "] (** A fixed-point combinator for bonsai components. This is used to build recursive components like so: @@ -561,7 +561,6 @@ val assoc_list -> f:('key Value.t -> 'a Value.t -> 'b Computation.t) -> [ `Duplicate_key of 'key | `Ok of 'b list ] Computation.t - (** [enum] is used for matching on a value and providing different behaviors on different values. The type of the value must be enumerable (there must be a finite number of possible values), and it must be comparable and sexpable. @@ -822,11 +821,11 @@ module Effect_throttling : sig module Poll_result : sig type 'a t = | Aborted - (** [Aborted] indicates that the effect was aborted before it even + (** [Aborted] indicates that the effect was aborted before it even started. If an effect starts, then it should complete with some kind of result - [Effect] does not support cancellation in general. *) | Finished of 'a - (** [Finished x] indicates that an effect successfully completed with value x. *) + (** [Finished x] indicates that an effect successfully completed with value x. *) [@@deriving sexp, equal] (** Collapses values of type ['a Or_error.t t] a plain Or_error.t, where @@ -840,7 +839,8 @@ module Effect_throttling : sig val collapse_fun_to_or_error : ?sexp_of_input:('a -> Sexp.t) -> ('a -> 'b Or_error.t t Effect.t) - -> ('a -> 'b Or_error.t Effect.t) + -> 'a + -> 'b Or_error.t Effect.t end (** Transforms an input effect into a new effect that enforces that invariant @@ -1057,8 +1057,6 @@ end module Map : sig val mapi : [ `Use_assoc ] val map : [ `Use_assoc ] - - val of_set : ('k, 'cmp) Set.t Value.t -> ('k, unit, 'cmp) Map.t Computation.t val filter_mapi @@ -1221,12 +1219,12 @@ module Map : sig val unordered_fold_nested_maps : ?update: - (outer_key:'outer_key - -> inner_key:'inner_key - -> old_data:'v - -> new_data:'v - -> 'acc - -> 'acc) + (outer_key:'outer_key + -> inner_key:'inner_key + -> old_data:'v + -> new_data:'v + -> 'acc + -> 'acc) -> ('outer_key, ('inner_key, 'v, 'inner_cmp) Map.t, 'outer_cmp) Map.t Value.t -> init:'acc -> add:(outer_key:'outer_key -> inner_key:'inner_key -> data:'v -> 'acc -> 'acc) @@ -1244,8 +1242,8 @@ module Map : sig -> ( 'outer_key * 'inner_key , 'v , ('outer_cmp, 'inner_cmp) Tuple2.comparator_witness ) - Map.t - Computation.t + Map.t + Computation.t val collapse_by : ('outer_key, ('inner_key, 'v, 'inner_cmp) Map.t, 'outer_cmp) Map.t Value.t @@ -1290,7 +1288,7 @@ end module Arrow_deprecated : sig include Legacy_api_intf.S - with type ('input, 'result) t = 'input Value.t -> 'result Computation.t + with type ('input, 'result) t = 'input Value.t -> 'result Computation.t end module Stable : sig diff --git a/src/constant_fold.ml b/src/constant_fold.ml index 637f0307..9c28c80b 100644 --- a/src/constant_fold.ml +++ b/src/constant_fold.ml @@ -76,12 +76,12 @@ include struct ;; let simplify_assoc_if_simpl - (type k v cmp) - ~(key_comparator : (k, cmp) comparator) - ~(key_id : k Type_equal.Id.t) - ~(data_id : v Type_equal.Id.t) - (map : (k, v, cmp) Map.t Value.t) - by + (type k v cmp) + ~(key_comparator : (k, cmp) comparator) + ~(key_id : k Type_equal.Id.t) + ~(data_id : v Type_equal.Id.t) + (map : (k, v, cmp) Map.t Value.t) + by = let module C = (val key_comparator) in let%map.Option by = @@ -231,7 +231,7 @@ module Constant_fold (Recurse : Fix_transform.Recurse with module Types := Types | None -> Assoc { assoc_t with map = map_v; by })) | Assoc_on ({ map; io_comparator = key_comparator; io_key_id = key_id; data_id; by; _ } as - assoc_on_t) -> + assoc_on_t) -> let (), (), map = Recurse.on_value { constants_in_scope; evaluated } () `Directly_on map in diff --git a/src/driver/bonsai_driver.ml b/src/driver/bonsai_driver.ml index d1f0b7d8..d0479b0e 100644 --- a/src/driver/bonsai_driver.ml +++ b/src/driver/bonsai_driver.ml @@ -34,8 +34,8 @@ type ('m, 'dynamic_action, 'static_action, 'action_input, 'r) unpacked = type 'r t = T : (_, _, _, _, 'r) unpacked -> 'r t let assert_type_equalities - (T a : _ Bonsai.Private.Computation.packed_info) - (T b : _ Bonsai.Private.Computation.packed_info) + (T a : _ Bonsai.Private.Computation.packed_info) + (T b : _ Bonsai.Private.Computation.packed_info) = let T = Bonsai.Private.Meta.Model.Type_id.same_witness_exn a.model.type_id b.model.type_id @@ -60,16 +60,16 @@ let create (type r) ?(optimize = true) ~clock (computation : r Bonsai.Computatio |> Bonsai.Private.gather in let (T - ({ model = - { default = default_model; sexp_of = sexp_of_model; equal = _; type_id = _ } - ; input = _ - ; apply_static - ; apply_dynamic - ; dynamic_action = _ - ; static_action = _ - ; run = _ - ; reset = _ - } as computation_info)) + ({ model = + { default = default_model; sexp_of = sexp_of_model; equal = _; type_id = _ } + ; input = _ + ; apply_static + ; apply_dynamic + ; dynamic_action = _ + ; static_action = _ + ; run = _ + ; reset = _ + } as computation_info)) = optimized_info in @@ -82,11 +82,11 @@ let create (type r) ?(optimize = true) ~clock (computation : r Bonsai.Computatio into the environment is by defining a function like this. See https://github.com/ocaml/ocaml/issues/7074. *) let create_polymorphic - (type dynamic_action static_action action_input) - (computation_info : - (_, dynamic_action, static_action, action_input, r) Bonsai.Private.Computation.info) - apply_static - apply_dynamic + (type dynamic_action static_action action_input) + (computation_info : + (_, dynamic_action, static_action, action_input, r) Bonsai.Private.Computation.info) + apply_static + apply_dynamic : r t = let queue = Queue.create () in @@ -144,15 +144,15 @@ let create (type r) ?(optimize = true) ~clock (computation : r Bonsai.Computatio let schedule_event _ = Ui_effect.Expert.handle let flush - (T - { model_var - ; static_apply_action - ; dynamic_apply_action - ; action_input - ; queue - ; clock - ; _ - }) + (T + { model_var + ; static_apply_action + ; dynamic_apply_action + ; action_input + ; queue + ; clock + ; _ + }) = Bonsai.Time_source.Private.flush clock; let update_model ~action ~apply_action = diff --git a/src/eval.ml b/src/eval.ml index 9635aac8..aa98160d 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -3,20 +3,20 @@ open! Import open Incr.Let_syntax let unusable_static_apply_action - ~inject_dynamic:_ - ~inject_static:_ - ~schedule_event:_ - _model + ~inject_dynamic:_ + ~inject_static:_ + ~schedule_event:_ + _model = Nothing.unreachable_code ;; let unusable_dynamic_apply_action - ~inject_dynamic:_ - ~inject_static:_ - ~schedule_event:_ - _input - _model + ~inject_dynamic:_ + ~inject_static:_ + ~schedule_event:_ + _input + _model = Nothing.unreachable_code ;; @@ -183,15 +183,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ } | Assoc { map; key_comparator; key_id; cmp_id; data_id; by } -> let (T - { model = model_info - ; input = input_info - ; dynamic_action - ; static_action - ; apply_static - ; apply_dynamic - ; run - ; reset - }) + { model = model_info + ; input = input_info + ; dynamic_action + ; static_action + ; apply_static + ; apply_dynamic + ; run + ; reset + }) = gather by in @@ -264,12 +264,12 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ else Map.set model ~key:id ~data in let apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - input - model - (id, action) + ~inject_dynamic + ~inject_static + ~schedule_event + input + model + (id, action) = let input = Option.bind input ~f:(fun input -> Map.find input id) in let inject_dynamic a = inject_dynamic (id, a) in @@ -323,15 +323,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ let module Io_comparator = (val io_comparator) in let model_key_comparator = Model_comparator.comparator in let (T - { model = model_info - ; input = input_info - ; dynamic_action - ; static_action - ; apply_static - ; apply_dynamic - ; run - ; reset - }) + { model = model_info + ; input = input_info + ; dynamic_action + ; static_action + ; apply_static + ; apply_dynamic + ; run + ; reset + }) = gather by in @@ -399,11 +399,11 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ ~lifecycle:(Some lifecycle) in let apply_static - ~inject_dynamic - ~inject_static - ~schedule_event - model - (input_id, model_id, action) + ~inject_dynamic + ~inject_static + ~schedule_event + model + (input_id, model_id, action) = let inject_dynamic a = inject_dynamic (input_id, model_id, a) in let inject_static a = inject_static (input_id, model_id, a) in @@ -420,12 +420,12 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ else Map.set model ~key:model_id ~data:(input_id, new_model) in let apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - input - model - (input_id, model_id, action) + ~inject_dynamic + ~inject_static + ~schedule_event + input + model + (input_id, model_id, action) = let input = Option.bind input ~f:(fun input -> Map.find input input_id) in let inject_dynamic a = inject_dynamic (input_id, model_id, a) in @@ -505,15 +505,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ nodes, which can cause [assert false] to trigger. *) let path = Path.append path (Path.Elem.Switch index) in let (T - { model = model_info - ; input = input_info - ; dynamic_action = dynamic_action_info - ; static_action = static_action_info - ; apply_static = _ - ; apply_dynamic = _ - ; reset = _ - ; run - }) + { model = model_info + ; input = input_info + ; dynamic_action = dynamic_action_info + ; static_action = static_action_info + ; apply_static = _ + ; apply_dynamic = _ + ; reset = _ + ; run + }) = Map.find_exn gathered index in @@ -551,11 +551,11 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ Snapshot.create ~result ~input ~lifecycle:(Some lifecycle) in let apply_static - ~inject_dynamic - ~inject_static - ~schedule_event - model - (action : int Meta.Action.Hidden.t) + ~inject_dynamic + ~inject_static + ~schedule_event + model + (action : int Meta.Action.Hidden.t) = let (T { action; type_id = action_type_id; key = index }) = action in let (T { model = chosen_model; info = chosen_model_info; _ }) = @@ -566,15 +566,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ (Meta.Action.Hidden.T { action; type_id = action_type_id; key = index }) in let (T - { model = tm - ; input = _ - ; static_action = am - ; dynamic_action = dm - ; apply_static - ; apply_dynamic = _ - ; run = _ - ; reset = _ - }) + { model = tm + ; input = _ + ; static_action = am + ; dynamic_action = dm + ; apply_static + ; apply_dynamic = _ + ; run = _ + ; reset = _ + }) = Map.find_exn gathered index in @@ -590,23 +590,23 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ Meta.Multi_model.set model ~key:index ~data:new_model in let apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - input - model - (Meta.Action.Hidden.T { action; type_id = action_type_id; key = index }) + ~inject_dynamic + ~inject_static + ~schedule_event + input + model + (Meta.Action.Hidden.T { action; type_id = action_type_id; key = index }) = let (T - { model = tm - ; input = im - ; static_action = am - ; dynamic_action = dm - ; apply_static = _ - ; apply_dynamic - ; run = _ - ; reset = _ - }) + { model = tm + ; input = im + ; static_action = am + ; dynamic_action = dm + ; apply_static = _ + ; apply_dynamic + ; run = _ + ; reset = _ + }) = Map.find_exn gathered index in @@ -628,7 +628,7 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ match input with | Some (Meta.Input.Hidden.T - { input = chosen_input; type_id = chosen_input_info; key = index' }) -> + { input = chosen_input; type_id = chosen_input_info; key = index' }) -> (match index = index', Meta.Input.same_witness chosen_input_info im with | true, Some T -> apply_dynamic @@ -671,15 +671,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ let f ~key:index ~data:(model : Meta.Model.Hidden.t) = let (T { model = chosen_model; info = chosen_model_info; _ }) = model in let (T - { model = tm - ; input = _ - ; static_action = am - ; dynamic_action = dm - ; reset - ; apply_static = _ - ; apply_dynamic = _ - ; run = _ - }) + { model = tm + ; input = _ + ; static_action = am + ; dynamic_action = dm + ; reset + ; apply_static = _ + ; apply_dynamic = _ + ; run = _ + }) = Map.find_exn gathered index in @@ -723,13 +723,13 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ let gathered = Lazy.map lazy_computation ~f:gather in let run ~environment ~path ~clock ~model ~inject_dynamic ~inject_static = let (T - { model = model_info - ; input = input_info - ; dynamic_action = dynamic_action_info - ; static_action = static_action_info - ; run - ; _ - }) + { model = model_info + ; input = input_info + ; dynamic_action = dynamic_action_info + ; static_action = static_action_info + ; run + ; _ + }) = force gathered in @@ -768,12 +768,12 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ let apply_static ~inject_dynamic ~inject_static ~schedule_event model action = (* forcing the lazy is fine because actions are finite in length *) let (T - { model = model_info - ; dynamic_action = dynamic_action_info - ; static_action = static_action_info - ; apply_static - ; _ - }) + { model = model_info + ; dynamic_action = dynamic_action_info + ; static_action = static_action_info + ; apply_static + ; _ + }) = force gathered in @@ -805,13 +805,13 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ let apply_dynamic ~inject_dynamic ~inject_static ~schedule_event input model action = (* forcing the lazy is fine because actions are finite in length *) let (T - { model = model_info - ; input = input_info - ; dynamic_action = dynamic_action_info - ; static_action = static_action_info - ; apply_dynamic - ; _ - }) + { model = model_info + ; input = input_info + ; dynamic_action = dynamic_action_info + ; static_action = static_action_info + ; apply_dynamic + ; _ + }) = force gathered in @@ -859,12 +859,12 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ in let reset' ~inject_dynamic ~inject_static ~schedule_event model = let (T - { model = model_info - ; dynamic_action = dynamic_action_info - ; static_action = static_action_info - ; reset - ; _ - }) + { model = model_info + ; dynamic_action = dynamic_action_info + ; static_action = static_action_info + ; reset + ; _ + }) = force gathered in @@ -913,15 +913,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ ; reset = reset_me } -> let (T - { model = inner_model - ; input = inner_input - ; dynamic_action = inner_dynamic_action - ; static_action = inner_static_action - ; apply_static - ; apply_dynamic - ; run - ; reset - }) + { model = inner_model + ; input = inner_input + ; dynamic_action = inner_dynamic_action + ; static_action = inner_static_action + ; apply_static + ; apply_dynamic + ; run + ; reset + }) = gather inner in @@ -961,12 +961,12 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ m1, apply_static ~inject_dynamic ~inject_static ~schedule_event m2 action in let apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - input - (outer_model, inner_model) - action + ~inject_dynamic + ~inject_static + ~schedule_event + input + (outer_model, inner_model) + action = let dynamic_inject_outer a = inject_dynamic (Either.First a) in let dynamic_inject_inner a = inject_dynamic (Either.Second a) in @@ -1021,15 +1021,15 @@ let rec gather : type result. result Computation.t -> result Computation.packed_ } | With_model_resetter { inner; reset_id } -> let (T - ({ model - ; input - ; dynamic_action - ; static_action - ; apply_static - ; apply_dynamic - ; run - ; reset - } as gathered_inner)) + ({ model + ; input + ; dynamic_action + ; static_action + ; apply_static + ; apply_dynamic + ; run + ; reset + } as gathered_inner)) = gather inner in diff --git a/src/eval_sub.ml b/src/eval_sub.ml index 75a5afce..a7b10e9f 100644 --- a/src/eval_sub.ml +++ b/src/eval_sub.ml @@ -2,10 +2,10 @@ open! Core open! Import let baseline - ~here - ~(info_from : _ Computation.info) - ~(info_into : _ Computation.info) - ~via + ~here + ~(info_from : _ Computation.info) + ~(info_into : _ Computation.info) + ~via = let reset ~inject_dynamic ~inject_static ~schedule_event (model_from, model_into) = let model_from = @@ -22,64 +22,64 @@ let baseline in let apply_static ~inject_dynamic ~inject_static ~schedule_event (model_from, model_into) = function - | First action -> - let inject_static action = inject_static (First action) in - let inject_dynamic action = inject_dynamic (First action) in - let model_from = - info_from.apply_static - ~inject_dynamic - ~inject_static - ~schedule_event - model_from - action - in - model_from, model_into - | Second action -> - let inject_static action = inject_static (Second action) in - let inject_dynamic action = inject_dynamic (Second action) in - let model_into = - info_into.apply_static - ~inject_dynamic - ~inject_static - ~schedule_event - model_into - action - in - model_from, model_into + | First action -> + let inject_static action = inject_static (First action) in + let inject_dynamic action = inject_dynamic (First action) in + let model_from = + info_from.apply_static + ~inject_dynamic + ~inject_static + ~schedule_event + model_from + action + in + model_from, model_into + | Second action -> + let inject_static action = inject_static (Second action) in + let inject_dynamic action = inject_dynamic (Second action) in + let model_into = + info_into.apply_static + ~inject_dynamic + ~inject_static + ~schedule_event + model_into + action + in + model_from, model_into in let apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - input - (model_from, model_into) + ~inject_dynamic + ~inject_static + ~schedule_event + input + (model_from, model_into) = function - | First action -> - let inject_static action = inject_static (First action) in - let inject_dynamic action = inject_dynamic (First action) in - let model_from = - info_from.apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - (Option.map input ~f:fst) - model_from - action - in - model_from, model_into - | Second action -> - let inject_static action = inject_static (Second action) in - let inject_dynamic action = inject_dynamic (Second action) in - let model_into = - info_into.apply_dynamic - ~inject_dynamic - ~inject_static - ~schedule_event - (Option.map input ~f:snd) - model_into - action - in - model_from, model_into + | First action -> + let inject_static action = inject_static (First action) in + let inject_dynamic action = inject_dynamic (First action) in + let model_from = + info_from.apply_dynamic + ~inject_dynamic + ~inject_static + ~schedule_event + (Option.map input ~f:fst) + model_from + action + in + model_from, model_into + | Second action -> + let inject_static action = inject_static (Second action) in + let inject_dynamic action = inject_dynamic (Second action) in + let model_into = + info_into.apply_dynamic + ~inject_dynamic + ~inject_static + ~schedule_event + (Option.map input ~f:snd) + model_into + action + in + model_from, model_into in let run ~environment ~path ~clock ~model ~inject_dynamic ~inject_static = let from = @@ -128,10 +128,10 @@ let baseline ;; let from_stateless - ~here - ~(info_from : _ Computation.info) - ~(info_into : _ Computation.info) - ~via + ~here + ~(info_from : _ Computation.info) + ~(info_into : _ Computation.info) + ~via = let run ~environment ~path ~clock ~model ~inject_dynamic ~inject_static = let from = @@ -174,10 +174,10 @@ let from_stateless ;; let into_stateless - ~here - ~(info_from : _ Computation.info) - ~(info_into : _ Computation.info) - ~via + ~here + ~(info_from : _ Computation.info) + ~(info_into : _ Computation.info) + ~via = let run ~environment ~path ~clock ~model ~inject_dynamic ~inject_static = let from = @@ -220,10 +220,10 @@ let into_stateless ;; let no_static_actions - ~here - ~(info_from : _ Computation.info) - ~(info_into : _ Computation.info) - ~via + ~here + ~(info_from : _ Computation.info) + ~(info_into : _ Computation.info) + ~via = let reset ~inject_dynamic:_ ~inject_static ~schedule_event (model_from, model_into) = let model_from = @@ -245,33 +245,33 @@ let no_static_actions model_from, model_into in let apply_static - ~inject_dynamic:_ - ~inject_static - ~schedule_event - (model_from, model_into) + ~inject_dynamic:_ + ~inject_static + ~schedule_event + (model_from, model_into) = function - | First action -> - let inject_static action = inject_static (First action) in - let model_from = - info_from.apply_static - ~inject_dynamic:Nothing.unreachable_code - ~inject_static - ~schedule_event - model_from - action - in - model_from, model_into - | Second action -> - let inject_static action = inject_static (Second action) in - let model_into = - info_into.apply_static - ~inject_dynamic:Nothing.unreachable_code - ~inject_static - ~schedule_event - model_into - action - in - model_from, model_into + | First action -> + let inject_static action = inject_static (First action) in + let model_from = + info_from.apply_static + ~inject_dynamic:Nothing.unreachable_code + ~inject_static + ~schedule_event + model_from + action + in + model_from, model_into + | Second action -> + let inject_static action = inject_static (Second action) in + let model_into = + info_into.apply_static + ~inject_dynamic:Nothing.unreachable_code + ~inject_static + ~schedule_event + model_into + action + in + model_from, model_into in let apply_dynamic ~inject_dynamic:_ ~inject_static:_ ~schedule_event:_ _ _ = Nothing.unreachable_code @@ -330,10 +330,10 @@ let no_static_actions ;; let no_dynamic_actions - ~here - ~(info_from : _ Computation.info) - ~(info_into : _ Computation.info) - ~via + ~here + ~(info_from : _ Computation.info) + ~(info_into : _ Computation.info) + ~via = let reset ~inject_dynamic ~inject_static:_ ~schedule_event (model_from, model_into) = let model_from = @@ -358,36 +358,36 @@ let no_dynamic_actions Nothing.unreachable_code in let apply_dynamic - ~inject_dynamic - ~inject_static:_ - ~schedule_event - input - (model_from, model_into) + ~inject_dynamic + ~inject_static:_ + ~schedule_event + input + (model_from, model_into) = function - | First action -> - let inject_dynamic action = inject_dynamic (First action) in - let model_from = - info_from.apply_dynamic - ~inject_dynamic - ~inject_static:Nothing.unreachable_code - ~schedule_event - (Option.map input ~f:fst) - model_from - action - in - model_from, model_into - | Second action -> - let inject_dynamic action = inject_dynamic (Second action) in - let model_into = - info_into.apply_dynamic - ~inject_dynamic - ~inject_static:Nothing.unreachable_code - ~schedule_event - (Option.map input ~f:snd) - model_into - action - in - model_from, model_into + | First action -> + let inject_dynamic action = inject_dynamic (First action) in + let model_from = + info_from.apply_dynamic + ~inject_dynamic + ~inject_static:Nothing.unreachable_code + ~schedule_event + (Option.map input ~f:fst) + model_from + action + in + model_from, model_into + | Second action -> + let inject_dynamic action = inject_dynamic (Second action) in + let model_into = + info_into.apply_dynamic + ~inject_dynamic + ~inject_static:Nothing.unreachable_code + ~schedule_event + (Option.map input ~f:snd) + model_into + action + in + model_from, model_into in let run ~environment ~path ~clock ~model ~inject_dynamic ~inject_static:_ = let from = diff --git a/src/fix_transform.ml b/src/fix_transform.ml index cc20eae4..44320d56 100644 --- a/src/fix_transform.ml +++ b/src/fix_transform.ml @@ -3,8 +3,8 @@ open! Import include Fix_transform_intf module Make - (Types : Types) (F : functor (_ : Recurse with module Types := Types) -> - Transform with module Types := Types) : Transform with module Types := Types = struct + (Types : Types) (F : functor (_ : Recurse with module Types := Types) -> + Transform with module Types := Types) : Transform with module Types := Types = struct module rec Recurse : (Recurse with module Types := Types) = struct let combine_up, empty, empty_for_lazy = Types.Up.(combine, empty, empty_for_lazy) @@ -52,8 +52,8 @@ module Make arms |> Map.to_alist |> List.fold_map ~init:(acc, up1) ~f:(fun (acc, up) (k, v) -> - let acc, up', v = User.transform_c down acc v in - (acc, combine_up up up'), (k, v)) + let acc, up', v = User.transform_c down acc v in + (acc, combine_up up up'), (k, v)) in let arms = Map.of_alist_exn (module Int) arms in acc, upn, Switch { match_; arms; here } diff --git a/src/fix_transform_intf.ml b/src/fix_transform_intf.ml index 31101995..5f5658f9 100644 --- a/src/fix_transform_intf.ml +++ b/src/fix_transform_intf.ml @@ -12,7 +12,6 @@ module type Up = sig val combine : t -> t -> t val empty : t - (** [Computation.lazy] is an obstacle to optimization in many cases. To force optimization authors to think about [lazy], we have a special empty value. @@ -94,6 +93,6 @@ module type S = sig module type Recurse = Recurse module Make - (Types : Types) (_ : functor (_ : Recurse with module Types := Types) -> - Transform with module Types := Types) : Transform with module Types := Types + (Types : Types) (_ : functor (_ : Recurse with module Types := Types) -> + Transform with module Types := Types) : Transform with module Types := Types end diff --git a/src/flatten_values.ml b/src/flatten_values.ml index 2c785127..a6dc2c9b 100644 --- a/src/flatten_values.ml +++ b/src/flatten_values.ml @@ -2,10 +2,10 @@ open! Core open! Import let value_map - (type a) - (context : _ Transform.For_value.context) - () - ({ value; here; id } : a Value.t) + (type a) + (context : _ Transform.For_value.context) + () + ({ value; here; id } : a Value.t) = let value = match value with @@ -167,10 +167,10 @@ let value_map ;; let computation_map - (type result) - (context : _ Transform.For_computation.context) - () - (computation : result Computation.t) + (type result) + (context : _ Transform.For_computation.context) + () + (computation : result Computation.t) : result Computation.t = context.recurse () computation diff --git a/src/graph_info.ml b/src/graph_info.ml index dbb58c91..afc24f38 100644 --- a/src/graph_info.ml +++ b/src/graph_info.ml @@ -192,11 +192,11 @@ let empty = ;; let value_map - (type a) - ({ recurse; var_from_parent; parent_path; current_path; _ } : - _ Transform.For_value.context) - state - (value : a Value.t) + (type a) + ({ recurse; var_from_parent; parent_path; current_path; _ } : + _ Transform.For_value.context) + state + (value : a Value.t) = let environment, add_tree_relationship, add_dag_relationship = state in let node_info = Node_info.of_value value in @@ -221,11 +221,11 @@ let value_map ;; let computation_map - (type result) - ({ recurse; var_from_parent; parent_path; current_path } : - _ Transform.For_computation.context) - state - (computation : result Computation.t) + (type result) + ({ recurse; var_from_parent; parent_path; current_path } : + _ Transform.For_computation.context) + state + (computation : result Computation.t) : result Computation.t = let environment, add_tree_relationship, add_dag_relationship = state in @@ -262,10 +262,10 @@ let iter_graph_updates (t : _ Computation.t) ~on_update = let (lazy from), (lazy to_) = from, to_ in let gm = !graph_info in graph_info - := { gm with - info = Map.add_exn gm.info ~key:from ~data:from_info - ; tree = Map.add_exn gm.tree ~key:from ~data:to_ - }; + := { gm with + info = Map.add_exn gm.info ~key:from ~data:from_info + ; tree = Map.add_exn gm.tree ~key:from ~data:to_ + }; on_update !graph_info in let environment = Type_equal.Id.Uid.Table.create () in diff --git a/src/graph_info.mli b/src/graph_info.mli index f3bb41a7..e53ad793 100644 --- a/src/graph_info.mli +++ b/src/graph_info.mli @@ -1,7 +1,6 @@ open! Core open! Import - module Node_info : sig type t = { node_type : string diff --git a/src/instrumentation.ml b/src/instrumentation.ml index 277c248e..bc3f762e 100644 --- a/src/instrumentation.ml +++ b/src/instrumentation.ml @@ -26,10 +26,10 @@ let extract_node_path_from_entry_label label = let instrument_computation (t : _ Computation.t) ~start_timer ~stop_timer = let computation_map - (type result) - (context : unit Transform.For_computation.context) - () - (computation : result Computation.t) + (type result) + (context : unit Transform.For_computation.context) + () + (computation : result Computation.t) : result Computation.t = let node_info = Graph_info.Node_info.of_computation computation in @@ -43,13 +43,13 @@ let instrument_computation (t : _ Computation.t) ~start_timer ~stop_timer = in let by_label = entry_label [%string "%{node_info.node_type}-by"] in let time_apply_action - ~apply_action - ~inject_dynamic - ~inject_static - ~schedule_event - input - model - action + ~apply_action + ~inject_dynamic + ~inject_static + ~schedule_event + input + model + action = start_timer apply_action_label; let model = @@ -59,12 +59,12 @@ let instrument_computation (t : _ Computation.t) ~start_timer ~stop_timer = model in let time_static_apply_action - ~apply_action - ~inject_dynamic - ~inject_static - ~schedule_event - model - action + ~apply_action + ~inject_dynamic + ~inject_static + ~schedule_event + model + action = start_timer apply_action_label; let model = @@ -100,10 +100,10 @@ let instrument_computation (t : _ Computation.t) ~start_timer ~stop_timer = | computation -> computation in let value_map - (type a) - (context : unit Transform.For_value.context) - () - ({ here; value; id } as wrapped_value : a Value.t) + (type a) + (context : unit Transform.For_value.context) + () + ({ here; value; id } as wrapped_value : a Value.t) = let (lazy current_path) = context.current_path in let node_info = Graph_info.Node_info.of_value wrapped_value in diff --git a/src/legacy_api.ml b/src/legacy_api.ml index 72be4523..699a0bee 100644 --- a/src/legacy_api.ml +++ b/src/legacy_api.ml @@ -21,13 +21,13 @@ let map_input a ~f i = a (Proc.Value.map i ~f) let of_module = Proc.of_module1 let state_machine - ~sexp_of_action - ?sexp_of_model - ~equal - _here - ~default_model - ~apply_action - input + ~sexp_of_action + ?sexp_of_model + ~equal + _here + ~default_model + ~apply_action + input = Proc.state_machine1 ~sexp_of_action @@ -148,12 +148,12 @@ module With_incr = struct let of_incr i _ = Proc.read (Proc.Private.conceal_value (Value.of_incr i)) let of_module - (type i m a r) - ?sexp_of_model - (component : (i, m, a, r) component_s_incr) - ~equal - ~default_model - input + (type i m a r) + ?sexp_of_model + (component : (i, m, a, r) component_s_incr) + ~equal + ~default_model + input : r Proc.Computation.t = let input = Proc.Private.reveal_value input in diff --git a/src/legacy_api.mli b/src/legacy_api.mli index 2238d6b8..e6de43f4 100644 --- a/src/legacy_api.mli +++ b/src/legacy_api.mli @@ -3,4 +3,4 @@ open! Import include Legacy_api_intf.S - with type ('input, 'result) t = 'input Proc.Value.t -> 'result Proc.Computation.t + with type ('input, 'result) t = 'input Proc.Value.t -> 'result Proc.Computation.t diff --git a/src/map0.ml b/src/map0.ml index 851f21f9..1dde591c 100644 --- a/src/map0.ml +++ b/src/map0.ml @@ -26,19 +26,19 @@ let cutoff m ~equal = ;; let mapi_count - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~f + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~f = Incr.compute m ~f:(Incr_map.mapi_count ~comparator:(module M) ~f) ;; let map_count - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~f + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~f = Incr.compute m ~f:(Incr_map.map_count ~comparator:(module M) ~f) ;; @@ -70,27 +70,27 @@ let max_value (type k cmp) m ~comparator:((module M) : (k, cmp) Module_types.com ;; let mapi_bounds - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~f + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~f = Incr.compute m ~f:(Incr_map.mapi_bounds ~comparator:(module M) ~f) ;; let map_bounds - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~f + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~f = Incr.compute m ~f:(Incr_map.map_bounds ~comparator:(module M) ~f) ;; let value_bounds - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) = Incr.compute m ~f:(Incr_map.value_bounds ~comparator:(module M)) ;; @@ -144,19 +144,19 @@ let rekey (type k cmp) m ~comparator:((module M) : (k, cmp) Module_types.compara ;; let index_byi - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~index + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~index = Incr.compute m ~f:(Incr_map.index_byi ~comparator:(module M) ~index) ;; let index_by - (type k cmp) - m - ~comparator:((module M) : (k, cmp) Module_types.comparator) - ~index + (type k cmp) + m + ~comparator:((module M) : (k, cmp) Module_types.comparator) + ~index = Incr.compute m ~f:(Incr_map.index_by ~comparator:(module M) ~index) ;; @@ -174,19 +174,19 @@ let collapse (type k cmp) m ~comparator:((module M) : (k, cmp) Module_types.comp ;; let collapse_by - (type k cmp) - m - ~merge_keys - ~comparator:((module M) : (k, cmp) Module_types.comparator) + (type k cmp) + m + ~merge_keys + ~comparator:((module M) : (k, cmp) Module_types.comparator) = Incr.compute m ~f:(Incr_map.collapse_by ~comparator:(module M) ~merge_keys) ;; let expand - (type k k2 cmp cmp2) - m - ~outer_comparator:((module M_outer) : (k, cmp) Module_types.comparator) - ~inner_comparator:((module M_inner) : (k2, cmp2) Module_types.comparator) + (type k k2 cmp cmp2) + m + ~outer_comparator:((module M_outer) : (k, cmp) Module_types.comparator) + ~inner_comparator:((module M_inner) : (k2, cmp2) Module_types.comparator) = Incr.compute m diff --git a/src/map0.mli b/src/map0.mli index 317a25f4..f9ba7f3d 100644 --- a/src/map0.mli +++ b/src/map0.mli @@ -161,12 +161,12 @@ val index_by val unordered_fold_nested_maps : ?update: - (outer_key:'outer_key - -> inner_key:'inner_key - -> old_data:'v - -> new_data:'v - -> 'acc - -> 'acc) + (outer_key:'outer_key + -> inner_key:'inner_key + -> old_data:'v + -> new_data:'v + -> 'acc + -> 'acc) -> ('outer_key, ('inner_key, 'v, 'inner_cmp) Map.t, 'outer_cmp) Map.t Value.t -> init:'acc -> add:(outer_key:'outer_key -> inner_key:'inner_key -> data:'v -> 'acc -> 'acc) @@ -184,8 +184,8 @@ val collapse -> ( 'outer_key * 'inner_key , 'v , ('outer_cmp, 'inner_cmp) Tuple2.comparator_witness ) - Map.t - Computation.t + Map.t + Computation.t val collapse_by : ('outer_key, ('inner_key, 'v, 'inner_cmp) Map.t, 'outer_cmp) Map.t Value.t diff --git a/src/meta.ml b/src/meta.ml index b0e0b0f6..fc1a62ca 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -68,17 +68,17 @@ module Model = struct let rec sexp_of_t : type a. (a -> Sexp.t) -> a t -> Sexp.t = fun sexp_of_a -> function - | Leaf { type_id } -> [%sexp (type_id : a Type_equal.Id.t)] - | Tuple { a; b } -> [%sexp (a : opaque t), (b : opaque t)] - | Tuple3 { a; b; c } -> [%sexp (a : opaque t), (b : opaque t), (c : opaque t)] - | Either { a; b; _ } -> [%sexp Either, (a : opaque t), (b : opaque t)] - | Map { by; _ } -> [%sexp (by : opaque t)] - | Map_on { by; _ } -> [%sexp (by : opaque t)] - | Multi_model { multi_model } -> - let sexp_of_hidden (T { info = { type_id; _ }; _ }) = - [%sexp (type_id : opaque t)] - in - [%sexp (multi_model : hidden Int.Map.t)] + | Leaf { type_id } -> [%sexp (type_id : a Type_equal.Id.t)] + | Tuple { a; b } -> [%sexp (a : opaque t), (b : opaque t)] + | Tuple3 { a; b; c } -> [%sexp (a : opaque t), (b : opaque t), (c : opaque t)] + | Either { a; b; _ } -> [%sexp Either, (a : opaque t), (b : opaque t)] + | Map { by; _ } -> [%sexp (by : opaque t)] + | Map_on { by; _ } -> [%sexp (by : opaque t)] + | Multi_model { multi_model } -> + let sexp_of_hidden (T { info = { type_id; _ }; _ }) = + [%sexp (type_id : opaque t)] + in + [%sexp (multi_model : hidden Int.Map.t)] ;; let rec to_sexp : type a. a t -> a -> Sexp.t = function @@ -239,11 +239,11 @@ module Model = struct ;; let map - (type k cmp) - (module M : Comparator with type t = k and type comparator_witness = cmp) - k - cmp - model + (type k cmp) + (module M : Comparator with type t = k and type comparator_witness = cmp) + k + cmp + model = let sexp_of_model = model.sexp_of in let sexp_of_map_model = [%sexp_of: model Map.M(M).t] in @@ -256,13 +256,13 @@ module Model = struct ;; let map_on - (type k cmp k_io cmp_io) - (module M : Comparator with type t = k and type comparator_witness = cmp) - (module M_io : Comparator with type t = k_io and type comparator_witness = cmp_io) - k_model - k_io - cmp - model + (type k cmp k_io cmp_io) + (module M : Comparator with type t = k and type comparator_witness = cmp) + (module M_io : Comparator with type t = k_io and type comparator_witness = cmp_io) + k_model + k_io + cmp + model = let sexp_of_model = model.sexp_of in let sexp_of_map_model = [%sexp_of: (M_io.t * model) Map.M(M).t] in @@ -294,8 +294,8 @@ module Model = struct let sexp_of_t (T { model; info = { sexp_of; _ }; _ }) = sexp_of model let equal - (T { model = m1; info = { type_id = t1; equal; _ }; _ }) - (T { model = m2; info = { type_id = t2; _ }; _ }) + (T { model = m1; info = { type_id = t1; equal; _ }; _ }) + (T { model = m2; info = { type_id = t2; _ }; _ }) = match Type_id.same_witness t1 t2 with | Some T -> equal m1 m2 @@ -383,7 +383,7 @@ module Multi_model = struct let sexp_of = [%sexp_of: int t] in let type_id = Model.Multi_model { multi_model = default } in ({ default; type_id; equal = [%equal: Model.Hidden.t Int.Map.t]; sexp_of } - : t Model.t) + : t Model.t) ;; end diff --git a/src/meta.mli b/src/meta.mli index d8493310..e6779bd6 100644 --- a/src/meta.mli +++ b/src/meta.mli @@ -1,4 +1,3 @@ - (** [Meta.Model] and [Meta.Action] contain the necessary functions associated with the hidden model and action types of Bonsai components. These are stored in [Computation.info]. *) diff --git a/src/module_types.ml b/src/module_types.ml index 72392f82..d4220704 100644 --- a/src/module_types.ml +++ b/src/module_types.ml @@ -89,10 +89,10 @@ end type ('input, 'model, 'action, 'result) component_s = (module Component_s - with type Input.t = 'input - and type Model.t = 'model - and type Action.t = 'action - and type Result.t = 'result) + with type Input.t = 'input + and type Model.t = 'model + and type Action.t = 'action + and type Result.t = 'result) (** This module type is similar to {!Component_s}, except that many of the functions' arguments and return values are incremental. See {!Component_s} for an explanation of @@ -114,7 +114,10 @@ module type Component_s_incr = sig val apply_action : Input.t -> inject:(Action.t -> unit Ui_effect.t) - -> (schedule_event:(unit Ui_effect.t -> unit) -> Model.t -> Action.t -> Model.t) + -> schedule_event:(unit Ui_effect.t -> unit) + -> Model.t + -> Action.t + -> Model.t val compute : Input.t Incr.t @@ -125,10 +128,10 @@ end type ('input, 'model, 'action, 'result) component_s_incr = (module Component_s_incr - with type Input.t = 'input - and type Model.t = 'model - and type Action.t = 'action - and type Result.t = 'result) + with type Input.t = 'input + and type Model.t = 'model + and type Action.t = 'action + and type Result.t = 'result) module type Mapn = sig type 'a t diff --git a/src/node_path.ml b/src/node_path.ml index 44fbffa3..c9ca5089 100644 --- a/src/node_path.ml +++ b/src/node_path.ml @@ -74,8 +74,8 @@ module T : sig include Comparable.S_binable - with type t := t - and type comparator_witness := comparator_witness + with type t := t + and type comparator_witness := comparator_witness include Stringable.S with type t := t end = struct diff --git a/src/path.ml b/src/path.ml index 622373db..5e37cc4c 100644 --- a/src/path.ml +++ b/src/path.ml @@ -12,8 +12,8 @@ module Elem = struct -> t let compare - (T { key = key1; id = id1; compare = compare1 }) - (T { key = key2; id = id2; compare = _ }) + (T { key = key1; id = id1; compare = compare1 }) + (T { key = key2; id = id2; compare = _ }) = match Type_equal.Id.same_witness id1 id2 with | Some T -> compare1 key1 key2 @@ -111,8 +111,8 @@ let append t ele = ;; include Comparable.Make_plain (struct - type nonrec t = t [@@deriving compare, sexp_of] - end) + type nonrec t = t [@@deriving compare, sexp_of] +end) let rec to_unique_identifier_string t = match t.string_repr with diff --git a/src/proc.ml b/src/proc.ml index 7b3c5145..fe78e21d 100644 --- a/src/proc.ml +++ b/src/proc.ml @@ -62,10 +62,10 @@ let enum (type k) (module E : Enum with type t = k) ~match_ ~with_ = ;; let scope_model - (type a cmp) - (module M : Comparator with type t = a and type comparator_witness = cmp) - ~on:v - computation + (type a cmp) + (module M : Comparator with type t = a and type comparator_witness = cmp) + ~on:v + computation = let v = Value.map v ~f:(fun k -> Map.singleton (module M) k ()) in let%sub map = assoc (module M) v ~f:(fun _ _ -> computation) in @@ -76,12 +76,12 @@ let scope_model ;; let of_module1 - (type i m a r) - ?sexp_of_model - (component : (i, m, a, r) component_s) - ?equal - ~default_model - input + (type i m a r) + ?sexp_of_model + (component : (i, m, a, r) component_s) + ?equal + ~default_model + input = let (module M) = component in let%sub input = return input in @@ -115,13 +115,13 @@ let of_module2 ?sexp_of_model c ?equal ~default_model i1 i2 = ;; let race_dynamic_model - (type m) - ?sexp_of_action - ?sexp_of_model - ~equal - ~model - ~apply_action - input + (type m) + ?sexp_of_action + ?sexp_of_model + ~equal + ~model + ~apply_action + input = let model_creator = match model with @@ -168,11 +168,11 @@ let race_dynamic_model ;; let of_module0 - (type m a r) - ?sexp_of_model - ?equal - (component : (unit, m, a, r) component_s) - ~default_model + (type m a r) + ?sexp_of_model + ?equal + (component : (unit, m, a, r) component_s) + ~default_model = let (module M) = component in let%sub model_and_inject = @@ -209,51 +209,51 @@ let actor1 -> (model * (action -> return Effect.t)) Computation.t = fun ?(sexp_of_action = sexp_of_opaque) - ?reset - ?sexp_of_model - ?equal - ~default_model - ~recv - input -> - let module Action_with_callback = struct - let sexp_of_t cb = sexp_of_action (Effect.Private.Callback.request cb) - end - in - let reset = - Option.map reset ~f:(fun f context model -> - let%tydi { inject; schedule_event } = Apply_action_context.Private.reveal context in - let inject action = - Effect.Private.make ~request:action ~evaluator:(fun action -> - schedule_event (inject action)) - in - f ~inject ~schedule_event model) - in - let%sub model, inject = - state_machine1 - ~sexp_of_action:[%sexp_of: Action_with_callback.t] - ?sexp_of_model - ?reset - ?equal - ~default_model - ~apply_action:(fun context input model callback -> - let%tydi { inject = _; schedule_event } = - Apply_action_context.Private.reveal context - in - let action = Effect.Private.Callback.request callback in - let new_model, response = recv ~schedule_event input model action in - schedule_event (Effect.Private.Callback.respond_to callback response); - new_model) - input - in - let%sub inject = - let%arr inject = inject in - fun action -> + ?reset + ?sexp_of_model + ?equal + ~default_model + ~recv + input -> + let module Action_with_callback = struct + let sexp_of_t cb = sexp_of_action (Effect.Private.Callback.request cb) + end + in + let reset = + Option.map reset ~f:(fun f context model -> + let%tydi { inject; schedule_event } = Apply_action_context.Private.reveal context in + let inject action = Effect.Private.make ~request:action ~evaluator:(fun action -> - Effect.Expert.handle (inject action)) - in - let%arr model = model - and inject = inject in - model, inject + schedule_event (inject action)) + in + f ~inject ~schedule_event model) + in + let%sub model, inject = + state_machine1 + ~sexp_of_action:[%sexp_of: Action_with_callback.t] + ?sexp_of_model + ?reset + ?equal + ~default_model + ~apply_action:(fun context input model callback -> + let%tydi { inject = _; schedule_event } = + Apply_action_context.Private.reveal context + in + let action = Effect.Private.Callback.request callback in + let new_model, response = recv ~schedule_event input model action in + schedule_event (Effect.Private.Callback.respond_to callback response); + new_model) + input + in + let%sub inject = + let%arr inject = inject in + fun action -> + Effect.Private.make ~request:action ~evaluator:(fun action -> + Effect.Expert.handle (inject action)) + in + let%arr model = model + and inject = inject in + model, inject ;; let actor0 ?reset ?sexp_of_model ?sexp_of_action ?equal ~default_model ~recv () = @@ -435,13 +435,13 @@ module Edge = struct end let manual_refresh_implementation - (type r) - ?sexp_of_model - ?equal - ~initial - ~wrap_result - ~effect - () + (type r) + ?sexp_of_model + ?equal + ~initial + ~wrap_result + ~effect + () = let%sub _, next_seqnum = actor0 @@ -481,9 +481,9 @@ module Edge = struct ~apply_action: (fun (_ : _ Apply_action_context.t) model (Action.Set (seqnum, res)) -> - if seqnum < model.State.last_seqnum - then model - else { State.last_seqnum = seqnum; last_result = res }) + if seqnum < model.State.last_seqnum + then model + else { State.last_seqnum = seqnum; last_result = res }) ~default_model:{ State.last_seqnum = -1; last_result = initial } () in @@ -547,8 +547,7 @@ module Edge = struct let%bind.Effect input = match%bind.Effect get_input with | Active input -> Effect.return input - | Inactive -> - Effect.never + | Inactive -> Effect.never in effect input in @@ -627,7 +626,7 @@ module Effect_throttling = struct ~sexp_of_action:[%sexp_of: Action.t] ~sexp_of_model:[%sexp_of: Model.t] ~equal:[%equal: Model.t] - (* This computation does nothing on reset because users should be + (* This computation does nothing on reset because users should be oblivious to the fact that it has a model. I don't think there is a "correct" decision in this case - this behavior just seems more reasonable to me. *) @@ -771,7 +770,7 @@ let most_recent_value_satisfying ?sexp_of_model ~equal input ~condition = let previous_value : ?sexp_of_model:('a -> Sexp.t) -> equal:('a -> 'a -> bool) -> 'a Value.t - -> 'a option Computation.t + -> 'a option Computation.t = fun ?sexp_of_model ~equal input -> let%sub prev, set_prev = state_opt ?sexp_of_model ~equal () in @@ -1040,8 +1039,8 @@ module Clock = struct | `Every_multiple_of_period_non_blocking | `Every_multiple_of_period_blocking ] - -> ?trigger_on_activate:bool -> Time_ns.Span.t -> unit Effect.t Value.t - -> unit Computation.t + -> ?trigger_on_activate:bool -> Time_ns.Span.t -> unit Effect.t Value.t + -> unit Computation.t = fun ~when_to_start_next_effect -> match when_to_start_next_effect with @@ -1071,9 +1070,9 @@ module Memo = struct -> ('query, 'response) t let create - (type query cmp response) - (module Query : Comparator with type t = query and type comparator_witness = cmp) - ~(f : query Value.t -> response Computation.t) + (type query cmp response) + (module Query : Comparator with type t = query and type comparator_witness = cmp) + ~(f : query Value.t -> response Computation.t) = let module Model = struct type t = int Map.M(Query).t [@@deriving sexp_of, equal] @@ -1116,11 +1115,11 @@ module Memo = struct ;; let lookup - (type query response) - ?sexp_of_model - ~equal - (t : (query, response) t Value.t) - query + (type query response) + ?sexp_of_model + ~equal + (t : (query, response) t Value.t) + query = let%sub (T { inject; _ }) = return t in let%sub () = @@ -1158,26 +1157,26 @@ module Computation = struct type 'a t = 'a Computation.t include Applicative.Make_using_map2 (struct - type nonrec 'a t = 'a t - - let return = const - - let map2 a b ~f = - let%sub a = a in - let%sub b = b in - let%arr a = a - and b = b in - f a b - ;; - - let map a ~f = - let%sub a = a in - let%arr a = a in - f a - ;; - - let map = `Custom map - end) + type nonrec 'a t = 'a t + + let return = const + + let map2 a b ~f = + let%sub a = a in + let%sub b = b in + let%arr a = a + and b = b in + f a b + ;; + + let map a ~f = + let%sub a = a in + let%arr a = a in + f a + ;; + + let map = `Custom map + end) module Mapn = struct let map2 = map2 diff --git a/src/proc_min.ml b/src/proc_min.ml index 120bd057..c4238325 100644 --- a/src/proc_min.ml +++ b/src/proc_min.ml @@ -34,11 +34,11 @@ let switch ~here ~match_ ~branches ~with_ = ;; let reset_to_default - ~default_model - ~inject_dynamic:_ - ~inject_static:_ - ~schedule_event:_ - _prev_model + ~default_model + ~inject_dynamic:_ + ~inject_static:_ + ~schedule_event:_ + _prev_model = default_model ;; @@ -59,13 +59,13 @@ module Edge = struct end let state_machine1_safe - ?(sexp_of_action = sexp_of_opaque) - ~sexp_of_model - ?reset - ~equal - ~default_model - ~apply_action - input + ?(sexp_of_action = sexp_of_opaque) + ~sexp_of_model + ?reset + ~equal + ~default_model + ~apply_action + input = let name = Source_code_position.to_string [%here] in let reset = @@ -73,8 +73,8 @@ let state_machine1_safe reset ~default_model ~f:(fun ~ignore_absurd reset ~inject_dynamic ~inject_static ~schedule_event -> - ignore_absurd inject_static; - reset (Apply_action_context.create ~inject:inject_dynamic ~schedule_event)) + ignore_absurd inject_static; + reset (Apply_action_context.create ~inject:inject_dynamic ~schedule_event)) in let apply_action ~inject_dynamic ~inject_static:_ ~schedule_event = apply_action (Apply_action_context.create ~inject:inject_dynamic ~schedule_event) @@ -102,13 +102,13 @@ module Computation_status = struct end let state_machine1 - ?sexp_of_action - ?reset - ?sexp_of_model - ?equal - ~default_model - ~apply_action - input + ?sexp_of_action + ?reset + ?sexp_of_model + ?equal + ~default_model + ~apply_action + input = let apply_action context input model action = let input = Computation_status.of_option input in @@ -125,13 +125,13 @@ let state_machine1 ;; let state_machine0 - ?reset - ?sexp_of_model - ?(sexp_of_action = sexp_of_opaque) - ?equal - ~default_model - ~apply_action - () + ?reset + ?sexp_of_model + ?(sexp_of_action = sexp_of_opaque) + ?equal + ~default_model + ~apply_action + () = let name = Source_code_position.to_string [%here] in let apply_action ~inject_dynamic:_ ~inject_static ~schedule_event = @@ -142,8 +142,8 @@ let state_machine0 reset ~default_model ~f:(fun ~ignore_absurd reset ~inject_dynamic ~inject_static ~schedule_event -> - ignore_absurd inject_dynamic; - reset (Apply_action_context.create ~inject:inject_static ~schedule_event)) + ignore_absurd inject_dynamic; + reset (Apply_action_context.create ~inject:inject_static ~schedule_event)) in Leaf0 { model = @@ -163,15 +163,15 @@ module Proc_incr = struct let compute_with_clock t ~f = Computation.Leaf_incr { input = t; compute = f } let of_module - (type input model result) - (module M : Component_s_incr - with type Input.t = input - and type Model.t = model - and type Result.t = result) - ?sexp_of_model - ~equal - ~(default_model : model) - (input : input Value.t) + (type input model result) + (module M : Component_s_incr + with type Input.t = input + and type Model.t = model + and type Result.t = result) + ?sexp_of_model + ~equal + ~(default_model : model) + (input : input Value.t) : result Computation.t = sub @@ -204,10 +204,10 @@ module Proc_incr = struct end let assoc - (type k v cmp) - (comparator : (k, cmp) comparator) - (map : (k, v, cmp) Map.t Value.t) - ~f + (type k v cmp) + (comparator : (k, cmp) comparator) + (map : (k, v, cmp) Map.t Value.t) + ~f = let module C = (val comparator) in let key_id : k Type_equal.Id.t = Type_equal.Id.create ~name:"key id" C.sexp_of_t in @@ -224,12 +224,12 @@ let assoc ;; let assoc_on - (type model_k io_k model_cmp io_cmp v) - (io_comparator : (io_k, io_cmp) comparator) - (model_comparator : (model_k, model_cmp) comparator) - (map : (io_k, v, io_cmp) Map.t Value.t) - ~get_model_key - ~f + (type model_k io_k model_cmp io_cmp v) + (io_comparator : (io_k, io_cmp) comparator) + (model_comparator : (model_k, model_cmp) comparator) + (map : (io_k, v, io_cmp) Map.t Value.t) + ~get_model_key + ~f = let module Io_comparator = (val io_comparator) in let module Model_comparator = (val model_comparator) in @@ -268,14 +268,14 @@ let assoc_on let lazy_ t = Lazy t let wrap - (type model action) - ?reset - ?sexp_of_model - ?equal - ~default_model - ~apply_action - ~f - () + (type model action) + ?reset + ?sexp_of_model + ?equal + ~default_model + ~apply_action + ~f + () = let model_id : model Type_equal.Id.t = Type_equal.Id.create ~name:"model id" [%sexp_of: opaque] @@ -285,8 +285,8 @@ let wrap reset ~default_model ~f:(fun ~ignore_absurd reset ~inject_dynamic ~inject_static ~schedule_event -> - ignore_absurd inject_static; - reset (Apply_action_context.create ~inject:inject_dynamic ~schedule_event)) + ignore_absurd inject_static; + reset (Apply_action_context.create ~inject:inject_dynamic ~schedule_event)) in let action_id = Meta.Action.of_module ~sexp_of_action:sexp_of_opaque ~name:"action id" diff --git a/src/proc_min.mli b/src/proc_min.mli index 0f7e75f6..c01cc291 100644 --- a/src/proc_min.mli +++ b/src/proc_min.mli @@ -26,9 +26,9 @@ module Proc_incr : sig val of_module : (module Component_s_incr - with type Input.t = 'input - and type Model.t = 'model - and type Result.t = 'result) + with type Input.t = 'input + and type Model.t = 'model + and type Result.t = 'result) -> ?sexp_of_model:('model -> Sexp.t) -> equal:('model -> 'model -> bool) -> default_model:'model diff --git a/src/skeleton.ml b/src/skeleton.ml index c19a92ba..f76a199e 100644 --- a/src/skeleton.ml +++ b/src/skeleton.ml @@ -9,10 +9,7 @@ module Id = struct include Int let of_type_id id = - id - |> Type_equal.Id.uid - |> Type_equal.Id.Uid.sexp_of_t - |> Int.t_of_sexp + id |> Type_equal.Id.uid |> Type_equal.Id.Uid.sexp_of_t |> Int.t_of_sexp ;; let of_model_type_id id = id |> Meta.Model.Type_id.to_type_id |> of_type_id diff --git a/src/to_dot.ml b/src/to_dot.ml index 8e00652c..d7a5e830 100644 --- a/src/to_dot.ml +++ b/src/to_dot.ml @@ -121,8 +121,8 @@ let register_const state shape id = ;; let rec follow_skeleton_value - state - { Skeleton.Value.kind = value; here; node_path = _; id } + state + { Skeleton.Value.kind = value; here; node_path = _; id } = let register s = register state (Kind.Value { kind = s; here }) s in let register_const = register_const state (Kind.Value { kind = "const"; here }) in diff --git a/src/transform.ml b/src/transform.ml index 5e703b09..24d89861 100644 --- a/src/transform.ml +++ b/src/transform.ml @@ -116,7 +116,7 @@ module For_computation = struct type 'from_parent user_mapper = { f : 'result. - 'from_parent context + 'from_parent context -> 'from_parent -> 'result Computation.t -> 'result Computation.t @@ -241,7 +241,7 @@ let map ~computation_mapper ~value_mapper ~init computation = (computation_mapper : _ user_mapper).f { recurse = (fun parent c -> - descend ~f:computation_mapper ~for_value:value_mapper ~append_to parent c) + descend ~f:computation_mapper ~for_value:value_mapper ~append_to parent c) ; var_from_parent = None ; parent_path = lazy (Node_path.finalize parent_path) ; current_path = lazy (Node_path.finalize current_path) diff --git a/src/transform.mli b/src/transform.mli index e2201e8d..4eecea36 100644 --- a/src/transform.mli +++ b/src/transform.mli @@ -1,16 +1,15 @@ open! Core open! Import - module Var_from_parent : sig type t = | None - (** The common case, in which the parent node does not introduce any variables. *) + (** The common case, in which the parent node does not introduce any variables. *) | One of Type_equal.Id.Uid.t - (** The case in which the parent node introduces one new variable; most of + (** The case in which the parent node introduces one new variable; most of the time this is for [Subst] or [Subst_stateless] *) | Two of Type_equal.Id.Uid.t * Type_equal.Id.Uid.t - (** The case in which the parent node introduces two new variables; most of + (** The case in which the parent node introduces two new variables; most of the time this is for [Assoc]. *) end @@ -66,7 +65,7 @@ module For_computation : sig type 'from_parent user_mapper = { f : 'result. - 'from_parent context + 'from_parent context -> 'from_parent -> 'result Computation.t -> 'result Computation.t diff --git a/src/value.ml b/src/value.ml index f3051544..7dc67e9e 100644 --- a/src/value.ml +++ b/src/value.ml @@ -158,8 +158,7 @@ let rec eval : type a. Environment.t -> a t -> a Incr.t = | Map4 _ | Map5 _ | Map6 _ - | Map7 _ -> - incremental_node + | Map7 _ -> incremental_node in Incremental.set_cutoff incremental_node (Incremental.Cutoff.of_equal equal); incremental_node @@ -214,12 +213,12 @@ let return_exn exn = { value = Exception exn; here = None; id = value_id "return let of_opt opt = Option.value_map opt ~default:(return None) ~f:(map ~f:Option.some) include Applicative.Make_using_map2 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return = return - let map2 = map2 - let map = `Custom map - end) + let return = return + let map2 = map2 + let map = `Custom map +end) let both a b = { value = Both (a, b); here = None; id = value_id "both" } diff --git a/test/driver.ml b/test/driver.ml index 08fa6fdf..a854e46f 100644 --- a/test/driver.ml +++ b/test/driver.ml @@ -8,11 +8,11 @@ type ('i, 'r) t = } let create - (type i r) - ?(optimize = true) - ~clock - ~(initial_input : i) - (component : (i, r) Bonsai.Arrow_deprecated.t) + (type i r) + ?(optimize = true) + ~clock + ~(initial_input : i) + (component : (i, r) Bonsai.Arrow_deprecated.t) : (i, r) t = let input_var, computation = diff --git a/test/driver.mli b/test/driver.mli index 04c99fd3..1dd2a602 100644 --- a/test/driver.mli +++ b/test/driver.mli @@ -21,7 +21,6 @@ val last_view : _ t -> string val store_view : _ t -> string -> unit val trigger_lifecycles : _ t -> unit val has_after_display_events : _ t -> bool - val sexp_of_model : _ t -> Sexp.t val input : ('i, _) t -> 'i val result_incr : (_, 'r) t -> 'r Incr.t diff --git a/test/helpers.ml b/test/helpers.ml index 95a06d55..211aabee 100644 --- a/test/helpers.ml +++ b/test/helpers.ml @@ -6,11 +6,11 @@ include Helpers_intf let sexp_to_string = Expect_test_helpers_core.sexp_to_string let make_generic - (type input action result s) - ~(driver : (input, s) Driver.t) - ~(string_of_result : result -> string) - ~(get_result : s -> result) - ~(schedule_action : s -> action -> unit) + (type input action result s) + ~(driver : (input, s) Driver.t) + ~(string_of_result : result -> string) + ~(get_result : s -> result) + ~(schedule_action : s -> action -> unit) : (module S with type input = input and type action = action) = (module struct @@ -57,7 +57,7 @@ let make_string_with_inject ~driver = ~string_of_result:Fn.id ~get_result:fst ~schedule_action:(fun (_, inject) action -> - Driver.schedule_event driver (inject action)) + Driver.schedule_event driver (inject action)) ;; let make_with_inject ~driver ~sexp_of_result = @@ -66,5 +66,5 @@ let make_with_inject ~driver ~sexp_of_result = ~string_of_result:(sexp_of_result >> sexp_to_string) ~get_result:fst ~schedule_action:(fun (_, inject) action -> - Driver.schedule_event driver (inject action)) + Driver.schedule_event driver (inject action)) ;; diff --git a/test/import.ml b/test/import.ml index d0de1418..c28a0741 100644 --- a/test/import.ml +++ b/test/import.ml @@ -5,10 +5,10 @@ module Effect = struct include Ui_effect module External = Define (struct - module Action = String + module Action = String - let handle str = printf "External event: %s\n" str - end) + let handle str = printf "External event: %s\n" str + end) let sequence l = Many l let no_op = Ignore diff --git a/test/path_test.ml b/test/path_test.ml index ed7c81cd..acba8c8f 100644 --- a/test/path_test.ml +++ b/test/path_test.ml @@ -46,8 +46,8 @@ let%test_unit "all the values are alpha" = String.quickcheck_generator ~sexp_of:[%sexp_of: string] ~f:(fun string -> - let path = Path.append Path.empty (Path.Elem.Assoc (keyed string)) in - assert_path_unique_id_is_alpha path) + let path = Path.append Path.empty (Path.Elem.Assoc (keyed string)) in + assert_path_unique_id_is_alpha path) ;; let%test_unit "larger groupings of paths behave" = @@ -74,8 +74,8 @@ let%test_unit "larger groupings of paths behave" = [%quickcheck.generator: P.t list] ~sexp_of:[%sexp_of: P.t list] ~f:(fun path -> - let path = - path |> List.map ~f:P.to_path_element |> List.fold ~init:Path.empty ~f:Path.append - in - assert_path_unique_id_is_alpha path) + let path = + path |> List.map ~f:P.to_path_element |> List.fold ~init:Path.empty ~f:Path.append + in + assert_path_unique_id_is_alpha path) ;; diff --git a/test/proc.ml b/test/proc.ml index 819e60b0..ba30ef44 100644 --- a/test/proc.ml +++ b/test/proc.ml @@ -70,11 +70,11 @@ module Handle = struct (unit, 'result * string * ('incoming -> unit Effect.t)) Driver.t let create - (type result incoming) - ?(start_time = Time_ns.epoch) - ~optimize - (result_spec : (result, incoming) Result_spec.t) - computation + (type result incoming) + ?(start_time = Time_ns.epoch) + ~optimize + (result_spec : (result, incoming) Result_spec.t) + computation = let (module R) = result_spec in let component (_ : unit Value.t) = @@ -117,20 +117,20 @@ module Handle = struct fun t -> let node_paths = ref Bonsai.Private.Node_path.Set.empty in let computation_map - (type result) - (context : _ Bonsai.Private.Transform.For_computation.context) - state - (computation : result Bonsai.Private.Computation.t) + (type result) + (context : _ Bonsai.Private.Transform.For_computation.context) + state + (computation : result Bonsai.Private.Computation.t) = node_paths := Set.add !node_paths (Lazy.force context.current_path); let out = context.recurse state computation in out in let value_map - (type a) - (context : _ Bonsai.Private.Transform.For_value.context) - state - (wrapped_value : a Bonsai.Private.Value.t) + (type a) + (context : _ Bonsai.Private.Transform.For_value.context) + state + (wrapped_value : a Bonsai.Private.Value.t) = node_paths := Set.add !node_paths (Lazy.force context.current_path); context.recurse state wrapped_value @@ -162,11 +162,11 @@ module Handle = struct ;; let create - (type result incoming) - ?start_time - ?(optimize = true) - (result_spec : (result, incoming) Result_spec.t) - computation + (type result incoming) + ?start_time + ?(optimize = true) + (result_spec : (result, incoming) Result_spec.t) + computation = (* [assert_node_paths_identical_between_transform_and_skeleton_nodepaths] is a useful function to verify that the skeleton code correctly generates node_path identifiers. @@ -224,9 +224,9 @@ module Handle = struct ;; let show_diff - ?(location_style = Patdiff_kernel.Format.Location_style.None) - ?(diff_context = 16) - handle + ?(location_style = Patdiff_kernel.Format.Location_style.None) + ?(diff_context = 16) + handle = generic_show handle diff --git a/test/proc.mli b/test/proc.mli index 09936dae..cc0ca727 100644 --- a/test/proc.mli +++ b/test/proc.mli @@ -99,9 +99,9 @@ module Handle : sig -> ('result, 'incoming) t val show_model : _ t -> unit - [@@alert - rampantly_nondeterministic - "This function exposes Bonsai internals that may change without warning"] + [@@alert + rampantly_nondeterministic + "This function exposes Bonsai internals that may change without warning"] val result_incr : ('r, 'i) t -> 'r Incr.t val lifecycle_incr : _ t -> Incr.Packed.t diff --git a/test/test_constant_fold.ml b/test/test_constant_fold.ml index 0f0074ba..b0d7dd24 100644 --- a/test/test_constant_fold.ml +++ b/test/test_constant_fold.ml @@ -590,8 +590,8 @@ let%expect_test "Static exception node on missing index of [Let_syntax.switch]." ~match_:(Value.return 1) ~branches:1 ~with_:(function - | 0 -> Bonsai.const "hi" - | _ -> assert false) + | 0 -> Bonsai.const "hi" + | _ -> assert false) in print_computation c; [%expect diff --git a/test/test_dot/src/test_instrumentation.ml b/test/test_dot/src/test_instrumentation.ml index fa0f98ed..f2d2a1f2 100644 --- a/test/test_dot/src/test_instrumentation.ml +++ b/test/test_dot/src/test_instrumentation.ml @@ -87,8 +87,8 @@ let instrument_computation component = Graph_info.iter_graph_updates (Bonsai.Private.reveal_computation component) ~on_update:(fun gm -> - graph_info := gm; - if !print_graph_info_on_update then print_graph_info !graph_info) + graph_info := gm; + if !print_graph_info_on_update then print_graph_info !graph_info) |> instrument_computation ~start_timer ~stop_timer |> Bonsai.Private.conceal_computation in @@ -994,14 +994,14 @@ let command = ; "name_used_twice", T name_used_twice ] |> Deferred.List.iter ~how:`Sequential ~f:(fun (name, T computation) -> - print_endline [%string "Processing %{name}"]; - write_computation_to_dot [%string "%{name}.dot"] (computation ()); - Sys_unix.command_exn [%string "dot -Tsvg %{name}.dot -o %{name}.svg"]; - let%bind () = Sys.remove [%string "%{name}.dot"] in - Writer.write - writer - [%string "# %{name}\n\n![](%{name}.svg \"Graph for %{name}\")\n\n"]; - Writer.flushed writer) + print_endline [%string "Processing %{name}"]; + write_computation_to_dot [%string "%{name}.dot"] (computation ()); + Sys_unix.command_exn [%string "dot -Tsvg %{name}.dot -o %{name}.svg"]; + let%bind () = Sys.remove [%string "%{name}.dot"] in + Writer.write + writer + [%string "# %{name}\n\n![](%{name}.svg \"Graph for %{name}\")\n\n"]; + Writer.flushed writer) in let%bind () = (* We have to special-case a bunch of code in order to force the diff --git a/test/test_effect_throttling.ml b/test/test_effect_throttling.ml index 4d0d022b..60849cac 100644 --- a/test/test_effect_throttling.ml +++ b/test/test_effect_throttling.ml @@ -21,10 +21,10 @@ let create_handle component = ;; module Common (M : sig - val poll - : ('a -> 'b Effect.t) Value.t - -> ('a -> 'b Bonsai.Effect_throttling.Poll_result.t Effect.t) Computation.t - end) = + val poll + : ('a -> 'b Effect.t) Value.t + -> ('a -> 'b Bonsai.Effect_throttling.Poll_result.t Effect.t) Computation.t +end) = struct let%expect_test {| Effect_throttling.poll only runs one instance of an effect at a time |} = @@ -103,23 +103,22 @@ struct end module _ = Common (struct - let poll = Bonsai.Effect_throttling.poll - end) + let poll = Bonsai.Effect_throttling.poll +end) module _ = Common (struct - let poll effect = - let open Bonsai.Let_syntax in - let%sub effect = Bonsai.Effect_throttling.poll effect in - let%sub effect = Bonsai.Effect_throttling.poll effect in - let%arr effect = effect in - fun int -> - match%map.Effect effect int with - | Aborted -> Bonsai.Effect_throttling.Poll_result.Aborted - | Finished (Finished result) -> Finished result - | Finished Aborted -> raise_s [%message "Unexpected finished of aborted"] - ;; - end) - + let poll effect = + let open Bonsai.Let_syntax in + let%sub effect = Bonsai.Effect_throttling.poll effect in + let%sub effect = Bonsai.Effect_throttling.poll effect in + let%arr effect = effect in + fun int -> + match%map.Effect effect int with + | Aborted -> Bonsai.Effect_throttling.Poll_result.Aborted + | Finished (Finished result) -> Finished result + | Finished Aborted -> raise_s [%message "Unexpected finished of aborted"] + ;; +end) let%expect_test {| Effect_throttling.poll deactivation |} = let qrt = Effect.For_testing.Query_response_tracker.create () in diff --git a/test/test_legacy_bonsai.ml b/test/test_legacy_bonsai.ml index 506fcc55..041c3388 100644 --- a/test/test_legacy_bonsai.ml +++ b/test/test_legacy_bonsai.ml @@ -125,7 +125,7 @@ let%expect_test "enum with action handling `Warn" = [%expect "counter 2"]; H.do_actions [ Outer Increment - (* The inner action is ignored. You can see this because it prints "counter 2" + (* The inner action is ignored. You can see this because it prints "counter 2" when it gets focus again. *) ; Inner Increment ]; @@ -144,10 +144,10 @@ let%expect_test "constant component" = ~component:(Bonsai.Arrow_deprecated.const "some constant value") ~initial_input:() ~f:(fun driver -> - [%expect {| |}]; - let (module H) = Helpers.make_string ~driver in - H.show (); - [%expect {| some constant value |}]) + [%expect {| |}]; + let (module H) = Helpers.make_string ~driver in + H.show (); + [%expect {| some constant value |}]) ;; let%expect_test "module component" = @@ -183,8 +183,8 @@ let%expect_test "state-machine counter-component" = dummy_source_code_position ~default_model:0 ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) () model -> function - | Increment -> model + 1 - | Decrement -> model - 1) + | Increment -> model + 1 + | Decrement -> model - 1) in Int.to_string model, inject in @@ -416,7 +416,7 @@ let%expect_test "input" = let apply_action (_ : _ Bonsai.Apply_action_context.t) _words model : Action.t -> Model.t = function - | Increment -> model + 1 + | Increment -> model + 1 ;; let compute ~inject words m = @@ -547,10 +547,10 @@ module _ = struct open Bonsai.Arrow_deprecated.Let_syntax let dummy - (type t) - (module M : Bonsai.Arrow_deprecated.Model with type t = t) - ~default - ~equal + (type t) + (module M : Bonsai.Arrow_deprecated.Model with type t = t) + ~default + ~equal = Bonsai.Arrow_deprecated.state_machine ~sexp_of_model:[%sexp_of: M.t] diff --git a/test/test_one_at_a_time.ml b/test/test_one_at_a_time.ml index 52bbd2f2..9bab07ad 100644 --- a/test/test_one_at_a_time.ml +++ b/test/test_one_at_a_time.ml @@ -192,4 +192,3 @@ let%expect_test {| One_at_a_time.effect releases lock after effect throws except Handle.show handle; [%expect {| Busy |}] ;; - diff --git a/test/test_proc_bonsai.ml b/test/test_proc_bonsai.ml index 09583717..84bbbf01 100644 --- a/test/test_proc_bonsai.ml +++ b/test/test_proc_bonsai.ml @@ -478,11 +478,11 @@ let%expect_test "assoc_on" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) input model new_model -> - match input with - | Active () -> new_model - | Inactive -> - print_endline "inactive"; - model) + match input with + | Active () -> new_model + | Inactive -> + print_endline "inactive"; + model) (opaque_const_value ())) in let handle = @@ -1145,11 +1145,11 @@ let%expect_test "dynamic action sent to non-existent assoc element" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) input model new_model -> - match input with - | Active () -> new_model - | Inactive -> - print_endline "inactive"; - model) + match input with + | Active () -> new_model + | Inactive -> + print_endline "inactive"; + model) (opaque_const_value ())) in let handle = @@ -1279,19 +1279,19 @@ let%test_module "inactive delivery" = let%expect_test "state_machine1 inactive-delivery" = (fun _ -> - Bonsai.state_machine1 - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~apply_action: - (fun - (_ : _ Bonsai.Apply_action_context.t) input _model new_model -> - (match input with - | Inactive -> print_endline "static action" - | Active () -> print_endline "dynamic action"); - new_model) - (Value.return ())) + Bonsai.state_machine1 + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~apply_action: + (fun + (_ : _ Bonsai.Apply_action_context.t) input _model new_model -> + (match input with + | Inactive -> print_endline "static action" + | Active () -> print_endline "dynamic action"); + new_model) + (Value.return ())) |> test_delivery_to_inactive_component; [%expect {| @@ -1309,19 +1309,19 @@ let%test_module "inactive delivery" = let%expect_test "race inactive-delivery (but an active input)" = (fun input -> - Bonsai.state_machine1 - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~apply_action: - (fun - (_ : _ Bonsai.Apply_action_context.t) input _model new_model -> - (match input with - | Inactive -> print_endline "static action" - | Active () -> print_endline "dynamic action"); - new_model) - input) + Bonsai.state_machine1 + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~apply_action: + (fun + (_ : _ Bonsai.Apply_action_context.t) input _model new_model -> + (match input with + | Inactive -> print_endline "static action" + | Active () -> print_endline "dynamic action"); + new_model) + input) |> test_delivery_to_inactive_component; [%expect {| @@ -1339,20 +1339,20 @@ let%test_module "inactive delivery" = let%expect_test "dynamic action inactive-delivery" = (fun _ -> - Bonsai.state_machine1 - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~apply_action: - (fun - (_ : _ Bonsai.Apply_action_context.t) input model new_model -> - match input with - | Active () -> new_model - | Inactive -> - print_endline "inactive"; - model) - (opaque_const_value ())) + Bonsai.state_machine1 + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~apply_action: + (fun + (_ : _ Bonsai.Apply_action_context.t) input model new_model -> + match input with + | Active () -> new_model + | Inactive -> + print_endline "inactive"; + model) + (opaque_const_value ())) |> test_delivery_to_inactive_component; [%expect {| @@ -1369,19 +1369,19 @@ let%test_module "inactive delivery" = let%expect_test "actor1 inactive-delivery" = (fun _ -> - Bonsai.actor1 - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~recv:(fun ~schedule_event:_ input model new_model -> - match input with - | Active () -> new_model, () - | Inactive -> - print_endline - "action sent to actor1 has been received while the input was inactive."; - model, ()) - (opaque_const_value ())) + Bonsai.actor1 + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~recv:(fun ~schedule_event:_ input model new_model -> + match input with + | Active () -> new_model, () + | Inactive -> + print_endline + "action sent to actor1 has been received while the input was inactive."; + model, ()) + (opaque_const_value ())) |> test_delivery_to_inactive_component; [%expect {| @@ -1419,13 +1419,13 @@ let%test_module "inactive delivery" = let%expect_test "actor0 inactive-delivery" = (fun _ -> - Bonsai.actor0 - () - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~recv:(fun ~schedule_event:_ _model new_model -> new_model, ())) + Bonsai.actor0 + () + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~recv:(fun ~schedule_event:_ _model new_model -> new_model, ())) |> test_delivery_to_inactive_component; [%expect {| @@ -1462,19 +1462,19 @@ let%test_module "inactive delivery" = let%expect_test "actor1 with constant input downgrades to actor0" = (fun _ -> - Bonsai.actor1 - ~sexp_of_model:[%sexp_of: Int.t] - ~equal:[%equal: Int.t] - ~sexp_of_action:[%sexp_of: Int.t] - ~default_model:0 - ~recv:(fun ~schedule_event:_ input model new_model -> - match input with - | Active () -> new_model, () - | Inactive -> - print_endline - "action sent to actor1 has been received while the input was inactive."; - model, ()) - (Value.return ())) + Bonsai.actor1 + ~sexp_of_model:[%sexp_of: Int.t] + ~equal:[%equal: Int.t] + ~sexp_of_action:[%sexp_of: Int.t] + ~default_model:0 + ~recv:(fun ~schedule_event:_ input model new_model -> + match input with + | Active () -> new_model, () + | Inactive -> + print_endline + "action sent to actor1 has been received while the input was inactive."; + model, ()) + (Value.return ())) |> test_delivery_to_inactive_component; [%expect {| @@ -1526,10 +1526,10 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a lazy" = (fun _ -> - opaque_computation - ((Bonsai.lazy_ [@alert "-deprecated"]) - (lazy - (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])))) + opaque_computation + ((Bonsai.lazy_ [@alert "-deprecated"]) + (lazy + (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])))) |> test_delivery_to_inactive_component; [%expect {| @@ -1551,8 +1551,8 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a lazy (optimized away)" = (fun _ -> - (Bonsai.lazy_ [@alert "-deprecated"]) - (lazy (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]))) + (Bonsai.lazy_ [@alert "-deprecated"]) + (lazy (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]))) |> test_delivery_to_inactive_component; [%expect {| @@ -1568,12 +1568,12 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a fix" = (fun _ -> - opaque_computation - (Bonsai.fix (opaque_const_value true) ~f:(fun ~recurse v -> - match%sub v with - | true -> recurse (opaque_const_value false) - | false -> - Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]))) + opaque_computation + (Bonsai.fix (opaque_const_value true) ~f:(fun ~recurse v -> + match%sub v with + | true -> recurse (opaque_const_value false) + | false -> + Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]))) |> test_delivery_to_inactive_component; [%expect {| @@ -1603,11 +1603,11 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a fix (optimized away)" = (fun _ -> - Bonsai.fix (Value.return true) ~f:(fun ~recurse v -> - match%sub v with - | true -> recurse (Value.return false) - | false -> - Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])) + Bonsai.fix (Value.return true) ~f:(fun ~recurse v -> + match%sub v with + | true -> recurse (Value.return false) + | false -> + Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])) |> test_delivery_to_inactive_component; [%expect {| @@ -1623,14 +1623,14 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a wrap" = (fun _ -> - Bonsai.wrap - () - ~sexp_of_model:[%sexp_of: Unit.t] - ~equal:[%equal: Unit.t] - ~default_model:() - ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) _ () () -> ()) - ~f:(fun _model _inject -> - Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])) + Bonsai.wrap + () + ~sexp_of_model:[%sexp_of: Unit.t] + ~equal:[%equal: Unit.t] + ~default_model:() + ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) _ () () -> ()) + ~f:(fun _model _inject -> + Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t])) |> test_delivery_to_inactive_component; [%expect {| @@ -1649,8 +1649,8 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a match%sub" = (fun _ -> - match%sub opaque_const_value () with - | () -> Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]) + match%sub opaque_const_value () with + | () -> Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]) |> test_delivery_to_inactive_component; [%expect {| @@ -1673,11 +1673,11 @@ let%test_module "inactive delivery" = let%expect_test "static inside of a with_model_resetter" = (fun _ -> - let%sub r, _reset = - Bonsai.with_model_resetter - (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]) - in - return r) + let%sub r, _reset = + Bonsai.with_model_resetter + (Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t]) + in + return r) |> test_delivery_to_inactive_component; [%expect {| @@ -1877,7 +1877,7 @@ let%test_module "inactive delivery" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) model is_increment -> - if is_increment then model + 1 else 999) + if is_increment then model + 1 else 999) ~reset:(fun context model -> Bonsai.Apply_action_context.schedule_event context @@ -1912,11 +1912,11 @@ let%test_module "inactive delivery" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) input model is_increment -> - match input with - | Active () -> if is_increment then model + 1 else 999 - | Inactive -> - print_endline "inactive"; - model) + match input with + | Active () -> if is_increment then model + 1 else 999 + | Inactive -> + print_endline "inactive"; + model) ~reset:(fun context model -> Bonsai.Apply_action_context.schedule_event context @@ -2068,8 +2068,8 @@ let%test_module "inactive delivery" = ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t] ~reset:(fun _ -> - print_endline "resetting"; - 999)) + print_endline "resetting"; + 999)) in let%arr map = map in let res = Map.to_alist map |> List.map ~f:(fun (k, (v, _)) -> k, v) in @@ -2146,7 +2146,7 @@ let%test_module "inactive delivery" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) _ model is_increment -> - if is_increment then model + 1 else 999) + if is_increment then model + 1 else 999) ~reset:(fun context model -> Bonsai.Apply_action_context.schedule_event context @@ -2188,7 +2188,7 @@ let%test_module "inactive delivery" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) model is_increment -> - if is_increment then model + 1 else 999) + if is_increment then model + 1 else 999) ~reset:(fun context model -> Bonsai.Apply_action_context.schedule_event context @@ -2225,8 +2225,8 @@ let%test_module "inactive delivery" = ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t] ~reset:(fun _ -> - print_endline "resetting"; - 999)) + print_endline "resetting"; + 999)) in let%arr map = map in let res = Map.to_alist map |> List.map ~f:(fun (k, (v, _)) -> k, v) in @@ -2274,11 +2274,11 @@ let%test_module "inactive delivery" = ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) input model new_model -> - match input with - | Active () -> new_model - | Inactive -> - print_endline "inactive"; - model) + match input with + | Active () -> new_model + | Inactive -> + print_endline "inactive"; + model) (opaque_const_value ())) in let handle = @@ -2452,15 +2452,15 @@ let%expect_test "let syntax is collapsed upon eval" = let open Bonsai.Private in let computation = reveal_computation computation in let (T - { model - ; input = _ - ; apply_static = _ - ; apply_dynamic = _ - ; static_action - ; dynamic_action - ; run - ; reset = _ - }) + { model + ; input = _ + ; apply_static = _ + ; apply_dynamic = _ + ; static_action + ; dynamic_action + ; run + ; reset = _ + }) = computation |> pre_process |> gather in @@ -2947,11 +2947,11 @@ let%test_module "Clock.every" = ;; let create_clock_handle - ~start - ~svar - ~when_to_start_next_effect - ~trigger_on_activate - ~span + ~start + ~svar + ~when_to_start_next_effect + ~trigger_on_activate + ~span = let action = Value.return @@ -3599,77 +3599,77 @@ let%test_module "Clock.every" = ; `Every_multiple_of_period_non_blocking ] ~f:(fun when_to_start_next_effect -> - let component = - let%sub state, set_state = - Bonsai.state - true - ~sexp_of_model:[%sexp_of: Bool.t] - ~equal:[%equal: Bool.t] - in - match%sub state with - | true -> - let%sub () = - Bonsai.Clock.every - ~when_to_start_next_effect - ~trigger_on_activate:false - (Time_ns.Span.of_sec 3.0) - (let%map set_state = set_state in - let%bind.Effect () = - (Effect.of_sync_fun (fun () -> - print_endline "[tick tock] - (state := false)")) - () - in - let%bind.Effect () = set_state false in - print_sanitized_dropped_action_if_needed ()) - in - Bonsai.const true - | false -> - let%sub () = - Bonsai.Edge.after_display - (let%map set_state = set_state in - let%bind.Effect () = - (Effect.of_sync_fun (fun () -> print_endline "(state := true)")) () - in - let%bind.Effect () = set_state true in - print_sanitized_dropped_action_if_needed ()) - in - Bonsai.const false - in - let start = Time_ns.of_span_since_epoch (Time_ns.Span.of_min 1.0) in - let handle = - Handle.create (Result_spec.sexp (module Bool)) ~start_time:start component + let component = + let%sub state, set_state = + Bonsai.state + true + ~sexp_of_model:[%sexp_of: Bool.t] + ~equal:[%equal: Bool.t] in - let move_forward_and_show = move_forward_and_show ~handle in - Handle.show handle; - [%expect {| true |}]; - move_forward_and_show 3.0; - [%expect - {| + match%sub state with + | true -> + let%sub () = + Bonsai.Clock.every + ~when_to_start_next_effect + ~trigger_on_activate:false + (Time_ns.Span.of_sec 3.0) + (let%map set_state = set_state in + let%bind.Effect () = + (Effect.of_sync_fun (fun () -> + print_endline "[tick tock] - (state := false)")) + () + in + let%bind.Effect () = set_state false in + print_sanitized_dropped_action_if_needed ()) + in + Bonsai.const true + | false -> + let%sub () = + Bonsai.Edge.after_display + (let%map set_state = set_state in + let%bind.Effect () = + (Effect.of_sync_fun (fun () -> print_endline "(state := true)")) () + in + let%bind.Effect () = set_state true in + print_sanitized_dropped_action_if_needed ()) + in + Bonsai.const false + in + let start = Time_ns.of_span_since_epoch (Time_ns.Span.of_min 1.0) in + let handle = + Handle.create (Result_spec.sexp (module Bool)) ~start_time:start component + in + let move_forward_and_show = move_forward_and_show ~handle in + Handle.show handle; + [%expect {| true |}]; + move_forward_and_show 3.0; + [%expect + {| [Whoops! An action was dropped!] after paint: 00:01:03.000000000Z |}]; - Handle.show handle; - [%expect {| true |}]; - move_forward_and_show 3.0; - [%expect - {| + Handle.show handle; + [%expect {| true |}]; + move_forward_and_show 3.0; + [%expect + {| [Whoops! An action was dropped!] after paint: 00:01:06.000000000Z |}]; - Handle.show handle; - [%expect {| true |}]; - move_forward_and_show 3.0; - [%expect - {| + Handle.show handle; + [%expect {| true |}]; + move_forward_and_show 3.0; + [%expect + {| [Whoops! An action was dropped!] after paint: 00:01:09.000000000Z |}]; - Handle.show handle; - [%expect {| true |}]; - move_forward_and_show 3.0; - [%expect - {| + Handle.show handle; + [%expect {| true |}]; + move_forward_and_show 3.0; + [%expect + {| [Whoops! An action was dropped!] after paint: 00:01:12.000000000Z |}]; - Handle.show handle; - [%expect {| true |}]) + Handle.show handle; + [%expect {| true |}]) ;; end) ;; @@ -3684,53 +3684,53 @@ let%test_module "Clock.every" = ; `Every_multiple_of_period_non_blocking ] ~f:(fun when_to_start_next_effect -> - let svar = ref (Effect.For_testing.Svar.create ()) in - let handle = - create_clock_handle - ~trigger_on_activate:false - ~start:0.0 - ~svar - ~when_to_start_next_effect - ~span:0.01 - in - let move_forward_and_show = move_forward_and_show ~handle in - Handle.show handle; - [%expect {| () |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + let svar = ref (Effect.For_testing.Svar.create ()) in + let handle = + create_clock_handle + ~trigger_on_activate:false + ~start:0.0 + ~svar + ~when_to_start_next_effect + ~span:0.01 + in + let move_forward_and_show = move_forward_and_show ~handle in + Handle.show handle; + [%expect {| () |}]; + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:00.000000000Z after: 00:00:00.010000000Z [tick] - effect started [tock] - effect ended after paint: 00:00:00.010000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:00.010000000Z after: 00:00:00.020000000Z [tick] - effect started [tock] - effect ended after paint: 00:00:00.020000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:00.020000000Z after: 00:00:00.030000000Z [tick] - effect started [tock] - effect ended after paint: 00:00:00.030000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:00.030000000Z after: 00:00:00.040000000Z [tick] - effect started @@ -3746,70 +3746,70 @@ let%test_module "Clock.every" = ; `Every_multiple_of_period_non_blocking ] ~f:(fun when_to_start_next_effect -> - let svar = ref (Effect.For_testing.Svar.create ()) in - let handle = - create_clock_handle - ~trigger_on_activate:false - ~start:0.0 - ~svar - ~when_to_start_next_effect - ~span:0.01 - in - let move_forward_and_show ?(after_show = Fn.const ()) ~handle span = - printf "before: "; - print_time handle; - Handle.advance_clock_by handle (Time_ns.Span.of_sec span); - printf "after: "; - print_time handle; - Handle.show handle; - (* Advancing the clock by one second (many time the clock's time span) before recomputing. *) - Handle.advance_clock_by handle (Time_ns.Span.of_sec 1.0); - Handle.recompute_view handle; - after_show (); - printf "after paint: "; - print_time handle - in - let move_forward_and_show = move_forward_and_show ~handle in + let svar = ref (Effect.For_testing.Svar.create ()) in + let handle = + create_clock_handle + ~trigger_on_activate:false + ~start:0.0 + ~svar + ~when_to_start_next_effect + ~span:0.01 + in + let move_forward_and_show ?(after_show = Fn.const ()) ~handle span = + printf "before: "; + print_time handle; + Handle.advance_clock_by handle (Time_ns.Span.of_sec span); + printf "after: "; + print_time handle; Handle.show handle; - [%expect {| () |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + (* Advancing the clock by one second (many time the clock's time span) before recomputing. *) + Handle.advance_clock_by handle (Time_ns.Span.of_sec 1.0); + Handle.recompute_view handle; + after_show (); + printf "after paint: "; + print_time handle + in + let move_forward_and_show = move_forward_and_show ~handle in + Handle.show handle; + [%expect {| () |}]; + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:00.000000000Z after: 00:00:00.010000000Z () [tick] - effect started [tock] - effect ended after paint: 00:00:01.010000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:01.010000000Z after: 00:00:01.020000000Z () [tick] - effect started [tock] - effect ended after paint: 00:00:02.020000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:02.020000000Z after: 00:00:02.030000000Z () [tick] - effect started [tock] - effect ended after paint: 00:00:03.030000000Z |}]; - move_forward_and_show - ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) - 0.01; - [%expect - {| + move_forward_and_show + ~after_show:(fun () -> advance_and_clear_svar ~handle ~svar 0.) + 0.01; + [%expect + {| before: 00:00:03.030000000Z after: 00:00:03.040000000Z () @@ -5038,22 +5038,22 @@ let%expect_test "with_self_effect" = ~sexp_of_model:[%sexp_of: Result_spec.t] ~equal:[%equal: Result_spec.t] ~f:(fun input -> - let%sub state = - Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t] - in - let%arr number, set_number = state - and input = input in - let effect action = - match action with - | Result_spec.Print -> - (match%bind.Effect input with - | Active (computed, (_ : Result_spec.action -> unit Effect.t)) -> - Effect.print_s [%message "Active" (computed : string)] - | Inactive -> Effect.print_s [%message "Inactive"]) - | Set i -> set_number i - in - let computed = sprintf "the value: [%d]" number in - computed, effect) + let%sub state = + Bonsai.state 0 ~sexp_of_model:[%sexp_of: Int.t] ~equal:[%equal: Int.t] + in + let%arr number, set_number = state + and input = input in + let effect action = + match action with + | Result_spec.Print -> + (match%bind.Effect input with + | Active (computed, (_ : Result_spec.action -> unit Effect.t)) -> + Effect.print_s [%message "Active" (computed : string)] + | Inactive -> Effect.print_s [%message "Inactive"]) + | Set i -> set_number i + in + let computed = sprintf "the value: [%d]" number in + computed, effect) in let handle = Handle.create (module Result_spec) component in Handle.show handle; @@ -5084,9 +5084,9 @@ let%expect_test "state_machine_dynamic_model" = (module String) ~model: (`Computed - (Bonsai.Value.return (function - | None -> "not set " - | Some s -> sprintf "set %s" s))) + (Bonsai.Value.return (function + | None -> "not set " + | Some s -> sprintf "set %s" s))) ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) _model action -> action) in let handle = @@ -5582,14 +5582,14 @@ let%test_module "mirror" = let interactive = Bonsai.Var.create interactive in let store_set = (fun value -> - printf "store set to \"%s\"" value; - Bonsai.Var.set store value) + printf "store set to \"%s\"" value; + Bonsai.Var.set store value) |> Ui_effect.of_sync_fun in let interactive_set = (fun value -> - printf "interactive set to \"%s\"" value; - Bonsai.Var.set interactive value) + printf "interactive set to \"%s\"" value; + Bonsai.Var.set interactive value) |> Ui_effect.of_sync_fun in let component = @@ -5677,14 +5677,14 @@ let%test_module "mirror'" = let interactive = Bonsai.Var.create interactive in let store_set = (fun value -> - printf "store set to \"%s\"" value; - Bonsai.Var.set store (Some value)) + printf "store set to \"%s\"" value; + Bonsai.Var.set store (Some value)) |> Ui_effect.of_sync_fun in let interactive_set = (fun value -> - printf "interactive set to \"%s\"" value; - Bonsai.Var.set interactive (Some value)) + printf "interactive set to \"%s\"" value; + Bonsai.Var.set interactive (Some value)) |> Ui_effect.of_sync_fun in let component = @@ -6262,13 +6262,13 @@ let%expect_test "State machine actions that are scheduled while running the acti ~sexp_of_action:[%sexp_of: Int.t] ~default_model:() ~apply_action:(fun context () n -> - print_s [%message (n : int)]; - if n <= 0 - then () - else - Bonsai.Apply_action_context.schedule_event - context - (Bonsai.Apply_action_context.inject context (n - 1))) + print_s [%message (n : int)]; + if n <= 0 + then () + else + Bonsai.Apply_action_context.schedule_event + context + (Bonsai.Apply_action_context.inject context (n - 1))) in let handle = Handle.create diff --git a/test/test_value_stability.ml b/test/test_value_stability.ml index fa56b024..a03720bb 100644 --- a/test/test_value_stability.ml +++ b/test/test_value_stability.ml @@ -25,13 +25,13 @@ let advance_by_sec handle seconds = let%test_module "Bonsai_extra.with_last_modified_time" = (module struct module Common (M : sig - val with_last_modified_time - : equal:('a -> 'a -> bool) - -> 'a Value.t - -> ('a * Time_ns.t) Computation.t + val with_last_modified_time + : equal:('a -> 'a -> bool) + -> 'a Value.t + -> ('a * Time_ns.t) Computation.t - val show_handle : ('a, 'b) Handle.t -> unit - end) = + val show_handle : ('a, 'b) Handle.t -> unit + end) = struct let show = M.show_handle @@ -114,41 +114,41 @@ let%test_module "Bonsai_extra.with_last_modified_time" = end module _ = Common (struct - let with_last_modified_time = Bonsai_extra.with_last_modified_time - let show_handle = Handle.show - end) + let with_last_modified_time = Bonsai_extra.with_last_modified_time + let show_handle = Handle.show + end) module _ = Common (struct - let with_last_modified_time = Bonsai_extra.with_last_modified_time + let with_last_modified_time = Bonsai_extra.with_last_modified_time - let show_handle handle = - Handle.recompute_view handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view handle; + Handle.show handle + ;; + end) module _ = Common (struct - let with_last_modified_time = Bonsai_extra.with_last_modified_time + let with_last_modified_time = Bonsai_extra.with_last_modified_time - let show_handle handle = - Handle.recompute_view_until_stable handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view_until_stable handle; + Handle.show handle + ;; + end) end) ;; let%test_module "Bonsai_extra.is_stable" = (module struct module Common (M : sig - val is_stable - : equal:('a -> 'a -> bool) - -> 'a Value.t - -> time_to_stable:Time_ns.Span.t - -> bool Computation.t - - val show_handle : ('a, 'b) Handle.t -> unit - end) = + val is_stable + : equal:('a -> 'a -> bool) + -> 'a Value.t + -> time_to_stable:Time_ns.Span.t + -> bool Computation.t + + val show_handle : ('a, 'b) Handle.t -> unit + end) = struct let show = M.show_handle @@ -300,42 +300,42 @@ let%test_module "Bonsai_extra.is_stable" = end module _ = Common (struct - let is_stable = Bonsai_extra.is_stable - let show_handle = Handle.show - end) + let is_stable = Bonsai_extra.is_stable + let show_handle = Handle.show + end) module _ = Common (struct - let is_stable = Bonsai_extra.is_stable + let is_stable = Bonsai_extra.is_stable - let show_handle handle = - Handle.recompute_view handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view handle; + Handle.show handle + ;; + end) module _ = Common (struct - let is_stable = Bonsai_extra.is_stable + let is_stable = Bonsai_extra.is_stable - let show_handle handle = - Handle.recompute_view_until_stable handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view_until_stable handle; + Handle.show handle + ;; + end) end) ;; let%test_module "Bonsai.most_recent_value_satisfying" = (module struct module Common (M : sig - val most_recent_value_satisfying - : ?sexp_of_model:('a -> Sexp.t) - -> equal:('a -> 'a -> bool) - -> 'a Value.t - -> condition:('a -> bool) - -> 'a option Computation.t - - val show_handle : ('a, 'b) Handle.t -> unit - end) = + val most_recent_value_satisfying + : ?sexp_of_model:('a -> Sexp.t) + -> equal:('a -> 'a -> bool) + -> 'a Value.t + -> condition:('a -> bool) + -> 'a option Computation.t + + val show_handle : ('a, 'b) Handle.t -> unit + end) = struct let show = M.show_handle @@ -415,38 +415,38 @@ let%test_module "Bonsai.most_recent_value_satisfying" = end module _ = Common (struct - let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying - let show_handle = Handle.show - end) + let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying + let show_handle = Handle.show + end) module _ = Common (struct - let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying + let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying - let show_handle handle = - Handle.recompute_view handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view handle; + Handle.show handle + ;; + end) module _ = Common (struct - let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying + let most_recent_value_satisfying = Bonsai.most_recent_value_satisfying - let show_handle handle = - Handle.recompute_view_until_stable handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view_until_stable handle; + Handle.show handle + ;; + end) end) ;; let%test_module "Bonsai_extra.value_stability" = (module struct let alternate_value_stability_implementation - (type a) - ?sexp_of_model - ~equal - input - ~time_to_stable + (type a) + ?sexp_of_model + ~equal + input + ~time_to_stable = let module M = struct type t = a @@ -512,54 +512,54 @@ let%test_module "Bonsai_extra.value_stability" = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Model.default ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model action -> - match action, model with - | Deactivate, { stability; _ } -> - let stability = - match stability with - | Inactive _ -> stability - | Unstable { previously_stable; _ } -> Inactive { previously_stable } - | Stable stable -> Inactive { previously_stable = Some stable } - in - (* Deactivating this component will automatically cause the value to be + match action, model with + | Deactivate, { stability; _ } -> + let stability = + match stability with + | Inactive _ -> stability + | Unstable { previously_stable; _ } -> Inactive { previously_stable } + | Stable stable -> Inactive { previously_stable = Some stable } + in + (* Deactivating this component will automatically cause the value to be considered unstable. This is because we have no way to tell what is happening to the value when this component is inactive, and I consider it safer to assume instability than to assume stability. *) - { stability; time_to_next_stable = None } - | Bounce (new_value, now), { stability; _ } -> - (* Bouncing will cause the value to become unstable, and set the + { stability; time_to_next_stable = None } + | Bounce (new_value, now), { stability; _ } -> + (* Bouncing will cause the value to become unstable, and set the time-to-next-stable to the provided value. *) - let stability = Model.set_value new_value stability in - let time_to_next_stable = Some (Time_ns.add now time_to_stable) in - { stability; time_to_next_stable } - | Set_stable (stable, now), { stability; time_to_next_stable } -> - (* Sets the value which is considered to be stable and resets + let stability = Model.set_value new_value stability in + let time_to_next_stable = Some (Time_ns.add now time_to_stable) in + { stability; time_to_next_stable } + | Set_stable (stable, now), { stability; time_to_next_stable } -> + (* Sets the value which is considered to be stable and resets the time until next stability. *) - (match stability with - | Inactive { previously_stable } -> - { stability = Unstable { previously_stable; unstable_value = stable } + (match stability with + | Inactive { previously_stable } -> + { stability = Unstable { previously_stable; unstable_value = stable } + ; time_to_next_stable = Some (Time_ns.add now time_to_stable) + } + | Stable previously_stable -> + if equal previously_stable stable + then { stability = Stable stable; time_to_next_stable = None } + else + { stability = + Unstable + { unstable_value = stable + ; previously_stable = Some previously_stable + } ; time_to_next_stable = Some (Time_ns.add now time_to_stable) } - | Stable previously_stable -> - if equal previously_stable stable - then { stability = Stable stable; time_to_next_stable = None } - else - { stability = - Unstable - { unstable_value = stable - ; previously_stable = Some previously_stable - } - ; time_to_next_stable = Some (Time_ns.add now time_to_stable) - } - | Unstable { unstable_value; previously_stable } -> - let candidate_time_to_next_stable = Time_ns.add now time_to_stable in - (match equal unstable_value stable, time_to_next_stable with - | true, Some time_to_next_stable - when Time_ns.( >= ) now time_to_next_stable -> - { stability = Stable stable; time_to_next_stable = None } - | _ -> - { stability = Unstable { unstable_value = stable; previously_stable } - ; time_to_next_stable = Some candidate_time_to_next_stable - }))) + | Unstable { unstable_value; previously_stable } -> + let candidate_time_to_next_stable = Time_ns.add now time_to_stable in + (match equal unstable_value stable, time_to_next_stable with + | true, Some time_to_next_stable + when Time_ns.( >= ) now time_to_next_stable -> + { stability = Stable stable; time_to_next_stable = None } + | _ -> + { stability = Unstable { unstable_value = stable; previously_stable } + ; time_to_next_stable = Some candidate_time_to_next_stable + }))) in let%sub get_current_time = Bonsai.Clock.get_current_time in let%sub bounce = @@ -598,7 +598,7 @@ let%test_module "Bonsai_extra.value_stability" = and get_current_time = get_current_time and bounce = bounce in fun (prev : Bonsai.Clock.Before_or_after.t option) - (cur : Bonsai.Clock.Before_or_after.t) -> + (cur : Bonsai.Clock.Before_or_after.t) -> match prev, cur with | Some Before, After -> let%bind.Effect now = get_current_time in @@ -630,15 +630,15 @@ let%test_module "Bonsai_extra.value_stability" = ;; module Common (M : sig - val value_stability - : ?sexp_of_model:('a -> Sexp.t) - -> equal:('a -> 'a -> bool) - -> 'a Value.t - -> time_to_stable:Time_ns.Span.t - -> 'a Bonsai_extra.Stability.t Computation.t - - val show_handle : ('a, 'b) Handle.t -> unit - end) = + val value_stability + : ?sexp_of_model:('a -> Sexp.t) + -> equal:('a -> 'a -> bool) + -> 'a Value.t + -> time_to_stable:Time_ns.Span.t + -> 'a Bonsai_extra.Stability.t Computation.t + + val show_handle : ('a, 'b) Handle.t -> unit + end) = struct let show = M.show_handle @@ -742,7 +742,7 @@ let%test_module "Bonsai_extra.value_stability" = end module _ = Common (struct - (* The function reference below is an implementation that exists purely + (* The function reference below is an implementation that exists purely as a sanity check for the real implementation. If two vastly different implemenations always yield the same result, that's an encouraging sign. Sadly, this implementation relies on having a @@ -751,35 +751,35 @@ let%test_module "Bonsai_extra.value_stability" = (This downside is one reason why this is not the real implementation.) *) - let value_stability = alternate_value_stability_implementation + let value_stability = alternate_value_stability_implementation - let show_handle handle = - Handle.recompute_view_until_stable handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view_until_stable handle; + Handle.show handle + ;; + end) module _ = Common (struct - let value_stability = Bonsai_extra.value_stability - let show_handle = Handle.show - end) + let value_stability = Bonsai_extra.value_stability + let show_handle = Handle.show + end) module _ = Common (struct - let value_stability = Bonsai_extra.value_stability + let value_stability = Bonsai_extra.value_stability - let show_handle handle = - Handle.recompute_view handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view handle; + Handle.show handle + ;; + end) module _ = Common (struct - let value_stability = Bonsai_extra.value_stability + let value_stability = Bonsai_extra.value_stability - let show_handle handle = - Handle.recompute_view_until_stable handle; - Handle.show handle - ;; - end) + let show_handle handle = + Handle.recompute_view_until_stable handle; + Handle.show handle + ;; + end) end) ;; diff --git a/uri_parsing/src/uri_parsing.ml b/uri_parsing/src/uri_parsing.ml index f70a5509..6d5db7b9 100644 --- a/uri_parsing/src/uri_parsing.ml +++ b/uri_parsing/src/uri_parsing.ml @@ -100,8 +100,8 @@ module Value_parser = struct let input = eval input in { parse_exn = (fun x -> - try input.parse_exn x with - | _ -> fallback) + try input.parse_exn x with + | _ -> fallback) ; unparse = input.unparse } | Name { name = _; input } -> eval input @@ -269,8 +269,8 @@ module Components = struct |> Uri.query |> String.Map.of_alist_multi |> Map.filter_map ~f:(function - | [ value ] -> Some value - | _ -> None) + | [ value ] -> Some value + | _ -> None) in { path; query } ;; @@ -462,7 +462,7 @@ module Parser = struct -> [ `Prefix of [ `Ignore | `Match of string ] list | `Remaining_path of [ `Ignore | `Match of string ] list ] - option + option = fun t -> let rec next_declared_path_pattern @@ -470,8 +470,8 @@ module Parser = struct prefix:[ `Ignore | `Match of string ] list -> a T.t -> ([ `Ignore | `Match of string ] list - * [ `Continue | `Stop_prefix | `Stop_remaining_path ]) - option + * [ `Continue | `Stop_prefix | `Stop_remaining_path ]) + option = fun ~prefix t -> match t with @@ -548,8 +548,8 @@ module Parser = struct { prefix = (Tuple2.get1 (pattern_for_variant f)).pattern |> List.filter_map ~f:(function - | `Match x -> Some x - | _ -> None) + | `Match x -> Some x + | _ -> None) ; t = out } ;; @@ -587,10 +587,10 @@ module Parser = struct end let make - (type a) - ?namespace - (module M : S with type Typed_variant.derived_on = a) - ~key + (type a) + ?namespace + (module M : S with type Typed_variant.derived_on = a) + ~key = let module Parser_map = Typed_field_map.Make (M.Typed_variant) (T) in let parsers_by_variant = Parser_map.create { f = M.parser_for_variant } in @@ -680,7 +680,7 @@ module Parser = struct | Query_based_variant { variant_module; _ } -> let module M = (val variant_module - : Query_based_variant.S with type Typed_variant.derived_on = a) + : Query_based_variant.S with type Typed_variant.derived_on = a) in List.exists M.Typed_variant.Packed.all ~f:(fun { f = T v } -> needs_to_appear_on_path_order (M.parser_for_variant v)) @@ -724,19 +724,19 @@ module Parser = struct ;; let namespace_for_record_field - ~current_namespace - ~override_namespace - ~parent_namespace + ~current_namespace + ~override_namespace + ~parent_namespace = current_namespace @ Option.value override_namespace ~default:parent_namespace ;; let eval_from_query_required - (type a) - ~override_key - ~(value_parser : a Value_parser.t) - ~current_namespace - ~inferred_name_from_parent + (type a) + ~override_key + ~(value_parser : a Value_parser.t) + ~current_namespace + ~inferred_name_from_parent = let value_projection = Value_parser.eval value_parser in let parse_exn (components : Components.t) = @@ -745,18 +745,18 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let value_to_parse, remaining = - if_field_is_present_in_query - ~query:components.query - ~key_name - ~f:(fun values -> - raise_if_empty values; - let remaining_query = Map.remove components.query key_name in - let remaining = { components with query = remaining_query } in - List.hd_exn values, remaining) - in - let result = value_projection.parse_exn value_to_parse in - { Parse_result.result; remaining }) + let value_to_parse, remaining = + if_field_is_present_in_query + ~query:components.query + ~key_name + ~f:(fun values -> + raise_if_empty values; + let remaining_query = Map.remove components.query key_name in + let remaining = { components with query = remaining_query } in + List.hd_exn values, remaining) + in + let result = value_projection.parse_exn value_to_parse in + { Parse_result.result; remaining }) in let unparse (result : a Parse_result.t) = read_query_key @@ -764,21 +764,21 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let query = - let unparse_result = value_projection.unparse result.result in - Map.set result.remaining.query ~key:key_name ~data:[ unparse_result ] - in - { result.remaining with query }) + let query = + let unparse_result = value_projection.unparse result.result in + Map.set result.remaining.query ~key:key_name ~data:[ unparse_result ] + in + { result.remaining with query }) in { Projection.parse_exn; unparse } ;; let eval_from_query_optional - (type a) - ~override_key - ~(value_parser : a Value_parser.t) - ~current_namespace - ~inferred_name_from_parent + (type a) + ~override_key + ~(value_parser : a Value_parser.t) + ~current_namespace + ~inferred_name_from_parent = let value_projection = Value_parser.eval value_parser in let parse_exn (components : Components.t) = @@ -787,22 +787,22 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let result, remaining = - match Map.find components.query key_name with - | None -> None, components - | Some values -> - raise_if_empty values; - let result = - let value_to_parse = List.hd_exn values in - Some (value_projection.parse_exn value_to_parse) - in - let remaining = - let query = Map.remove components.query key_name in - { components with query } - in - result, remaining - in - { Parse_result.result; remaining }) + let result, remaining = + match Map.find components.query key_name with + | None -> None, components + | Some values -> + raise_if_empty values; + let result = + let value_to_parse = List.hd_exn values in + Some (value_projection.parse_exn value_to_parse) + in + let remaining = + let query = Map.remove components.query key_name in + { components with query } + in + result, remaining + in + { Parse_result.result; remaining }) in let unparse { Parse_result.result; remaining = { path = _; query } as remaining } = read_query_key @@ -810,25 +810,25 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let query = - match result with - | None -> query - | Some value -> - Map.set query ~key:key_name ~data:[ value_projection.unparse value ] - in - { remaining with query }) + let query = + match result with + | None -> query + | Some value -> + Map.set query ~key:key_name ~data:[ value_projection.unparse value ] + in + { remaining with query }) in { Projection.parse_exn; unparse } ;; let eval_from_query_optional_with_default - (type a) - ~override_key - ~(value_parser : a Value_parser.t) - ~equal - ~default - ~current_namespace - ~inferred_name_from_parent + (type a) + ~override_key + ~(value_parser : a Value_parser.t) + ~equal + ~default + ~current_namespace + ~inferred_name_from_parent = let value_projection = Value_parser.eval value_parser in let parse_exn (components : Components.t) = @@ -837,22 +837,22 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let result, remaining = - match Map.find components.query key_name with - | None -> default, components - | Some values -> - raise_if_empty values; - let result = - let value_to_parse = List.hd_exn values in - value_projection.parse_exn value_to_parse - in - let remaining = - let query = Map.remove components.query key_name in - { components with query } - in - result, remaining - in - { Parse_result.result; remaining }) + let result, remaining = + match Map.find components.query key_name with + | None -> default, components + | Some values -> + raise_if_empty values; + let result = + let value_to_parse = List.hd_exn values in + value_projection.parse_exn value_to_parse + in + let remaining = + let query = Map.remove components.query key_name in + { components with query } + in + result, remaining + in + { Parse_result.result; remaining }) in let unparse { Parse_result.result; remaining = { path = _; query } as remaining } = read_query_key @@ -860,27 +860,27 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let query = - (* If the value that needs to be unparsed happens to be "equal" (as defined + let query = + (* If the value that needs to be unparsed happens to be "equal" (as defined by the user) to the default value, then then value is not included in the prefix. *) - match equal result default with - | true -> query - | false -> - let unparse_result = value_projection.unparse result in - Map.set query ~key:key_name ~data:[ unparse_result ] - in - { remaining with query }) + match equal result default with + | true -> query + | false -> + let unparse_result = value_projection.unparse result in + Map.set query ~key:key_name ~data:[ unparse_result ] + in + { remaining with query }) in { Projection.parse_exn; unparse } ;; let eval_from_query_many - (type a) - ~override_key - ~(value_parser : a Value_parser.t) - ~current_namespace - ~inferred_name_from_parent + (type a) + ~override_key + ~(value_parser : a Value_parser.t) + ~current_namespace + ~inferred_name_from_parent = let value_projection = Value_parser.eval value_parser in let parse_exn (components : Components.t) = @@ -889,15 +889,15 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let result, remaining_query = - match Map.find components.query key_name with - | None -> [], components.query - | Some values -> - ( List.map values ~f:value_projection.parse_exn - , Map.remove components.query key_name ) - in - let remaining = { components with query = remaining_query } in - { Parse_result.result; remaining }) + let result, remaining_query = + match Map.find components.query key_name with + | None -> [], components.query + | Some values -> + ( List.map values ~f:value_projection.parse_exn + , Map.remove components.query key_name ) + in + let remaining = { components with query = remaining_query } in + { Parse_result.result; remaining }) in let unparse { Parse_result.result; remaining } = read_query_key @@ -905,16 +905,16 @@ module Parser = struct ~inferred_name_from_parent ~current_namespace ~f:(fun key_name -> - let query = - match result with - | [] -> remaining.query - | _ :: _ -> - Map.set - remaining.query - ~key:key_name - ~data:(List.map result ~f:value_projection.unparse) - in - { remaining with query }) + let query = + match result with + | [] -> remaining.query + | _ :: _ -> + Map.set + remaining.query + ~key:key_name + ~data:(List.map result ~f:value_projection.unparse) + in + { remaining with query }) in { Projection.parse_exn; unparse } ;; @@ -954,9 +954,9 @@ module Parser = struct ;; let eval_project - (type a b) - ~(input : (Components.t, a Parse_result.t) Projection.t) - ~(projection : (a, b) Projection.t) + (type a b) + ~(input : (Components.t, a Parse_result.t) Projection.t) + ~(projection : (a, b) Projection.t) = let parse_exn (components : Components.t) = let intermediate_result = input.parse_exn components in @@ -979,9 +979,9 @@ module Parser = struct ;; let eval_with_prefix - (type a) - (t : (Components.t, a Parse_result.t) Projection.t) - ~prefix + (type a) + (t : (Components.t, a Parse_result.t) Projection.t) + ~prefix = let parse_exn (components : Components.t) = let remaining_path = remaining_after_prefix ~prefix ~path:components.path in @@ -1003,9 +1003,9 @@ module Parser = struct ;; let eval_with_remaining_path - (type a) - (t : (Components.t, a Parse_result.t) Projection.t) - ~needed_path + (type a) + (t : (Components.t, a Parse_result.t) Projection.t) + ~needed_path = let parse_exn (components : Components.t) = match List.equal String.equal needed_path components.path with @@ -1027,8 +1027,8 @@ module Parser = struct ;; let raise_if_path_order_has_duplicates - (type a) - (module M : Record.Cached_s with type Typed_field.derived_on = a) + (type a) + (module M : Record.Cached_s with type Typed_field.derived_on = a) : unit = try @@ -1041,8 +1041,8 @@ module Parser = struct ;; let raise_if_path_field_does_not_have_order - (type a) - (module M : Record.Cached_s with type Typed_field.derived_on = a) + (type a) + (module M : Record.Cached_s with type Typed_field.derived_on = a) : unit = let module Packed_typed_field = struct @@ -1077,34 +1077,34 @@ module Parser = struct -> (Components.t, a Parse_result.t) Projection.t = fun (module M : Record.Cached_s with type Typed_field.derived_on = a) - ~(override_namespace : string list option) - ~more_path_parsing_allowed - ~current_namespace - ~parent_namespace -> - (* Caching evaluated projections. *) - let module Projection_map = - Typed_field_map.Make_for_records - (M.Typed_field) - (struct - type 'a t = (Components.t, 'a Parse_result.t) Projection.t - end) - in - let eval_field f = - let inferred_field_name = M.Typed_field.name f in - eval - ~more_path_parsing_allowed - ~current_namespace: - (namespace_for_record_field - ~current_namespace - ~override_namespace - ~parent_namespace) - ~inferred_name_from_parent:(Some inferred_field_name) - ~parent_namespace:[ inferred_field_name ] - (M.parser_for_field f) - in - let projections_by_field = Projection_map.create { f = eval_field } in - let projection_for_field f = Projection_map.find projections_by_field f in - (* Unfortunately, the parsed record can't be created in one go with [create] since + ~(override_namespace : string list option) + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace -> + (* Caching evaluated projections. *) + let module Projection_map = + Typed_field_map.Make_for_records + (M.Typed_field) + (struct + type 'a t = (Components.t, 'a Parse_result.t) Projection.t + end) + in + let eval_field f = + let inferred_field_name = M.Typed_field.name f in + eval + ~more_path_parsing_allowed + ~current_namespace: + (namespace_for_record_field + ~current_namespace + ~override_namespace + ~parent_namespace) + ~inferred_name_from_parent:(Some inferred_field_name) + ~parent_namespace:[ inferred_field_name ] + (M.parser_for_field f) + in + let projections_by_field = Projection_map.create { f = eval_field } in + let projection_for_field f = Projection_map.find projections_by_field f in + (* Unfortunately, the parsed record can't be created in one go with [create] since path parsing cares about the order that the path fields are found in [path_order]. A [Typed_field_map] with an [Option] data is used to set the parsed values in the desired order. @@ -1126,79 +1126,79 @@ module Parser = struct (folding over the remaining components). 3. Unparsed result is in remaining functions. *) - let module Result_map = Typed_field_map.Make (M.Typed_field) (Option) in - (* [parse_order] has the path order fields at the beginning and all of the + let module Result_map = Typed_field_map.Make (M.Typed_field) (Option) in + (* [parse_order] has the path order fields at the beginning and all of the remaining fields at the end to satisfy order dependent steps trivially. *) - let parse_order = - let module Packed_field = struct - module T = struct - include M.Typed_field.Packed - end - - include T - include Comparable.Make (T) + let parse_order = + let module Packed_field = struct + module T = struct + include M.Typed_field.Packed end - in - let path_order_set = Packed_field.Set.of_list M.path_order in - let fields_not_in_path = - List.filter M.Typed_field.Packed.all ~f:(fun f -> - not (Set.mem path_order_set f)) - in - M.path_order @ fields_not_in_path + + include T + include Comparable.Make (T) + end in - let parse_exn (components : Components.t) = - raise_if_path_order_has_duplicates (module M); - raise_if_path_field_does_not_have_order (module M); - let empty_results = - { Parse_result.result = Result_map.create { f = (fun _ -> None) } - ; remaining = components - } - in - let results = - List.fold parse_order ~init:empty_results ~f:(fun results { f = T f } -> - let projection = projection_for_field f in - let { Parse_result.result; remaining } = - try projection.parse_exn results.remaining with - | Missing_key x -> raise (Missing_key x) - | e -> - let error_message = Exn.sexp_of_t e in - let field_name = M.Typed_field.name f in - let unparseable_components = results.remaining in - raise_s - [%message - "Error while parsing record field:" - (error_message : Sexp.t) - (field_name : string) - (unparseable_components : Components.t)] - in - let result = Result_map.set results.result ~key:f ~data:(Some result) in - { Parse_result.result; remaining }) - in - let result = - M.Typed_field.create - { f = - (fun f -> - Option.value_or_thunk - (Result_map.find results.result f) - ~default:(fun () -> - raise_s - [%message - "Internal Bug: Result for a record field was never parsed" - ({ f = T f } : M.Typed_field.Packed.t)])) - } - in - { Parse_result.result; remaining = results.remaining } + let path_order_set = Packed_field.Set.of_list M.path_order in + let fields_not_in_path = + List.filter M.Typed_field.Packed.all ~f:(fun f -> + not (Set.mem path_order_set f)) in - let unparse (result : a Parse_result.t) = - List.fold - (List.rev parse_order) - ~init:result.remaining - ~f:(fun components { f = T f } -> - let projection = projection_for_field f in - let result = M.Typed_field.get f result.result in - projection.unparse { Parse_result.result; remaining = components }) + M.path_order @ fields_not_in_path + in + let parse_exn (components : Components.t) = + raise_if_path_order_has_duplicates (module M); + raise_if_path_field_does_not_have_order (module M); + let empty_results = + { Parse_result.result = Result_map.create { f = (fun _ -> None) } + ; remaining = components + } + in + let results = + List.fold parse_order ~init:empty_results ~f:(fun results { f = T f } -> + let projection = projection_for_field f in + let { Parse_result.result; remaining } = + try projection.parse_exn results.remaining with + | Missing_key x -> raise (Missing_key x) + | e -> + let error_message = Exn.sexp_of_t e in + let field_name = M.Typed_field.name f in + let unparseable_components = results.remaining in + raise_s + [%message + "Error while parsing record field:" + (error_message : Sexp.t) + (field_name : string) + (unparseable_components : Components.t)] + in + let result = Result_map.set results.result ~key:f ~data:(Some result) in + { Parse_result.result; remaining }) + in + let result = + M.Typed_field.create + { f = + (fun f -> + Option.value_or_thunk + (Result_map.find results.result f) + ~default:(fun () -> + raise_s + [%message + "Internal Bug: Result for a record field was never parsed" + ({ f = T f } : M.Typed_field.Packed.t)])) + } in - { Projection.parse_exn; unparse } + { Parse_result.result; remaining = results.remaining } + in + let unparse (result : a Parse_result.t) = + List.fold + (List.rev parse_order) + ~init:result.remaining + ~f:(fun components { f = T f } -> + let projection = projection_for_field f in + let result = M.Typed_field.get f result.result in + projection.unparse { Parse_result.result; remaining = components }) + in + { Projection.parse_exn; unparse } and eval_variant : type a. @@ -1210,94 +1210,94 @@ module Parser = struct -> (Components.t, a Parse_result.t) Projection.t = fun (module M : Variant.Cached_s with type Typed_variant.derived_on = a) - ~(override_namespace : string list option) - ~more_path_parsing_allowed - ~current_namespace - ~parent_namespace -> - (* Caching evaluated projections *) - let module Projection_map = - Typed_field_map.Make - (M.Typed_variant) - (struct - type 'a t = (Components.t, 'a Parse_result.t) Projection.t - end) - in - let eval_constructor v = - let inferred_constructor_name = M.Typed_variant.name v in - eval - ~more_path_parsing_allowed - ~current_namespace: - (namespace_for_record_field - ~current_namespace - ~override_namespace - ~parent_namespace) - ~inferred_name_from_parent:(Some inferred_constructor_name) - ~parent_namespace:[ inferred_constructor_name ] - (M.parser_for_variant v) - in - let projections_by_variant = Projection_map.create { f = eval_constructor } in - let projection_for_variant v = Projection_map.find projections_by_variant v in - (* Caching which pattern is expected for each variant. *) - let rec path_matches_pattern ~(pattern : Path_pattern.t) ~path = - match pattern.pattern, path with - | [], _ -> - (match pattern.needed_match with - | `All -> List.is_empty path - | `Prefix -> true) - | `Ignore :: pattern_tl, _ :: path_tl -> - path_matches_pattern - ~pattern:{ pattern with pattern = pattern_tl } - ~path:path_tl - | `Match pattern_hd :: pattern_tl, path_hd :: path_tl -> - String.equal pattern_hd path_hd - && path_matches_pattern - ~pattern:{ pattern with pattern = pattern_tl } - ~path:path_tl - | _ -> false - in - (* For variants, the parse order is "most-specific to least-specific". This is + ~(override_namespace : string list option) + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace -> + (* Caching evaluated projections *) + let module Projection_map = + Typed_field_map.Make + (M.Typed_variant) + (struct + type 'a t = (Components.t, 'a Parse_result.t) Projection.t + end) + in + let eval_constructor v = + let inferred_constructor_name = M.Typed_variant.name v in + eval + ~more_path_parsing_allowed + ~current_namespace: + (namespace_for_record_field + ~current_namespace + ~override_namespace + ~parent_namespace) + ~inferred_name_from_parent:(Some inferred_constructor_name) + ~parent_namespace:[ inferred_constructor_name ] + (M.parser_for_variant v) + in + let projections_by_variant = Projection_map.create { f = eval_constructor } in + let projection_for_variant v = Projection_map.find projections_by_variant v in + (* Caching which pattern is expected for each variant. *) + let rec path_matches_pattern ~(pattern : Path_pattern.t) ~path = + match pattern.pattern, path with + | [], _ -> + (match pattern.needed_match with + | `All -> List.is_empty path + | `Prefix -> true) + | `Ignore :: pattern_tl, _ :: path_tl -> + path_matches_pattern + ~pattern:{ pattern with pattern = pattern_tl } + ~path:path_tl + | `Match pattern_hd :: pattern_tl, path_hd :: path_tl -> + String.equal pattern_hd path_hd + && path_matches_pattern + ~pattern:{ pattern with pattern = pattern_tl } + ~path:path_tl + | _ -> false + in + (* For variants, the parse order is "most-specific to least-specific". This is defined as: 1. Which variant's path pattern has more elements 2. (If tied) total matches come before partial matches *) - let parse_order = - List.sort M.Typed_variant.Packed.all ~compare:(fun { f = T va } { f = T vb } -> - Path_pattern.compare_specificity - (M.pattern_for_variant va) - (M.pattern_for_variant vb)) + let parse_order = + List.sort M.Typed_variant.Packed.all ~compare:(fun { f = T va } { f = T vb } -> + Path_pattern.compare_specificity + (M.pattern_for_variant va) + (M.pattern_for_variant vb)) + in + let parse_exn (components : Components.t) = + let result = + List.find_map parse_order ~f:(fun { f = T v } -> + if path_matches_pattern + ~pattern:(M.pattern_for_variant v) + ~path:components.path + then ( + let projection = projection_for_variant v in + let parse_result = projection.parse_exn components in + let variant = M.Typed_variant.create v parse_result.result in + Some { Parse_result.result = variant; remaining = parse_result.remaining }) + else None) in - let parse_exn (components : Components.t) = - let result = - List.find_map parse_order ~f:(fun { f = T v } -> - if path_matches_pattern - ~pattern:(M.pattern_for_variant v) - ~path:components.path - then ( - let projection = projection_for_variant v in - let parse_result = projection.parse_exn components in - let variant = M.Typed_variant.create v parse_result.result in - Some { Parse_result.result = variant; remaining = parse_result.remaining }) - else None) + Option.value_or_thunk result ~default:(fun () -> + let available_patterns = + List.map M.Typed_variant.Packed.all ~f:(fun { f = T v } -> + M.Typed_variant.name v, M.pattern_for_variant v) in - Option.value_or_thunk result ~default:(fun () -> - let available_patterns = - List.map M.Typed_variant.Packed.all ~f:(fun { f = T v } -> - M.Typed_variant.name v, M.pattern_for_variant v) - in - raise_s - [%message - "Error while parsing! No matching variant contructor found for current \ - path!" - (components : Components.t) - (available_patterns : (string * Path_pattern.t) list)]) - in - let unparse (result : a Parse_result.t) = - let { f = T v } = M.Typed_variant.which result.result in - let inner_result = M.Typed_variant.get v result.result |> Option.value_exn in - let projection = projection_for_variant v in - projection.unparse - { Parse_result.result = inner_result; remaining = result.remaining } - in - { Projection.parse_exn; unparse } + raise_s + [%message + "Error while parsing! No matching variant contructor found for current \ + path!" + (components : Components.t) + (available_patterns : (string * Path_pattern.t) list)]) + in + let unparse (result : a Parse_result.t) = + let { f = T v } = M.Typed_variant.which result.result in + let inner_result = M.Typed_variant.get v result.result |> Option.value_exn in + let projection = projection_for_variant v in + projection.unparse + { Parse_result.result = inner_result; remaining = result.remaining } + in + { Projection.parse_exn; unparse } and eval_query_based_variant : type a. @@ -1310,99 +1310,99 @@ module Parser = struct -> (Components.t, a Parse_result.t) Projection.t = fun (module M) - ~override_namespace - ~more_path_parsing_allowed - ~current_namespace - ~parent_namespace - ~key -> - (* Caching evaluated projections *) - let module Projection_map = - Typed_field_map.Make - (M.Typed_variant) - (struct - type 'a t = (Components.t, 'a Parse_result.t) Projection.t - end) - in - let eval_constructor v = - let inferred_constructor_name = M.Typed_variant.name v in - eval - ~more_path_parsing_allowed - ~current_namespace: - (namespace_for_record_field - ~current_namespace - ~override_namespace - ~parent_namespace) - ~inferred_name_from_parent:(Some inferred_constructor_name) - ~parent_namespace:[ inferred_constructor_name ] - (M.parser_for_variant v) - in - let projections_by_variant = Projection_map.create { f = eval_constructor } in - let projection_for_variant v = Projection_map.find projections_by_variant v in - let variant_by_identifier = - (* Fails at eval_time if two different variants expect the same value. *) - List.fold M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc variant -> - let key = - let { f = T v } = variant in - M.identifier_for_variant v - in - match Map.add acc ~key ~data:variant with - | `Duplicate -> raise_s [%message "found duplicate identifier!" key] - | `Ok acc -> acc) - in - let parse_exn (components : Components.t) = - match Map.find components.query key with - | None | Some [] -> - raise_s - [%message - [%string - {|Error while parsing url! Expected key "%{key}=" inside of the url's query.|}]] - | Some (_ :: _ :: _) -> + ~override_namespace + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace + ~key -> + (* Caching evaluated projections *) + let module Projection_map = + Typed_field_map.Make + (M.Typed_variant) + (struct + type 'a t = (Components.t, 'a Parse_result.t) Projection.t + end) + in + let eval_constructor v = + let inferred_constructor_name = M.Typed_variant.name v in + eval + ~more_path_parsing_allowed + ~current_namespace: + (namespace_for_record_field + ~current_namespace + ~override_namespace + ~parent_namespace) + ~inferred_name_from_parent:(Some inferred_constructor_name) + ~parent_namespace:[ inferred_constructor_name ] + (M.parser_for_variant v) + in + let projections_by_variant = Projection_map.create { f = eval_constructor } in + let projection_for_variant v = Projection_map.find projections_by_variant v in + let variant_by_identifier = + (* Fails at eval_time if two different variants expect the same value. *) + List.fold M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc variant -> + let key = + let { f = T v } = variant in + M.identifier_for_variant v + in + match Map.add acc ~key ~data:variant with + | `Duplicate -> raise_s [%message "found duplicate identifier!" key] + | `Ok acc -> acc) + in + let parse_exn (components : Components.t) = + match Map.find components.query key with + | None | Some [] -> + raise_s + [%message + [%string + {|Error while parsing url! Expected key "%{key}=" inside of the url's query.|}]] + | Some (_ :: _ :: _) -> + raise_s + [%message + [%string + {|Error while parsing! Got multiple "%{key}" query parameters, but expected just one.|}]] + | Some [ single_identifier ] -> + (match Map.find variant_by_identifier single_identifier with + | None -> + let expected_one_of = + List.map M.Typed_variant.Packed.all ~f:(fun { f = T v } -> + M.Typed_variant.name v, M.identifier_for_variant v) + in + raise_s + [%message + [%string + {|Error while parsing! Got unexpected value "%{single_identifier}" for "%{key}" query parameter.|}] + (expected_one_of : (string * string) list)] + | Some { f = T v } -> + let components = + { components with query = Map.remove components.query key } + in + let projection = projection_for_variant v in + let parse_result = projection.parse_exn components in + let variant = M.Typed_variant.create v parse_result.result in + { Parse_result.result = variant; remaining = parse_result.remaining }) + in + let unparse (result : a Parse_result.t) = + let { f = T v } = M.Typed_variant.which result.result in + let inner_result = M.Typed_variant.get v result.result |> Option.value_exn in + let projection = projection_for_variant v in + let query = + match + Map.add result.remaining.query ~key ~data:[ M.identifier_for_variant v ] + with + | `Ok query -> query + | `Duplicate -> raise_s [%message - [%string - {|Error while parsing! Got multiple "%{key}" query parameters, but expected just one.|}]] - | Some [ single_identifier ] -> - (match Map.find variant_by_identifier single_identifier with - | None -> - let expected_one_of = - List.map M.Typed_variant.Packed.all ~f:(fun { f = T v } -> - M.Typed_variant.name v, M.identifier_for_variant v) - in - raise_s - [%message - [%string - {|Error while parsing! Got unexpected value "%{single_identifier}" for "%{key}" query parameter.|}] - (expected_one_of : (string * string) list)] - | Some { f = T v } -> - let components = - { components with query = Map.remove components.query key } - in - let projection = projection_for_variant v in - let parse_result = projection.parse_exn components in - let variant = M.Typed_variant.create v parse_result.result in - { Parse_result.result = variant; remaining = parse_result.remaining }) + "query key was added multiple times while unparsing a URL. This likely \ + indicates an illegal URL structure, which will be caught if you run \ + [check_ok_and_print_urls_or_errors]. If that function doesn't complain, \ + this is a bug."] in - let unparse (result : a Parse_result.t) = - let { f = T v } = M.Typed_variant.which result.result in - let inner_result = M.Typed_variant.get v result.result |> Option.value_exn in - let projection = projection_for_variant v in - let query = - match - Map.add result.remaining.query ~key ~data:[ M.identifier_for_variant v ] - with - | `Ok query -> query - | `Duplicate -> - raise_s - [%message - "query key was added multiple times while unparsing a URL. This likely \ - indicates an illegal URL structure, which will be caught if you run \ - [check_ok_and_print_urls_or_errors]. If that function doesn't complain, \ - this is a bug."] - in - let remaining = { result.remaining with query } in - projection.unparse { Parse_result.result = inner_result; remaining } - in - { Projection.parse_exn; unparse } + let remaining = { result.remaining with query } in + projection.unparse { Parse_result.result = inner_result; remaining } + in + { Projection.parse_exn; unparse } and eval_optional_query_fields : type a. @@ -1435,106 +1435,106 @@ module Parser = struct -> (Components.t, a Parse_result.t) Projection.t = fun t - ~more_path_parsing_allowed - ~current_namespace - ~inferred_name_from_parent - ~parent_namespace -> - match t with - | Unit -> - { Projection.parse_exn = - (fun components -> { Parse_result.result = (); remaining = components }) - ; unparse = (fun result -> result.remaining) - } - | Project { input; projection } -> - let input = - eval - ~more_path_parsing_allowed - ~current_namespace - ~inferred_name_from_parent - ~parent_namespace - input - in - eval_project ~input ~projection - | From_query_required { override_key; value_parser } -> - eval_from_query_required - ~override_key - ~value_parser - ~current_namespace - ~inferred_name_from_parent - | From_query_optional { override_key; value_parser } -> - eval_from_query_optional - ~override_key - ~value_parser - ~current_namespace - ~inferred_name_from_parent - | From_query_optional_with_default { override_key; equal; value_parser; default } -> - eval_from_query_optional_with_default - ~override_key - ~value_parser - ~equal - ~default - ~current_namespace - ~inferred_name_from_parent - | From_query_many { override_key; value_parser } -> - eval_from_query_many - ~override_key - ~value_parser + ~more_path_parsing_allowed + ~current_namespace + ~inferred_name_from_parent + ~parent_namespace -> + match t with + | Unit -> + { Projection.parse_exn = + (fun components -> { Parse_result.result = (); remaining = components }) + ; unparse = (fun result -> result.remaining) + } + | Project { input; projection } -> + let input = + eval + ~more_path_parsing_allowed ~current_namespace ~inferred_name_from_parent - | From_path value_parser -> eval_from_path ~value_parser - | From_remaining_path value_parser -> eval_from_remaining_path ~value_parser - | With_prefix { prefix; t } -> - let t = - eval - ~more_path_parsing_allowed - ~current_namespace - ~inferred_name_from_parent - ~parent_namespace - t - in - eval_with_prefix t ~prefix - | With_remaining_path { needed_path; t } -> - let t = - eval - ~more_path_parsing_allowed:false - ~current_namespace - ~inferred_name_from_parent - ~parent_namespace - t - in - eval_with_remaining_path t ~needed_path - | Record { record_module; override_namespace } -> - eval_record - record_module - ~override_namespace + ~parent_namespace + input + in + eval_project ~input ~projection + | From_query_required { override_key; value_parser } -> + eval_from_query_required + ~override_key + ~value_parser + ~current_namespace + ~inferred_name_from_parent + | From_query_optional { override_key; value_parser } -> + eval_from_query_optional + ~override_key + ~value_parser + ~current_namespace + ~inferred_name_from_parent + | From_query_optional_with_default { override_key; equal; value_parser; default } -> + eval_from_query_optional_with_default + ~override_key + ~value_parser + ~equal + ~default + ~current_namespace + ~inferred_name_from_parent + | From_query_many { override_key; value_parser } -> + eval_from_query_many + ~override_key + ~value_parser + ~current_namespace + ~inferred_name_from_parent + | From_path value_parser -> eval_from_path ~value_parser + | From_remaining_path value_parser -> eval_from_remaining_path ~value_parser + | With_prefix { prefix; t } -> + let t = + eval ~more_path_parsing_allowed ~current_namespace + ~inferred_name_from_parent ~parent_namespace - | Variant { variant_module; override_namespace } -> - eval_variant - variant_module - ~override_namespace - ~more_path_parsing_allowed + t + in + eval_with_prefix t ~prefix + | With_remaining_path { needed_path; t } -> + let t = + eval + ~more_path_parsing_allowed:false ~current_namespace + ~inferred_name_from_parent ~parent_namespace - | Query_based_variant { variant_module; override_namespace; key } -> - eval_query_based_variant - variant_module - ~override_namespace + t + in + eval_with_remaining_path t ~needed_path + | Record { record_module; override_namespace } -> + eval_record + record_module + ~override_namespace + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace + | Variant { variant_module; override_namespace } -> + eval_variant + variant_module + ~override_namespace + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace + | Query_based_variant { variant_module; override_namespace; key } -> + eval_query_based_variant + variant_module + ~override_namespace + ~more_path_parsing_allowed + ~current_namespace + ~parent_namespace + ~key + | Optional_query_fields { t } -> + let t = + eval + t ~more_path_parsing_allowed ~current_namespace + ~inferred_name_from_parent ~parent_namespace - ~key - | Optional_query_fields { t } -> - let t = - eval - t - ~more_path_parsing_allowed - ~current_namespace - ~inferred_name_from_parent - ~parent_namespace - in - eval_optional_query_fields t + in + eval_optional_query_fields t ;; end @@ -1617,10 +1617,10 @@ module Parser = struct M.Typed_field.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T f } -> - Map.set - acc - ~key:(M.Typed_field.name f) - ~data:(of_parser (M.parser_for_field f))) + Map.set + acc + ~key:(M.Typed_field.name f) + ~data:(of_parser (M.parser_for_field f))) in let path_order = List.map M.path_order ~f:(fun { f = T f } -> M.Typed_field.name f) @@ -1635,40 +1635,40 @@ module Parser = struct M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T v } -> - Map.set - acc - ~key:(M.Typed_variant.name v) - ~data:(of_parser (M.parser_for_variant v))) + Map.set + acc + ~key:(M.Typed_variant.name v) + ~data:(of_parser (M.parser_for_variant v))) in let patterns = List.fold M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T v } -> - Map.set acc ~key:(M.Typed_variant.name v) ~data:(M.pattern_for_variant v)) + Map.set acc ~key:(M.Typed_variant.name v) ~data:(M.pattern_for_variant v)) in Variant { override_namespace; constructor_declarations; patterns } | Query_based_variant { variant_module; override_namespace; key } -> let module M = (val variant_module - : Query_based_variant.S with type Typed_variant.derived_on = a) + : Query_based_variant.S with type Typed_variant.derived_on = a) in let constructor_declarations = List.fold M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T v } -> - Map.set - acc - ~key:(M.Typed_variant.name v) - ~data:(of_parser (M.parser_for_variant v))) + Map.set + acc + ~key:(M.Typed_variant.name v) + ~data:(of_parser (M.parser_for_variant v))) in let identifiers = List.fold M.Typed_variant.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T v } -> - Map.set acc ~key:(M.Typed_variant.name v) ~data:(M.identifier_for_variant v)) + Map.set acc ~key:(M.Typed_variant.name v) ~data:(M.identifier_for_variant v)) in Query_based_variant { override_namespace; constructor_declarations; identifiers; key } @@ -1806,11 +1806,11 @@ module Parser = struct let all_url_shapes (type a) (t : a T.t) : Url_shape.t list = let skeleton = Skeleton.of_parser t in let rec all_url_shapes - (t : Skeleton.t) - ~(current_shape : Url_shape.t) - ~current_namespace - ~parent_namespace - ~inferred_name_from_parent + (t : Skeleton.t) + ~(current_shape : Url_shape.t) + ~current_namespace + ~parent_namespace + ~inferred_name_from_parent = let wrap_if_multiple s = if Skeleton.is_multiple t then [%string ""] else s @@ -1907,12 +1907,12 @@ module Parser = struct List.concat_map (Map.to_alist constructor_declarations) ~f:(fun (constructor_name, declaration) -> - all_url_shapes - declaration - ~current_shape - ~current_namespace:namespace - ~parent_namespace:[ constructor_name ] - ~inferred_name_from_parent:(Some constructor_name)) + all_url_shapes + declaration + ~current_shape + ~current_namespace:namespace + ~parent_namespace:[ constructor_name ] + ~inferred_name_from_parent:(Some constructor_name)) | Query_based_variant { constructor_declarations; override_namespace; identifiers; key } -> let namespace = @@ -1924,23 +1924,23 @@ module Parser = struct List.concat_map (Map.to_alist constructor_declarations) ~f:(fun (constructor_name, declaration) -> - let current_shape = - { current_shape with - query = - { Query_tag.key - ; value = - Map.find identifiers constructor_name - |> Option.value ~default:"" - } - :: current_shape.query - } - in - all_url_shapes - declaration - ~current_shape - ~current_namespace:namespace - ~parent_namespace:[ constructor_name ] - ~inferred_name_from_parent:(Some constructor_name)) + let current_shape = + { current_shape with + query = + { Query_tag.key + ; value = + Map.find identifiers constructor_name + |> Option.value ~default:"" + } + :: current_shape.query + } + in + all_url_shapes + declaration + ~current_shape + ~current_namespace:namespace + ~parent_namespace:[ constructor_name ] + ~inferred_name_from_parent:(Some constructor_name)) | Optional_query_fields { t; _ } -> current_shape :: all_url_shapes @@ -2032,7 +2032,7 @@ module Parser = struct | Query_based_variant { variant_module; _ } -> let module M = (val variant_module - : Query_based_variant.S with type Typed_variant.derived_on = a) + : Query_based_variant.S with type Typed_variant.derived_on = a) in List.iter M.Typed_variant.Packed.all ~f:(fun { f = T v } -> check_that_path_orders_are_ok (M.parser_for_variant v)) @@ -2089,7 +2089,7 @@ module Parser = struct | Query_based_variant { variant_module; _ } -> let module M = (val variant_module - : Query_based_variant.S with type Typed_variant.derived_on = a) + : Query_based_variant.S with type Typed_variant.derived_on = a) in List.iter M.Typed_variant.Packed.all ~f:(fun { f = T v } -> check_that_with_remaining_path_has_no_path_parsers_after_it @@ -2131,7 +2131,7 @@ module Parser = struct | Query_based_variant { variant_module; _ } -> let module M = (val variant_module - : Query_based_variant.S with type Typed_variant.derived_on = a) + : Query_based_variant.S with type Typed_variant.derived_on = a) in let all_identifiers = List.map M.Typed_variant.Packed.all ~f:(fun { f = T v } -> @@ -2256,24 +2256,24 @@ module Versioned_parser = struct -> (Components.t, a Parse_result.t) Projection.t = fun ?encoding_behavior -> function - | Non_typed_parser projection -> eval_non_typed_parser projection - | First_typed_parser parser -> Parser.eval ?encoding_behavior parser - | New_parser { current_parser; map; previous_parser } -> - let current_projection = Parser.eval ?encoding_behavior current_parser in - let previous_projection = eval ?encoding_behavior previous_parser in - let parse_exn (components : Components.t) = - try current_projection.parse_exn components with - | error -> - print_s - [%message - "URL unrecognized, maybe this is an old URL? Attempting to parse with a \ - previous URL parser. Here's the error of the current parser:" - (error : Exn.t)]; - let result = previous_projection.parse_exn components in - { Parse_result.result = map result.result; remaining = result.remaining } - in - let unparse result = current_projection.unparse result in - { Projection.parse_exn; unparse } + | Non_typed_parser projection -> eval_non_typed_parser projection + | First_typed_parser parser -> Parser.eval ?encoding_behavior parser + | New_parser { current_parser; map; previous_parser } -> + let current_projection = Parser.eval ?encoding_behavior current_parser in + let previous_projection = eval ?encoding_behavior previous_parser in + let parse_exn (components : Components.t) = + try current_projection.parse_exn components with + | error -> + print_s + [%message + "URL unrecognized, maybe this is an old URL? Attempting to parse with a \ + previous URL parser. Here's the error of the current parser:" + (error : Exn.t)]; + let result = previous_projection.parse_exn components in + { Parse_result.result = map result.result; remaining = result.remaining } + in + let unparse result = current_projection.unparse result in + { Projection.parse_exn; unparse } ;; let eval_for_uri ?encoding_behavior (t : 'a t) : (Uri.t, 'a Parse_result.t) Projection.t @@ -2301,10 +2301,10 @@ module Versioned_parser = struct let rec to_parser_list : type a. a t -> [ `Typed of packed_parser | `Non_typed ] list = function - | Non_typed_parser _ -> [ `Non_typed ] - | First_typed_parser parser -> [ `Typed (T parser) ] - | New_parser { current_parser; map = _; previous_parser } -> - `Typed (T current_parser) :: to_parser_list previous_parser + | Non_typed_parser _ -> [ `Non_typed ] + | First_typed_parser parser -> [ `Typed (T parser) ] + | New_parser { current_parser; map = _; previous_parser } -> + `Typed (T current_parser) :: to_parser_list previous_parser ;; let check_ok_and_print_urls_or_errors (t : 'a t) = diff --git a/uri_parsing/src/uri_parsing.mli b/uri_parsing/src/uri_parsing.mli index d357e9e3..864b8c61 100644 --- a/uri_parsing/src/uri_parsing.mli +++ b/uri_parsing/src/uri_parsing.mli @@ -68,7 +68,7 @@ module Components : sig type t = { path : string list (** "foo/bar" -> ["foo"; "bar"] *) ; query : string list String.Map.t - (** "?foo=1&bar=2" -> String.Map.of_alist_exn ["foo", ["1"]; "bar", ["2"]] *) + (** "?foo=1&bar=2" -> String.Map.of_alist_exn ["foo", ["1"]; "bar", ["2"]] *) } [@@deriving sexp, equal] diff --git a/uri_parsing/test/uri_parsing_test.ml b/uri_parsing/test/uri_parsing_test.ml index 21ed5631..6ed33b4f 100644 --- a/uri_parsing/test/uri_parsing_test.ml +++ b/uri_parsing/test/uri_parsing_test.ml @@ -22,12 +22,12 @@ let diff_paths a b = ;; let expect_output_and_identity_roundtrip - ?(expect_diff = fun () -> ()) - ~path - ~query - ~sexp_of_t - ~expect - (projection : (Components.t, 'a Parse_result.t) Projection.t) + ?(expect_diff = fun () -> ()) + ~path + ~query + ~sexp_of_t + ~expect + (projection : (Components.t, 'a Parse_result.t) Projection.t) = let result = projection.parse_exn { query; path } in print_s (sexp_of_t result.result); @@ -149,13 +149,13 @@ module All_primitives_query = struct end let assert_is_equal_and_eval - ~(old_eval : - ?encoding_behavior:Percent_encoding_behavior.t - -> 'a - -> ('b, 'c Parse_result.t) Projection.t) - ~equal_from - ~equal - parser + ~(old_eval : + ?encoding_behavior:Percent_encoding_behavior.t + -> 'a + -> ('b, 'c Parse_result.t) Projection.t) + ~equal_from + ~equal + parser = let incorrect_projection = old_eval ~encoding_behavior:Percent_encoding_behavior.Legacy_incorrect parser @@ -252,8 +252,8 @@ let%expect_test "all primitives parser" = ~query ~sexp_of_t:Query.sexp_of_t ~expect:(fun () -> - [%expect - {| + [%expect + {| ((int_field 10) (float_field 1.25) (string_field hi!) (bool_field true) (stringable_field Bonsai) (sexpable_field ((x 1) (y 2))) (binable_field ((a 1) (b 2) (c 3))) @@ -461,7 +461,7 @@ let%expect_test "from_query_many can parse empty list options from missing query ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> (* Some []*) - [%expect {| + [%expect {| ((strings (()))) |}]) ;; @@ -641,7 +641,7 @@ let%expect_test "Value parser project" = ~query ~sexp_of_t:Query.sexp_of_t ~expect:(fun () -> - [%expect {| + [%expect {| ((game_id 10) (players (foo bar)) (watchers (baz bam))) |}]); show_structure parser; [%expect @@ -1156,7 +1156,7 @@ let%test_module "quickcheck" = ; int_list_field : int list ; float_list_field : (float list - [@quickcheck.generator Generator.list Generator.float_without_nan]) + [@quickcheck.generator Generator.list Generator.float_without_nan]) ; sexpable : Point.t ; stringable : Player_id.t ; nested : Point.t @@ -1208,8 +1208,8 @@ let%test_module "quickcheck" = bool_generator remaining_generator ~f:(fun int_ bool_ remaining -> - [ "main"; "path_int"; Int.to_string int_; Bool.to_string bool_; "remaining" ] - @ List.map remaining ~f:Int.to_string) + [ "main"; "path_int"; Int.to_string int_; Bool.to_string bool_; "remaining" ] + @ List.map remaining ~f:Int.to_string) ;; module Path_order = Path_order (Typed_field) @@ -1269,32 +1269,32 @@ let%test_module "quickcheck" = let equal_values_for_field : type a. a Typed_field.t -> (string list -> string list -> bool) option = function - | Int_field -> Some string_list_equal - | Time_ns_field -> Some string_list_equal - | Int_list_field -> Some string_list_equal - | Float_list_field -> Some string_list_equal - | Sexpable -> Some string_list_equal - | Stringable -> Some string_list_equal - | Nested -> None - | List_projection -> Some string_list_equal - | Int_list_with_fallback -> - (* This equality function is weird, but it makes + | Int_field -> Some string_list_equal + | Time_ns_field -> Some string_list_equal + | Int_list_field -> Some string_list_equal + | Float_list_field -> Some string_list_equal + | Sexpable -> Some string_list_equal + | Stringable -> Some string_list_equal + | Nested -> None + | List_projection -> Some string_list_equal + | Int_list_with_fallback -> + (* This equality function is weird, but it makes ["1"; "not an int"; "3"; "4"] equal to ["1"; "100"; "3"; "4"] which is useful to make check that the fallback did its work! *) - Some - (List.equal (fun a b -> - match is_int_string a with - | true -> - (* This fixes strings that happen to be ints with leading 0's (e.g. "05") *) - String.equal (Int.of_string a |> Int.to_string) b - | false -> String.equal (Int.to_string fallback_value) b)) - | At_least_one_int -> Some string_list_equal - | Path_int -> None - | Path_bool_without_name -> None - | Remaining_path -> None + Some + (List.equal (fun a b -> + match is_int_string a with + | true -> + (* This fixes strings that happen to be ints with leading 0's (e.g. "05") *) + String.equal (Int.of_string a |> Int.to_string) b + | false -> String.equal (Int.to_string fallback_value) b)) + | At_least_one_int -> Some string_list_equal + | Path_int -> None + | Path_bool_without_name -> None + | Remaining_path -> None ;; end @@ -1327,14 +1327,14 @@ let%test_module "quickcheck" = Query.Anon_main.Typed_field.Packed.all ~init:(Generator.return String.Map.empty) ~f:(fun acc { f = T f } -> - match Query.Anon_main.generator_for_field f with - | None -> acc - | Some generator -> - Generator.map2 acc generator ~f:(fun acc field_generator -> - Map.set - acc - ~key:(Query.Anon_main.Typed_field.name f) - ~data:field_generator)) + match Query.Anon_main.generator_for_field f with + | None -> acc + | Some generator -> + Generator.map2 acc generator ~f:(fun acc field_generator -> + Map.set + acc + ~key:(Query.Anon_main.Typed_field.name f) + ~data:field_generator)) in let x_generator = Generator.int >>| fun x -> [ Int.to_string x ] in let y_generator = Generator.int >>| fun x -> [ Int.to_string x ] in @@ -1375,11 +1375,11 @@ let%test_module "quickcheck" = Query.Anon_main.Typed_field.Packed.all ~init:String.Map.empty ~f:(fun acc { f = T f } -> - let key = Query.Anon_main.Typed_field.name f in - let equal = Query.Anon_main.equal_values_for_field f in - match equal with - | None -> acc - | Some equal -> Map.set acc ~key ~data:equal) + let key = Query.Anon_main.Typed_field.name f in + let equal = Query.Anon_main.equal_values_for_field f in + match equal with + | None -> acc + | Some equal -> Map.set acc ~key ~data:equal) in Map.for_alli (unparsed : _ String.Map.t) @@ -1405,16 +1405,16 @@ let%test_module "quickcheck" = let%quick_test "attempt to parse generated queries" = fun ((query, path) : - (string list String.Map.t * string list - [@generator generator] [@shrinker Shrinker.atomic])) -> - let parser = Parser.Variant.make ~namespace:[] (module Query) in - let projection = Parser.eval ~equal:[%equal: Query.t] parser in - let result = projection.parse_exn { query; path } in - let { Components.query = unparsed_query; path = unparsed_path } = - projection.unparse result - in - assert (maps_equal query unparsed_query); - assert (List.equal String.equal unparsed_path path) + (string list String.Map.t * string list + [@generator generator] [@shrinker Shrinker.atomic])) -> + let parser = Parser.Variant.make ~namespace:[] (module Query) in + let projection = Parser.eval ~equal:[%equal: Query.t] parser in + let result = projection.parse_exn { query; path } in + let { Components.query = unparsed_query; path = unparsed_path } = + projection.unparse result + in + assert (maps_equal query unparsed_query); + assert (List.equal String.equal unparsed_path path) ;; end) ;; @@ -2845,39 +2845,39 @@ let%expect_test "/library, /library/nyc, library/nyc/book, library/nyc/book/dune ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> - [%expect {| (Library_page (library_name nyc) (library_contents Content_search)) |}]); + [%expect {| (Library_page (library_name nyc) (library_contents Content_search)) |}]); expect_output_and_identity_roundtrip projection ~path:[ "library"; "nyc"; "book" ] ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> - [%expect - {| (Library_page (library_name nyc) (library_contents (Book Book_search))) |}]); + [%expect + {| (Library_page (library_name nyc) (library_contents (Book Book_search))) |}]); expect_output_and_identity_roundtrip projection ~path:[ "library"; "nyc"; "book"; "dune" ] ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> - [%expect - {| (Library_page (library_name nyc) (library_contents (Book (Book_view dune)))) |}]); + [%expect + {| (Library_page (library_name nyc) (library_contents (Book (Book_view dune)))) |}]); expect_output_and_identity_roundtrip projection ~path:[ "library"; "nyc"; "movie" ] ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> - [%expect - {| (Library_page (library_name nyc) (library_contents (Movie Movie_search))) |}]); + [%expect + {| (Library_page (library_name nyc) (library_contents (Movie Movie_search))) |}]); expect_output_and_identity_roundtrip projection ~path:[ "library"; "nyc"; "movie"; "dune" ] ~query:String.Map.empty ~sexp_of_t:Url.sexp_of_t ~expect:(fun () -> - [%expect - {| + [%expect + {| (Library_page (library_name nyc) (library_contents (Movie (Movie_view dune)))) |}]) ;; diff --git a/web/forward_performance_entries.ml b/web/forward_performance_entries.ml index 462258e1..c7f284b3 100644 --- a/web/forward_performance_entries.ml +++ b/web/forward_performance_entries.ml @@ -21,7 +21,7 @@ module PerformanceObserver : sig * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) + *) (** PerformanceObserver API @@ -95,7 +95,7 @@ end = struct let performanceObserver : ((performanceObserverEntryList Js.t -> performanceObserver Js.t -> unit) Js.callback -> performanceObserver Js.t) - Js.constr + Js.constr = performanceObserver ;; @@ -163,18 +163,18 @@ end = struct in let result = { worker; acknowledged = false; buffer = [] } in worker##.onmessage - := Dom.handler (fun (message : Js.js_string Js.t Worker.messageEvent Js.t) -> - result.acknowledged <- true; - on_message result (Js.to_string message##.data); - Js._false); + := Dom.handler (fun (message : Js.js_string Js.t Worker.messageEvent Js.t) -> + result.acknowledged <- true; + on_message result (Js.to_string message##.data); + Js._false); result ;; let set_error_handler t ~f = t.worker##.onerror - := Dom.handler (fun error_message -> - f error_message; - Js._false) + := Dom.handler (fun error_message -> + f error_message; + Js._false) ;; let send_message t message = t.buffer <- message :: t.buffer @@ -201,16 +201,16 @@ let iter_entries performance_observer_entry_list ~f = performance_observer_entry_list##getEntries |> Js.to_array |> Array.iter ~f:(fun entry -> - let label = - let label = entry##.name |> Js.to_string in - match Instrumentation.extract_node_path_from_entry_label label with - | None -> `Other label - | Some node_id -> `Bonsai node_id - in - let entry_type = entry##.entryType |> Js.to_bytestring in - let start_time = entry##.startTime in - let duration = entry##.duration in - f { Entry.label; entry_type; start_time; duration }) + let label = + let label = entry##.name |> Js.to_string in + match Instrumentation.extract_node_path_from_entry_label label with + | None -> `Other label + | Some node_id -> `Bonsai node_id + in + let entry_type = entry##.entryType |> Js.to_bytestring in + let start_time = entry##.startTime in + let duration = entry##.duration in + f { Entry.label; entry_type; start_time; duration }) ;; let uuid_to_url ~host ~port uuid = [%string "https://%{host}:%{port#Int}/%{uuid#Uuid}"] @@ -296,8 +296,8 @@ let instrument ~host ~port ~worker_name component = Worker.create ~url:[%string "https://%{host}:%{port#Int}/%{worker_name}"] ~on_message:(fun worker _ -> - if not !got_first_message then got_first_message := true; - on_first_message worker) + if not !got_first_message then got_first_message := true; + on_first_message worker) in let component = Bonsai.Private.Graph_info.iter_graph_updates component ~on_update:(fun gi -> diff --git a/web/persistent_var.mli b/web/persistent_var.mli index cbb5385f..68b3dca5 100644 --- a/web/persistent_var.mli +++ b/web/persistent_var.mli @@ -4,8 +4,6 @@ open! Import type 'a t - - (** A Persistent_var.t is similar to Bonsai.Var.t, but the contents of the var are persisted into either local storage or session storage. @@ -44,4 +42,3 @@ val clear_persistence : 'a t -> unit threaded through your components and triggered inside an action-application or inside of an event listener. *) val effect : 'a t -> 'a -> unit Effect.t - diff --git a/web/rpc_effect.ml b/web/rpc_effect.ml index b1a75cc8..81293eb8 100644 --- a/web/rpc_effect.ml +++ b/web/rpc_effect.ml @@ -83,8 +83,7 @@ end = struct [%message "BUG: Skipped computing Rvar result because it has already been computed."]; return_result t (Ok value)) - | Error e -> - return_result t (Error e)) + | Error e -> return_result t (Error e)) | Pending -> Bvar.wait t.finished | Value value -> Deferred.Or_error.return value ;; @@ -100,8 +99,8 @@ module Connector = struct | Persistent_connection : { connection_module : (module Persistent_connection.S - with type t = 'conn - and type conn = Rpc.Connection.t) + with type t = 'conn + and type conn = Rpc.Connection.t) ; connection : 'conn ; menu : Versioned_rpc.Menu.t Rvar.t } @@ -114,11 +113,11 @@ module Connector = struct | Test_fallback : t let persistent_connection - (type conn) - (module Conn : Persistent_connection.S - with type t = conn - and type conn = Rpc.Connection.t) - (connection : conn) + (type conn) + (module Conn : Persistent_connection.S + with type t = conn + and type conn = Rpc.Connection.t) + (connection : conn) = let menu = Rvar.create (fun () -> @@ -241,14 +240,14 @@ module Private = struct Memo.of_comparable (module String) (fun url -> - Connector.persistent_connection - (module Persistent_connection.Rpc) - (Persistent_connection.Rpc.create - ~server_name:"self-ws-server" - ~address:(module String) - ~connect:(fun url -> - Async_js.Rpc.Connection.client ~uri:(Uri.of_string url) ()) - (fun () -> Deferred.Or_error.return url))) + Connector.persistent_connection + (module Persistent_connection.Rpc) + (Persistent_connection.Rpc.create + ~server_name:"self-ws-server" + ~address:(module String) + ~connect:(fun url -> + Async_js.Rpc.Connection.client ~uri:(Uri.of_string url) ()) + (fun () -> Deferred.Or_error.return url))) ;; let is_test_fallback connector = @@ -299,22 +298,22 @@ module Poll_behavior = struct type t = | Always (* Sends an rpc on every clock tick. *) | Until_ok - (* Sends an rpc repeatedly until an ok response arrives. Stops polling + (* Sends an rpc repeatedly until an ok response arrives. Stops polling once an error occurs.*) end let generic_poll_or_error - (type query response) - ~sexp_of_query - ~sexp_of_response - ~equal_query - ?(equal_response = phys_equal) - ~clear_when_deactivated - ~on_response_received - dispatcher - ~every - ~poll_behavior - query + (type query response) + ~sexp_of_query + ~sexp_of_response + ~equal_query + ?(equal_response = phys_equal) + ~clear_when_deactivated + ~on_response_received + dispatcher + ~every + ~poll_behavior + query = let module Query = struct type t = query @@ -375,31 +374,31 @@ let generic_poll_or_error ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) computation_status model action -> - let should_ignore = - match computation_status with - | Inactive -> clear_when_deactivated - | Active () -> false - in - if should_ignore - then default_model - else ( - match action with - | Finish { query; response; inflight_query_key } -> - let last_ok_response, last_error = - match response with - | Finished (Ok response) -> Some (query, response), None - | Finished (Error error) -> model.last_ok_response, Some (query, error) - | Aborted -> model.last_ok_response, model.last_error - in - { last_ok_response - ; last_error - ; inflight_queries = Map.remove model.inflight_queries inflight_query_key - } - | Start { query; inflight_query_key } -> - { model with - inflight_queries = - Map.add_exn model.inflight_queries ~key:inflight_query_key ~data:query - })) + let should_ignore = + match computation_status with + | Inactive -> clear_when_deactivated + | Active () -> false + in + if should_ignore + then default_model + else ( + match action with + | Finish { query; response; inflight_query_key } -> + let last_ok_response, last_error = + match response with + | Finished (Ok response) -> Some (query, response), None + | Finished (Error error) -> model.last_ok_response, Some (query, error) + | Aborted -> model.last_ok_response, model.last_error + in + { last_ok_response + ; last_error + ; inflight_queries = Map.remove model.inflight_queries inflight_query_key + } + | Start { query; inflight_query_key } -> + { model with + inflight_queries = + Map.add_exn model.inflight_queries ~key:inflight_query_key ~data:query + })) in let%sub effect = let%arr dispatcher = dispatcher @@ -472,16 +471,16 @@ let generic_poll_or_error leak on the server, so it would be shame if we didn't also defend against memory leaks on the client. *) let generic_poll_or_error - ~sexp_of_query - ~sexp_of_response - ~equal_query - ?equal_response - ?(clear_when_deactivated = true) - ?(on_response_received = Bonsai.Value.return (fun _ _ -> Effect.Ignore)) - dispatcher - ~every - ~poll_behavior - query + ~sexp_of_query + ~sexp_of_response + ~equal_query + ?equal_response + ?(clear_when_deactivated = true) + ?(on_response_received = Bonsai.Value.return (fun _ _ -> Effect.Ignore)) + dispatcher + ~every + ~poll_behavior + query = let c = generic_poll_or_error @@ -536,16 +535,16 @@ module Our_rpc = struct ;; let poll - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every + query = let open Bonsai.Let_syntax in let%sub dispatcher = dispatcher rpc ~where_to_connect in @@ -564,16 +563,16 @@ module Our_rpc = struct ;; let babel_poll - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every + query = let open Bonsai.Let_syntax in let%sub dispatcher = babel_dispatcher rpc ~where_to_connect in @@ -592,16 +591,16 @@ module Our_rpc = struct ;; let streamable_poll - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every + query = let open Bonsai.Let_syntax in let%sub dispatcher = streamable_dispatcher rpc ~where_to_connect in @@ -620,15 +619,15 @@ module Our_rpc = struct ;; let shared_poller - (type q cmp) - (module Q : Bonsai.Comparator with type t = q and type comparator_witness = cmp) - ?sexp_of_response - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every + (type q cmp) + (module Q : Bonsai.Comparator with type t = q and type comparator_witness = cmp) + ?sexp_of_response + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every = let module M = struct include Q @@ -653,16 +652,16 @@ module Our_rpc = struct ;; let poll_until_ok - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~retry_interval - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~retry_interval + query = let open Bonsai.Let_syntax in let%sub dispatcher = dispatcher rpc ~where_to_connect in @@ -681,16 +680,16 @@ module Our_rpc = struct ;; let babel_poll_until_ok - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~retry_interval - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~retry_interval + query = let open Bonsai.Let_syntax in let%sub dispatcher = babel_dispatcher rpc ~where_to_connect in @@ -747,16 +746,16 @@ module Polling_state_rpc = struct ;; let poll - ?sexp_of_query - ?sexp_of_response - ~equal_query - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every - query + ?sexp_of_query + ?sexp_of_response + ~equal_query + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every + query = let open Bonsai.Let_syntax in let%sub dispatcher = dispatcher rpc ~where_to_connect in @@ -780,15 +779,15 @@ module Polling_state_rpc = struct ;; let shared_poller - (type q cmp) - (module Q : Bonsai.Comparator with type t = q and type comparator_witness = cmp) - ?sexp_of_response - ?equal_response - ?clear_when_deactivated - ?on_response_received - rpc - ~where_to_connect - ~every + (type q cmp) + (module Q : Bonsai.Comparator with type t = q and type comparator_witness = cmp) + ?sexp_of_response + ?equal_response + ?clear_when_deactivated + ?on_response_received + rpc + ~where_to_connect + ~every = let module M = struct include Q @@ -883,51 +882,51 @@ module Status = struct dispatcher ~default_model:{ state = Initial; clock = None; connecting_since = None } ~apply_action:(fun context dispatcher model action -> - let writeback a = - Bonsai.Apply_action_context.schedule_event - context - (Bonsai.Apply_action_context.inject context (Set a)) - in - let state = model.state in - let new_state = - match action, dispatcher with - | Activate _, Inactive -> - (* The activate message got to us, but we became inactive in the interim *) - state - | Activate _, Active dispatch -> - (match state with - | Initial | State (Disconnected _ | Failed_to_connect _) -> - Bonsai.Apply_action_context.schedule_event context (dispatch writeback); - State Connecting - | State (Connecting | Connected) -> - (* We got activated, but we're still listening to the previous connection. *) - state) - | Set new_state, Active dispatch -> - (match new_state with - | Failed_to_connect _ | Disconnected _ -> - (* we failed, but we're still active, so try to reconnect *) - Bonsai.Apply_action_context.schedule_event context (dispatch writeback) - | Connected | Connecting -> ()); - State new_state - | Set new_state, Inactive -> State new_state - in - let clock = - match action with - | Activate clock -> Some clock - | Set _ -> model.clock - in - let connecting_since = - let now () = Option.map ~f:Bonsai.Time_source.now clock in - match state with - | State Connected -> - (match new_state with - | State Connected -> model.connecting_since - | Initial | State (Connecting | Disconnected _ | Failed_to_connect _) -> - now ()) - | Initial -> now () - | State _ -> model.connecting_since - in - { state = new_state; clock; connecting_since }) + let writeback a = + Bonsai.Apply_action_context.schedule_event + context + (Bonsai.Apply_action_context.inject context (Set a)) + in + let state = model.state in + let new_state = + match action, dispatcher with + | Activate _, Inactive -> + (* The activate message got to us, but we became inactive in the interim *) + state + | Activate _, Active dispatch -> + (match state with + | Initial | State (Disconnected _ | Failed_to_connect _) -> + Bonsai.Apply_action_context.schedule_event context (dispatch writeback); + State Connecting + | State (Connecting | Connected) -> + (* We got activated, but we're still listening to the previous connection. *) + state) + | Set new_state, Active dispatch -> + (match new_state with + | Failed_to_connect _ | Disconnected _ -> + (* we failed, but we're still active, so try to reconnect *) + Bonsai.Apply_action_context.schedule_event context (dispatch writeback) + | Connected | Connecting -> ()); + State new_state + | Set new_state, Inactive -> State new_state + in + let clock = + match action with + | Activate clock -> Some clock + | Set _ -> model.clock + in + let connecting_since = + let now () = Option.map ~f:Bonsai.Time_source.now clock in + match state with + | State Connected -> + (match new_state with + | State Connected -> model.connecting_since + | Initial | State (Connecting | Disconnected _ | Failed_to_connect _) -> + now ()) + | Initial -> now () + | State _ -> model.connecting_since + in + { state = new_state; clock; connecting_since }) in let%sub () = let%sub clock = Bonsai.Incr.with_clock Ui_incr.return in diff --git a/web/start.ml b/web/start.ml index efd57838..185020be 100644 --- a/web/start.ml +++ b/web/start.ml @@ -99,12 +99,12 @@ module Arrow_deprecated = struct let create = Fields.create let of_result_spec - (type result extra incoming) - (module Result : Result_spec - with type t = result - and type extra = extra - and type incoming = incoming) - (r : Result.t) + (type result extra incoming) + (module Result : Result_spec + with type t = result + and type extra = extra + and type incoming = incoming) + (r : Result.t) = { view = Result.view r ; extra = Result.extra r @@ -140,10 +140,10 @@ module Arrow_deprecated = struct } let start_bonsai_debugger - (is_debugging_var : debugging_state Incr.Var.t) - (host : Js.js_string Js.t Js.Optdef.t) - (port : int Js.Optdef.t) - (worker_name : Js.js_string Js.t Js.Optdef.t) + (is_debugging_var : debugging_state Incr.Var.t) + (host : Js.js_string Js.t Js.Optdef.t) + (port : int Js.Optdef.t) + (worker_name : Js.js_string Js.t Js.Optdef.t) = match Incr.Var.value is_debugging_var with | Debugging _ -> print_endline "Already debugging." @@ -159,32 +159,32 @@ module Arrow_deprecated = struct ;; let start_generic_poly - (type input action_input input_and_inject model dynamic_action static_action result - extra incoming outgoing) - ~(get_app_result : result -> (extra, incoming) App_result.t) - ~(get_app_input : - input:input - -> inject_outgoing:(outgoing -> unit Vdom.Effect.t) - -> input_and_inject) - ~(initial_input : input) - ~bind_to_element_with_id - ~(computation : result Bonsai.Private.Computation.t) - ~fresh - ({ model - ; input = _ - ; dynamic_action - ; static_action - ; apply_static - ; apply_dynamic - ; run - ; reset = _ - } as info : - ( model - , dynamic_action - , static_action - , action_input - , result ) - Bonsai.Private.Computation.info) + (type input action_input input_and_inject model dynamic_action static_action result + extra incoming outgoing) + ~(get_app_result : result -> (extra, incoming) App_result.t) + ~(get_app_input : + input:input + -> inject_outgoing:(outgoing -> unit Vdom.Effect.t) + -> input_and_inject) + ~(initial_input : input) + ~bind_to_element_with_id + ~(computation : result Bonsai.Private.Computation.t) + ~fresh + ({ model + ; input = _ + ; dynamic_action + ; static_action + ; apply_static + ; apply_dynamic + ; run + ; reset = _ + } as info : + ( model + , dynamic_action + , static_action + , action_input + , result ) + Bonsai.Private.Computation.info) : (input, extra, incoming, outgoing) Handle.t = let outgoing_pipe, pipe_write = Pipe.create () in @@ -246,16 +246,16 @@ module Arrow_deprecated = struct ;; let create - model - ~old_model:_ - ~inject - (run : - ( model - , dynamic_action - , static_action - , action_input - , result ) - Bonsai.Private.Computation.eval_fun) + model + ~old_model:_ + ~inject + (run : + ( model + , dynamic_action + , static_action + , action_input + , result ) + Bonsai.Private.Computation.eval_fun) = let open Incr.Let_syntax in let environment = @@ -373,11 +373,11 @@ module Arrow_deprecated = struct ;; let start_generic - ~optimize - ~get_app_result - ~initial_input - ~bind_to_element_with_id - ~component + ~optimize + ~get_app_result + ~initial_input + ~bind_to_element_with_id + ~component = let fresh = Type_equal.Id.create ~name:"" sexp_of_opaque in let var = @@ -400,10 +400,10 @@ module Arrow_deprecated = struct (* I can't use currying here because of the value restriction. *) let start_standalone - ?(optimize = true) - ~initial_input - ~bind_to_element_with_id - component + ?(optimize = true) + ~initial_input + ~bind_to_element_with_id + component = start_generic ~optimize @@ -476,18 +476,18 @@ module Proc = struct ;; let start_and_get_handle - result_spec - ?(optimize = true) - ?(custom_connector = default_custom_connector) - ~bind_to_element_with_id - computation + result_spec + ?(optimize = true) + ?(custom_connector = default_custom_connector) + ~bind_to_element_with_id + computation = let computation = Rpc_effect.Private.with_connector (function - | Self -> Rpc_effect.Private.self_connector () - | Url url -> Rpc_effect.Private.url_connector url - | Custom custom -> custom_connector custom) + | Self -> Rpc_effect.Private.self_connector () + | Url url -> Rpc_effect.Private.url_connector url + | Custom custom -> custom_connector custom) computation in let bonsai = diff --git a/web/start.mli b/web/start.mli index 7fd96450..b0cc6195 100644 --- a/web/start.mli +++ b/web/start.mli @@ -113,9 +113,8 @@ module Arrow_deprecated : sig -> bind_to_element_with_id:string -> ( ('input, 'outgoing) App_input.t , ('extra, 'incoming) App_result.t ) - Bonsai.Arrow_deprecated.t + Bonsai.Arrow_deprecated.t -> ('input, 'extra, 'incoming, 'outgoing) Handle.t - end module Proc : sig @@ -174,9 +173,9 @@ module Proc : sig type ('result, 'extra, 'incoming) t = (module S - with type t = 'result - and type extra = 'extra - and type incoming = 'incoming) + with type t = 'result + and type extra = 'extra + and type incoming = 'incoming) (** This module can be [include]d in an implementation of [Result_spec.S] where the result doesn't contain any [extra] output. *) diff --git a/web/to_incr_dom.ml b/web/to_incr_dom.ml index d66bc12b..1297c59e 100644 --- a/web/to_incr_dom.ml +++ b/web/to_incr_dom.ml @@ -20,14 +20,14 @@ end module Action_unshadowed = Action let create_generic - run - ~fresh - ~input - ~model - ~inject_dynamic - ~inject_static - ~apply_static - ~apply_dynamic + run + ~fresh + ~input + ~model + ~inject_dynamic + ~inject_static + ~apply_static + ~apply_dynamic = let environment = Bonsai.Private.Environment.(empty |> add_exn ~key:fresh ~data:input) @@ -72,22 +72,22 @@ let create_generic ;; let convert_generic - (type input action_input model dynamic_action static_action extra) - ~fresh - ~(run : - ( model - , dynamic_action - , static_action - , action_input - , Vdom.Node.t * extra ) - Bonsai.Private.Computation.eval_fun) - ~default_model - ~(dynamic_action_type_id : dynamic_action Bonsai.Private.Meta.Action.t) - ~(static_action_type_id : static_action Bonsai.Private.Meta.Action.t) - ~apply_static - ~apply_dynamic - ~equal_model - ~sexp_of_model + (type input action_input model dynamic_action static_action extra) + ~fresh + ~(run : + ( model + , dynamic_action + , static_action + , action_input + , Vdom.Node.t * extra ) + Bonsai.Private.Computation.eval_fun) + ~default_model + ~(dynamic_action_type_id : dynamic_action Bonsai.Private.Meta.Action.t) + ~(static_action_type_id : static_action Bonsai.Private.Meta.Action.t) + ~apply_static + ~apply_dynamic + ~equal_model + ~sexp_of_model : (module S with type Input.t = input and type Extra.t = extra) = (module struct @@ -142,15 +142,15 @@ let convert_with_extra ?(optimize = false) component = let var = Bonsai.Private.(Value.named App_input fresh |> conceal_value) in let maybe_optimize = if optimize then Bonsai.Private.pre_process else Fn.id in let (T - { model - ; input = _ - ; dynamic_action - ; static_action - ; apply_static - ; apply_dynamic - ; run - ; reset = _ - }) + { model + ; input = _ + ; dynamic_action + ; static_action + ; apply_static + ; apply_dynamic + ; run + ; reset = _ + }) = component var |> Bonsai.Private.reveal_computation diff --git a/web/util.ml b/web/util.ml index c70ccfc9..4d0ee933 100644 --- a/web/util.ml +++ b/web/util.ml @@ -1,7 +1,6 @@ open! Core open! Js_of_ocaml - let am_running_how : [ `Node_test | `Node_benchmark | `Node | `Browser_benchmark | `Browser ] = @@ -29,10 +28,10 @@ let am_within_disabled_fieldset (event : #Dom_html.event Js.t) = in Js.to_array event##composedPath |> Array.exists ~f:(fun element -> - let tag_name = Js.Optdef.to_option element##.tagName in - let disabled = Js.Optdef.to_option element##.disabled in - match Option.both tag_name disabled with - | None -> false - | Some (tag_name, disabled) -> - String.equal (Js.to_string tag_name) "FIELDSET" && Js.to_bool disabled) + let tag_name = Js.Optdef.to_option element##.tagName in + let disabled = Js.Optdef.to_option element##.disabled in + match Option.both tag_name disabled with + | None -> false + | Some (tag_name, disabled) -> + String.equal (Js.to_string tag_name) "FIELDSET" && Js.to_bool disabled) ;; diff --git a/web_test/external_event.ml b/web_test/external_event.ml index ddf42efc..3911bd0c 100644 --- a/web_test/external_event.ml +++ b/web_test/external_event.ml @@ -1,7 +1,7 @@ open! Core include Bonsai_web.Vdom.Effect.Define (struct - module Action = String + module Action = String - let handle str = printf "External event: %s\n" str - end) + let handle str = printf "External event: %s\n" str +end) diff --git a/web_test/helpers.ml b/web_test/helpers.ml index 65e2725e..6e7ac564 100644 --- a/web_test/helpers.ml +++ b/web_test/helpers.ml @@ -5,12 +5,12 @@ include Helpers_intf let sexp_to_string = Expect_test_helpers_core.sexp_to_string let make_generic - (type input extra action result s) - ~(driver : (input, s) Driver.t) - ~(string_of_result : result -> string) - ~(get_result : s -> result) - ~(get_extra : s -> extra) - ~(schedule_action : s -> action -> unit) + (type input extra action result s) + ~(driver : (input, s) Driver.t) + ~(string_of_result : result -> string) + ~(get_result : s -> result) + ~(get_extra : s -> extra) + ~(schedule_action : s -> action -> unit) : (module S with type input = input and type action = action and type extra = extra) = (module struct @@ -23,7 +23,6 @@ let make_generic ;; let show_model () = - (* Cleans up a sexp by - removing empty lists (unit models are common in bonsai) - flattening lists that contain a single element *) @@ -46,7 +45,6 @@ let make_generic let get_extra () = driver |> Driver.result |> get_extra - let set_input input = Driver.set_input driver input; Driver.flush driver; @@ -62,17 +60,17 @@ let make_generic ;; let make_vdom_generic - (type input action extra s) - ~(driver : (input, s) Driver.t) - ~(vdom_of_result : s -> Vdom.Node.t) - ~(get_extra : s -> extra) - ~(inject_of_result : s -> action -> unit Vdom.Effect.t) - ?(vdom_to_string = - fun node -> - node - |> Virtual_dom_test_helpers.Node_helpers.unsafe_convert_exn - |> Virtual_dom_test_helpers.Node_helpers.to_string_html) - () + (type input action extra s) + ~(driver : (input, s) Driver.t) + ~(vdom_of_result : s -> Vdom.Node.t) + ~(get_extra : s -> extra) + ~(inject_of_result : s -> action -> unit Vdom.Effect.t) + ?(vdom_to_string = + fun node -> + node + |> Virtual_dom_test_helpers.Node_helpers.unsafe_convert_exn + |> Virtual_dom_test_helpers.Node_helpers.to_string_html) + () : (module S_vdom with type input = input and type action = action and type extra = extra) = let open Virtual_dom_test_helpers in @@ -83,7 +81,7 @@ let make_vdom_generic ~get_result:vdom_of_result ~get_extra ~schedule_action:(fun s action -> - Driver.schedule_event driver ((inject_of_result s) action)) + Driver.schedule_event driver ((inject_of_result s) action)) in (module struct include H @@ -164,7 +162,7 @@ let make_string_with_inject ~driver = ~get_result:fst ~get_extra:(Fn.const ()) ~schedule_action:(fun (_, inject) action -> - Driver.schedule_event driver (inject action)) + Driver.schedule_event driver (inject action)) ;; let make_with_inject ~driver ~sexp_of_result = diff --git a/web_test/helpers_intf.ml b/web_test/helpers_intf.ml index 19dfae9a..76e9b393 100644 --- a/web_test/helpers_intf.ml +++ b/web_test/helpers_intf.ml @@ -1,7 +1,6 @@ open! Core open! Import - module type S = sig type input type action @@ -31,17 +30,17 @@ module type Helpers = sig -> get_extra:('s -> 'extra) -> schedule_action:('s -> 'action -> unit) -> (module S - with type action = 'action - and type input = 'input - and type extra = 'extra) + with type action = 'action + and type input = 'input + and type extra = 'extra) val make : driver:('input, 'result) Driver.t -> sexp_of_result:('result -> Sexp.t) -> (module S - with type input = 'input - and type action = Nothing.t - and type extra = unit) + with type input = 'input + and type action = Nothing.t + and type extra = unit) val make_with_inject : driver:('input, 'result * ('action -> unit Vdom.Effect.t)) Driver.t @@ -51,9 +50,9 @@ module type Helpers = sig val make_string : driver:('input, string) Driver.t -> (module S - with type input = 'input - and type action = Nothing.t - and type extra = unit) + with type input = 'input + and type action = Nothing.t + and type extra = unit) val make_string_with_inject : driver:('input, string * ('action -> unit Vdom.Effect.t)) Driver.t @@ -63,23 +62,23 @@ module type Helpers = sig : ?vdom_to_string:(Vdom.Node.t -> string) -> driver:('input, Vdom.Node.t) Driver.t -> (module S_vdom - with type input = 'input - and type action = Nothing.t - and type extra = unit) + with type input = 'input + and type action = Nothing.t + and type extra = unit) val make_vdom_with_extra : ?vdom_to_string:(Vdom.Node.t -> string) -> driver:('input, Vdom.Node.t * 'extra) Driver.t -> (module S_vdom - with type input = 'input - and type action = Nothing.t - and type extra = 'extra) + with type input = 'input + and type action = Nothing.t + and type extra = 'extra) val make_vdom_with_inject : ?vdom_to_string:(Vdom.Node.t -> string) -> driver:('input, Vdom.Node.t * ('action -> unit Vdom.Effect.t)) Driver.t -> (module S_vdom - with type input = 'input - and type action = 'action - and type extra = unit) + with type input = 'input + and type action = 'action + and type extra = unit) end diff --git a/web_test/proc.ml b/web_test/proc.ml index a56dffe6..dcd7d100 100644 --- a/web_test/proc.ml +++ b/web_test/proc.ml @@ -5,13 +5,13 @@ module Result_spec = struct include Bonsai_test.Result_spec let vdom - (type result) - ?filter_printed_attributes - ?(censor_paths = true) - ?(censor_hash = true) - ?path_censoring_message - ?hash_censoring_message - get_vdom + (type result) + ?filter_printed_attributes + ?(censor_paths = true) + ?(censor_hash = true) + ?path_censoring_message + ?hash_censoring_message + get_vdom = (module struct type t = result @@ -39,12 +39,12 @@ module Handle = struct include Bonsai_test.Handle let create - result_spec - ?rpc_implementations - ?(connectors = fun _ -> Bonsai_web.Rpc_effect.Connector.test_fallback) - ?start_time - ?optimize - computation + result_spec + ?rpc_implementations + ?(connectors = fun _ -> Bonsai_web.Rpc_effect.Connector.test_fallback) + ?start_time + ?optimize + computation = let connectors = match rpc_implementations with @@ -71,9 +71,9 @@ module Handle = struct ;; let flush_async_and_bonsai - ?(max_iterations = 100) - ?(silence_between_frames = false) - handle + ?(max_iterations = 100) + ?(silence_between_frames = false) + handle = let open Async_kernel in let rec loop i = @@ -102,13 +102,13 @@ module Handle = struct ;; let click_on - ?extra_event_fields - ?shift_key_down - ?alt_key_down - ?ctrl_key_down - handle - ~get_vdom - ~selector + ?extra_event_fields + ?shift_key_down + ?alt_key_down + ?ctrl_key_down + handle + ~get_vdom + ~selector = let element = get_element handle ~get_vdom ~selector in Node_helpers.User_actions.click_on @@ -120,14 +120,14 @@ module Handle = struct ;; let set_checkbox - ?extra_event_fields - ?shift_key_down - ?alt_key_down - ?ctrl_key_down - handle - ~get_vdom - ~selector - ~checked + ?extra_event_fields + ?shift_key_down + ?alt_key_down + ?ctrl_key_down + handle + ~get_vdom + ~selector + ~checked = let element = get_element handle ~get_vdom ~selector in Node_helpers.User_actions.set_checkbox @@ -185,14 +185,14 @@ module Handle = struct ;; let keydown - ?extra_event_fields - ?shift_key_down - ?alt_key_down - ?ctrl_key_down - handle - ~get_vdom - ~selector - ~key + ?extra_event_fields + ?shift_key_down + ?alt_key_down + ?ctrl_key_down + handle + ~get_vdom + ~selector + ~key = let element = get_element handle ~get_vdom ~selector in Node_helpers.User_actions.keydown diff --git a/web_test/proc.mli b/web_test/proc.mli index 337ec24a..20a300a0 100644 --- a/web_test/proc.mli +++ b/web_test/proc.mli @@ -52,7 +52,7 @@ module Handle : sig -> ?rpc_implementations: Async_rpc_kernel.Rpc.Connection.t Async_rpc_kernel.Rpc.Implementation.t list -> ?connectors:(Rpc_effect.Where_to_connect.t -> Rpc_effect.Connector.t) - (** By default [connectors] always returns + (** By default [connectors] always returns [Bonsai_web.Rpc_effect.Connector.test_fallback], which uses any provided [rpc_implementations] to handle any dispatched RPCs. *) -> ?start_time:Time_ns.t @@ -236,6 +236,4 @@ module Handle : sig -> Bonsai_web_ui_drag_and_drop.For_testing.Action.t -> unit end - - end diff --git a/web_test/rpc_effect_tests.ml b/web_test/rpc_effect_tests.ml index 97eeaff0..cdcb69ef 100644 --- a/web_test/rpc_effect_tests.ml +++ b/web_test/rpc_effect_tests.ml @@ -68,9 +68,9 @@ module Streamable_plain_rpc = struct let diffs ~from ~to_ = Map.symmetric_diff from to_ ~data_equal:[%equal: int] |> Sequence.map ~f:(fun (key, change) -> - match change with - | `Left _value -> Update.Diff.Remove { key } - | `Right data | `Unequal (_, data) -> Update.Diff.Set { key; data }) + match change with + | `Left _value -> Update.Diff.Remove { key } + | `Right data | `Unequal (_, data) -> Update.Diff.Set { key; data }) |> Sequence.to_list ;; @@ -83,15 +83,15 @@ module Streamable_plain_rpc = struct end include Streamable.Plain_rpc.Make (struct - let name = "streamable-plain-rpc" - let version = 0 - let client_pushes_back = false + let name = "streamable-plain-rpc" + let version = 0 + let client_pushes_back = false - module Response = Response + module Response = Response - type query = unit [@@deriving bin_io] - type response = Response.t - end) + type query = unit [@@deriving bin_io] + type response = Response.t + end) end let async_do_actions handle actions = @@ -222,8 +222,8 @@ let incrementing_polling_state_rpc_implementation ?block_on () = incr count; return (query * !count)) (fun _ query -> - incr count; - return (query * !count))) + incr count; + return (query * !count))) ;; let%expect_test "polling_state_rpc" = @@ -482,7 +482,7 @@ let%expect_test "disconnect and re-connect async_durable" = [%expect {| (Ok 0) |}]; is_broken := true; implementations - := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; + := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; let%bind () = async_do_actions handle [ 0 ] in [%expect {| (Ok 1) |}]; return () @@ -524,7 +524,7 @@ let%expect_test "disconnect and re-connect persistent_connection" = Rpc.Connection.close_finished connection in implementations - := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; + := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; let%bind _connection = Conn.connected connection in let%bind () = async_do_actions handle [ 0 ] in [%expect {| (Ok 1) |}]; @@ -568,7 +568,7 @@ let%expect_test "connect without menu" = (rpc_version 1))) |}]; is_broken := true; implementations - := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; + := Versioned_rpc.Menu.add [ Rpc.Rpc.implement' rpc_b (fun _ _query -> 1) ]; let%bind () = async_do_actions handle [ 0 ] in [%expect {| (Ok 1) |}]; return () @@ -708,12 +708,12 @@ let%test_module "Rvar tests" = let%test_module "Status.state" = (module struct module Conn = Persistent_connection_kernel.Make (struct - type t = Rpc.Connection.t + type t = Rpc.Connection.t - let close t = Rpc.Connection.close t - let is_closed t = Rpc.Connection.is_closed t - let close_finished t = Rpc.Connection.close_finished t - end) + let close t = Rpc.Connection.close t + let is_closed t = Rpc.Connection.is_closed t + let close_finished t = Rpc.Connection.close_finished t + end) module Status_option = struct type t = Rpc_effect.Status.t option [@@deriving sexp_of] @@ -1159,8 +1159,8 @@ let%test_module "Polling_state_rpc.poll" = (Expect_test_helpers_core.print_s ~hide_positions:true) ~for_first_request:(fun _ query -> next_result query) (fun _ query -> - incr count; - next_result query)) + incr count; + next_result query)) ;; let%expect_test "hit all possible responses from the poller" = @@ -2026,11 +2026,11 @@ let%test_module "Rpc.poll_until_ok" = type incoming = Refresh let view - { Rpc_effect.Poll_result.last_ok_response - ; last_error - ; inflight_query - ; refresh = _ - } + { Rpc_effect.Poll_result.last_ok_response + ; last_error + ; inflight_query + ; refresh = _ + } = Sexp.to_string_hum [%message @@ -2040,12 +2040,12 @@ let%test_module "Rpc.poll_until_ok" = ;; let incoming - { Rpc_effect.Poll_result.last_ok_response = _ - ; last_error = _ - ; inflight_query = _ - ; refresh - } - Refresh + { Rpc_effect.Poll_result.last_ok_response = _ + ; last_error = _ + ; inflight_query = _ + ; refresh + } + Refresh = refresh ;; diff --git a/web_ui/accordion/src/bonsai_web_ui_accordion.ml b/web_ui/accordion/src/bonsai_web_ui_accordion.ml index 59eda69c..3050ce03 100644 --- a/web_ui/accordion/src/bonsai_web_ui_accordion.ml +++ b/web_ui/accordion/src/bonsai_web_ui_accordion.ml @@ -11,13 +11,13 @@ type t = } let component - ?(extra_container_attrs = Value.return []) - ?(extra_title_attrs = Value.return []) - ?(extra_content_attrs = Value.return []) - ~starts_open - ~title - ~content - () + ?(extra_container_attrs = Value.return []) + ?(extra_title_attrs = Value.return []) + ?(extra_content_attrs = Value.return []) + ~starts_open + ~title + ~content + () = let%sub { state = is_open; set_state = set_is_open; toggle } = Bonsai.toggle' ~default_model:starts_open diff --git a/web_ui/auto_generated/src/bonsai_web_ui_auto_generated.ml b/web_ui/auto_generated/src/bonsai_web_ui_auto_generated.ml index 84d935e2..7be4a8ae 100644 --- a/web_ui/auto_generated/src/bonsai_web_ui_auto_generated.ml +++ b/web_ui/auto_generated/src/bonsai_web_ui_auto_generated.ml @@ -29,13 +29,13 @@ module Customization = struct let create_for_view ~apply_to_tag on_match = { apply_to_tag; on_match } let transform_form' - (type a) - (module M : Sexpable with type t = a) - ~apply_to_tag - (on_match : - Sexp_grammar.grammar Sexp_grammar.with_tag Value.t - -> recurse:(Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) - -> a Form.t Computation.t) + (type a) + (module M : Sexpable with type t = a) + ~apply_to_tag + (on_match : + Sexp_grammar.grammar Sexp_grammar.with_tag Value.t + -> recurse:(Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) + -> a Form.t Computation.t) = let transform grammar ~recurse = let%map.Computation on_match = on_match grammar ~recurse in @@ -45,20 +45,20 @@ module Customization = struct ;; let transform_form - ~apply_to_tag - (on_match : - Sexp_grammar.grammar Sexp_grammar.with_tag Value.t - -> recurse:(Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) - -> Sexp.t Form.t Computation.t) + ~apply_to_tag + (on_match : + Sexp_grammar.grammar Sexp_grammar.with_tag Value.t + -> recurse:(Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) + -> Sexp.t Form.t Computation.t) = transform_form' (module Sexp) ~apply_to_tag on_match ;; let constant_form - (type a) - (module M : Sexpable with type t = a) - ~apply_to_tag - (on_match : a Form.t Computation.t) + (type a) + (module M : Sexpable with type t = a) + ~apply_to_tag + (on_match : a Form.t Computation.t) = transform_form' (module M) ~apply_to_tag (fun _ ~recurse:_ -> on_match) ;; @@ -78,8 +78,8 @@ module Customization = struct module Defaults = struct module Form = struct let transform_key_data_pair - (with_tag : Sexp_grammar.grammar Sexp_grammar.with_tag Value.t) - ~recurse + (with_tag : Sexp_grammar.grammar Sexp_grammar.with_tag Value.t) + ~recurse = let%sub grammar = let%arr with_tag = with_tag in @@ -138,8 +138,8 @@ module Customization = struct ;; let transform_multiple_button_name - (with_tag : Sexp_grammar.grammar Sexp_grammar.with_tag Value.t) - ~(recurse : Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) + (with_tag : Sexp_grammar.grammar Sexp_grammar.with_tag Value.t) + ~(recurse : Sexp_grammar.grammar Value.t -> Sexp.t Form.t Computation.t) = let%sub { grammar; value; key = _ } = return with_tag in let%sub form = recurse grammar in @@ -213,9 +213,9 @@ module Customization = struct end module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .with_whitespace { white-space: pre-wrap; } @@ -283,12 +283,12 @@ let view grammar ~customizations = | Option g -> let view = view_grammar g in (function%sub - | List [] | Atom "None" | Atom "none" -> Bonsai.const (N.pre [ N.text "None" ]) - | List [ a ] | List [ Atom ("Some" | "some"); a ] -> view a - | other -> - let%arr other = other in - error_box - [%string "Expected a sexp representing an option, but got: %{other#Sexp}"]) + | List [] | Atom "None" | Atom "none" -> Bonsai.const (N.pre [ N.text "None" ]) + | List [ a ] | List [ Atom ("Some" | "some"); a ] -> view a + | other -> + let%arr other = other in + error_box + [%string "Expected a sexp representing an option, but got: %{other#Sexp}"]) | List l -> let view_list = view_list_grammar l in let list_kind = @@ -329,8 +329,8 @@ let view grammar ~customizations = | List [ Atom name; value ] -> Some (name, Sexp.List [ value ]) | _ -> None) |> String.Map.of_alist_reduce ~f:(fun _first second -> - (* there should never be duplicate fields, but if there are, take the last one *) - second) + (* there should never be duplicate fields, but if there are, take the last one *) + second) in let%sub map = Bonsai.assoc @@ -408,8 +408,8 @@ let view grammar ~customizations = in original_fields @ Map.data extra_fields and view_clauses - (case_sensitivity : Sexp_grammar.case_sensitivity) - (clauses : Sexp_grammar.clause Sexp_grammar.with_tag_list list) + (case_sensitivity : Sexp_grammar.case_sensitivity) + (clauses : Sexp_grammar.clause Sexp_grammar.with_tag_list list) = (* Note that since comparator witnesses have different types, we can't just use this case to pick which version of [of_alist_exn] to use. *) @@ -423,7 +423,7 @@ let view grammar ~customizations = clauses |> List.map ~f:Grammar_helper.Tags.strip_tags |> List.map ~f:(fun { name; clause_kind } -> - normalize_name name, view_clause clause_kind) + normalize_name name, view_clause clause_kind) |> String.Map.of_alist_exn in fun sexp -> @@ -484,66 +484,66 @@ let view grammar ~customizations = and view_list_grammar : Sexp_grammar.list_grammar -> Sexp.t Value.t -> Vdom.Node.t list Computation.t = function - | Empty -> fun _ -> Bonsai.const [] - | Cons (g, rest) as cons -> - (function%sub - | List (a :: xs) -> - let xs = Value.map xs ~f:(fun xs -> Sexp.List xs) in - let%map.Computation a = view_grammar g a - and xs = view_list_grammar rest xs in - a :: xs - | List [] -> - (Bonsai.lazy_ [@alert "-deprecated"]) - (lazy - (let cons = [%sexp (cons : Sexp_grammar.list_grammar)] in - [%string - "Encountered empty list sexp when attempting to process the grammar: \ - %{cons#Sexp}"] - |> error_box - |> List.return - |> Bonsai.const)) - | sexp -> - let%arr sexp = sexp in - [%string - "Encountered malformed sexp when attempting to view list grammar. Expected \ - non-empty list, but got %{sexp#Sexp}."] - |> error_box - |> List.return) - | Many g as many -> - (function%sub - | List xs -> - let xs = xs >>| List.mapi ~f:(fun i x -> i, x) >>| Int.Map.of_alist_exn in - let%map.Computation xs = - Bonsai.assoc (module Int) xs ~f:(fun _ data -> view_grammar g data) - in - Map.data xs - | Atom atom -> - let many = [%sexp (many : Sexp_grammar.list_grammar)] in - let%arr atom = atom in - [%string - "Encountered an atom, '%{atom}', while processing a list grammar: %{many#Sexp}"] - |> error_box - |> List.return) - | Fields f -> view_fields f + | Empty -> fun _ -> Bonsai.const [] + | Cons (g, rest) as cons -> + (function%sub + | List (a :: xs) -> + let xs = Value.map xs ~f:(fun xs -> Sexp.List xs) in + let%map.Computation a = view_grammar g a + and xs = view_list_grammar rest xs in + a :: xs + | List [] -> + (Bonsai.lazy_ [@alert "-deprecated"]) + (lazy + (let cons = [%sexp (cons : Sexp_grammar.list_grammar)] in + [%string + "Encountered empty list sexp when attempting to process the grammar: \ + %{cons#Sexp}"] + |> error_box + |> List.return + |> Bonsai.const)) + | sexp -> + let%arr sexp = sexp in + [%string + "Encountered malformed sexp when attempting to view list grammar. Expected \ + non-empty list, but got %{sexp#Sexp}."] + |> error_box + |> List.return) + | Many g as many -> + (function%sub + | List xs -> + let xs = xs >>| List.mapi ~f:(fun i x -> i, x) >>| Int.Map.of_alist_exn in + let%map.Computation xs = + Bonsai.assoc (module Int) xs ~f:(fun _ data -> view_grammar g data) + in + Map.data xs + | Atom atom -> + let many = [%sexp (many : Sexp_grammar.list_grammar)] in + let%arr atom = atom in + [%string + "Encountered an atom, '%{atom}', while processing a list grammar: %{many#Sexp}"] + |> error_box + |> List.return) + | Fields f -> view_fields f in view_grammar grammar ;; let view - (type a) - (module M : S with type t = a) - ?(customizations = []) - (value : a Value.t) - `This_view_may_change_without_notice + (type a) + (module M : S with type t = a) + ?(customizations = []) + (value : a Value.t) + `This_view_may_change_without_notice = let%sub sexp = Bonsai.pure M.sexp_of_t value in view M.t_sexp_grammar.untyped sexp ~customizations ;; let project_to_sexp - (type a) - (module M : Sexpable with type t = a) - (form : a Form.t Computation.t) + (type a) + (module M : Sexpable with type t = a) + (form : a Form.t Computation.t) = let%map.Computation form = form in Form.project form ~parse_exn:M.sexp_of_t ~unparse:M.t_of_sexp @@ -556,10 +556,10 @@ let maybe_set_tooltip doc view = ;; let form - ?textbox_for_string - (grammar : Sexp_grammar.grammar Value.t) - ~on_set_error - ~customizations + ?textbox_for_string + (grammar : Sexp_grammar.grammar Value.t) + ~on_set_error + ~customizations = let rec grammar_form (grammar : Sexp_grammar.grammar Value.t) : Sexp.t Form.t Computation.t @@ -748,14 +748,14 @@ let form clauses_as_map ~init:[] ~f:(fun ~key:name ~data:(_clause, doc) acc -> - match doc with - | None -> acc - | Some doc -> - View.vbox - [ Vdom.Node.span ~attrs:[ Style.bold_text ] [ Vdom.Node.text name ] - ; Vdom.Node.text doc - ] - :: acc) + match doc with + | None -> acc + | Some doc -> + View.vbox + [ Vdom.Node.span ~attrs:[ Style.bold_text ] [ Vdom.Node.text name ] + ; Vdom.Node.text doc + ] + :: acc) |> List.rev in match info with @@ -777,8 +777,8 @@ let form and view = view in ( Opt.to_option outer , (function - | None -> set_outer Explicitly_none - | Some outer -> set_outer (Set outer)) + | None -> set_outer Explicitly_none + | Some outer -> set_outer (Set outer)) , view ) in let%sub clauses_forms = @@ -1184,10 +1184,10 @@ let form ;; let form' - ?(on_set_error = Effect.print_s) - ?(customizations = Customization.Defaults.Form.all) - ?textbox_for_string - sexp_grammar + ?(on_set_error = Effect.print_s) + ?(customizations = Customization.Defaults.Form.all) + ?textbox_for_string + sexp_grammar = let%sub sexp_grammar = Bonsai.pure Sexp_grammar.Unroll_recursion.of_grammar_exn sexp_grammar @@ -1209,12 +1209,12 @@ let form' ;; let form - (type a) - (module M : S with type t = a) - ?on_set_error - ?customizations - ?textbox_for_string - () + (type a) + (module M : S with type t = a) + ?on_set_error + ?customizations + ?textbox_for_string + () : a Form.t Computation.t = let%map.Computation form = @@ -1234,8 +1234,8 @@ let view_as_vdom ?on_submit ?editable form = ~f: (fun { Form.Submit.f; handle_enter; button_text; button_attr; button_location } -> - let on_submit = Form.value form |> Result.ok |> Option.map ~f in - { Form.View.on_submit; handle_enter; button_text; button_attr; button_location }) + let on_submit = Form.value form |> Result.ok |> Option.map ~f in + { Form.View.on_submit; handle_enter; button_text; button_attr; button_location }) in Render_form.to_vdom ?on_submit ?editable (Form.view form) ;; diff --git a/web_ui/auto_generated/src/render_form.ml b/web_ui/auto_generated/src/render_form.ml index e2123295..493536b9 100644 --- a/web_ui/auto_generated/src/render_form.ml +++ b/web_ui/auto_generated/src/render_form.ml @@ -7,9 +7,9 @@ module Form_view = Form.View module Tooltip = struct module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .container { position: relative; display: inline-block; @@ -45,16 +45,16 @@ module Tooltip = struct end module Style = - [%css - stylesheet - ~rewrite: - [ "--font-family", "--font-family" - ; "--font-size", "--font-size" - ; "--accent-h", "--accent-h" - ; "--accent-s", "--accent-s" - ; "--accent-l", "--accent-l" - ] - {| +[%css +stylesheet + ~rewrite: + [ "--font-family", "--font-family" + ; "--font-size", "--font-size" + ; "--accent-h", "--accent-h" + ; "--accent-s", "--accent-s" + ; "--accent-l", "--accent-l" + ] + {| .form { --font-size: 12px; --font-family: monospace; @@ -264,9 +264,9 @@ let with_auto_generated_forms ~theme = else rest method! form_raw - ~eval_context - ~view_context - ({ unique_key; raw_view } : Form_view.raw) = + ~eval_context + ~view_context + ({ unique_key; raw_view } : Form_view.raw) = let view_context = { view_context with label = @@ -305,9 +305,9 @@ let with_auto_generated_forms ~theme = else rest method! form_variant - ~eval_context - ~view_context - ({ clause_selector; selected_clause } : Form_view.variant) = + ~eval_context + ~view_context + ({ clause_selector; selected_clause } : Form_view.variant) = let eval_context = Form_context.incr_depth eval_context in let rest = match selected_clause with @@ -321,9 +321,9 @@ let with_auto_generated_forms ~theme = ] method! form_option - ~eval_context - ~view_context - ({ toggle; status } : Form_view.option_view) = + ~eval_context + ~view_context + ({ toggle; status } : Form_view.option_view) = let eval_context = Form_context.incr_depth eval_context in let rest = match status with @@ -335,10 +335,10 @@ let with_auto_generated_forms ~theme = [ Node.tr [ label; Node.td [ toggle ] ]; nested_table eval_context rest ] method! form_list - ~eval_context - ~view_context - ({ list_items; append_item; legacy_button_position = _ } : - Form_view.list_view) = + ~eval_context + ~view_context + ({ list_items; append_item; legacy_button_position = _ } : + Form_view.list_view) = let header_is_inhabited = header_is_inhabited view_context in let eval_context = if header_is_inhabited diff --git a/web_ui/auto_generated/test/bonsai_web_ui_auto_generated_test.ml b/web_ui/auto_generated/test/bonsai_web_ui_auto_generated_test.ml index 24669542..0df6a8a7 100644 --- a/web_ui/auto_generated/test/bonsai_web_ui_auto_generated_test.ml +++ b/web_ui/auto_generated/test/bonsai_web_ui_auto_generated_test.ml @@ -22,11 +22,11 @@ let test_view (type a) ?customizations (module M : S with type t = a) (t : a) = ;; let sexp_form_handle - (type a) - ?optimize - ?get_vdom - ?customizations - (module M : S with type t = a) + (type a) + ?optimize + ?get_vdom + ?customizations + (module M : S with type t = a) = let form = Auto_generated.form (module M) ?customizations () in Handle.create ?optimize (form_result_spec ?get_vdom M.sexp_of_t) form @@ -483,12 +483,12 @@ let%expect_test "custom view for time" = String.equal key Sexplib0.Sexp_grammar.type_name_tag && Sexp.equal value ([%sexp_of: string] "Core.Time_ns.Alternate_sexp.t")) (fun sexp -> - let%arr sexp = sexp in - let time = [%of_sexp: Time_ns.Alternate_sexp.t] sexp in - List.map - ~f:Vdom.Node.text - (Time_ns.to_string_abs_parts ~zone:Time_float.Zone.utc time) - |> Vdom.Node.pre) + let%arr sexp = sexp in + let time = [%of_sexp: Time_ns.Alternate_sexp.t] sexp in + List.map + ~f:Vdom.Node.text + (Time_ns.to_string_abs_parts ~zone:Time_float.Zone.utc time) + |> Vdom.Node.pre) in test_view ~customizations:[ customize_t ] @@ -1676,33 +1676,33 @@ let%expect_test "customizing a tuple within a list" = String.equal key Sexplib0.Sexp_grammar.type_name_tag && Sexp.equal value ([%sexp_of: string] "my_pair")) (fun (with_tag : Sexp_grammar.grammar Sexp_grammar.with_tag Value.t) ~recurse -> - let%sub grammar = - let%arr with_tag = with_tag in - with_tag.grammar - in - match%sub (grammar : Sexplib0.Sexp_grammar.grammar Value.t) with - | List (Cons (first, Cons (second, Empty))) -> - let%sub first = recurse first in - let%sub second = recurse second in - let%arr first = first - and second = second in - let view = - Form.View.tuple - [ Form.view (Form.label "Key" first); Form.view (Form.label "Data" second) ] - in - let value = - match Or_error.both (Form.value first) (Form.value second) with - | Ok (first, second) -> Ok (Sexp.List [ first; second ]) - | Error _ as err -> err - in - let set sexp = - match sexp with - | Sexp.List [ first_val; second_val ] -> - Effect.Many [ Form.set first first_val; Form.set second second_val ] - | _ -> Effect.Ignore - in - Form.Expert.create ~value ~view ~set - | _ -> recurse grammar) + let%sub grammar = + let%arr with_tag = with_tag in + with_tag.grammar + in + match%sub (grammar : Sexplib0.Sexp_grammar.grammar Value.t) with + | List (Cons (first, Cons (second, Empty))) -> + let%sub first = recurse first in + let%sub second = recurse second in + let%arr first = first + and second = second in + let view = + Form.View.tuple + [ Form.view (Form.label "Key" first); Form.view (Form.label "Data" second) ] + in + let value = + match Or_error.both (Form.value first) (Form.value second) with + | Ok (first, second) -> Ok (Sexp.List [ first; second ]) + | Error _ as err -> err + in + let set sexp = + match sexp with + | Sexp.List [ first_val; second_val ] -> + Effect.Many [ Form.set first first_val; Form.set second second_val ] + | _ -> Effect.Ignore + in + Form.Expert.create ~value ~view ~set + | _ -> recurse grammar) in let handle = sexp_form_handle diff --git a/web_ui/common_components/bonsai_web_ui_common_components.ml b/web_ui/common_components/bonsai_web_ui_common_components.ml index 1a426bf7..7e516fbd 100644 --- a/web_ui/common_components/bonsai_web_ui_common_components.ml +++ b/web_ui/common_components/bonsai_web_ui_common_components.ml @@ -4,19 +4,19 @@ open! Bonsai.Let_syntax module Pills = struct let component - ~extra_container_attr - ~extra_pill_attr - ~to_string - ~to_list - ~inject_selected_options - ~remove_option - selected_options + ~extra_container_attr + ~extra_pill_attr + ~to_string + ~to_list + ~inject_selected_options + ~remove_option + selected_options = let%arr extra_container_attr = extra_container_attr - and extra_pill_attr = extra_pill_attr - and selected_options = selected_options + and extra_pill_attr = extra_pill_attr + and selected_options = selected_options and inject_selected_options = inject_selected_options - and to_string = to_string in + and to_string = to_string in let pill option = let remove_option event = if Bonsai_web.am_within_disabled_fieldset event @@ -30,27 +30,27 @@ module Pills = struct [ Vdom.Attr.( extra_pill_attr @ tabindex 0 - @ create "data-value" (to_string option) + @ create "data-value" (to_string option) @ on_click remove_option @ on_keyup (fun ev -> - match Js_of_ocaml.Dom_html.Keyboard_code.of_event ev with - | Space | Enter | NumpadEnter | Backspace | Delete -> remove_option ev - | _ -> Ui_effect.Ignore)) + match Js_of_ocaml.Dom_html.Keyboard_code.of_event ev with + | Space | Enter | NumpadEnter | Backspace | Delete -> remove_option ev + | _ -> Ui_effect.Ignore)) ] [ Vdom.Node.text (to_string option ^ " ×") ] in match to_list selected_options with - | [] -> Vdom.Node.none + | [] -> Vdom.Node.none | selected_options -> Vdom.Node.div ~attrs:[ extra_container_attr ] (List.map selected_options ~f:pill) ;; let of_list - ?(extra_container_attr = Value.return Vdom.Attr.empty) - ?(extra_pill_attr = Value.return Vdom.Attr.empty) - ~to_string - ~inject_selected_options - selected_options + ?(extra_container_attr = Value.return Vdom.Attr.empty) + ?(extra_pill_attr = Value.return Vdom.Attr.empty) + ~to_string + ~inject_selected_options + selected_options = let%sub selected_options = let%arr selected_options = selected_options in @@ -78,11 +78,11 @@ module Pills = struct ;; let of_set - ?(extra_container_attr = Value.return Vdom.Attr.empty) - ?(extra_pill_attr = Value.return Vdom.Attr.empty) - ~to_string - ~inject_selected_options - selected_options + ?(extra_container_attr = Value.return Vdom.Attr.empty) + ?(extra_pill_attr = Value.return Vdom.Attr.empty) + ~to_string + ~inject_selected_options + selected_options = component ~extra_container_attr diff --git a/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.ml b/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.ml index 1da6a22b..659326b4 100644 --- a/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.ml +++ b/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.ml @@ -4,9 +4,9 @@ open Bonsai.Let_syntax open Js_of_ocaml module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .no_select { user-select: none; } @@ -39,7 +39,7 @@ module State_machine_model = struct type ('source_id, 'target_id) dragging = { source : 'source_id ; target : 'target_id option - (* If [has_moved] is false, then the mouse has been clicked, but we do + (* If [has_moved] is false, then the mouse has been clicked, but we do not yet consider the dragging to have started, so for all visual purposes we are [Not_dragging]. *) ; has_moved : bool @@ -97,7 +97,7 @@ type ('source_id, 'target_id) t = let project_target : ('source, 'target_a) t -> map:('target_a -> 'target_b) - -> unmap:('target_b -> 'target_a) -> ('source, 'target_b) t + -> unmap:('target_b -> 'target_a) -> ('source, 'target_b) t = fun t ~map ~unmap -> let source ~id = t.source ~id in @@ -129,35 +129,35 @@ module For_testing = struct [@@deriving sexp, equal] let to_internal_actions - (type source target) - (module Source : S with type t = source) - (module Target : S with type t = target) + (type source target) + (module Source : S with type t = source) + (module Target : S with type t = target) = function - | Start_drag source -> - [ Action.Started_drag - { source = Sexp.of_string source |> Source.t_of_sexp - ; offset = { x = 0; y = 0 } - ; position = { x = 0; y = 0 } - ; size = { width = 0; height = 0 } - } - ; Action.Mouse_moved { x = 0; y = 0 } - ] - | Set_target (Some target) -> - [ Set_target (Some (Sexp.of_string target |> Target.t_of_sexp)) ] - | Set_target None -> [ Set_target None ] - | Finish_drag -> [ Finished_drag ] + | Start_drag source -> + [ Action.Started_drag + { source = Sexp.of_string source |> Source.t_of_sexp + ; offset = { x = 0; y = 0 } + ; position = { x = 0; y = 0 } + ; size = { width = 0; height = 0 } + } + ; Action.Mouse_moved { x = 0; y = 0 } + ] + | Set_target (Some target) -> + [ Set_target (Some (Sexp.of_string target |> Target.t_of_sexp)) ] + | Set_target None -> [ Set_target None ] + | Finish_drag -> [ Finished_drag ] ;; end module Inject_hook = Vdom.Attr.No_op_hook (struct - module Input = struct - type t = Action.t -> unit Effect.t [@@deriving sexp] + module Input = struct + type t = Action.t -> unit Effect.t [@@deriving sexp] - let combine _ second = second - end + let combine _ second = second + end - let name = "dnd-test-hook" - end) + let name = "dnd-test-hook" + end) let type_id = Inject_hook.type_id end @@ -190,10 +190,10 @@ let add_event_listener, remove_event_listener = ;; let create - (type source target) - ~source_id:(module Source : S with type t = source) - ~target_id:(module Target : S with type t = target) - ~on_drop + (type source target) + ~source_id:(module Source : S with type t = source) + ~target_id:(module Target : S with type t = target) + ~on_drop = let%sub model, inject = Bonsai.state_machine1 @@ -203,39 +203,39 @@ let create on_drop ~default_model:Not_dragging ~apply_action:(fun context on_drop model actions -> - match on_drop with - | Active on_drop -> - List.fold actions ~init:model ~f:(fun model action -> - match action with - | Action.Started_drag { source; offset; position; size } -> - (match model with - | State_machine_model.Not_dragging -> () - | Dragging _ -> bug "Started dragging before dragging finished"); - Dragging { source; offset; position; size; target = None; has_moved = false } - | Set_target target -> - (match model with - | State_machine_model.Not_dragging -> Not_dragging - | Dragging t -> Dragging { t with target }) - | Finished_drag -> - (match model with - | State_machine_model.Not_dragging | Dragging { target = None; _ } -> - Not_dragging - | Dragging { source; target = Some target; _ } -> - Bonsai.Apply_action_context.schedule_event context (on_drop source target); - Not_dragging) - | Mouse_moved position -> - (match model with - | State_machine_model.Not_dragging -> Not_dragging - | Dragging t -> Dragging { t with position; has_moved = true })) - | Inactive -> - eprint_s - [%message - [%here] - "An action sent to a [state_machine1] has been dropped because its input \ - was not present. This happens when the [state_machine1] is inactive when \ - it receives a message." - (actions : (Source.t, Target.t) Action.t list)]; - model) + match on_drop with + | Active on_drop -> + List.fold actions ~init:model ~f:(fun model action -> + match action with + | Action.Started_drag { source; offset; position; size } -> + (match model with + | State_machine_model.Not_dragging -> () + | Dragging _ -> bug "Started dragging before dragging finished"); + Dragging { source; offset; position; size; target = None; has_moved = false } + | Set_target target -> + (match model with + | State_machine_model.Not_dragging -> Not_dragging + | Dragging t -> Dragging { t with target }) + | Finished_drag -> + (match model with + | State_machine_model.Not_dragging | Dragging { target = None; _ } -> + Not_dragging + | Dragging { source; target = Some target; _ } -> + Bonsai.Apply_action_context.schedule_event context (on_drop source target); + Not_dragging) + | Mouse_moved position -> + (match model with + | State_machine_model.Not_dragging -> Not_dragging + | Dragging t -> Dragging { t with position; has_moved = true })) + | Inactive -> + eprint_s + [%message + [%here] + "An action sent to a [state_machine1] has been dropped because its input \ + was not present. This happens when the [state_machine1] is inactive when \ + it receives a message." + (actions : (Source.t, Target.t) Action.t list)]; + model) in let%sub source = let%arr inject = inject in @@ -286,13 +286,13 @@ let create Dom_html.Event.pointermove path_for_pointermove (fun (event : Dom_html.pointerEvent Js.t) -> - let (event - : < composedPath : 'a Js.js_array Js.t Js.meth ; Dom_html.pointerEvent > - Js.t) - = - Js.Unsafe.coerce event - in - (* Why client coordinates and not page or screen coordinates. I've + let (event + : < composedPath : 'a Js.js_array Js.t Js.meth ; Dom_html.pointerEvent > + Js.t) + = + Js.Unsafe.coerce event + in + (* Why client coordinates and not page or screen coordinates. I've tested with all three and client coordinates is clearly the correct choice. @@ -311,22 +311,22 @@ let create It makes sense that client coordinates is correct because the dragged element itself uses fixed positioning, which is roughly equivalent to client coordinates. *) - let position = { Position.x = event##.clientX; y = event##.clientY } in - let path = Js.to_array event##composedPath |> Array.to_list in - let target = - List.find_map path ~f:(fun element -> - let%bind.Option dataset = Js.Opt.to_option element##.dataset in - let%map.Option drag_target = - Js.Opt.to_option (Js.Unsafe.get dataset ("dragTarget" ^ universe_suffix)) - in - let drag_target = Js.to_string drag_target in - Target.t_of_sexp (Sexp.of_string drag_target)) - in - Effect.Expert.handle_non_dom_event_exn - (match Bonsai_web.am_within_disabled_fieldset event with - | true -> inject [ Set_target None; Mouse_moved position ] - | false -> inject [ Set_target target; Mouse_moved position ]); - Js._true) + let position = { Position.x = event##.clientX; y = event##.clientY } in + let path = Js.to_array event##composedPath |> Array.to_list in + let target = + List.find_map path ~f:(fun element -> + let%bind.Option dataset = Js.Opt.to_option element##.dataset in + let%map.Option drag_target = + Js.Opt.to_option (Js.Unsafe.get dataset ("dragTarget" ^ universe_suffix)) + in + let drag_target = Js.to_string drag_target in + Target.t_of_sexp (Sexp.of_string drag_target)) + in + Effect.Expert.handle_non_dom_event_exn + (match Bonsai_web.am_within_disabled_fieldset event with + | true -> inject [ Set_target None; Mouse_moved position ] + | false -> inject [ Set_target target; Mouse_moved position ]); + Js._true) in add_event_listener Dom_html.Event.pointerup path_for_pointerup (fun event -> Effect.Expert.handle_non_dom_event_exn diff --git a/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.mli b/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.mli index 4d3a9719..d435f142 100644 --- a/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.mli +++ b/web_ui/drag_and_drop/src/bonsai_web_ui_drag_and_drop.mli @@ -62,7 +62,6 @@ val project_target dragged value to the input ['source_id]. *) val source : ('source_id, 'target_id) t -> id:'source_id -> Vdom.Attr.t - (** While this attribute does nothing while the app is running, it facilitates testing by allowing tests to directly change the state of the universe. *) val sentinel : ('source_id, 'target_id) t -> name:string -> Vdom.Attr.t diff --git a/web_ui/element_size_hooks/src/bulk_size_tracker.ml b/web_ui/element_size_hooks/src/bulk_size_tracker.ml index 8ae8f447..cd1beefb 100644 --- a/web_ui/element_size_hooks/src/bulk_size_tracker.ml +++ b/web_ui/element_size_hooks/src/bulk_size_tracker.ml @@ -83,11 +83,11 @@ module Hook = struct List.iter changes ~f:(fun (input, dimensions) -> Input.to_alist input |> List.iter ~f:(fun (T (group_key, keys)) -> - List.iter keys ~f:(fun key -> - dimension_groups - := Event_groups.change !dimension_groups group_key ~f:(fun items -> - let items = Option.value ~default:[] items in - Some (Action.Set (key, dimensions) :: items))))); + List.iter keys ~f:(fun key -> + dimension_groups + := Event_groups.change !dimension_groups group_key ~f:(fun items -> + let items = Option.value ~default:[] items in + Some (Action.Set (key, dimensions) :: items))))); let events = let f ~key:_ = function | `Both (tracker, dimension_group) -> Some (tracker dimension_group) @@ -168,9 +168,9 @@ module Options = struct end let component - (type key cmp contained) - (key : (key, cmp) Bonsai.comparator) - (options : contained Options.t) + (type key cmp contained) + (key : (key, cmp) Bonsai.comparator) + (options : contained Options.t) = let open Bonsai.Let_syntax in let module Key = (val key) in diff --git a/web_ui/element_size_hooks/src/freeze.ml b/web_ui/element_size_hooks/src/freeze.ml index 15d34d64..9b79487a 100644 --- a/web_ui/element_size_hooks/src/freeze.ml +++ b/web_ui/element_size_hooks/src/freeze.ml @@ -31,12 +31,12 @@ module T = struct let combine left right = { set = (fun element -> - left.set element; - right.set element) + left.set element; + right.set element) ; reset = (fun element -> - left.reset element; - right.reset element) + left.reset element; + right.reset element) } ;; end diff --git a/web_ui/element_size_hooks/src/gen_js_api.ml b/web_ui/element_size_hooks/src/gen_js_api.ml index 678914a6..b18a978a 100644 --- a/web_ui/element_size_hooks/src/gen_js_api.ml +++ b/web_ui/element_size_hooks/src/gen_js_api.ml @@ -1,2 +1,2 @@ -module Ojs = Ojs +module Ojs = Ojs module Ojs_exn = Ojs_exn diff --git a/web_ui/element_size_hooks/src/import.ml b/web_ui/element_size_hooks/src/import.ml index 6b20e7c9..1523a162 100644 --- a/web_ui/element_size_hooks/src/import.ml +++ b/web_ui/element_size_hooks/src/import.ml @@ -1,7 +1,6 @@ open! Core open Js_of_ocaml - let cancel_animation_frame id = Dom_html.window##cancelAnimationFrame id let request_animation_frame f = diff --git a/web_ui/element_size_hooks/src/position_tracker.ml b/web_ui/element_size_hooks/src/position_tracker.ml index cc4296b4..ba56bfa3 100644 --- a/web_ui/element_size_hooks/src/position_tracker.ml +++ b/web_ui/element_size_hooks/src/position_tracker.ml @@ -88,11 +88,11 @@ module Hook = struct List.iter changes ~f:(fun (input, dimensions) -> Input.to_alist input |> List.iter ~f:(fun (T (group_key, keys)) -> - List.iter keys ~f:(fun key -> - dimension_groups - := Event_groups.change !dimension_groups group_key ~f:(fun items -> - let items = Option.value ~default:[] items in - Some (Action.Set (key, dimensions) :: items))))); + List.iter keys ~f:(fun key -> + dimension_groups + := Event_groups.change !dimension_groups group_key ~f:(fun items -> + let items = Option.value ~default:[] items in + Some (Action.Set (key, dimensions) :: items))))); let events = let f ~key:_ = function | `Both (tracker, dimension_group) -> Some (tracker dimension_group) diff --git a/web_ui/element_size_hooks/src/resize_to_fit.ml b/web_ui/element_size_hooks/src/resize_to_fit.ml index b4a52b05..f767e9a2 100644 --- a/web_ui/element_size_hooks/src/resize_to_fit.ml +++ b/web_ui/element_size_hooks/src/resize_to_fit.ml @@ -30,7 +30,7 @@ module T = struct module State = struct type t = { mutable observer : ResizeObserver.resizeObserver Js.t option - (* [my_dims] and [parent_dims] are in their local dimensionality and are + (* [my_dims] and [parent_dims] are in their local dimensionality and are calculated prior to the transformation taking effect. *) ; mutable my_dims : Dims.t ; mutable parent_dims : Dims.t @@ -70,9 +70,9 @@ module T = struct in let lte_zero f = Float.(f <= 0.0) in if lte_zero state.my_dims.width - || lte_zero state.my_dims.height - || lte_zero state.parent_dims.width - || lte_zero state.parent_dims.height + || lte_zero state.my_dims.height + || lte_zero state.parent_dims.width + || lte_zero state.parent_dims.height then set_scale 1.0 else ( let width_rat = state.parent_dims.width /. state.my_dims.width in @@ -135,7 +135,7 @@ module T = struct Js.Opt.case state.me##.parentNode (fun () -> - eprint_s [%message "BUG" [%here] "parent should always be set in [on_mount]"]) + eprint_s [%message "BUG" [%here] "parent should always be set in [on_mount]"]) (fun parent -> state.observer <- Some (observe ~parent ~state)) ;; diff --git a/web_ui/element_size_hooks/src/resize_to_fit.mli b/web_ui/element_size_hooks/src/resize_to_fit.mli index e0fca69d..1a74e737 100644 --- a/web_ui/element_size_hooks/src/resize_to_fit.mli +++ b/web_ui/element_size_hooks/src/resize_to_fit.mli @@ -2,7 +2,6 @@ open! Core open! Bonsai_web open! Js_of_ocaml - module Behavior : sig type t = | Grow_to_fill diff --git a/web_ui/element_size_hooks/src/resizer.mli b/web_ui/element_size_hooks/src/resizer.mli index e6c47f6e..77c8d244 100644 --- a/web_ui/element_size_hooks/src/resizer.mli +++ b/web_ui/element_size_hooks/src/resizer.mli @@ -11,5 +11,3 @@ end (** This attribute, when added to a Vdom node adds the ability for that dom-node to be clicked-and-dragged to change its parents width. *) val attr : side:Side.t -> Vdom.Attr.t - - diff --git a/web_ui/element_size_hooks/src/scroll_tracker.ml b/web_ui/element_size_hooks/src/scroll_tracker.ml index ba73023a..e4fd6e11 100644 --- a/web_ui/element_size_hooks/src/scroll_tracker.ml +++ b/web_ui/element_size_hooks/src/scroll_tracker.ml @@ -44,11 +44,11 @@ module Scroll_tracker = struct let vertical = target##.scrollHeight > target##.clientHeight in let horizontal = target##.scrollWidth > target##.clientWidth in state.scrollable - <- (match vertical, horizontal with - | true, true -> Both - | true, false -> Vertical - | false, true -> Horizontal - | false, false -> Neither); + <- (match vertical, horizontal with + | true, true -> Both + | true, false -> Vertical + | false, true -> Horizontal + | false, false -> Neither); state.callback ~scrollable:state.scrollable in () diff --git a/web_ui/element_size_hooks/src/visibility_tracker.ml b/web_ui/element_size_hooks/src/visibility_tracker.ml index 883c0b20..e4413e85 100644 --- a/web_ui/element_size_hooks/src/visibility_tracker.ml +++ b/web_ui/element_size_hooks/src/visibility_tracker.ml @@ -30,12 +30,12 @@ module T = struct let sexp_of_t = sexp_of_opaque let combine - { client_rect_changed = client_rect_changed_left - ; visible_rect_changed = visible_rect_changed_left - } - { client_rect_changed = client_rect_changed_right - ; visible_rect_changed = visible_rect_changed_right - } + { client_rect_changed = client_rect_changed_left + ; visible_rect_changed = visible_rect_changed_left + } + { client_rect_changed = client_rect_changed_right + ; visible_rect_changed = visible_rect_changed_right + } = let client_rect_changed bbox = Vdom.Effect.sequence_as_sibling @@ -82,17 +82,17 @@ module T = struct and observer = lazy (new%js IntersectionObserver.intersectionObserver - (Js.wrap_callback - (fun entries (observer : IntersectionObserver.intersectionObserver Js.t) -> - for i = 0 to entries##.length - 1 do - let entry = Js.array_get entries i in - Js.Optdef.iter entry process - done; - (* unobserve and immediately re-observe in order to trigger a + (Js.wrap_callback + (fun entries (observer : IntersectionObserver.intersectionObserver Js.t) -> + for i = 0 to entries##.length - 1 do + let entry = Js.array_get entries i in + Js.Optdef.iter entry process + done; + (* unobserve and immediately re-observe in order to trigger a recomputation of the intersection rect. *) - observer##unobserve (element :> #Dom.node Js.t); - observer##observe (element :> #Dom.node Js.t))) - (IntersectionObserver.empty_intersection_observer_options ())) + observer##unobserve (element :> #Dom.node Js.t); + observer##observe (element :> #Dom.node Js.t))) + (IntersectionObserver.empty_intersection_observer_options ())) and process entry = let client_rect = Bbox.of_client_rect entry##.boundingClientRect in let intersection_rect = @@ -109,7 +109,7 @@ module T = struct in let state = Lazy.force state in if state.dirty - || not ([%equal: Bbox.t option] intersection_rect state.prev.visible_section) + || not ([%equal: Bbox.t option] intersection_rect state.prev.visible_section) then ( intersection_rect |> state.callback.visible_rect_changed @@ -141,9 +141,9 @@ end module Hook = Vdom.Attr.Hooks.Make (T) let detect - ?(client_rect_changed = fun _ -> Effect.Ignore) - ?(visible_rect_changed = fun _ -> Effect.Ignore) - () + ?(client_rect_changed = fun _ -> Effect.Ignore) + ?(visible_rect_changed = fun _ -> Effect.Ignore) + () = Vdom.Attr.create_hook "bounds-change" diff --git a/web_ui/extendy/src/bonsai_web_ui_extendy.ml b/web_ui/extendy/src/bonsai_web_ui_extendy.ml index 956363dc..f0d4b270 100644 --- a/web_ui/extendy/src/bonsai_web_ui_extendy.ml +++ b/web_ui/extendy/src/bonsai_web_ui_extendy.ml @@ -42,8 +42,8 @@ let state_component = ~sexp_of_action:[%sexp_of: Action.t] ~default_model:Model.default ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) (model : Model.t) -> function - | Add { how_many } -> Fn.apply_n_times ~n:how_many Model.add_one model - | Remove key -> Model.remove model ~key) + | Add { how_many } -> Fn.apply_n_times ~n:how_many Model.add_one model + | Remove key -> Model.remove model ~key) ;; let component' t ~wrap_remove = diff --git a/web_ui/file/from_web_file/bonsai_web_ui_file_from_web_file.ml b/web_ui/file/from_web_file/bonsai_web_ui_file_from_web_file.ml index 91e663b7..a1939dda 100644 --- a/web_ui/file/from_web_file/bonsai_web_ui_file_from_web_file.ml +++ b/web_ui/file/from_web_file/bonsai_web_ui_file_from_web_file.ml @@ -10,50 +10,50 @@ let create file = let result = Bonsai_web.Effect.of_deferred_fun (fun () -> - let call_on_progress ev = - if Js.to_bool ev##.lengthComputable - then - on_progress - { Bonsai_web_ui_file.Progress.loaded = ev##.loaded; total = ev##.total } - |> Ui_effect.Expert.handle - in - file_reader##.onprogress - := Dom.handler (fun ev -> - call_on_progress ev; - Js._true); - file_reader##.onerror - := Dom.handler (fun _ev -> - let error = - Error.create_s - [%message - "Error reading file" - ~code:(file_reader##.error##.code : int) - ~message: - (Js.to_string - (Js.Unsafe.get file_reader##.error (Js.string "message")))] - in - Ivar.fill_if_empty - result - (Error (Bonsai_web_ui_file.Read_error.Error error)); - Js._true); - file_reader##.onload - := Dom.handler (fun ev -> - call_on_progress ev; - (match - file_reader##.result - |> File.CoerceTo.arrayBuffer - |> Js.Opt.to_option - with - | None -> - raise_s - [%message - "BUG: could not coerce fileReader result to arrayBuffer"] - | Some array_buffer -> - let contents = Typed_array.Bigstring.of_arrayBuffer array_buffer in - Ivar.fill_if_empty result (Ok contents)); - Js._true); - file_reader##readAsArrayBuffer file; - Ivar.read result) + let call_on_progress ev = + if Js.to_bool ev##.lengthComputable + then + on_progress + { Bonsai_web_ui_file.Progress.loaded = ev##.loaded; total = ev##.total } + |> Ui_effect.Expert.handle + in + file_reader##.onprogress + := Dom.handler (fun ev -> + call_on_progress ev; + Js._true); + file_reader##.onerror + := Dom.handler (fun _ev -> + let error = + Error.create_s + [%message + "Error reading file" + ~code:(file_reader##.error##.code : int) + ~message: + (Js.to_string + (Js.Unsafe.get file_reader##.error (Js.string "message")))] + in + Ivar.fill_if_empty + result + (Error (Bonsai_web_ui_file.Read_error.Error error)); + Js._true); + file_reader##.onload + := Dom.handler (fun ev -> + call_on_progress ev; + (match + file_reader##.result + |> File.CoerceTo.arrayBuffer + |> Js.Opt.to_option + with + | None -> + raise_s + [%message + "BUG: could not coerce fileReader result to arrayBuffer"] + | Some array_buffer -> + let contents = Typed_array.Bigstring.of_arrayBuffer array_buffer in + Ivar.fill_if_empty result (Ok contents)); + Js._true); + file_reader##readAsArrayBuffer file; + Ivar.read result) () in let abort = Ui_effect.of_sync_fun (fun () -> file_reader##abort) () in diff --git a/web_ui/file/src/bonsai_web_ui_file.ml b/web_ui/file/src/bonsai_web_ui_file.ml index e5398cd9..2001cfc5 100644 --- a/web_ui/file/src/bonsai_web_ui_file.ml +++ b/web_ui/file/src/bonsai_web_ui_file.ml @@ -178,24 +178,24 @@ module For_testing = struct let result = Ui_effect.For_testing.of_svar_fun (fun () -> - Test_data.read - test_data - { on_progress = - (fun progress -> on_progress progress |> Ui_effect.Expert.handle) - ; on_finished = - (fun result -> - Svar.fill_if_empty - result_var - (Result.map_error result ~f:(fun e -> Read_error.Error e))) - }; - result_var) + Test_data.read + test_data + { on_progress = + (fun progress -> on_progress progress |> Ui_effect.Expert.handle) + ; on_finished = + (fun result -> + Svar.fill_if_empty + result_var + (Result.map_error result ~f:(fun e -> Read_error.Error e))) + }; + result_var) () in let abort = Ui_effect.of_sync_fun (fun () -> - Test_data.abort_read test_data; - Svar.fill_if_empty result_var (Error Aborted)) + Test_data.abort_read test_data; + Svar.fill_if_empty result_var (Error Aborted)) () in { File_read.result; abort } diff --git a/web_ui/file/src/bonsai_web_ui_file.mli b/web_ui/file/src/bonsai_web_ui_file.mli index 7c970033..4b6f7684 100644 --- a/web_ui/file/src/bonsai_web_ui_file.mli +++ b/web_ui/file/src/bonsai_web_ui_file.mli @@ -88,7 +88,7 @@ module Read_on_change : sig module Status : sig type t = | Starting - (** The file read has been kicked off but no progress has been received yet *) + (** The file read has been kicked off but no progress has been received yet *) | In_progress of Progress.t | Complete of Bigstring.t Or_error.t [@@deriving sexp_of] diff --git a/web_ui/file/test/test_bonsai_web_ui_file.ml b/web_ui/file/test/test_bonsai_web_ui_file.ml index 48137fda..f92f8480 100644 --- a/web_ui/file/test/test_bonsai_web_ui_file.ml +++ b/web_ui/file/test/test_bonsai_web_ui_file.ml @@ -184,7 +184,6 @@ let%expect_test "abort" = [%expect {| ("Read result"(Finished(Error Aborted))) |}] ;; - module Test_read_on_change = struct let%expect_test "create_single" = let t_var = Bonsai.Var.create None in diff --git a/web_ui/form/src/bonsai_web_ui_form.ml b/web_ui/form/src/bonsai_web_ui_form.ml index f6f35398..4715e950 100644 --- a/web_ui/form/src/bonsai_web_ui_form.ml +++ b/web_ui/form/src/bonsai_web_ui_form.ml @@ -2,4 +2,3 @@ open! Core include Form module Elements = Elements module Typed = Typed - diff --git a/web_ui/form/src/elements.ml b/web_ui/form/src/elements.ml index b8c37898..302425cf 100644 --- a/web_ui/form/src/elements.ml +++ b/web_ui/form/src/elements.ml @@ -18,9 +18,9 @@ module type Stringable_model = sig end module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .invalid_text_box { outline: none; border: 2px solid red; @@ -72,19 +72,19 @@ module Non_interactive = struct end let string_underlying - ~(f : - ?extra_attrs:Vdom.Attr.t list - -> ?call_on_input_when:Vdom_input_widgets.Entry.Call_on_input_when.t - -> ?disabled:bool - -> ?placeholder:string - -> ?merge_behavior:Vdom_input_widgets.Merge_behavior.t - -> value:string option - -> on_input:(string option -> unit Ui_effect.t) - -> unit - -> Vdom.Node.t) - ?(extra_attrs = Value.return []) - ?placeholder - () + ~(f : + ?extra_attrs:Vdom.Attr.t list + -> ?call_on_input_when:Vdom_input_widgets.Entry.Call_on_input_when.t + -> ?disabled:bool + -> ?placeholder:string + -> ?merge_behavior:Vdom_input_widgets.Merge_behavior.t + -> value:string option + -> on_input:(string option -> unit Ui_effect.t) + -> unit + -> Vdom.Node.t) + ?(extra_attrs = Value.return []) + ?placeholder + () = let view = let%map extra_attrs = extra_attrs in @@ -139,10 +139,10 @@ module Textbox = struct ;; let stringable - (type t) - ?extra_attrs - ?placeholder - (module M : Stringable with type t = t) + (type t) + ?extra_attrs + ?placeholder + (module M : Stringable with type t = t) = let%map.Computation form = string ?extra_attrs ?placeholder () in Form.project form ~parse_exn:M.of_string ~unparse:M.to_string @@ -155,10 +155,10 @@ module Password = struct ;; let stringable - (type t) - ?extra_attrs - ?placeholder - (module M : Stringable with type t = t) + (type t) + ?extra_attrs + ?placeholder + (module M : Stringable with type t = t) = let%map.Computation form = string ?extra_attrs ?placeholder () in Form.project form ~parse_exn:M.of_string ~unparse:M.to_string @@ -201,10 +201,10 @@ module Textarea = struct ;; let stringable - (type t) - ?extra_attrs - ?placeholder - (module M : Stringable with type t = t) + (type t) + ?extra_attrs + ?placeholder + (module M : Stringable with type t = t) = let%map.Computation form = string ?extra_attrs ?placeholder () in Form.project form ~parse_exn:M.of_string ~unparse:M.to_string @@ -258,13 +258,13 @@ module Checkbox = struct let bool ?extra_attrs ~default () = checkbox ?extra_attrs default let set - (type a cmp) - ?(style = Value.return Selectable_style.Native) - ?(extra_attrs = Value.return []) - ?to_string - ?(layout = `Vertical) - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - values + (type a cmp) + ?(style = Value.return Selectable_style.Native) + ?(extra_attrs = Value.return []) + ?to_string + ?(layout = `Vertical) + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + values : (a, cmp) Set.t Form.t Computation.t = let to_string = @@ -311,9 +311,9 @@ module Toggle = struct (* Most of this css is from https://www.w3schools.com/howto/howto_css_switch.asp *) module Style = - [%css - stylesheet - {| + [%css + stylesheet + {| .toggle { position: relative; display: inline-block; @@ -404,18 +404,18 @@ module Dropdown = struct end let make_input - (type a) - ?to_string - (module E : Model with type t = a) - ~equal - ~id - ~include_empty - ~default_value - ~(state : a Opt.t) - ~(set_state : a Opt.t -> unit Effect.t) - ~extra_attrs - ~extra_option_attrs - ~all + (type a) + ?to_string + (module E : Model with type t = a) + ~equal + ~id + ~include_empty + ~default_value + ~(state : a Opt.t) + ~(set_state : a Opt.t -> unit Effect.t) + ~extra_attrs + ~extra_option_attrs + ~all = let module E = struct include E @@ -459,15 +459,15 @@ module Dropdown = struct ;; let impl - (type t) - ?to_string - ?(extra_attrs = Value.return []) - ?(extra_option_attrs = Value.return (Fn.const [])) - (module E : Model with type t = t) - ~equal - all - ~include_empty - ~init + (type t) + ?to_string + ?(extra_attrs = Value.return []) + ?(extra_option_attrs = Value.return (Fn.const [])) + (module E : Model with type t = t) + ~equal + all + ~include_empty + ~init = let module E = struct include E @@ -528,14 +528,14 @@ module Dropdown = struct ;; let list_opt - (type t) - ?(init = `Empty) - ?extra_attrs - ?extra_option_attrs - ?to_string - (module E : Model with type t = t) - ~equal - all + (type t) + ?(init = `Empty) + ?extra_attrs + ?extra_option_attrs + ?to_string + (module E : Model with type t = t) + ~equal + all = impl ?to_string @@ -549,12 +549,12 @@ module Dropdown = struct ;; let enumerable_opt - (type t) - ?(init = `Empty) - ?extra_attrs - ?extra_option_attrs - ?to_string - (module E : Bonsai.Enum with type t = t) + (type t) + ?(init = `Empty) + ?extra_attrs + ?extra_option_attrs + ?to_string + (module E : Bonsai.Enum with type t = t) = impl ?extra_attrs @@ -588,12 +588,12 @@ module Dropdown = struct ;; let enumerable - (type t) - ?(init = `First_item) - ?extra_attrs - ?extra_option_attrs - ?to_string - (module E : Bonsai.Enum with type t = t) + (type t) + ?(init = `First_item) + ?extra_attrs + ?extra_option_attrs + ?to_string + (module E : Bonsai.Enum with type t = t) = let%map.Computation form = impl @@ -618,15 +618,15 @@ end module Typeahead = struct let single_opt - (type a) - ?(extra_attrs = Value.return []) - ?placeholder - ?to_string - ?to_option_description - ?handle_unknown_option - (module M : Bonsai.Model with type t = a) - ~equal - ~all_options + (type a) + ?(extra_attrs = Value.return []) + ?placeholder + ?to_string + ?to_option_description + ?handle_unknown_option + (module M : Bonsai.Model with type t = a) + ~equal + ~all_options = let%sub path, id = path in let extra_attrs = @@ -653,14 +653,14 @@ module Typeahead = struct ;; let single - ?extra_attrs - ?placeholder - ?to_string - ?to_option_description - ?handle_unknown_option - m - ~equal - ~all_options + ?extra_attrs + ?placeholder + ?to_string + ?to_option_description + ?handle_unknown_option + m + ~equal + ~all_options = let%map.Computation form = single_opt @@ -677,13 +677,13 @@ module Typeahead = struct ;; let set - ?(extra_attrs = Value.return []) - ?placeholder - ?to_string - ?to_option_description - ?split - m - ~all_options + ?(extra_attrs = Value.return []) + ?placeholder + ?to_string + ?to_option_description + ?split + m + ~all_options = let%sub path, id = path in let extra_attrs = @@ -709,14 +709,14 @@ module Typeahead = struct ;; let list - (type a cmp) - ?extra_attrs - ?placeholder - ?to_string - ?to_option_description - ?split - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - ~all_options + (type a cmp) + ?extra_attrs + ?placeholder + ?to_string + ?to_option_description + ?split + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + ~all_options = let%map.Computation form = set @@ -805,10 +805,10 @@ module Date_time = struct ;; let time_span_opt - ?(extra_unit_attrs = Value.return []) - ?(extra_amount_attrs = Value.return []) - ?(default_unit = Span_unit.Seconds) - () + ?(extra_unit_attrs = Value.return []) + ?(extra_amount_attrs = Value.return []) + ?(default_unit = Span_unit.Seconds) + () = let%sub unit, set_unit = Bonsai.state @@ -934,14 +934,14 @@ module Date_time = struct end let make_opt_range - (type a) - ?(allow_equal = false) - ?(extra_attr = Value.return Vdom.Attr.empty) - ~kind_name - (module M : Model with type t = a) - ~equal - (module C : Comparisons.S with type t = a) - (view : a Input_element.t) + (type a) + ?(allow_equal = false) + ?(extra_attr = Value.return Vdom.Attr.empty) + ~kind_name + (module M : Model with type t = a) + ~equal + (module C : Comparisons.S with type t = a) + (view : a Input_element.t) = let module M = struct include M @@ -1045,7 +1045,7 @@ module Date_time = struct ~equal:[%equal: Date.t] (module Date) (fun ~extra_attrs -> - Vdom_input_widgets.Entry.date ~merge_behavior:Legacy_dont_merge ~extra_attrs ()) + Vdom_input_widgets.Entry.date ~merge_behavior:Legacy_dont_merge ~extra_attrs ()) ;; let date ?extra_attr ?allow_equal () = @@ -1062,7 +1062,7 @@ module Date_time = struct ~equal:[%equal: Time_ns.Ofday.t] (module Time_ns.Ofday) (fun ~extra_attrs -> - Vdom_input_widgets.Entry.time ~merge_behavior:Legacy_dont_merge ~extra_attrs ()) + Vdom_input_widgets.Entry.time ~merge_behavior:Legacy_dont_merge ~extra_attrs ()) ;; let time ?extra_attr ?allow_equal () = @@ -1079,10 +1079,10 @@ module Date_time = struct ~equal:[%equal: Time_ns.Alternate_sexp.t] (module Time_ns.Alternate_sexp) (fun ~extra_attrs -> - Vdom_input_widgets.Entry.datetime_local - ~merge_behavior:Legacy_dont_merge - ~extra_attrs - ()) + Vdom_input_widgets.Entry.datetime_local + ~merge_behavior:Legacy_dont_merge + ~extra_attrs + ()) ;; let datetime_local ?extra_attr ?allow_equal () = @@ -1094,12 +1094,12 @@ end module Multiselect = struct let set - (type a cmp) - ?(extra_attrs = Value.return []) - ?to_string - ?default_selection_status - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - input_list + (type a cmp) + ?(extra_attrs = Value.return []) + ?to_string + ?default_selection_status + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + input_list = let module Item = struct include M @@ -1159,12 +1159,12 @@ module Multiselect = struct ;; let list - (type a cmp) - ?extra_attrs - ?to_string - ?default_selection_status - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - input_list + (type a cmp) + ?extra_attrs + ?to_string + ?default_selection_status + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + input_list = let%map.Computation form = set ?extra_attrs ?to_string ?default_selection_status (module M) input_list @@ -1187,13 +1187,13 @@ let list_rev_map2 a b ~f = module Multiple = struct let stringable_list - (type a) - ?(extra_input_attr = Value.return Vdom.Attr.empty) - ?(extra_pill_container_attr = Value.return Vdom.Attr.empty) - ?(extra_pill_attr = Value.return Vdom.Attr.empty) - ?(placeholder = "") - (module M : Stringable_model with type t = a) - ~equal + (type a) + ?(extra_input_attr = Value.return Vdom.Attr.empty) + ?(extra_pill_container_attr = Value.return Vdom.Attr.empty) + ?(extra_pill_attr = Value.return Vdom.Attr.empty) + ?(placeholder = "") + (module M : Stringable_model with type t = a) + ~equal = let module M = struct include M @@ -1256,7 +1256,7 @@ module Multiple = struct @ placeholder placeholder_ @ value_prop state @ on_input (fun _ input -> - Effect.Many [ inject_invalid false; set_state input ]) + Effect.Many [ inject_invalid false; set_state input ]) @ on_keydown handle_keydown) ] () @@ -1269,11 +1269,11 @@ module Multiple = struct ;; let list - (type a) - ?element_group_label - ?add_element_text - ?(button_placement = `Indented) - (t : a Form.t Computation.t) + (type a) + ?element_group_label + ?add_element_text + ?(button_placement = `Indented) + (t : a Form.t Computation.t) : a list Form.t Computation.t = let%sub add_element_text = @@ -1303,11 +1303,11 @@ module Multiple = struct contents |> Map.to_alist |> List.map ~f:(fun (key, form) -> - View.list_item - ~view:(Form.view form) - ~remove_item: - (Remove_info - { remove = remove key; element_label = element_group_label })) + View.list_item + ~view:(Form.view form) + ~remove_item: + (Remove_info + { remove = remove key; element_label = element_group_label })) |> View.list ~append_item:(Append_info { append; text = add_element_text }) ~legacy_button_position:button_placement @@ -1326,12 +1326,12 @@ module Multiple = struct ;; let set - (type a cmp) - ?element_group_label - ?add_element_text - ?button_placement - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - form + (type a cmp) + ?element_group_label + ?add_element_text + ?button_placement + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + form = let%map.Computation form = list ?button_placement ?element_group_label ?add_element_text form @@ -1340,13 +1340,13 @@ module Multiple = struct ;; let map - (type a cmp) - ?element_group_label - ?add_element_text - ?button_placement - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - ~key - ~data + (type a cmp) + ?element_group_label + ?add_element_text + ?button_placement + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + ~key + ~data = let both = let%sub key_form = key in @@ -1384,11 +1384,11 @@ module type Number_input_specification = sig end let number_input - (type a) - ?(extra_attrs = Value.return []) - input_type - (module S : Number_input_specification with type t = a) - ~equal + (type a) + ?(extra_attrs = Value.return []) + input_type + (module S : Number_input_specification with type t = a) + ~equal = let module S = struct include S @@ -1542,15 +1542,15 @@ end module Radio_buttons = struct let list - (type t) - ?(style = Value.return Selectable_style.Native) - ?(extra_attrs = Value.return []) - ?init - ?to_string - (module E : Model with type t = t) - ~equal - ~layout - all + (type t) + ?(style = Value.return Selectable_style.Native) + ?(extra_attrs = Value.return []) + ?init + ?to_string + (module E : Model with type t = t) + ~equal + ~layout + all = let module E = struct include E @@ -1603,13 +1603,13 @@ module Radio_buttons = struct ;; let enumerable - (type t) - ?style - ?extra_attrs - ?init - ?to_string - (module E : Bonsai.Enum with type t = t) - ~layout + (type t) + ?style + ?extra_attrs + ?init + ?to_string + (module E : Bonsai.Enum with type t = t) + ~layout = list ?style @@ -1727,14 +1727,14 @@ end module Rank = struct let list - key - ?enable_debug_overlay - ?extra_item_attrs - ?left - ?right - ?empty_list_placeholder - ?default_item_height - render + key + ?enable_debug_overlay + ?extra_item_attrs + ?left + ?right + ?empty_list_placeholder + ?default_item_height + render = let%sub path = Bonsai.Private.path in let%map.Computation value, view, inject = @@ -1747,8 +1747,8 @@ module Rank = struct ?empty_list_placeholder ?default_item_height (fun ~index:_ ~source key -> - let%map.Computation view = render ~source key in - (), view) + let%map.Computation view = render ~source key in + (), view) and path = return (path >>| Bonsai.Private.Path.to_unique_identifier_string) in Form.Expert.create ~value:(Ok (List.map ~f:fst value)) @@ -1759,18 +1759,18 @@ end module Query_box = struct let create_opt - (type k cmp) - (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) - ?initial_query - ?max_visible_items - ?suggestion_list_kind - ?selected_item_attr - ?extra_list_container_attr - ?(extra_input_attr = Value.return Vdom.Attr.empty) - ?(extra_attr = Value.return Vdom.Attr.empty) - ~selection_to_string - ~f - () + (type k cmp) + (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) + ?initial_query + ?max_visible_items + ?suggestion_list_kind + ?selected_item_attr + ?extra_list_container_attr + ?(extra_input_attr = Value.return Vdom.Attr.empty) + ?(extra_attr = Value.return Vdom.Attr.empty) + ~selection_to_string + ~f + () = let%sub path, id = path in let%sub extra_attr = @@ -1829,17 +1829,17 @@ module Query_box = struct ;; let create - key - ?initial_query - ?max_visible_items - ?suggestion_list_kind - ?selected_item_attr - ?extra_list_container_attr - ?extra_input_attr - ?extra_attr - ~selection_to_string - ~f - () + key + ?initial_query + ?max_visible_items + ?suggestion_list_kind + ?selected_item_attr + ?extra_list_container_attr + ?extra_input_attr + ?extra_attr + ~selection_to_string + ~f + () = Computation.map (create_opt @@ -1858,9 +1858,9 @@ module Query_box = struct ;; module Query_box_styles = - [%css - stylesheet - {| + [%css + stylesheet + {| .list_container { background: white; border: solid 2px black; @@ -1920,15 +1920,15 @@ module Query_box = struct ;; let underlying_query_box_component - (type a cmp) - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - ~extra_attr - ~(to_string : (a -> string) Value.t) - ~selected_item_attr - ~extra_list_container_attr - ~all_options - ~handle_unknown_option - ~to_option_description + (type a cmp) + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + ~extra_attr + ~(to_string : (a -> string) Value.t) + ~selected_item_attr + ~extra_list_container_attr + ~all_options + ~handle_unknown_option + ~to_option_description = create_opt (module M) @@ -1944,13 +1944,13 @@ module Query_box = struct to_option_description ~default:main_item ~f:(fun to_option_description -> - Bonsai_web.View.vbox - ~attrs:[ Query_box_styles.item ] - [ main_item - ; Vdom.Node.span - ~attrs:[ Query_box_styles.description ] - [ Vdom.Node.text (to_option_description key) ] - ]) + Bonsai_web.View.vbox + ~attrs:[ Query_box_styles.item ] + [ main_item + ; Vdom.Node.span + ~attrs:[ Query_box_styles.description ] + [ Vdom.Node.text (to_option_description key) ] + ]) in let%sub result_without_unknown_option = Bonsai.Incr.compute @@ -1999,15 +1999,15 @@ module Query_box = struct ;; let single_opt - (type a cmp) - ?extra_attrs - ?to_string - ?to_option_description - ?selected_item_attr - ?extra_list_container_attr - ?handle_unknown_option - (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) - ~all_options + (type a cmp) + ?extra_attrs + ?to_string + ?to_option_description + ?selected_item_attr + ?extra_list_container_attr + ?handle_unknown_option + (module M : Bonsai.Comparator with type t = a and type comparator_witness = cmp) + ~all_options : a option Form.t Computation.t = let%sub extra_attr = @@ -2055,14 +2055,14 @@ module Query_box = struct ;; let single - ?extra_attrs - ?to_string - ?to_option_description - ?selected_item_attr - ?extra_list_container_attr - ?handle_unknown_option - m - ~all_options + ?extra_attrs + ?to_string + ?to_option_description + ?selected_item_attr + ?extra_list_container_attr + ?handle_unknown_option + m + ~all_options = let%map.Computation form = single_opt @@ -2081,10 +2081,10 @@ end module Optional = struct let dropdown - (type a) - ?(some_label = "Some") - ?(none_label = "None") - (form : a Form.t Computation.t) + (type a) + ?(some_label = "Some") + ?(none_label = "None") + (form : a Form.t Computation.t) = let module M = struct type t = @@ -2117,8 +2117,8 @@ module Optional = struct let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | None -> Bonsai.const (Form.return ()) - | Some -> form + | None -> Bonsai.const (Form.return ()) + | Some -> form ;; let initial_choice = `First_constructor diff --git a/web_ui/form/src/elements.mli b/web_ui/form/src/elements.mli index 3e4189b5..4bbacd1d 100644 --- a/web_ui/form/src/elements.mli +++ b/web_ui/form/src/elements.mli @@ -476,7 +476,6 @@ module File_select : sig NOTE: these widgets are not safe for use in Tangle as internally they require a model which cannot be [of_sexp]'d. *) - val single_opt : ?extra_attrs:Vdom.Attr.t list Value.t -> ?accept:[ `Extension of string | `Mimetype of string ] list @@ -525,7 +524,6 @@ module Rank : sig -> ?default_item_height:int -> (source:Vdom.Attr.t Value.t -> 'a Value.t -> Vdom.Node.t Computation.t) -> 'a list Form.t Computation.t - end module Query_box : sig @@ -565,7 +563,7 @@ module Query_box : sig -> ?extra_list_container_attr:Vdom.Attr.t Value.t -> ?handle_unknown_option:(string -> 'a option) Value.t -> (module Bonsai.Comparator with type t = 'a and type comparator_witness = 'cmp) - (* If there are duplicate items in [all_options] (according to the comparator), + (* If there are duplicate items in [all_options] (according to the comparator), the last of the duplicates will be the only one that show up in the list of suggestions. *) -> all_options:'a list Value.t @@ -579,7 +577,7 @@ module Query_box : sig -> ?extra_list_container_attr:Vdom.Attr.t Value.t -> ?handle_unknown_option:(string -> 'a option) Value.t -> (module Bonsai.Comparator with type t = 'a and type comparator_witness = 'cmp) - (* If there are duplicate items in [all_options] (according to the comparator), + (* If there are duplicate items in [all_options] (according to the comparator), the last of the duplicates will be the only one that show up in the list of suggestions. *) -> all_options:'a list Value.t diff --git a/web_ui/form/src/form.ml b/web_ui/form/src/form.ml index c2c719a0..a33a1bf8 100644 --- a/web_ui/form/src/form.ml +++ b/web_ui/form/src/form.ml @@ -31,12 +31,12 @@ module Submit = struct } let create - ?(handle_enter = true) - ?(button = Some "submit") - ?(button_attr = Vdom.Attr.empty) - ?(button_location = `After) - ~f - () + ?(handle_enter = true) + ?(button = Some "submit") + ?(button_attr = Vdom.Attr.empty) + ?(button_location = `After) + ~f + () = { f; handle_enter; button_text = button; button_attr; button_location } ;; @@ -51,12 +51,12 @@ let view_as_vdom ?theme ?on_submit ?editable t = Option.map on_submit ~f:(fun { Submit.f; handle_enter; button_text; button_attr; button_location } -> - { View.on_submit = Option.map ~f (Or_error.ok t.value) - ; handle_enter - ; button_text - ; button_attr - ; button_location - }) + { View.on_submit = Option.map ~f (Or_error.ok t.value) + ; handle_enter + ; button_text + ; button_attr + ; button_location + }) in View.to_vdom ?theme ?on_submit ?editable t.view ;; @@ -134,8 +134,8 @@ let all_map (type k cmp) (forms : (k, _, cmp) Map.t) = let value = forms_as_alist |> List.map ~f:(fun (k, form) -> - let%map.Or_error value = form.value in - k, value) + let%map.Or_error value = form.value in + k, value) |> Or_error.all |> Or_error.map ~f:(Map.of_alist_exn comparator) in @@ -227,21 +227,21 @@ module For_profunctor = struct : type read write. (read, write) t -> read Or_error.t * (write -> unit Effect.t) * View.field list = function - | Return { name; form } -> - form.value, form.set, [ { View.field_name = name; field_view = form.view } ] - | Map (form, f) -> - let value, set, fields = finalize_view form in - Or_error.map value ~f, set, fields - | Contra_map (form, g) -> - let value, set, fields = finalize_view form in - value, (fun x -> Effect.lazy_ (lazy (set (g x)))), fields - | Both (a, b) -> - let a_value, a_set, a_fields = finalize_view a in - let b_value, b_set, b_fields = finalize_view b in - let value = Or_error.both a_value b_value in - let set t = Effect.lazy_ (lazy (Effect.Many [ a_set t; b_set t ])) in - let fields = a_fields @ b_fields in - value, set, fields + | Return { name; form } -> + form.value, form.set, [ { View.field_name = name; field_view = form.view } ] + | Map (form, f) -> + let value, set, fields = finalize_view form in + Or_error.map value ~f, set, fields + | Contra_map (form, g) -> + let value, set, fields = finalize_view form in + value, (fun x -> Effect.lazy_ (lazy (set (g x)))), fields + | Both (a, b) -> + let a_value, a_set, a_fields = finalize_view a in + let b_value, b_set, b_fields = finalize_view b in + let value = Or_error.both a_value b_value in + let set t = Effect.lazy_ (lazy (Effect.Many [ a_set t; b_set t ])) in + let fields = a_fields @ b_fields in + value, set, fields ;; end @@ -252,8 +252,8 @@ module Record_builder = struct fieldslib_field |> Fieldslib.Field.name |> String.map ~f:(function - | '_' -> ' ' - | other -> other) + | '_' -> ' ' + | other -> other) ;; let attach_fieldname_to_error t fieldslib_field = @@ -324,8 +324,7 @@ module Dynamic = struct let%arr get_default = get_default in match%bind.Effect get_default with | Active default -> Effect.return default - | Inactive -> - Effect.never + | Inactive -> Effect.never in with_default_from_effect effect form ;; @@ -390,12 +389,12 @@ module Dynamic = struct ;; let on_change - (type a) - ?(on_error = Value.return (Fn.const Ui_effect.Ignore)) - ?sexp_of_model - ~equal - ~f - value_to_watch + (type a) + ?(on_error = Value.return (Fn.const Ui_effect.Ignore)) + ?sexp_of_model + ~equal + ~f + value_to_watch = let module M_or_error = struct type model = a @@ -421,16 +420,16 @@ module Dynamic = struct ;; let project_via_effect - (type a b) - ?sexp_of_input - ?sexp_of_result - ~equal_input - ~equal_result - ?(one_at_a_time = false) - ?debounce_ui - (t : a t Bonsai.Value.t) - ~unparse - ~parse + (type a b) + ?sexp_of_input + ?sexp_of_result + ~equal_input + ~equal_result + ?(one_at_a_time = false) + ?debounce_ui + (t : a t Bonsai.Value.t) + ~unparse + ~parse = let open Bonsai.Effect_throttling in let module Validated = struct @@ -504,13 +503,13 @@ module Dynamic = struct ;; let validate_via_effect - (type a) - ?sexp_of_model - ~equal - ?one_at_a_time - ?debounce_ui - (t : a t Bonsai.Value.t) - ~f + (type a) + ?sexp_of_model + ~equal + ?one_at_a_time + ?debounce_ui + (t : a t Bonsai.Value.t) + ~f = let%sub parse = let%arr f = f in @@ -534,12 +533,12 @@ module Dynamic = struct module Record_builder = struct include Profunctor.Record_builder (struct - type ('read, 'write) t = ('read, 'write) For_profunctor.t Value.t + type ('read, 'write) t = ('read, 'write) For_profunctor.t Value.t - let both a b = Value.map2 a b ~f:For_profunctor.both - let map a ~f = Value.map a ~f:(For_profunctor.map ~f) - let contra_map a ~f = Value.map a ~f:(For_profunctor.contra_map ~f) - end) + let both a b = Value.map2 a b ~f:For_profunctor.both + let map a ~f = Value.map a ~f:(For_profunctor.map ~f) + let contra_map a ~f = Value.map a ~f:(For_profunctor.contra_map ~f) + end) let field t fieldslib_field = let for_profunctor = diff --git a/web_ui/form/src/form.mli b/web_ui/form/src/form.mli index f167328c..e6dcc53a 100644 --- a/web_ui/form/src/form.mli +++ b/web_ui/form/src/form.mli @@ -174,7 +174,6 @@ val optional' -> none:'a -> 'b option t - (** [fallback_to] modifies the given form so that [Ok default] is used as the form's value when it is in an [Error] state. *) val fallback_to : 'a t -> value:'a -> 'a t @@ -261,7 +260,6 @@ module Dynamic : sig -> 'a t Value.t -> unit Computation.t - (** Unlike [validate] which requires the validation function to be available locally (and synchronous), [validate_via_effect] runs an effectful computation. The asynchrony makes this function interesting: diff --git a/web_ui/form/src/record_builder_intf.ml b/web_ui/form/src/record_builder_intf.ml index 833099c4..9c7086ff 100644 --- a/web_ui/form/src/record_builder_intf.ml +++ b/web_ui/form/src/record_builder_intf.ml @@ -16,13 +16,13 @@ module type Record_builder = sig , 'a , ('b, 'c) Record_builder_lib.Hlist.cons , 'record ) - Bare.Make_creator_types.handle_one_field + Bare.Make_creator_types.handle_one_field val build_for_record : ( 'record , ('a, 'b) Record_builder_lib.Hlist.cons , 'record ) - Bare.Make_creator_types.handle_all_fields + Bare.Make_creator_types.handle_all_fields -> 'record profunctor_term end diff --git a/web_ui/form/src/typed.ml b/web_ui/form/src/typed.ml index 419bad00..a3b86b2e 100644 --- a/web_ui/form/src/typed.ml +++ b/web_ui/form/src/typed.ml @@ -61,9 +61,9 @@ module Record = struct let view = M.Typed_field.Packed.all |> List.map ~f:(fun { f = T field } -> - { Form_view.field_name = get_label (M.Typed_field.Packed.pack field) - ; field_view = Form.view (The_forms.find forms_per_field field) - }) + { Form_view.field_name = get_label (M.Typed_field.Packed.pack field) + ; field_view = Form.view (The_forms.find forms_per_field field) + }) |> Form_view.record in let value = @@ -76,7 +76,7 @@ module Record = struct let set r = M.Typed_field.Packed.all |> List.map ~f:(fun { f = T field } -> - Form.set (The_forms.find forms_per_field field) (M.Typed_field.get field r)) + Form.set (The_forms.find forms_per_field field) (M.Typed_field.get field r)) |> Vdom.Effect.Many in Form.Expert.create ~view ~value ~set @@ -98,10 +98,10 @@ module Variant = struct end let make - (type a) - ?(picker = `Dropdown) - ?picker_attr - (module M : S with type Typed_variant.derived_on = a) + (type a) + ?(picker = `Dropdown) + ?picker_attr + (module M : S with type Typed_variant.derived_on = a) = let to_string = match M.label_for_variant with @@ -261,8 +261,7 @@ module Variant = struct let%bind inner = match%bind.Effect get_inner_form with | Active inner -> Effect.return inner - | Inactive -> - Effect.never + | Inactive -> Effect.never in Form.set inner value in @@ -270,11 +269,11 @@ module Variant = struct ;; let make_optional - (type a) - ?picker - ?picker_attr - ?(empty_label = "(none)") - (module M : S with type Typed_variant.derived_on = a) + (type a) + ?picker + ?picker_attr + ?(empty_label = "(none)") + (module M : S with type Typed_variant.derived_on = a) : a option Form.t Computation.t = let module Transformed = struct @@ -312,8 +311,8 @@ module Variant = struct let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | None -> Bonsai.const (Form.return ()) - | Some subvariant -> M.form_for_variant subvariant + | None -> Bonsai.const (Form.return ()) + | Some subvariant -> M.form_for_variant subvariant ;; let initial_choice = diff --git a/web_ui/form/src/typed.mli b/web_ui/form/src/typed.mli index 257bf090..966b9c7d 100644 --- a/web_ui/form/src/typed.mli +++ b/web_ui/form/src/typed.mli @@ -14,7 +14,7 @@ module Record : sig val label_for_field : [ `Inferred | `Computed of 'a Typed_field.t -> string - (** The value passed to [`Dynamic] is used in many [let%arr]s within [make]. Thus, + (** The value passed to [`Dynamic] is used in many [let%arr]s within [make]. Thus, it's possible to accidentally duplicate work, if the provided value is built using [let%map] instead of [let%arr]. *) | `Dynamic of (Typed_field.Packed.t -> string) Value.t @@ -41,7 +41,7 @@ module Variant : sig val label_for_variant : [ `Inferred | `Computed of 'a Typed_variant.t -> string - (** The value passed to [`Dynamic] is used in many [let%arr]s within [make]. Thus, + (** The value passed to [`Dynamic] is used in many [let%arr]s within [make]. Thus, it's possible to accidentally duplicate work, if the provided value is built using [let%map] instead of [let%arr]. *) | `Dynamic of (Typed_variant.Packed.t -> string) Value.t diff --git a/web_ui/form/src/view.ml b/web_ui/form/src/view.ml index db3e5476..ef7b96a1 100644 --- a/web_ui/form/src/view.ml +++ b/web_ui/form/src/view.ml @@ -9,8 +9,8 @@ let sexp_to_pretty_string sexp_of_t t = |> Sexp.to_string_mach |> String.lowercase |> String.map ~f:(function - | '(' | ')' | '-' | '_' -> ' ' - | o -> o) + | '(' | ')' | '-' | '_' -> ' ' + | o -> o) ;; let to_vdom_plain ?(theme = View.Expert.default_theme) ?editable view = diff --git a/web_ui/form/test/bonsai_web_ui_form_test.ml b/web_ui/form/test/bonsai_web_ui_form_test.ml index 6d822673..382edd28 100644 --- a/web_ui/form/test/bonsai_web_ui_form_test.ml +++ b/web_ui/form/test/bonsai_web_ui_form_test.ml @@ -13,11 +13,11 @@ let get_vdom form = let get_vdom_verbose ?on_submit ?editable f = Form.view_as_vdom ?on_submit ?editable f let form_result_spec - (type a) - ?filter_printed_attributes - ?censor_paths - ?(get_vdom = get_vdom) - sexp_of_a + (type a) + ?filter_printed_attributes + ?censor_paths + ?(get_vdom = get_vdom) + sexp_of_a : (a Form.t, a) Result_spec.t = (module struct @@ -3134,8 +3134,8 @@ let%expect_test "form of nested record of int and float (typed fields)" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | Age -> Form.Elements.Textbox.int () - | Height -> Form.Elements.Textbox.float () + | Age -> Form.Elements.Textbox.int () + | Height -> Form.Elements.Textbox.float () ;; end) ;; @@ -3156,8 +3156,8 @@ let%expect_test "form of nested record of int and float (typed fields)" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Nested -> Nested.form + | Unit -> Bonsai.const (Form.return ()) + | Nested -> Nested.form ;; end) ;; @@ -3266,8 +3266,8 @@ let%expect_test "typed records labelling overrides defaults" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | Age -> Form.Elements.Textbox.int () - | Height -> Form.Elements.Textbox.float () + | Age -> Form.Elements.Textbox.int () + | Height -> Form.Elements.Textbox.float () ;; end) ;; @@ -3293,8 +3293,8 @@ let%expect_test "typed records labelling overrides defaults" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Nested -> Nested.form + | Unit -> Bonsai.const (Form.return ()) + | Nested -> Nested.form ;; end) ;; @@ -3416,7 +3416,7 @@ let%expect_test "typed records: dynamic labelling" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | Int -> Form.Elements.Number.int ~step:1 ~default:0 () + | Int -> Form.Elements.Number.int ~step:1 ~default:0 () ;; end) ;; @@ -3488,11 +3488,11 @@ let%expect_test "typed variants recursive" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Nil -> Bonsai.const (Form.return ()) - | Cons -> - let%map.Computation int = Form.Elements.Textbox.int () - and me = (Bonsai.lazy_ [@alert "-deprecated"]) (lazy (form ())) in - Form.both int me + | Nil -> Bonsai.const (Form.return ()) + | Cons -> + let%map.Computation int = Form.Elements.Textbox.int () + and me = (Bonsai.lazy_ [@alert "-deprecated"]) (lazy (form ())) in + Form.both int me ;; end) ;; @@ -3604,9 +3604,9 @@ let%expect_test "typed variants" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -3747,7 +3747,7 @@ let%expect_test "typed variants: dynamic labelling" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Integer -> Form.Elements.Number.int ~default:0 ~step:1 () + | Integer -> Form.Elements.Number.int ~default:0 ~step:1 () ;; end) ;; @@ -3829,9 +3829,9 @@ let%expect_test "typed optional variants" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -3999,9 +3999,9 @@ let%expect_test "typed variants with custom labels" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -4046,9 +4046,9 @@ let%expect_test "typed variants: attr is applied to dropdown" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -4093,9 +4093,9 @@ let%expect_test "typed variants: radio vertical" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -4167,9 +4167,9 @@ let%expect_test "typed variants: radio horizontal" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | Unit -> Bonsai.const (Form.return ()) - | Integer -> Form.Elements.Textbox.int () - | Text -> Form.Elements.Textbox.string () + | Unit -> Bonsai.const (Form.return ()) + | Integer -> Form.Elements.Textbox.int () + | Text -> Form.Elements.Textbox.string () ;; end) ;; @@ -4278,8 +4278,8 @@ let%expect_test "typed variants: dropdown with example default" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | String -> Form.Elements.Textbox.string () - | Other_thing -> Bonsai.const (Form.return ()) + | String -> Form.Elements.Textbox.string () + | Other_thing -> Bonsai.const (Form.return ()) ;; end) ;; @@ -4321,8 +4321,8 @@ let%expect_test "optional typed-variant-form: dropdown with example default" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | String -> Form.Elements.Textbox.string () - | Other_thing -> Bonsai.const (Form.return ()) + | String -> Form.Elements.Textbox.string () + | Other_thing -> Bonsai.const (Form.return ()) ;; end) ;; @@ -5265,8 +5265,8 @@ let%expect_test "Bonsai_form.Typed sets groups/labels correctly on nested record let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | B_1 -> checkbox - | B_2 -> checkbox + | B_1 -> checkbox + | B_2 -> checkbox ;; end) ;; @@ -5287,8 +5287,8 @@ let%expect_test "Bonsai_form.Typed sets groups/labels correctly on nested record let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | A_1 -> checkbox - | A_2 -> B.form () + | A_1 -> checkbox + | A_2 -> B.form () ;; end) ;; @@ -6200,9 +6200,9 @@ let%test_module "Typed fields monomorphization" = let form_for_field : type a. a Typed_field.t -> a Form.t Computation.t = function - | A -> Form.Elements.Textbox.int () - | B -> Form.Elements.Textbox.string () - | C -> Form.Elements.Textbox.float () + | A -> Form.Elements.Textbox.int () + | B -> Form.Elements.Textbox.string () + | C -> Form.Elements.Textbox.float () ;; end) ;; @@ -6303,9 +6303,9 @@ let%test_module "Typed fields monomorphization" = let form_for_variant : type a. a Typed_variant.t -> a Form.t Computation.t = function - | A -> Form.Elements.Textbox.int () - | B -> Form.Elements.Textbox.string () - | C -> Form.Elements.Textbox.float () + | A -> Form.Elements.Textbox.int () + | B -> Form.Elements.Textbox.string () + | C -> Form.Elements.Textbox.float () ;; end) ;; diff --git a/web_ui/freeform_multiselect/src/freeform_multiselect.ml b/web_ui/freeform_multiselect/src/freeform_multiselect.ml index 8e637c9e..6b7aeb75 100644 --- a/web_ui/freeform_multiselect/src/freeform_multiselect.ml +++ b/web_ui/freeform_multiselect/src/freeform_multiselect.ml @@ -11,15 +11,15 @@ let input ~placeholder:placeholder_ ~value:value_ ~extra_attr ~id:id_ ~on_input: ~attrs: [ Vdom.Attr.( extra_attr - @ type_ "text" - @ create "list" id_ + @ type_ "text" + @ create "list" id_ @ placeholder placeholder_ (* Both Attr.value and Attr.string_property value must be set. The former only affects initial control state while the latter affects the control state whilst the form is being used. *) - @ value value_ - @ value_prop value_ - @ on_change (fun _ input -> on_input_ input)) + @ value value_ + @ value_prop value_ + @ on_change (fun _ input -> on_input_ input)) ] () ;; @@ -38,9 +38,9 @@ let pills ~selected_options ~on_set_change ~inject_selected_options = @ create "data-value" option @ on_click remove_option @ on_keyup (fun ev -> - match Js_of_ocaml.Dom_html.Keyboard_code.of_event ev with - | Space | Enter | NumpadEnter | Backspace | Delete -> remove_option ev - | _ -> Effect.Ignore)) + match Js_of_ocaml.Dom_html.Keyboard_code.of_event ev with + | Space | Enter | NumpadEnter | Backspace | Delete -> remove_option ev + | _ -> Effect.Ignore)) ] [ Vdom.Node.text (option ^ " ×") ] in @@ -81,11 +81,11 @@ let input ~placeholder ~extra_attr ~split ~id ~selected_options ~on_set_change = ;; let create - ?(extra_attr = Value.return Vdom.Attr.empty) - ?(placeholder = "") - ?(on_set_change = Value.return (const Effect.Ignore)) - ?(split = List.return) - () + ?(extra_attr = Value.return Vdom.Attr.empty) + ?(placeholder = "") + ?(on_set_change = Value.return (const Effect.Ignore)) + ?(split = List.return) + () = let%sub selected_options = Bonsai.state @@ -98,7 +98,7 @@ let create input ~placeholder ~extra_attr ~id ~on_set_change ~split ~selected_options in let%arr selected_options, inject_selected_options = selected_options - and input = input + and input = input and on_set_change = on_set_change in let pills = pills ~selected_options ~on_set_change ~inject_selected_options in selected_options, Vdom.Node.div [ input; pills ], inject_selected_options diff --git a/web_ui/freeform_multiselect/src/freeform_multiselect.mli b/web_ui/freeform_multiselect/src/freeform_multiselect.mli index a5c22aab..f908bc5b 100644 --- a/web_ui/freeform_multiselect/src/freeform_multiselect.mli +++ b/web_ui/freeform_multiselect/src/freeform_multiselect.mli @@ -1,7 +1,6 @@ open! Core open! Bonsai_web - (** These controls come unstyled by default. jane-web-style provides css that will make the control and option pills pretty. *) diff --git a/web_ui/freeform_multiselect/test/freeform_multiselect.ml b/web_ui/freeform_multiselect/test/freeform_multiselect.ml index cca68f9a..5a08a7c6 100644 --- a/web_ui/freeform_multiselect/test/freeform_multiselect.ml +++ b/web_ui/freeform_multiselect/test/freeform_multiselect.ml @@ -1,7 +1,7 @@ open! Core open! Bonsai_web_test open! Bonsai_web -open Bonsai.Let_syntax +open Bonsai.Let_syntax let shared_computation = Bonsai_web_ui_freeform_multiselect.Freeform_multiselect.create @@ -71,8 +71,8 @@ let%expect_test "Deselect an element" = Handle.recompute_view handle; input_value handle "this is yet another thing"; Handle.store_view handle; - Handle.click_on handle ~get_vdom:Fn.id ~selector:"[data-value='this is a thing']"; - Handle.show_diff handle; + Handle.click_on handle ~get_vdom:Fn.id ~selector:"[data-value='this is a thing']"; + Handle.show_diff handle; (* Expected change: this is a thing should disappear from pills *) [%expect {| @@ -95,7 +95,7 @@ let%expect_test "set the elements" = Handle.create (module struct type incoming = String.Set.t - type t = Vdom.Node.t * (String.Set.t -> unit Ui_effect.t) + type t = Vdom.Node.t * (String.Set.t -> unit Ui_effect.t) let view (vdom, _) = let module V = (val Result_spec.vdom Fn.id) in diff --git a/web_ui/gauge/src/bonsai_web_ui_gauge.ml b/web_ui/gauge/src/bonsai_web_ui_gauge.ml index 2f1d862d..dc2f3bdf 100644 --- a/web_ui/gauge/src/bonsai_web_ui_gauge.ml +++ b/web_ui/gauge/src/bonsai_web_ui_gauge.ml @@ -4,9 +4,9 @@ module Svg = Virtual_dom_svg open Vdom module Styles = - [%css - stylesheet - {| +[%css +stylesheet + {| .wrapper { display: flex; diff --git a/web_ui/multi_select/focus_ring/src/focus_ring.ml b/web_ui/multi_select/focus_ring/src/focus_ring.ml index 3c10d186..8c41141a 100644 --- a/web_ui/multi_select/focus_ring/src/focus_ring.ml +++ b/web_ui/multi_select/focus_ring/src/focus_ring.ml @@ -2,15 +2,15 @@ open! Core type 'a t = { current_focus : 'a - ; before_rev : 'a list - ; after : 'a list + ; before_rev : 'a list + ; after : 'a list } [@@deriving fields ~getters, compare, equal, sexp] let of_nonempty_list_exn full_list = { current_focus = List.hd_exn full_list - ; before_rev = [] - ; after = List.tl_exn full_list + ; before_rev = [] + ; after = List.tl_exn full_list } ;; @@ -21,8 +21,8 @@ let next t = | [] -> let full_list = List.rev (t.current_focus :: t.before_rev) in { current_focus = List.hd_exn full_list - ; before_rev = [] - ; after = List.tl_exn full_list + ; before_rev = [] + ; after = List.tl_exn full_list } ;; @@ -33,16 +33,16 @@ let prev t = | [] -> let full_list_rev = List.rev (t.current_focus :: t.after) in { current_focus = List.hd_exn full_list_rev - ; before_rev = List.tl_exn full_list_rev - ; after = [] + ; before_rev = List.tl_exn full_list_rev + ; after = [] } ;; let set t ~f = - let full_list = List.rev_append t.before_rev (t.current_focus :: t.after) in - let before, after = List.split_while full_list ~f:(fun a -> not (f a)) in + let full_list = List.rev_append t.before_rev (t.current_focus :: t.after) in + let before, after = List.split_while full_list ~f:(fun a -> not (f a)) in match after with - | [] -> None + | [] -> None | focus :: after -> Some { current_focus = focus; before_rev = List.rev before; after } ;; diff --git a/web_ui/multi_select/focus_ring/src/focus_ring.mli b/web_ui/multi_select/focus_ring/src/focus_ring.mli index ade3f14a..c42cd5aa 100644 --- a/web_ui/multi_select/focus_ring/src/focus_ring.mli +++ b/web_ui/multi_select/focus_ring/src/focus_ring.mli @@ -8,9 +8,9 @@ open! Core type 'a t [@@deriving compare, equal, sexp] val of_nonempty_list_exn : 'a list -> 'a t -val next : 'a t -> 'a t -val prev : 'a t -> 'a t -val current_focus : 'a t -> 'a +val next : 'a t -> 'a t +val prev : 'a t -> 'a t +val current_focus : 'a t -> 'a (** O(n). Find the first element matching [f] in the list, and make that the focus. *) -val set : 'a t -> f:('a -> bool) -> 'a t option +val set : 'a t -> f:('a -> bool) -> 'a t option diff --git a/web_ui/multi_select/src/bonsai_web_ui_multi_select.ml b/web_ui/multi_select/src/bonsai_web_ui_multi_select.ml index 17edf126..46ba47d1 100644 --- a/web_ui/multi_select/src/bonsai_web_ui_multi_select.ml +++ b/web_ui/multi_select/src/bonsai_web_ui_multi_select.ml @@ -1,3 +1,3 @@ -module Multi_factor = Multi_factor +module Multi_factor = Multi_factor module Selection_status = Selection_status include Single_factor diff --git a/web_ui/multi_select/src/multi_factor.ml b/web_ui/multi_select/src/multi_factor.ml index 1cee9068..85a6fe4c 100644 --- a/web_ui/multi_select/src/multi_factor.ml +++ b/web_ui/multi_select/src/multi_factor.ml @@ -1,8 +1,8 @@ open! Core open! Import -open Multi_factor_intf +open Multi_factor_intf -module type S = S +module type S = S module type Key = Key module Make (Item : Single_factor.Item) (Key : Key) = struct @@ -12,7 +12,7 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct module Action = struct type t = | Cycle_focused_subwidget of [ `Next | `Prev ] - | Set_focused_subwidget of Key.t + | Set_focused_subwidget of Key.t [@@deriving sexp_of] end @@ -30,37 +30,37 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct match (action : Action.t) with | Cycle_focused_subwidget `Next -> Focus_ring.next model | Cycle_focused_subwidget `Prev -> Focus_ring.prev model - | Set_focused_subwidget key -> + | Set_focused_subwidget key -> Focus_ring.set model ~f:(fun key' -> [%compare.equal: Key.t] key key') |> Option.value ~default:model ;; let compute ~inject () model = Focus_ring.current_focus model, inject - let name = Source_code_position.to_string [%here] + let name = Source_code_position.to_string [%here] end module Action = struct type t = - | Cycle_focused_subwidget of [ `Next | `Prev ] - | Set_focused_subwidget of Key.t - | Subwidget_action of Key.t * Single_factor.Action.t + | Cycle_focused_subwidget of [ `Next | `Prev ] + | Set_focused_subwidget of Key.t + | Subwidget_action of Key.t * Single_factor.Action.t | Select_on_all_subwidgets of [ `All | `None ] [@@deriving sexp_of] end type per_subwidget = { default_selection_status : Selection_status.t - ; all_items : Item.Set.t + ; all_items : Item.Set.t } [@@deriving fields ~getters] module Result = struct type t = - { view : Vdom.Node.t + { view : Vdom.Node.t ; view_for_testing : string Lazy.t - ; key_handler : Vdom_keyboard.Keyboard_event_handler.t - ; inject : Action.t -> unit Vdom.Effect.t - ; selection : Item.Set.t Key.Map.t + ; key_handler : Vdom_keyboard.Keyboard_event_handler.t + ; inject : Action.t -> unit Vdom.Effect.t + ; selection : Item.Set.t Key.Map.t } [@@deriving fields ~getters] @@ -127,8 +127,8 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct let handler = let open Keyboard_event_handler.Handler in match cond with - | None -> with_prevent_default f - | Some cond -> only_handle_if cond f ~prevent_default:() + | None -> with_prevent_default f + | Some cond -> only_handle_if cond f ~prevent_default:() in { Keyboard_event_handler.Command.keys; description; group = None; handler } in @@ -167,7 +167,7 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct (List.map (Map.data subwidgets) ~f:(fun subwidget -> subwidget.inject (match what with - | `All -> Select_all + | `All -> Select_all | `None -> Select_none))) ;; @@ -204,8 +204,8 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct Option.iter (Dom_html.getElementById_coerce id Dom_html.CoerceTo.input) ~f:(fun elt -> - elt##focus; - elt##select) + elt##focus; + elt##select) ;; let focus_elt = @@ -237,9 +237,9 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct let%sub single_factors = all_keys |> Set.to_map ~f:(fun key -> - match%sub subwidgets >>| Fn.flip Map.find key with - | Some input -> Computation.map (single_factor key input) ~f:Option.some - | None -> Bonsai.const None) + match%sub subwidgets >>| Fn.flip Map.find key with + | Some input -> Computation.map (single_factor key input) ~f:Option.some + | None -> Bonsai.const None) |> Computation.all_map |> Computation.map ~f:(Map.filter_map ~f:Fn.id) in @@ -265,16 +265,16 @@ module Make (Item : Single_factor.Item) (Key : Key) = struct ~callback in let%arr subwidgets = single_factors - and focus = focus + and focus = focus and inject_ring_focus_action = inject_focus_action - and id_prefix = id_prefix in + and id_prefix = id_prefix in let inject = inject ~subwidgets ~inject_ring_focus_action in let selection = Map.map subwidgets ~f:(fun result -> result.Single_factor.Result.selected_items) in - let view = view ~inject ~subwidgets ~focus ~id_prefix in - let view_for_testing = view_for_testing ~subwidgets ~focus in - let key_handler = key_handler ~inject ~subwidgets ~focus in + let view = view ~inject ~subwidgets ~focus ~id_prefix in + let view_for_testing = view_for_testing ~subwidgets ~focus in + let key_handler = key_handler ~inject ~subwidgets ~focus in { Result.selection; view; view_for_testing; key_handler; inject } ;; end diff --git a/web_ui/multi_select/src/multi_factor_intf.ml b/web_ui/multi_select/src/multi_factor_intf.ml index a88a9ca8..f23c6a1e 100644 --- a/web_ui/multi_select/src/multi_factor_intf.ml +++ b/web_ui/multi_select/src/multi_factor_intf.ml @@ -25,25 +25,25 @@ module type S = sig open! Core open! Import module Item : Single_factor.Item - module Key : Key + module Key : Key module Single_factor : module type of Single_factor.Make (Item) module Action : sig type t = - | Cycle_focused_subwidget of [ `Next | `Prev ] - | Set_focused_subwidget of Key.t - | Subwidget_action of Key.t * Single_factor.Action.t + | Cycle_focused_subwidget of [ `Next | `Prev ] + | Set_focused_subwidget of Key.t + | Subwidget_action of Key.t * Single_factor.Action.t | Select_on_all_subwidgets of [ `All | `None ] end module Result : sig type t = - { view : Vdom.Node.t + { view : Vdom.Node.t ; view_for_testing : string Lazy.t - ; key_handler : Vdom_keyboard.Keyboard_event_handler.t - ; inject : Action.t -> unit Vdom.Effect.t - (** [selection] is the set of all selected items, by key. *) - ; selection : Item.Set.t Key.Map.t + ; key_handler : Vdom_keyboard.Keyboard_event_handler.t + ; inject : Action.t -> unit Vdom.Effect.t + (** [selection] is the set of all selected items, by key. *) + ; selection : Item.Set.t Key.Map.t } [@@deriving fields ~getters] @@ -58,7 +58,7 @@ module type S = sig type per_subwidget = { default_selection_status : Selection_status.t - ; all_items : Item.Set.t + ; all_items : Item.Set.t } val bonsai @@ -70,7 +70,7 @@ module type S = sig end module type Multi_factor = sig - module type S = S + module type S = S module type Key = Key module Make (Item : Single_factor.Item) (Key : Key) : diff --git a/web_ui/multi_select/src/selection_status.ml b/web_ui/multi_select/src/selection_status.ml index 2dcb2e88..c105b819 100644 --- a/web_ui/multi_select/src/selection_status.ml +++ b/web_ui/multi_select/src/selection_status.ml @@ -6,6 +6,6 @@ type t = [@@deriving compare, equal, sexp] let toggle = function - | Selected -> Unselected + | Selected -> Unselected | Unselected -> Selected ;; diff --git a/web_ui/multi_select/src/single_factor.ml b/web_ui/multi_select/src/single_factor.ml index ca2dcfe5..a48e832f 100644 --- a/web_ui/multi_select/src/single_factor.ml +++ b/web_ui/multi_select/src/single_factor.ml @@ -1,9 +1,9 @@ open! Core open! Import -open Bonsai_web -open Single_factor_intf +open Bonsai_web +open Single_factor_intf -module type S = S +module type S = S module type Item = Item module Make (Item : Item) = struct @@ -15,12 +15,12 @@ module Make (Item : Item) = struct module Result = struct type t = { items_matching_search : Item.Set.t - ; update_search : string -> unit Bonsai.Effect.t - ; current_search : string + ; update_search : string -> unit Bonsai.Effect.t + ; current_search : string } end - module Model = String + module Model = String module Action = String let apply_action _ _input _model new_search = new_search @@ -28,12 +28,10 @@ module Make (Item : Item) = struct let compute ~inject all_items search_string = let items_matching_search = Set.filter all_items ~f:(fun item -> - String.Caseless.is_substring - (Item.to_string item) - ~substring:search_string) + String.Caseless.is_substring (Item.to_string item) ~substring:search_string) in { Result.items_matching_search - ; update_search = inject + ; update_search = inject ; current_search = search_string } ;; @@ -56,10 +54,10 @@ module Make (Item : Item) = struct module T = struct module View_config = struct type t = - { header : Vdom.Node.t + { header : Vdom.Node.t ; autofocus_search_box : bool - ; search_box_id : string option - ; extra_row_attrs : (is_focused:bool -> Vdom.Attr.t) option + ; search_box_id : string option + ; extra_row_attrs : (is_focused:bool -> Vdom.Attr.t) option } let create ?extra_row_attrs ?(autofocus_search_box = false) ?id ~header () = @@ -69,19 +67,19 @@ module Make (Item : Item) = struct module Input = struct type t = - { items_matching_search : Item.Set.t - ; update_search : string -> unit Bonsai.Effect.t - ; all_items : Item.Set.t + { items_matching_search : Item.Set.t + ; update_search : string -> unit Bonsai.Effect.t + ; all_items : Item.Set.t ; default_selection_status : Selection_status.t - ; current_search : string - ; view_config : View_config.t + ; current_search : string + ; view_config : View_config.t } end module Model = struct type t = { selection_status : Selection_status.t Map.M(Item).t - ; focused_item : Item.t option + ; focused_item : Item.t option } [@@deriving compare, equal, sexp_of] @@ -92,15 +90,15 @@ module Make (Item : Item) = struct module Action = struct type t = - | Update_search_string of string - | Set_item_selected of - { item : Item.t + | Update_search_string of string + | Set_item_selected of + { item : Item.t ; status : Selection_status.t } | Set_all_selection_statuses of Selection_status.t Item.Map.t | Toggle_focused_item_selected - | Set_focus of Item.t option - | Move_focus of [ `Next | `Prev ] + | Set_focus of Item.t option + | Move_focus of [ `Next | `Prev ] | Select_all | Select_none [@@deriving sexp_of] @@ -108,24 +106,24 @@ module Make (Item : Item) = struct module Result = struct type t = - { view : Vdom.Node.t + { view : Vdom.Node.t ; view_for_testing : string Lazy.t - ; key_handler : Vdom_keyboard.Keyboard_event_handler.t - ; inject : Action.t -> unit Bonsai.Effect.t - ; selected_items : Item.Set.t + ; key_handler : Vdom_keyboard.Keyboard_event_handler.t + ; inject : Action.t -> unit Bonsai.Effect.t + ; selected_items : Item.Set.t } end let move_in_set set element ~dir = match element with - | None -> + | None -> (match dir with | `Prev -> Set.max_elt set | `Next -> Set.min_elt set) | Some element -> let sequence = match dir with - | `Prev -> Set.to_sequence set ~less_or_equal_to: element ~order:`Decreasing + | `Prev -> Set.to_sequence set ~less_or_equal_to:element ~order:`Decreasing | `Next -> Set.to_sequence set ~greater_or_equal_to:element ~order:`Increasing in (* The first element in the sequence will be [element], since the arguments that @@ -143,7 +141,7 @@ module Make (Item : Item) = struct Map.find model.selection_status item |> Option.value ~default:input.default_selection_status with - | Selected -> true + | Selected -> true | Unselected -> false ;; @@ -151,14 +149,14 @@ module Make (Item : Item) = struct let explicitly_selected = List.filter_map (Map.to_alist model.selection_status) ~f:(fun (item, status) -> match status with - | Selected -> Some item + | Selected -> Some item | Unselected -> None) |> Item.Set.of_list in let defaults = match input.default_selection_status with | Unselected -> Item.Set.empty - | Selected -> Set.diff input.all_items (Set.of_map_keys model.selection_status) + | Selected -> Set.diff input.all_items (Set.of_map_keys model.selection_status) in Set.union explicitly_selected defaults ;; @@ -176,14 +174,14 @@ module Make (Item : Item) = struct context (input.update_search search_string); { model with focused_item } - | Set_item_selected { item; status } -> + | Set_item_selected { item; status } -> { model with selection_status = Map.set model.selection_status ~key:item ~data:status } | Set_all_selection_statuses selection_status -> { model with selection_status } - | Toggle_focused_item_selected -> + | Toggle_focused_item_selected -> (match focused_item input model with - | None -> model + | None -> model | Some focused_item -> let selection_status = Map.update model.selection_status focused_item ~f:(fun status -> @@ -197,7 +195,7 @@ module Make (Item : Item) = struct move_in_set input.items_matching_search (focused_item input model) ~dir in (match focused_item with - | None -> model + | None -> model | Some focused_item -> { model with focused_item = Some focused_item }) | Select_all -> let selection_status = @@ -222,23 +220,23 @@ module Make (Item : Item) = struct ~sep:"\n" (sprintf "Search string: '%s'" input.current_search :: List.map (Set.to_list input.items_matching_search) ~f:(fun item -> - let is_focused = - match model.focused_item with - | None -> false - | Some item' -> Item.( = ) item item' - in - let is_selected = is_item_selected input model ~item in - sprintf - !"%s %s %{Item}" - (if is_focused then "->" else " ") - (if is_selected then "*" else " " ) - item)) + let is_focused = + match model.focused_item with + | None -> false + | Some item' -> Item.( = ) item item' + in + let is_selected = is_item_selected input model ~item in + sprintf + !"%s %s %{Item}" + (if is_focused then "->" else " ") + (if is_selected then "*" else " ") + item)) ;; let search_box_view (input : Input.t) ~inject ~autofocus ~id = let open Vdom in let on_input = function - | None -> inject (Action.Update_search_string "" ) + | None -> inject (Action.Update_search_string "") | Some text -> inject (Action.Update_search_string text) in let extra_attrs = @@ -263,7 +261,7 @@ module Make (Item : Item) = struct [ Attr.href "about:blank" ; Attr.on_click (fun ev -> match Bonsai_web.am_within_disabled_fieldset ev with - | true -> Effect.Prevent_default + | true -> Effect.Prevent_default | false -> Effect.Many [ inject action; Effect.Prevent_default ]) ; Attr.class_ class_ ] @@ -280,11 +278,11 @@ module Make (Item : Item) = struct ;; let checkboxes_view - (input : Input.t) - (model : Model.t) - ~extra_row_attrs - ~selected_items - ~inject + (input : Input.t) + (model : Model.t) + ~extra_row_attrs + ~selected_items + ~inject = let open Vdom in let focused_item = focused_item input model in @@ -295,7 +293,7 @@ module Make (Item : Item) = struct Attr.on_change (fun ev _new_value -> let status = match Js_of_ocaml.Js.Opt.to_option ev##.target with - | None -> + | None -> Js_of_ocaml.Firebug.console##error "Target missing"; assert false | Some t -> @@ -306,8 +304,8 @@ module Make (Item : Item) = struct in inject (Action.Set_item_selected { item; status })) in - let checked_attrs = [ Attr.checked; Attr.bool_property "checked" true ] in - let unchecked_attrs = [ Attr.bool_property "checked" false ] in + let checked_attrs = [ Attr.checked; Attr.bool_property "checked" true ] in + let unchecked_attrs = [ Attr.bool_property "checked" false ] in Node.input ~attrs: [ Attr.many_without_merge @@ -319,8 +317,8 @@ module Make (Item : Item) = struct ] () in - let is_focused = [%compare.equal: Item.t option] (Some item) focused_item in - let extra_attrs = extra_row_attrs ~is_focused in + let is_focused = [%compare.equal: Item.t option] (Some item) focused_item in + let extra_attrs = extra_row_attrs ~is_focused in let focus_attrs = if is_focused then @@ -331,7 +329,7 @@ module Make (Item : Item) = struct let on_click = Attr.on_click (fun ev -> match Bonsai_web.am_within_disabled_fieldset ev with - | true -> Effect.Ignore + | true -> Effect.Ignore | false -> Effect.Many [ inject (Action.Set_focus (Some item)) @@ -379,8 +377,8 @@ module Make (Item : Item) = struct let handler = let open Keyboard_event_handler.Handler in match cond with - | None -> with_prevent_default f - | Some cond -> only_handle_if cond f ~prevent_default:() + | None -> with_prevent_default f + | Some cond -> only_handle_if cond f ~prevent_default:() in { Keyboard_event_handler.Command.keys; description; group = None; handler } in @@ -404,8 +402,8 @@ module Make (Item : Item) = struct let compute ~inject input model = let selected_items = selected_items input model in { Result.view_for_testing = lazy (view_for_testing input model) - ; view = view input model ~selected_items ~inject - ; key_handler = key_handler ~inject + ; view = view input model ~selected_items ~inject + ; key_handler = key_handler ~inject ; selected_items ; inject } @@ -422,17 +420,17 @@ module Make (Item : Item) = struct module _ = struct type _t = - { all_items : Item.Set.t + { all_items : Item.Set.t ; default_selection_status : Selection_status.t - ; view_config : View_config.t + ; view_config : View_config.t } end module Initial_model_settings = struct type t = - { search_string : string + { search_string : string ; selection_status : Selection_status.t Item.Map.t option - ; focused_item : Item.t option + ; focused_item : Item.t option } let create ?(search_string = "") ?selection_status ?focused_item () = @@ -441,19 +439,19 @@ module Make (Item : Item) = struct end let bonsai - ?(initial_model_settings = Initial_model_settings.create ()) - ?(default_selection_status = Value.return Selection_status.Unselected) - ~view_config - all_items + ?(initial_model_settings = Initial_model_settings.create ()) + ?(default_selection_status = Value.return Selection_status.Unselected) + ~view_config + all_items = let open Bonsai.Let_syntax in let%sub search_results = Searcher.bonsai ~initial:initial_model_settings.search_string all_items in let input_for_t = - let%map all_items = all_items - and view_config = view_config - and default_selection_status = default_selection_status + let%map all_items = all_items + and view_config = view_config + and default_selection_status = default_selection_status and { Searcher.Result.items_matching_search; update_search; current_search } = search_results in @@ -475,4 +473,3 @@ module Make (Item : Item) = struct input_for_t ;; end - diff --git a/web_ui/multi_select/src/single_factor_intf.ml b/web_ui/multi_select/src/single_factor_intf.ml index 1c53173a..d4d5e876 100644 --- a/web_ui/multi_select/src/single_factor_intf.ml +++ b/web_ui/multi_select/src/single_factor_intf.ml @@ -1,6 +1,6 @@ open! Core open! Import -open Bonsai_web +open Bonsai_web module type Item = sig type t [@@deriving equal, sexp_of] @@ -22,15 +22,15 @@ module type S = sig module View_config : sig type t = - { header : Vdom.Node.t - (** The header will be displayed above the rest of the node. *) + { header : Vdom.Node.t + (** The header will be displayed above the rest of the node. *) ; autofocus_search_box : bool - (** If true, appends the autofocus attribute. This can cause the browser to + (** If true, appends the autofocus attribute. This can cause the browser to automatically focus the search box when the page loads. (That probably isn't useful if there is more than one of these components on a given page.) *) - ; search_box_id : string option (** The HTML ID to give the search box input *) - ; extra_row_attrs : (is_focused:bool -> Vdom.Attr.t) option - (** This attribute will be added to the selected row *) + ; search_box_id : string option (** The HTML ID to give the search box input *) + ; extra_row_attrs : (is_focused:bool -> Vdom.Attr.t) option + (** This attribute will be added to the selected row *) } val create @@ -44,17 +44,17 @@ module type S = sig module Action : sig type t = - | Update_search_string of string - | Set_item_selected of - { item : Item.t + | Update_search_string of string + | Set_item_selected of + { item : Item.t ; status : Selection_status.t } | Set_all_selection_statuses of Selection_status.t Item.Map.t - (** [Set_all_selection_statuses] sets the status for every item in the map, and any + (** [Set_all_selection_statuses] sets the status for every item in the map, and any item not in the map gets [input.default_selection_status]. *) | Toggle_focused_item_selected - | Set_focus of Item.t option - | Move_focus of [ `Next | `Prev ] + | Set_focus of Item.t option + | Move_focus of [ `Next | `Prev ] | Select_all | Select_none [@@deriving sexp_of] @@ -62,11 +62,11 @@ module type S = sig module Result : sig type t = - { view : Vdom.Node.t + { view : Vdom.Node.t ; view_for_testing : string Lazy.t - ; key_handler : Vdom_keyboard.Keyboard_event_handler.t - ; inject : Action.t -> unit Vdom.Effect.t - ; selected_items : Item.Set.t + ; key_handler : Vdom_keyboard.Keyboard_event_handler.t + ; inject : Action.t -> unit Vdom.Effect.t + ; selected_items : Item.Set.t } end @@ -84,7 +84,7 @@ module type S = sig val bonsai : ?initial_model_settings:Initial_model_settings.t -> ?default_selection_status:Selection_status.t Value.t - (** [default_selection_status] controls whether items that have not been + (** [default_selection_status] controls whether items that have not been explicitly toggled by the user should be considered selected or not. For example, setting this to [Selected] has the effect of causing all items to show initially selected. *) @@ -95,7 +95,7 @@ end module type Single_factor = sig module type Item = Item - module type S = S + module type S = S module Make (Item : Item) : S with module Item := Item end diff --git a/web_ui/multi_select/test/test_multi_factor.ml b/web_ui/multi_select/test/test_multi_factor.ml index 9d0cbfc6..34305a66 100644 --- a/web_ui/multi_select/test/test_multi_factor.ml +++ b/web_ui/multi_select/test/test_multi_factor.ml @@ -1,7 +1,7 @@ open! Core open! Import -open Bonsai.Let_syntax -open Bonsai_web_test +open Bonsai.Let_syntax +open Bonsai_web_test module Key = struct module T = struct @@ -17,7 +17,7 @@ module Key = struct include Sexpable.To_stringable (T) let name_singular = "foo" - let name_plural = "foos" + let name_plural = "foos" end module S = Bonsai_web_ui_multi_select.Multi_factor.Make (String) (Key) @@ -34,11 +34,11 @@ let default_per_subwidget = ;; let make_handle - ?initial_model_settings - ?(all_keys = default_all_keys) - ?(per_subwidget = default_per_subwidget) - ?(id_prefix = Bonsai.Value.return "test-foo") - which_display + ?initial_model_settings + ?(all_keys = default_all_keys) + ?(per_subwidget = default_per_subwidget) + ?(id_prefix = Bonsai.Value.return "test-foo") + which_display = let bonsai = let%sub result = @@ -46,26 +46,26 @@ let make_handle in result |> Bonsai.Value.map ~f:(fun result -> - let display = - sprintf - !"Selected items: %{sexp: String.Set.t Key.Map.t}\n" - (S.Result.selection result) - ^ - match which_display with - | `Simple -> Lazy.force result.view_for_testing - | `Html -> - Virtual_dom_test_helpers.Node_helpers.( - unsafe_convert_exn result.view |> to_string_html) - in - display, result.inject) + let display = + sprintf + !"Selected items: %{sexp: String.Set.t Key.Map.t}\n" + (S.Result.selection result) + ^ + match which_display with + | `Simple -> Lazy.force result.view_for_testing + | `Html -> + Virtual_dom_test_helpers.Node_helpers.( + unsafe_convert_exn result.view |> to_string_html) + in + display, result.inject) |> return in Handle.create (module struct - type t = string * (S.Action.t -> unit Ui_effect.t) + type t = string * (S.Action.t -> unit Ui_effect.t) type incoming = S.Action.t - let view (s, _ ) = s + let view (s, _) = s let incoming (_, inject) = inject end) bonsai @@ -101,7 +101,7 @@ let%expect_test "simple view" = │ * foo3 │ │ │ └───────────────────┴───────────────────┴───────────────────┘ |}]; Handle.do_actions handle [ Cycle_focused_subwidget `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: ((Foo (foo1 foo2 foo3)) (Bar ()) (Baz (baz1 baz2))) @@ -114,7 +114,7 @@ let%expect_test "simple view" = │ * foo3 │ │ │ └───────────────────┴───────────────────┴───────────────────┘ |}]; Handle.do_actions handle [ Select_on_all_subwidgets `None ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: ((Foo ()) (Bar ()) (Baz ())) @@ -264,7 +264,7 @@ let%expect_test "html view" = |}]; Handle.do_actions handle [ Cycle_focused_subwidget `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: ((Foo (foo1 foo2 foo3)) (Bar ()) (Baz (baz1 baz2))) diff --git a/web_ui/multi_select/test/test_single_factor.ml b/web_ui/multi_select/test/test_single_factor.ml index 5c80b9bc..b9816b73 100644 --- a/web_ui/multi_select/test/test_single_factor.ml +++ b/web_ui/multi_select/test/test_single_factor.ml @@ -4,18 +4,17 @@ module S = Bonsai_web_ui_multi_select.Make (String) open Bonsai.Let_syntax open Bonsai_web_test - let all_items = String.Set.of_list [ "foo"; "bar"; "baz" ] let bonsai - ?(which_display = `Simple) - ?search_string - ?(default_selection_status = - Bonsai.Value.return Bonsai_web_ui_multi_select.Selection_status.Selected) - ?selection_status - ?focused_item - ~view_config - all_items + ?(which_display = `Simple) + ?search_string + ?(default_selection_status = + Bonsai.Value.return Bonsai_web_ui_multi_select.Selection_status.Selected) + ?selection_status + ?focused_item + ~view_config + all_items = let%sub result = S.bonsai @@ -35,7 +34,7 @@ let bonsai ^ match which_display with | `Simple -> Lazy.force result.view_for_testing - | `Html -> + | `Html -> Virtual_dom_test_helpers.Node_helpers.( unsafe_convert_exn result.view |> to_string_html) in @@ -51,21 +50,21 @@ let default_view_config = ;; let handle - ?which_display - ?search_string - ?selection_status - ?focused_item - ?default_selection_status - ?(view_config = default_view_config) - ?(all_items = Bonsai.Value.return all_items) - () + ?which_display + ?search_string + ?selection_status + ?focused_item + ?default_selection_status + ?(view_config = default_view_config) + ?(all_items = Bonsai.Value.return all_items) + () = Bonsai_web_test.Handle.create (module struct - type t = string * (S.Action.t -> unit Vdom.Effect.t) + type t = string * (S.Action.t -> unit Vdom.Effect.t) type incoming = S.Action.t - let view (s, _ ) = s + let view (s, _) = s let incoming (_, inject) = inject end) (bonsai @@ -81,7 +80,7 @@ let handle let%expect_test "focus" = let handle = handle () in Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -90,7 +89,7 @@ let%expect_test "focus" = * baz * foo |}]; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -99,7 +98,7 @@ let%expect_test "focus" = * baz * foo |}]; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -108,7 +107,7 @@ let%expect_test "focus" = -> * baz * foo |}]; Handle.do_actions handle [ Move_focus `Prev ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -117,7 +116,7 @@ let%expect_test "focus" = * baz * foo |}]; Handle.do_actions handle [ Move_focus `Prev ]; - Handle.show handle; + Handle.show handle; (* Note that we don't wrap around. *) [%expect {| @@ -127,7 +126,7 @@ let%expect_test "focus" = * baz * foo |}]; Handle.do_actions handle [ Set_focus (Some "foo") ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -136,7 +135,7 @@ let%expect_test "focus" = * baz -> * foo |}]; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show handle; + Handle.show handle; (* Note that we don't wrap around. *) [%expect {| @@ -146,7 +145,7 @@ let%expect_test "focus" = * baz -> * foo |}]; Handle.do_actions handle [ Set_focus None ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -159,7 +158,7 @@ let%expect_test "focus" = let%expect_test "selections" = let handle = handle () in Handle.do_actions handle [ Set_item_selected { item = "bar"; status = Unselected } ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (baz foo) @@ -168,7 +167,7 @@ let%expect_test "selections" = * baz * foo |}]; Handle.do_actions handle [ Set_item_selected { item = "bar"; status = Selected } ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -177,7 +176,7 @@ let%expect_test "selections" = * baz * foo |}]; Handle.do_actions handle [ Move_focus `Prev ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -186,7 +185,7 @@ let%expect_test "selections" = * baz -> * foo |}]; Handle.do_actions handle [ Toggle_focused_item_selected ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz) @@ -195,7 +194,7 @@ let%expect_test "selections" = * baz -> foo |}]; Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -204,7 +203,7 @@ let%expect_test "selections" = * baz -> * foo |}]; Handle.do_actions handle [ Select_none ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: () @@ -301,28 +300,28 @@ let%expect_test "search string vdom" = let%expect_test "searching" = let handle = handle () in Handle.do_actions handle [ Select_none; Update_search_string "ba" ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: () Search string: 'ba' bar baz |}]; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: () Search string: 'ba' -> bar baz |}]; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: () Search string: 'ba' bar -> baz |}]; Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz) @@ -330,7 +329,7 @@ let%expect_test "searching" = * bar -> * baz |}]; Handle.do_actions handle [ Update_search_string "" ]; - Handle.show handle; + Handle.show handle; (* Note that "foo" is not selected as it was not in the search results when Select_all was run *) [%expect @@ -341,7 +340,7 @@ let%expect_test "searching" = -> * baz foo |}]; Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -350,7 +349,7 @@ let%expect_test "searching" = -> * baz * foo |}]; Handle.do_actions handle [ Update_search_string "ba" ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -358,7 +357,7 @@ let%expect_test "searching" = * bar -> * baz |}]; Handle.do_actions handle [ Select_none ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (foo) @@ -366,7 +365,7 @@ let%expect_test "searching" = bar -> baz |}]; Handle.do_actions handle [ Update_search_string "" ]; - Handle.show handle; + Handle.show handle; (* Note that foo is not deselected as it was not in the search results when Select_none was run. *) [%expect @@ -379,9 +378,9 @@ let%expect_test "searching" = ;; let%expect_test "changing items" = - let all_items_var = Bonsai.Var.create all_items in - let all_items = Bonsai.Var.value all_items_var in - let handle = handle ~all_items () in + let all_items_var = Bonsai.Var.create all_items in + let all_items = Bonsai.Var.value all_items_var in + let handle = handle ~all_items () in Bonsai.Var.update all_items_var ~f:(fun all_items -> Set.add all_items "quux"); Handle.show handle; [%expect @@ -393,7 +392,7 @@ let%expect_test "changing items" = * foo * quux |}]; Handle.do_actions handle [ Update_search_string "" ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo quux) @@ -405,13 +404,13 @@ let%expect_test "changing items" = ;; let%expect_test "default_selection_status = Unselected" = - let all_items_var = Bonsai.Var.create all_items in - let all_items = Bonsai.Var.value all_items_var in + let all_items_var = Bonsai.Var.create all_items in + let all_items = Bonsai.Var.value all_items_var in let default_selection_status_var = Bonsai.Var.create Bonsai_web_ui_multi_select.Selection_status.Unselected in - let default_selection_status = Bonsai.Var.value default_selection_status_var in - let handle = handle ~default_selection_status ~all_items () in + let default_selection_status = Bonsai.Var.value default_selection_status_var in + let handle = handle ~default_selection_status ~all_items () in Handle.show handle; [%expect {| @@ -421,7 +420,7 @@ let%expect_test "default_selection_status = Unselected" = baz foo |}]; Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -462,12 +461,12 @@ let%expect_test "specifying arguments to S.Model.create" = ;; let%expect_test "html" = - let all_items_var = Bonsai.Var.create all_items in - let all_items = Bonsai.Var.value all_items_var in + let all_items_var = Bonsai.Var.create all_items in + let all_items = Bonsai.Var.value all_items_var in let default_selection_status_var = Bonsai.Var.create Bonsai_web_ui_multi_select.Selection_status.Selected in - let default_selection_status = Bonsai.Var.value default_selection_status_var in + let default_selection_status = Bonsai.Var.value default_selection_status_var in let handle = handle ~default_selection_status ~all_items ~which_display:`Html () in Handle.show handle; [%expect @@ -498,7 +497,7 @@ let%expect_test "html" = |}]; Handle.do_actions handle [ Move_focus `Next; Select_none ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: () @@ -527,7 +526,7 @@ let%expect_test "html" = |}]; Handle.do_actions handle [ Select_all ]; - Handle.show handle; + Handle.show handle; [%expect {| Selected items: (bar baz foo) @@ -592,8 +591,8 @@ let%expect_test "html" = ;; let%expect_test "html-custom-selected-attr" = - let all_items_var = Bonsai.Var.create all_items in - let all_items = Bonsai.Var.value all_items_var in + let all_items_var = Bonsai.Var.create all_items in + let all_items = Bonsai.Var.value all_items_var in let default_selection_status_var = Bonsai.Var.create Bonsai_web_ui_multi_select.Selection_status.Selected in @@ -614,7 +613,7 @@ let%expect_test "html-custom-selected-attr" = in Handle.store_view handle; Handle.do_actions handle [ Move_focus `Next ]; - Handle.show_diff handle; + Handle.show_diff handle; [%expect {| Selected items: (bar baz foo) diff --git a/web_ui/not_connected_warning_box/src/bonsai_web_ui_not_connected_warning_box.ml b/web_ui/not_connected_warning_box/src/bonsai_web_ui_not_connected_warning_box.ml index 1b33f016..135273bf 100644 --- a/web_ui/not_connected_warning_box/src/bonsai_web_ui_not_connected_warning_box.ml +++ b/web_ui/not_connected_warning_box/src/bonsai_web_ui_not_connected_warning_box.ml @@ -3,9 +3,9 @@ open Virtual_dom open Bonsai.Let_syntax module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .connected { display: none; } diff --git a/web_ui/notifications/src/bonsai_web_ui_notifications.ml b/web_ui/notifications/src/bonsai_web_ui_notifications.ml index f711e975..e4c94427 100644 --- a/web_ui/notifications/src/bonsai_web_ui_notifications.ml +++ b/web_ui/notifications/src/bonsai_web_ui_notifications.ml @@ -3,9 +3,9 @@ open! Bonsai_web open! Bonsai.Let_syntax module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .notification_container { position: fixed; bottom: 20px; @@ -158,9 +158,9 @@ let component (type a) (module M : Bonsai.Model with type t = a) ~equal = the data that is known about the notificaiton like when we expect it to closed an also when it was sent. *) let render_with_access_to_entire_notification - ?(notification_container_extra_attr = Value.return Vdom.Attr.empty) - t - ~f + ?(notification_container_extra_attr = Value.return Vdom.Attr.empty) + t + ~f = let%sub { notifications; inject; send_notification = _; modify_notification = _ } = return t @@ -184,10 +184,10 @@ let render_with_access_to_entire_notification and notification_container_extra_attr = notification_container_extra_attr in Map.to_alist rendered |> List.map ~f:(fun (notification_id, (rendered, _)) -> - Vdom.Node.div - ~key:(Notification_id.to_string notification_id) - ~attrs:[ Style.notification ] - [ rendered ]) + Vdom.Node.div + ~key:(Notification_id.to_string notification_id) + ~attrs:[ Style.notification ] + [ rendered ]) |> Vdom.Node.div ~attrs:[ Style.notification_container; notification_container_extra_attr ] ;; @@ -202,24 +202,24 @@ let render t ~f = ;; let send_notification - ?close_after - { send_notification; notifications = _; inject = _; modify_notification = _ } + ?close_after + { send_notification; notifications = _; inject = _; modify_notification = _ } = send_notification ?close_after ;; let close_notification - { inject; notifications = _; send_notification = _; modify_notification = _ } - id + { inject; notifications = _; send_notification = _; modify_notification = _ } + id = inject (Remove id) ;; let modify_notification - ?close_after - { modify_notification; inject = _; notifications = _; send_notification = _ } - id - content + ?close_after + { modify_notification; inject = _; notifications = _; send_notification = _ } + id + content = Effect.ignore_m (modify_notification ?close_after id content) ;; @@ -250,9 +250,9 @@ module Basic = struct } module Notification_style = - [%css - stylesheet - {| + [%css + stylesheet + {| .success { background-color: #00AB66; } @@ -263,10 +263,10 @@ module Basic = struct |}] let create - ?(dismiss_notifications_after : Time_ns.Span.t Value.t = - Value.return (Time_ns.Span.of_sec 15.0)) - ?(dismiss_errors_automatically : bool Value.t = Value.return false) - () + ?(dismiss_notifications_after : Time_ns.Span.t Value.t = + Value.return (Time_ns.Span.of_sec 15.0)) + ?(dismiss_errors_automatically : bool Value.t = Value.return false) + () = let%sub notifications = component (module Basic_notification) ~equal:[%equal: Basic_notification.t] @@ -307,10 +307,10 @@ module Basic = struct let default_module : (module Style) = (module Notification_style) let render - ?(notification_style = default_module) - ?(notification_extra_attr = Value.return Vdom.Attr.empty) - ?notification_container_extra_attr - (t : basic_t Value.t) + ?(notification_style = default_module) + ?(notification_extra_attr = Value.return Vdom.Attr.empty) + ?notification_container_extra_attr + (t : basic_t Value.t) = let module Notification_style = (val notification_style) in let%sub { notifications @@ -324,48 +324,48 @@ module Basic = struct notifications ?notification_container_extra_attr ~f:(fun ~close ~id:notification_id notification -> - let%arr { Notification.content = { text; level }; opened_at = _; close_after } = - notification - and close = close - and notification_id = notification_id - and notification_extra_attr = notification_extra_attr in - let level_class = - match level with - | Success -> Notification_style.success - | Error _ -> Notification_style.error - in - Vdom.Node.div - ~key:(Notification_id.to_string notification_id) - ~attrs: - [ Vdom.Attr.( - Style.notification - @ on_click (fun _ -> close) - @ notification_extra_attr - @ create "data-notification-id" (Notification_id.to_string notification_id)) - ] - [ Vdom.Node.div - ~attrs: - [ Vdom.Attr.( - many [ Style.notification_body; level_class ] - @ - match close_after with - | None -> Vdom.Attr.empty - | Some close_after -> - style - (let open Css_gen in - animation - ~name:"fadeOut" - ~duration:close_after - ~timing_function:"ease-in" - ())) - ] - [ Vdom.Node.text text - ; (match level with - | Success | Error None -> Vdom.Node.None - | Error (Some error) -> - Vdom.Node.pre [ Vdom.Node.text (Error.to_string_hum error) ]) + let%arr { Notification.content = { text; level }; opened_at = _; close_after } = + notification + and close = close + and notification_id = notification_id + and notification_extra_attr = notification_extra_attr in + let level_class = + match level with + | Success -> Notification_style.success + | Error _ -> Notification_style.error + in + Vdom.Node.div + ~key:(Notification_id.to_string notification_id) + ~attrs: + [ Vdom.Attr.( + Style.notification + @ on_click (fun _ -> close) + @ notification_extra_attr + @ create "data-notification-id" (Notification_id.to_string notification_id)) + ] + [ Vdom.Node.div + ~attrs: + [ Vdom.Attr.( + many [ Style.notification_body; level_class ] + @ + match close_after with + | None -> Vdom.Attr.empty + | Some close_after -> + style + (let open Css_gen in + animation + ~name:"fadeOut" + ~duration:close_after + ~timing_function:"ease-in" + ())) ] - ]) + [ Vdom.Node.text text + ; (match level with + | Success | Error None -> Vdom.Node.None + | Error (Some error) -> + Vdom.Node.pre [ Vdom.Node.text (Error.to_string_hum error) ]) + ] + ]) ;; type t = basic_t diff --git a/web_ui/notifications/src/bonsai_web_ui_notifications.mli b/web_ui/notifications/src/bonsai_web_ui_notifications.mli index b90ab1cd..edd6543d 100644 --- a/web_ui/notifications/src/bonsai_web_ui_notifications.mli +++ b/web_ui/notifications/src/bonsai_web_ui_notifications.mli @@ -90,4 +90,3 @@ module Basic : sig -> t Value.t -> Vdom.Node.t Computation.t end - diff --git a/web_ui/partial_render_table/bench/bin/main.ml b/web_ui/partial_render_table/bench/bin/main.ml index 655f954a..88e34d6b 100644 --- a/web_ui/partial_render_table/bench/bin/main.ml +++ b/web_ui/partial_render_table/bench/bin/main.ml @@ -45,10 +45,10 @@ module Dynamic_cells = struct module Column = Expert.Columns.Dynamic_cells let column_helper - (type a) - (module M : S with type t = a) - ?visible - (field : (_, a) Field.t) + (type a) + (module M : S with type t = a) + ?visible + (field : (_, a) Field.t) = Column.column ?visible @@ -87,10 +87,10 @@ module Dynamic_columns = struct module Column = Expert.Columns.Dynamic_columns let column_helper - (type a) - (module M : S with type t = a) - ?visible - (field : (_, a) Field.t) + (type a) + (module M : S with type t = a) + ?visible + (field : (_, a) Field.t) = Column.column ?visible @@ -251,10 +251,10 @@ let set_map ~config ~size ~num_sets ~batch_size ~window_size = List.init batch_size ~f:(fun i -> let index = (set_num * batch_size) + i in current_map - := Map.set - !current_map - ~key:(index mod window_size) - ~data:(Row.of_int (index + size)); + := Map.set + !current_map + ~key:(index mod window_size) + ~data:(Row.of_int (index + size)); Input.set_map input !current_map) |> Interaction.many) |> Interaction.many_with_stabilizations diff --git a/web_ui/partial_render_table/bench/src/bonsai_web_ui_partial_render_table_bench.ml b/web_ui/partial_render_table/bench/src/bonsai_web_ui_partial_render_table_bench.ml index 63fb08d4..d6f95d8a 100644 --- a/web_ui/partial_render_table/bench/src/bonsai_web_ui_partial_render_table_bench.ml +++ b/web_ui/partial_render_table/bench/src/bonsai_web_ui_partial_render_table_bench.ml @@ -28,12 +28,12 @@ module Input = struct } let create - ?(filter = None) - ?(order = Compare.Unchanged) - ?(rank_range = Collate.Which_range.To 100) - ?(key_range = Collate.Which_range.All_rows) - ?(on_change = Fn.const Effect.Ignore) - map + ?(filter = None) + ?(order = Compare.Unchanged) + ?(rank_range = Collate.Which_range.To 100) + ?(key_range = Collate.Which_range.All_rows) + ?(on_change = Fn.const Effect.Ignore) + map = { filter = Bonsai.Var.create filter ; order = Bonsai.Var.create order @@ -55,18 +55,18 @@ module Input = struct let stride = if start > stop then -1 else 1 in List.range ~stride start stop |> List.map ~f:(fun i -> - Interaction.change_input - t.rank_range - (Collate.Which_range.Between (i, i + window_size - 1))) + Interaction.change_input + t.rank_range + (Collate.Which_range.Between (i, i + window_size - 1))) |> Interaction.many_with_stabilizations ;; end let component_for_bench - ?preload_rows - comparator - ~columns - { Input.filter; order; rank_range; key_range; map; on_change } + ?preload_rows + comparator + ~columns + { Input.filter; order; rank_range; key_range; map; on_change } = let filter = Bonsai.Var.value filter in let order = Bonsai.Var.value order in diff --git a/web_ui/partial_render_table/protocol/bonsai_web_ui_partial_render_table_protocol.ml b/web_ui/partial_render_table/protocol/bonsai_web_ui_partial_render_table_protocol.ml index e99cd770..6cefd954 100644 --- a/web_ui/partial_render_table/protocol/bonsai_web_ui_partial_render_table_protocol.ml +++ b/web_ui/partial_render_table/protocol/bonsai_web_ui_partial_render_table_protocol.ml @@ -63,10 +63,10 @@ module Order = struct end let apply_action - (type col_id) - t - (module Col_id : Col_id with type t = col_id) - (action : col_id Action.t) + (type col_id) + t + (module Col_id : Col_id with type t = col_id) + (action : col_id Action.t) = let equal = Col_id.equal in let cycle_sort_direction id = diff --git a/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.ml b/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.ml index 14078c86..e2dbdb44 100644 --- a/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.ml +++ b/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.ml @@ -51,14 +51,14 @@ module Expert = struct ;; let implementation - (type key presence data cmp) - ~preload_rows - (key : (key, cmp) Bonsai.comparator) - ~(focus : (_, presence, key) Focus.Kind.t) - ~row_height - ~headers - ~assoc - (collated : (key, data) Collated.t Value.t) + (type key presence data cmp) + ~preload_rows + (key : (key, cmp) Bonsai.comparator) + ~(focus : (_, presence, key) Focus.Kind.t) + ~row_height + ~headers + ~assoc + (collated : (key, data) Collated.t Value.t) = let%sub row_height = let%arr (`Px row_height) = row_height in @@ -102,18 +102,18 @@ module Expert = struct ~apply_action: (fun (_ : _ Bonsai.Apply_action_context.t) model (idx, `Px_float width) -> - (* While checking for float equality is usually not a good idea, + (* While checking for float equality is usually not a good idea, this is meant to handle the specific case when a column has "display:none", in which case the width will be exactly 0.0, so there is no concern about float rounding errors. *) - Map.update model idx ~f:(fun prev -> - if Float.equal width 0.0 - then ( - match prev with - | None -> Hidden { prev_width_px = None } - | Some (Visible { width_px }) -> Hidden { prev_width_px = Some width_px } - | Some (Hidden _ as prev) -> prev) - else Visible { width_px = width })) + Map.update model idx ~f:(fun prev -> + if Float.equal width 0.0 + then ( + match prev with + | None -> Hidden { prev_width_px = None } + | Some (Visible { width_px }) -> Hidden { prev_width_px = Some width_px } + | Some (Hidden _ as prev) -> prev) + else Visible { width_px = width })) in let%sub column_widths = return (Value.cutoff ~equal:[%equal: Column_widths_model.t] column_widths) @@ -357,7 +357,7 @@ module Expert = struct and path = path in let body = Vdom.Node.div - (* If the number is large enough, it will use scientific notation for unknown reasons. + (* If the number is large enough, it will use scientific notation for unknown reasons. However, the number is accurate, and scientific notation is in spec. https://developer.mozilla.org/en-US/docs/Web/CSS/number *) ~attrs: @@ -403,13 +403,13 @@ module Expert = struct ;; let component - (type key focus presence data cmp) - ?(preload_rows = default_preload) - (key : (key, cmp) Bonsai.comparator) - ~(focus : (focus, presence, key) Focus.Kind.t) - ~row_height - ~(columns : (key, data) Column_intf.t) - (collated : (key, data) Collated.t Value.t) + (type key focus presence data cmp) + ?(preload_rows = default_preload) + (key : (key, cmp) Bonsai.comparator) + ~(focus : (focus, presence, key) Focus.Kind.t) + ~row_height + ~(columns : (key, data) Column_intf.t) + (collated : (key, data) Collated.t Value.t) = let (T { value; vtable }) = columns in let module T = (val vtable) in @@ -419,14 +419,14 @@ module Expert = struct ;; let collate - (type k v cmp filter order) - ?operation_order - ~filter_equal - ~order_equal - ~(filter_to_predicate : filter -> _) - ~(order_to_compare : order -> _) - (data : (k, v, cmp) Map.t Value.t) - (collate : (k, filter, order) Collate.t Value.t) + (type k v cmp filter order) + ?operation_order + ~filter_equal + ~order_equal + ~(filter_to_predicate : filter -> _) + ~(order_to_compare : order -> _) + (data : (k, v, cmp) Map.t Value.t) + (collate : (k, filter, order) Collate.t Value.t) = let data_and_collate = Value.both data collate in Bonsai.Incr.compute data_and_collate ~f:(fun data_and_collate -> @@ -494,107 +494,107 @@ module Basic = struct -> focus Result.t Computation.t = fun ?filter - ?override_sort - ?default_sort - ?(preload_rows = default_preload) - comparator - ~focus - ~row_height - ~columns - map -> - let module Cmp = (val comparator) in - let focus : (focus, presence, key) Expert.Focus.Kind.t = - match focus with - | None -> None - | By_row { on_change } -> - let compute_presence focus = - let%arr focus = focus - and map = map in - match focus with - | None -> None - | Some focus -> if Map.mem map focus then Some focus else None - in - By_row { on_change; compute_presence } - in - let filter = Value.of_opt filter in - let%sub rank_range, set_rank_range = - Bonsai.state - (Collate.Which_range.To 0) - ~sexp_of_model:[%sexp_of: Rank_range.t] - ~equal:[%equal: Rank_range.t] - in - let%sub sortable_header = Sortable_header.component (module Int) in - let (Y { value; vtable }) = columns in - let module Column = (val vtable) in - let assoc = Column.instantiate_cells value comparator in - let default_sort = - match default_sort with - | None -> Value.return None - | Some v -> v >>| Option.some - in - let%sub sorters, headers = Column.headers_and_sorters value sortable_header in - let%sub collate = - let%sub override_sort = - match override_sort with - | None -> Bonsai.const None - | Some override -> return (override >>| Option.some) - in - let%sub order = - let%arr sorters = sorters - and default_sort = default_sort - and sortable_header = sortable_header - and override_sort = override_sort in - let override_sort = - Option.map override_sort ~f:(fun override_sort -> - override_sort Cmp.comparator.compare) - in - Order.to_compare - (Sortable_header.order sortable_header) - ?override_sort - ~sorters - ~default_sort + ?override_sort + ?default_sort + ?(preload_rows = default_preload) + comparator + ~focus + ~row_height + ~columns + map -> + let module Cmp = (val comparator) in + let focus : (focus, presence, key) Expert.Focus.Kind.t = + match focus with + | None -> None + | By_row { on_change } -> + let compute_presence focus = + let%arr focus = focus + and map = map in + match focus with + | None -> None + | Some focus -> if Map.mem map focus then Some focus else None in - let%arr filter = filter - and order = order - and rank_range = rank_range in - let key_range = Collate.Which_range.All_rows in - { Collate.filter; order; key_range; rank_range } - in - let%sub collated = - Expert.collate - ~filter_equal:phys_equal - ~filter_to_predicate:Fn.id - ~order_equal:phys_equal - ~order_to_compare:Fn.id - map - collate - in - let%sub num_filtered_rows = - let%arr collated = collated in - Collated.num_filtered_rows collated - in - let%sub ({ range = viewed_range; _ } as result) = - Expert.implementation - ~preload_rows - comparator - ~focus - ~row_height - ~headers - ~assoc - collated + By_row { on_change; compute_presence } + in + let filter = Value.of_opt filter in + let%sub rank_range, set_rank_range = + Bonsai.state + (Collate.Which_range.To 0) + ~sexp_of_model:[%sexp_of: Rank_range.t] + ~equal:[%equal: Rank_range.t] + in + let%sub sortable_header = Sortable_header.component (module Int) in + let (Y { value; vtable }) = columns in + let module Column = (val vtable) in + let assoc = Column.instantiate_cells value comparator in + let default_sort = + match default_sort with + | None -> Value.return None + | Some v -> v >>| Option.some + in + let%sub sorters, headers = Column.headers_and_sorters value sortable_header in + let%sub collate = + let%sub override_sort = + match override_sort with + | None -> Bonsai.const None + | Some override -> return (override >>| Option.some) in - let%sub () = - Bonsai.Edge.on_change - ~sexp_of_model:[%sexp_of: int * int] - ~equal:[%equal: int * int] - viewed_range - ~callback: - (let%map set_rank_range = set_rank_range in - fun (low, high) -> set_rank_range (Collate.Which_range.Between (low, high))) + let%sub order = + let%arr sorters = sorters + and default_sort = default_sort + and sortable_header = sortable_header + and override_sort = override_sort in + let override_sort = + Option.map override_sort ~f:(fun override_sort -> + override_sort Cmp.comparator.compare) + in + Order.to_compare + (Sortable_header.order sortable_header) + ?override_sort + ~sorters + ~default_sort in - let%arr { view; for_testing; range = _; focus } = result - and num_filtered_rows = num_filtered_rows - and sortable_header = sortable_header in - { Result.view; for_testing; focus; num_filtered_rows; sortable_header } + let%arr filter = filter + and order = order + and rank_range = rank_range in + let key_range = Collate.Which_range.All_rows in + { Collate.filter; order; key_range; rank_range } + in + let%sub collated = + Expert.collate + ~filter_equal:phys_equal + ~filter_to_predicate:Fn.id + ~order_equal:phys_equal + ~order_to_compare:Fn.id + map + collate + in + let%sub num_filtered_rows = + let%arr collated = collated in + Collated.num_filtered_rows collated + in + let%sub ({ range = viewed_range; _ } as result) = + Expert.implementation + ~preload_rows + comparator + ~focus + ~row_height + ~headers + ~assoc + collated + in + let%sub () = + Bonsai.Edge.on_change + ~sexp_of_model:[%sexp_of: int * int] + ~equal:[%equal: int * int] + viewed_range + ~callback: + (let%map set_rank_range = set_rank_range in + fun (low, high) -> set_rank_range (Collate.Which_range.Between (low, high))) + in + let%arr { view; for_testing; range = _; focus } = result + and num_filtered_rows = num_filtered_rows + and sortable_header = sortable_header in + { Result.view; for_testing; focus; num_filtered_rows; sortable_header } ;; end diff --git a/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.mli b/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.mli index feea03c0..b94e70e7 100644 --- a/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.mli +++ b/web_ui/partial_render_table/src/bonsai_web_ui_partial_render_table.mli @@ -56,16 +56,16 @@ module Basic : sig val column : ?sort:('key * 'data -> 'key * 'data -> int) Value.t - (** If this column is sortable, you can provide the sorting function here *) + (** If this column is sortable, you can provide the sorting function here *) -> ?sort_reversed:('key * 'data -> 'key * 'data -> int) Value.t - (** If the column has a specialized "reverse order", you can provide it here. *) + (** If the column has a specialized "reverse order", you can provide it here. *) -> ?initial_width:Css_gen.Length.t -> ?visible:bool Value.t - (** [visible] can be set to [false] to hide the whole column. *) + (** [visible] can be set to [false] to hide the whole column. *) -> header:(Sort_state.t -> Vdom.Node.t) Value.t - (** [header] determines the contents of the column header *) + (** [header] determines the contents of the column header *) -> cell:(key:'key Value.t -> data:'data Value.t -> Vdom.Node.t Computation.t) - (** [cell] is the function determines the contents of every cell in this column. *) + (** [cell] is the function determines the contents of every cell in this column. *) -> unit -> ('key, 'data) t @@ -96,15 +96,15 @@ module Basic : sig val column : ?sort:('key * 'data -> 'key * 'data -> int) - (** If this column is sortable, you can provide the sorting function here *) + (** If this column is sortable, you can provide the sorting function here *) -> ?sort_reversed:('key * 'data -> 'key * 'data -> int) - (** If the column has a specialized "reverse order", you can provide it here. *) + (** If the column has a specialized "reverse order", you can provide it here. *) -> ?initial_width:Css_gen.Length.t -> ?visible:bool (** [visible] can be set to [false] to hide the whole column. *) -> header:(Sort_state.t -> Vdom.Node.t) - (** [header] determines the contents of the column header *) + (** [header] determines the contents of the column header *) -> cell:(key:'key -> data:'data -> Vdom.Node.t) - (** [cell] is the function determines the contents of every cell in this column. *) + (** [cell] is the function determines the contents of every cell in this column. *) -> unit -> ('key, 'data) t @@ -126,10 +126,10 @@ module Basic : sig (** This is the main UI component for the table content. *) val component : ?filter:(key:'key -> data:'data -> bool) Value.t - (** An optional function may be provided, which filters the rows in the table. *) + (** An optional function may be provided, which filters the rows in the table. *) -> ?override_sort: ('key compare -> ('key * 'data) compare -> ('key * 'data) compare) Value.t - (** override_sort is an optional function that transforms the tables current sort, + (** override_sort is an optional function that transforms the tables current sort, taking into account the default-sort and any user-provided sorts that they've added by clicking on column headers. @@ -137,12 +137,12 @@ module Basic : sig which the overrider can use as a fall-back for when the the ('key * 'data) comparison function returns 0. *) -> ?default_sort:('key * 'data) compare Value.t - (** An optional function may be provided to sort the table. *) + (** An optional function may be provided to sort the table. *) -> ?preload_rows:int -> ('key, 'cmp) Bonsai.comparator -> focus:('focus, 'presence, 'key) Focus.t -> row_height:[ `Px of int ] Value.t - (** [row_height] is the height of every row in the table. If the row height + (** [row_height] is the height of every row in the table. If the row height is specified to be 0px or less, we instead use 1px. *) -> columns:('key, 'data) Columns.t -> ('key, 'data, 'cmp) Map.t Value.t (** The input data for the table *) @@ -156,7 +156,6 @@ module Expert : sig table data is too large to pass to the client directly, or when you'd like to update your table via RPC. *) - open Incr_map_collate module Focus : sig @@ -166,7 +165,7 @@ module Expert : sig | None : (unit, unit, 'k) t | By_row : { on_change : ('k option -> unit Effect.t) Value.t - (** Row-selection is not required to be inside the viewport, so the selected row + (** Row-selection is not required to be inside the viewport, so the selected row can be offscreen such that it isn't given to the table component. [compute_presence] forces the user to consider if a row is considered 'focused' or not. *) ; compute_presence : 'k option Value.t -> 'p Computation.t @@ -230,40 +229,40 @@ module Expert : sig val collate : ?operation_order:[ `Filter_first | `Sort_first ] -> filter_equal:('filter -> 'filter -> bool) - (** [filter_equal] is used to decide when the filters have actually changed, requiring + (** [filter_equal] is used to decide when the filters have actually changed, requiring a recomputation of the collation. *) -> order_equal:('order -> 'order -> bool) - (** [order_equal] is used to decide when the sorting params have actually changed, + (** [order_equal] is used to decide when the sorting params have actually changed, requiring a recomputation of the collation. *) -> filter_to_predicate:('filter -> (key:'k -> data:'v -> bool) option) - (** [filter_to_predicate] takes the current set of filters ['filter] and optionally + (** [filter_to_predicate] takes the current set of filters ['filter] and optionally returns a function that can apply those filters to each row. When [filter_to_predicate] returns [None], no filtering is done. *) -> order_to_compare:('order -> ('k, 'v, 'cmp) Compare.t) - (** [order_to_compare] takes the current set of sort params ['order] and uses the + (** [order_to_compare] takes the current set of sort params ['order] and uses the [Compare] specification to decide how to apply them. Return [Unchanged] to perform no sorting. *) -> ('k, 'v, 'cmp) Map.t Value.t - (** A [Map.t] containing the source for all the table data, pre-collation. *) + (** A [Map.t] containing the source for all the table data, pre-collation. *) -> ('k, 'filter, 'order) Collate.t Value.t - (** A [Collate.t] is a specification for how to perform collation: it's where the + (** A [Collate.t] is a specification for how to perform collation: it's where the ['filter], ['order], and rank range are defined. *) -> ('k, 'v) Collated.t Computation.t val component : ?preload_rows:int - (** [preload_rows] is the number of rows that are maintained before and after the + (** [preload_rows] is the number of rows that are maintained before and after the viewport range. This number can have a significant effect on performance: too small and scrolling might be choppy; too large and you start to lose some of the benefits of partial rendering. *) -> ('key, 'cmp) Bonsai.comparator -> focus:('focus, 'presence, 'key) Focus.t -> row_height:[ `Px of int ] Value.t - (** [row_height] is the height of every row in the table. If the row height + (** [row_height] is the height of every row in the table. If the row height is specified to be 0px or less, we instead use 1px. *) -> columns:('key, 'row) Columns.t -> ('key, 'row) Collated.t Value.t - (** The collated value is the proper input to the component. + (** The collated value is the proper input to the component. You can use [Expert.collate] to get a Collated.t value, or do the collation manually on the server by using the Incr_map_collate library manually. *) diff --git a/web_ui/partial_render_table/src/column.ml b/web_ui/partial_render_table/src/column.ml index 85410f38..0e812393 100644 --- a/web_ui/partial_render_table/src/column.ml +++ b/web_ui/partial_render_table/src/column.ml @@ -89,39 +89,39 @@ module Dynamic_cells = struct -> (k * Vdom.Node.t) Map_list.t Computation.t list = fun map ~empty comparator -> function - | Leaf { cell; visible; _ } -> - [ (if%sub visible - then - Bonsai.Expert.assoc_on - (module Map_list.Key) - comparator - map - ~get_model_key:(fun _ (k, _) -> k) - ~f:(fun _ data -> - let%sub key, data = return data in - let%sub r = cell ~key ~data in - let%arr key = key - and r = r in - key, r) - else ( - let f = Ui_incr.Map.map ~f:(fun (k, _) -> k, empty_div) in - Bonsai.Incr.compute map ~f)) - ] - | Group { children; _ } | Org_group children -> - List.bind children ~f:(visible_leaves map ~empty comparator) + | Leaf { cell; visible; _ } -> + [ (if%sub visible + then + Bonsai.Expert.assoc_on + (module Map_list.Key) + comparator + map + ~get_model_key:(fun _ (k, _) -> k) + ~f:(fun _ data -> + let%sub key, data = return data in + let%sub r = cell ~key ~data in + let%arr key = key + and r = r in + key, r) + else ( + let f = Ui_incr.Map.map ~f:(fun (k, _) -> k, empty_div) in + Bonsai.Incr.compute map ~f)) + ] + | Group { children; _ } | Org_group children -> + List.bind children ~f:(visible_leaves map ~empty comparator) ;; let instantiate_cells (type k) t comparator (map : (k * _) Map_list.t Value.t) = let empty = Map.empty (module Map_list.Key) in visible_leaves map ~empty comparator t |> Computation.fold_right ~init:(Value.return empty) ~f:(fun a acc -> - Bonsai.Incr.compute (Value.both a acc) ~f:(fun a_and_acc -> - let%pattern_bind.Ui_incr a, acc = a_and_acc in - Ui_incr.Map.merge a acc ~f:(fun ~key:_ change -> - match change with - | `Left (i, l) -> Some (i, [ l ]) - | `Right (i, r) -> Some (i, r) - | `Both ((i, l), (_, r)) -> Some (i, l :: r)))) + Bonsai.Incr.compute (Value.both a acc) ~f:(fun a_and_acc -> + let%pattern_bind.Ui_incr a, acc = a_and_acc in + Ui_incr.Map.merge a acc ~f:(fun ~key:_ change -> + match change with + | `Left (i, l) -> Some (i, [ l ]) + | `Right (i, r) -> Some (i, r) + | `Both ((i, l), (_, r)) -> Some (i, l :: r)))) ;; end @@ -308,8 +308,8 @@ module Dynamic_cells_with_sorter = struct sorters |> Map.to_alist |> List.map ~f:(fun (i, sorter) -> - let%map sorter = sorter in - Option.map sorter ~f:(fun sorter -> i, sorter)) + let%map sorter = sorter in + Option.map sorter ~f:(fun sorter -> i, sorter)) |> Value.all >>| Fn.compose Int.Map.of_alist_exn List.filter_opt in @@ -394,7 +394,7 @@ module Dynamic_columns_with_sorter = struct sorters |> Map.to_alist |> List.filter_map ~f:(fun (i, sorter) -> - Option.map sorter ~f:(fun sorter -> i, sorter)) + Option.map sorter ~f:(fun sorter -> i, sorter)) |> Int.Map.of_alist_exn in sorters, tree @@ -440,4 +440,3 @@ module Dynamic_columns_with_sorter = struct module Header_helpers = Header_helpers end - diff --git a/web_ui/partial_render_table/src/focus.ml b/web_ui/partial_render_table/src/focus.ml index 4bb9e440..04a948aa 100644 --- a/web_ui/partial_render_table/src/focus.ml +++ b/web_ui/partial_render_table/src/focus.ml @@ -59,7 +59,7 @@ module Row_machine = struct collated |> Collated.to_map_list |> Map.iter ~f:(fun (key, _) -> - if f ~key ~index:!i then return { Triple.key; index = !i } else Int.incr i)) + if f ~key ~index:!i then return { Triple.key; index = !i } else Int.incr i)) ;; let find_by_key collated ~key:needle ~key_equal = @@ -90,13 +90,13 @@ module Row_machine = struct end let component - (type key data cmp presence) - (key : (key, cmp) Bonsai.comparator) - ~(compute_presence : key option Value.t -> presence Computation.t) - ~(on_change : (key option -> unit Effect.t) Value.t) - ~(collated : (key, data) Incr_map_collate.Collated.t Value.t) - ~(range : (int * int) Value.t) - ~(scroll_to_index : (int -> unit Effect.t) Value.t) + (type key data cmp presence) + (key : (key, cmp) Bonsai.comparator) + ~(compute_presence : key option Value.t -> presence Computation.t) + ~(on_change : (key option -> unit Effect.t) Value.t) + ~(collated : (key, data) Incr_map_collate.Collated.t Value.t) + ~(range : (int * int) Value.t) + ~(scroll_to_index : (int -> unit Effect.t) Value.t) : ((key, presence) By_row.t, key) t Computation.t = let module Key = struct @@ -356,9 +356,9 @@ let get_focused (type r presence k) ;; let get_on_row_click - (type r presence k) - (kind : (r, presence, k) Kind.t) - (value : r Value.t) + (type r presence k) + (kind : (r, presence, k) Kind.t) + (value : r Value.t) : (k -> unit Effect.t) Value.t = match kind with diff --git a/web_ui/partial_render_table/src/focus.mli b/web_ui/partial_render_table/src/focus.mli index 3d3704e9..d0bc81db 100644 --- a/web_ui/partial_render_table/src/focus.mli +++ b/web_ui/partial_render_table/src/focus.mli @@ -12,7 +12,7 @@ module By_row : sig ; page_down : unit Effect.t ; focus : 'k -> unit Effect.t ; focus_index : int -> unit Effect.t - (** [focus_index n] sets the focus to the nth row from the top of the + (** [focus_index n] sets the focus to the nth row from the top of the entire table. The first row is 0, the second is 1, and so on. *) } [@@deriving fields ~getters] diff --git a/web_ui/partial_render_table/src/sortable_header.ml b/web_ui/partial_render_table/src/sortable_header.ml index fbc7cbfa..f2e4615b 100644 --- a/web_ui/partial_render_table/src/sortable_header.ml +++ b/web_ui/partial_render_table/src/sortable_header.ml @@ -19,9 +19,9 @@ let assoc_findi ~f list = ;; let component - (type col_id) - ?(initial_order = Value.return Order.default) - (module Col_id : Col_id with type t = col_id) + (type col_id) + ?(initial_order = Value.return Order.default) + (module Col_id : Col_id with type t = col_id) = let module Action = struct type t = Col_id.t Order.Action.t [@@deriving sexp_of] diff --git a/web_ui/partial_render_table/src/style_intf.ml b/web_ui/partial_render_table/src/style_intf.ml index 23602255..4814660e 100644 --- a/web_ui/partial_render_table/src/style_intf.ml +++ b/web_ui/partial_render_table/src/style_intf.ml @@ -1,7 +1,7 @@ include [%css - stylesheet - {| + stylesheet + {| .column_header { white-space: pre; cursor: pointer; diff --git a/web_ui/partial_render_table/src/table_body.ml b/web_ui/partial_render_table/src/table_body.ml index be620621..0d11eaa7 100644 --- a/web_ui/partial_render_table/src/table_body.ml +++ b/web_ui/partial_render_table/src/table_body.ml @@ -35,18 +35,18 @@ let set_or_wrap ~classes ~style = let float_to_px_string px = Virtual_dom.Dom_float.to_string_fixed 8 px ^ "px" let component - (type key data cmp) - ~(comparator : (key, cmp) Bonsai.comparator) - ~row_height - ~(leaves : Header_tree.leaf list Value.t) - ~(headers : Header_tree.t Value.t) - ~(assoc : - (key * data) Map_list.t Value.t -> (key * Vdom.Node.t list) Map_list.t Computation.t) - ~column_widths - ~(visually_focused : key option Value.t) - ~on_row_click - (collated : (key, data) Collated.t Value.t) - (input : (key * data) Map_list.t Value.t) + (type key data cmp) + ~(comparator : (key, cmp) Bonsai.comparator) + ~row_height + ~(leaves : Header_tree.leaf list Value.t) + ~(headers : Header_tree.t Value.t) + ~(assoc : + (key * data) Map_list.t Value.t -> (key * Vdom.Node.t list) Map_list.t Computation.t) + ~column_widths + ~(visually_focused : key option Value.t) + ~on_row_click + (collated : (key, data) Collated.t Value.t) + (input : (key * data) Map_list.t Value.t) : (Vdom.Node.t * For_testing.t Lazy.t) Computation.t = (* Css_gen is really slow, so we need to re-use the results of all these diff --git a/web_ui/partial_render_table/src/table_header.ml b/web_ui/partial_render_table/src/table_header.ml index cdcc89fe..54247b09 100644 --- a/web_ui/partial_render_table/src/table_header.ml +++ b/web_ui/partial_render_table/src/table_header.ml @@ -4,7 +4,6 @@ open! Js_of_ocaml open! Incr_map_collate open! Bonsai.Let_syntax - let attr_colspan i = match i with | 0 -> Vdom.Attr.style (Css_gen.display `None) @@ -83,10 +82,10 @@ let render_header headers ~column_widths ~set_column_width = ;; let component - (headers : Header_tree.t Value.t) - ~column_widths - ~set_column_width - ~set_header_client_rect + (headers : Header_tree.t Value.t) + ~column_widths + ~set_column_width + ~set_header_client_rect = let%arr set_column_width = set_column_width and set_header_client_rect = set_header_client_rect diff --git a/web_ui/partial_render_table/src/table_header.mli b/web_ui/partial_render_table/src/table_header.mli index 1fc6e7a3..2cbfb2c9 100644 --- a/web_ui/partial_render_table/src/table_header.mli +++ b/web_ui/partial_render_table/src/table_header.mli @@ -10,5 +10,5 @@ val component -> set_column_width:(index:int -> [ `Px_float of float ] -> unit Vdom.Effect.t) Value.t -> set_header_client_rect: (Bonsai_web_ui_element_size_hooks.Visibility_tracker.Bbox.t -> unit Vdom.Effect.t) - Value.t + Value.t -> Vdom.Node.t Computation.t diff --git a/web_ui/partial_render_table/test/ansi_table_tests.ml b/web_ui/partial_render_table/test/ansi_table_tests.ml index 60ba474f..7ad08c25 100644 --- a/web_ui/partial_render_table/test/ansi_table_tests.ml +++ b/web_ui/partial_render_table/test/ansi_table_tests.ml @@ -7,13 +7,13 @@ open Shared module Table = Bonsai_web_ui_partial_render_table let table_to_string - ~include_stats - ?(include_num_column = true) - ?(selected_header = ">") - ?num_filtered_rows - (res : _ Table.Focus_by_row.t option) - (for_testing : Table.For_testing.t) - () + ~include_stats + ?(include_num_column = true) + ?(selected_header = ">") + ?num_filtered_rows + (res : _ Table.Focus_by_row.t option) + (for_testing : Table.For_testing.t) + () = let open Ascii_table_kernel in let module Node_h = Virtual_dom_test_helpers.Node_helpers in @@ -77,9 +77,9 @@ let table_to_string | None -> result | Some res -> ([%message - "" - ~focused:(res.focused : int option) - ~num_filtered_rows:(num_filtered_rows : int option)] + "" + ~focused:(res.focused : int option) + ~num_filtered_rows:(num_filtered_rows : int option)] |> Sexp.to_string_hum |> fun s -> s ^ "\n") ^ result @@ -89,13 +89,13 @@ module Test = struct include Shared.Test let create_with_var - (type a) - ?(stabilize_height = true) - ?(visible_range = 0, 100) - ?(map = Bonsai.Var.create small_map) - ?(should_set_bounds = true) - ~stats - component + (type a) + ?(stabilize_height = true) + ?(visible_range = 0, 100) + ?(map = Bonsai.Var.create small_map) + ?(should_set_bounds = true) + ~stats + component = let min_vis, max_vis = visible_range in let filter_var = Bonsai.Var.create (fun ~key:_ ~data:_ -> true) in @@ -145,12 +145,12 @@ module Test = struct ;; let create - ?stabilize_height - ?visible_range - ?(map = small_map) - ?should_set_bounds - ~stats - component + ?stabilize_height + ?visible_range + ?(map = small_map) + ?should_set_bounds + ~stats + component = create_with_var ?stabilize_height @@ -1730,7 +1730,7 @@ let%expect_test "moving focus down should work even when the index changes" = let map = [ 1; 2; 3; 4 ] |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) + i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) |> Int.Map.of_alist_exn |> Bonsai.Var.create in @@ -1804,7 +1804,7 @@ let%expect_test "moving focus down should work even when the index changes and f let map = [ 1; 2; 3; 4 ] |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) + i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) |> Int.Map.of_alist_exn |> Bonsai.Var.create in @@ -1889,7 +1889,7 @@ let%expect_test "moving focus up should work even when the index changes" = let map = [ 1; 2; 3; 4 ] |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) + i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) |> Int.Map.of_alist_exn |> Bonsai.Var.create in @@ -1970,7 +1970,7 @@ let%expect_test "moving focus up should work even when the index changes and foc let map = [ 1; 2; 3; 4 ] |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) + i, { a = "hi"; b = Float.of_int (i / 2); c = "c"; d = Some 100; e = "e" }) |> Int.Map.of_alist_exn |> Bonsai.Var.create in @@ -2060,7 +2060,6 @@ skipping scroll because target already in view └───┴──────┴─────┴────┴──────────┴─────┘ |}] ;; - let%expect_test "Pseudo-BUG: setting rank_range does not change the which rows the \ for_testing output will display" = @@ -2072,7 +2071,7 @@ let%expect_test "Pseudo-BUG: setting rank_range does not change the which rows t let map = [ 1; 2; 3; 4; 5; 6; 7 ] |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int i; c = "c"; d = Some 100; e = "e" }) + i, { a = "hi"; b = Float.of_int i; c = "c"; d = Some 100; e = "e" }) |> Int.Map.of_alist_exn |> Value.return in @@ -2101,11 +2100,11 @@ let%expect_test "Pseudo-BUG: setting rank_range does not change the which rows t { on_change = Test.focus_changed ; compute_presence = (fun focus -> - let%arr map = map - and focus = focus in - match focus with - | None -> None - | Some focus -> if Map.mem map focus then Some focus else None) + let%arr map = map + and focus = focus in + match focus with + | None -> None + | Some focus -> if Map.mem map focus then Some focus else None) }) ~row_height:(Value.return (`Px 20)) ~columns: @@ -2404,7 +2403,7 @@ let%expect_test "show that scrolling out of a custom table will execute the pres | None -> None | Some focus -> if Map.exists (Incr_map_collate.Collated.to_map_list collation) ~f:(fun (k, _v) -> - focus = k) + focus = k) then Some focus else None in diff --git a/web_ui/partial_render_table/test/shared.ml b/web_ui/partial_render_table/test/shared.ml index 6cf27b61..bf8610a0 100644 --- a/web_ui/partial_render_table/test/shared.ml +++ b/web_ui/partial_render_table/test/shared.ml @@ -203,7 +203,7 @@ let big_map = Int.Map.of_alist_exn (List.range 1 100 |> List.map ~f:(fun i -> - i, { a = "hi"; b = Float.of_int (i / 2); c = "apple"; d = Some 100; e = "1st" }) + i, { a = "hi"; b = Float.of_int (i / 2); c = "apple"; d = Some 100; e = "1st" }) ) ;; @@ -258,15 +258,15 @@ module Test = struct let get_inject_expert t = get_inject' t Table_expert.Result.focus let default - ?(preload_rows = 0) - ?(is_column_b_visible = Value.return true) - ?override_sort - ?default_sort - ?(use_legacy_header = false) - ?(row_height = Value.return (`Px 1)) - () - input - filter + ?(preload_rows = 0) + ?(is_column_b_visible = Value.return true) + ?override_sort + ?default_sort + ?(use_legacy_header = false) + ?(row_height = Value.return (`Px 1)) + () + input + filter = let module Column = Table.Columns.Dynamic_cells in { component = @@ -289,12 +289,12 @@ module Test = struct ;; let default' - ?(with_groups = false) - ?(preload_rows = 0) - ?(is_column_b_visible = true) - () - input - filter + ?(with_groups = false) + ?(preload_rows = 0) + ?(is_column_b_visible = true) + () + input + filter = let columns = match with_groups with diff --git a/web_ui/partial_render_table/test/vdom_based_tests.ml b/web_ui/partial_render_table/test/vdom_based_tests.ml index 78133de4..94783174 100644 --- a/web_ui/partial_render_table/test/vdom_based_tests.ml +++ b/web_ui/partial_render_table/test/vdom_based_tests.ml @@ -8,12 +8,12 @@ module Test = struct include Shared.Test let create - (type a) - ?(visible_range = 0, 100) - ?(map = small_map) - ?(should_print_styles = false) - ?(should_set_bounds = true) - component + (type a) + ?(visible_range = 0, 100) + ?(map = small_map) + ?(should_print_styles = false) + ?(should_set_bounds = true) + component : a t = let min_vis, max_vis = visible_range in @@ -42,7 +42,7 @@ module Test = struct ~path_censoring_message:"" ~hash_censoring_message:"" ~filter_printed_attributes:(fun ~key ~data:_ -> - should_print_styles || not (String.is_prefix ~prefix:"style." key)) + should_print_styles || not (String.is_prefix ~prefix:"style." key)) ;; type incoming = Action.t diff --git a/web_ui/popover/src/bonsai_web_ui_popover.ml b/web_ui/popover/src/bonsai_web_ui_popover.ml index 2a38e649..fcd4a9c6 100644 --- a/web_ui/popover/src/bonsai_web_ui_popover.ml +++ b/web_ui/popover/src/bonsai_web_ui_popover.ml @@ -61,7 +61,6 @@ let has_clicked_outside : popover_id:string -> Dom.node Js.t Js.opt -> bool = loop element ;; - let default_popover_styles = let%sub theme = View.Theme.current in let%arr theme = theme in @@ -77,19 +76,19 @@ let default_popover_styles = ;; let component - ?popover_extra_attr - ?popover_style_attr - ?base_extra_attr - ?(allow_event_propagation_when_clicked_outside : - ([ `Left_click | `Right_click | `Escape ] -> bool) Value.t = - Value.return (fun _ -> false)) - ?(on_close = Value.return Effect.Ignore) - ?(keep_popover_inside_window = Value.return false) - ~close_when_clicked_outside - ~direction - ~alignment - ~popover - () + ?popover_extra_attr + ?popover_style_attr + ?base_extra_attr + ?(allow_event_propagation_when_clicked_outside : + ([ `Left_click | `Right_click | `Escape ] -> bool) Value.t = + Value.return (fun _ -> false)) + ?(on_close = Value.return Effect.Ignore) + ?(keep_popover_inside_window = Value.return false) + ~close_when_clicked_outside + ~direction + ~alignment + ~popover + () = let%sub popover_id = Bonsai.path_id in let%sub popover_extra_attr = @@ -143,7 +142,7 @@ let component Effect.Many [ close ; Effect.Stop_propagation - (* Prevents other listeners/from trigerring their events. *) + (* Prevents other listeners/from trigerring their events. *) ; Effect.Prevent_default (* Prevents non-event interactions like context menus from opening and interactions with form elements + clicking on links. *) diff --git a/web_ui/popover/src/bonsai_web_ui_popover.mli b/web_ui/popover/src/bonsai_web_ui_popover.mli index 7cb61732..dca270fb 100644 --- a/web_ui/popover/src/bonsai_web_ui_popover.mli +++ b/web_ui/popover/src/bonsai_web_ui_popover.mli @@ -4,11 +4,11 @@ open Bonsai_web module Result : sig type t = { wrap : Vdom.Node.t -> Vdom.Node.t - (** [wrap] is a function that you can call to attach the popover to an element. *) + (** [wrap] is a function that you can call to attach the popover to an element. *) ; open_ : unit Effect.t (** effect that when scheduled, will open the popover. *) ; close : unit Effect.t (** effect that when scheduled, will close the popover. *) ; toggle : unit Effect.t - (** effect that when scheduled, will close or open the popover depending on the current state.*) + (** effect that when scheduled, will close or open the popover depending on the current state.*) ; is_open : bool } end diff --git a/web_ui/popover/src/reposition_hook.ml b/web_ui/popover/src/reposition_hook.ml index b0a2ffe0..f762267b 100644 --- a/web_ui/popover/src/reposition_hook.ml +++ b/web_ui/popover/src/reposition_hook.ml @@ -3,27 +3,25 @@ open Virtual_dom open Js_of_ocaml include Vdom.Attr.Hooks.Make (struct - module State = struct - type t = - { mutable current_transform : int - ; mutable anim_frame_id : Dom_html.animation_frame_request_id option - } - end + module State = struct + type t = + { mutable current_transform : int + ; mutable anim_frame_id : Dom_html.animation_frame_request_id option + } + end - module Input = struct - type t = unit [@@deriving sexp_of] + module Input = struct + type t = unit [@@deriving sexp_of] - let combine _ _ = () - end + let combine _ _ = () + end - let safe_screen_margin = 12 + let safe_screen_margin = 12 - let step (state : State.t) element = - let frame_width, frame_offset = - Dom_html.window##.innerWidth, 0 - in - let element_width = element##.clientWidth in - (* What if it's off screen to the top, bottom, or right? + let step (state : State.t) element = + let frame_width, frame_offset = Dom_html.window##.innerWidth, 0 in + let element_width = element##.clientWidth in + (* What if it's off screen to the top, bottom, or right? These are more tricky I think, especially if you fall out at the bottom, generally the document will just become scrollable. But I'm thinking @@ -32,54 +30,54 @@ include Vdom.Attr.Hooks.Make (struct right, and vice versa for [Left]/[Right].) Or maybe, we only push the element down if it overflows at the top, but not up? *) - let offset = - (* Remove the transform from the offset, since we're setting it here. *) - let total_offset = element##getBoundingClientRect##.left |> Float.to_int in - total_offset - state.current_transform - frame_offset - in - let total_width = offset + element_width + safe_screen_margin in - let delta = - if frame_width < total_width - then frame_width - total_width - else if offset - safe_screen_margin < 0 - then -(offset - safe_screen_margin) - else 0 - in - if state.current_transform <> delta - then ( - (* only update the style if the delta is different. *) - state.current_transform <- delta; - element##.style##.transform := Js.string [%string "translate(%{delta#Int}px, 0px)"]) - ;; + let offset = + (* Remove the transform from the offset, since we're setting it here. *) + let total_offset = element##getBoundingClientRect##.left |> Float.to_int in + total_offset - state.current_transform - frame_offset + in + let total_width = offset + element_width + safe_screen_margin in + let delta = + if frame_width < total_width + then frame_width - total_width + else if offset - safe_screen_margin < 0 + then -(offset - safe_screen_margin) + else 0 + in + if state.current_transform <> delta + then ( + (* only update the style if the delta is different. *) + state.current_transform <- delta; + element##.style##.transform := Js.string [%string "translate(%{delta#Int}px, 0px)"]) + ;; - let reposition_until_stopped state ~element = - let rec loop () = - step state element; - (* Repeat this for every frame. *) - let next_frame_anim_id = - Dom_html.window##requestAnimationFrame (Js.wrap_callback (fun _ -> loop ())) - in - state.anim_frame_id <- Some next_frame_anim_id + let reposition_until_stopped state ~element = + let rec loop () = + step state element; + (* Repeat this for every frame. *) + let next_frame_anim_id = + Dom_html.window##requestAnimationFrame (Js.wrap_callback (fun _ -> loop ())) in - (* Unset the elements inline opacity value set before; we don't set it to + state.anim_frame_id <- Some next_frame_anim_id + in + (* Unset the elements inline opacity value set before; we don't set it to [100%] since we want it to respect values set e.g. via a CSS stylesheet. *) - element##.style##.opacity := Js.Optdef.return (Js.string ""); - loop () - ;; + element##.style##.opacity := Js.Optdef.return (Js.string ""); + loop () + ;; - let init () element = - (* Hide the element before we fully re-flow it, to prevent it from jumping around + let init () element = + (* Hide the element before we fully re-flow it, to prevent it from jumping around on the first paint. *) - element##.style##.opacity := Js.Optdef.return (Js.string "0"); - { State.anim_frame_id = None; current_transform = 0 } - ;; + element##.style##.opacity := Js.Optdef.return (Js.string "0"); + { State.anim_frame_id = None; current_transform = 0 } + ;; - let on_mount () state element = reposition_until_stopped state ~element - let update ~old_input:() ~new_input:() _state _element = () + let on_mount () state element = reposition_until_stopped state ~element + let update ~old_input:() ~new_input:() _state _element = () - let destroy () (state : State.t) element = - Option.iter state.anim_frame_id ~f:(fun anim_frame_id -> - Dom_html.window##cancelAnimationFrame anim_frame_id); - element##.style##.transform := Js.string "" - ;; - end) + let destroy () (state : State.t) element = + Option.iter state.anim_frame_id ~f:(fun anim_frame_id -> + Dom_html.window##cancelAnimationFrame anim_frame_id); + element##.style##.transform := Js.string "" + ;; +end) diff --git a/web_ui/popover/test/bonsai_web_ui_popover_test.ml b/web_ui/popover/test/bonsai_web_ui_popover_test.ml index 23a66031..f8214814 100644 --- a/web_ui/popover/test/bonsai_web_ui_popover_test.ml +++ b/web_ui/popover/test/bonsai_web_ui_popover_test.ml @@ -34,9 +34,9 @@ is_open: %{is_open#Bool} let incoming (_, { Popover.Result.open_; close; wrap = _; toggle; is_open = _ }) = function - | Open_close.Open -> open_ - | Close -> close - | Toggle -> toggle + | Open_close.Open -> open_ + | Close -> close + | Toggle -> toggle ;; end @@ -252,7 +252,7 @@ let%expect_test "Opening from base and closing from dialog" = () in let%arr ({ Popover.Result.wrap; open_; close = _; toggle = _; is_open = _ } as - popover) + popover) = popover in @@ -322,18 +322,18 @@ let%expect_test "Opening from returned effect and closing by clicking outside." ~hook_name:"global-contextmenu-listener" ~hook_id:Vdom.Attr.Global_listeners.For_testing.contextmenu_type_id ; (fun handle -> - let fake_event = - object%js - val key = Js_of_ocaml.Js.string "Escape" - end - in - Handle.trigger_hook - handle - ~get_vdom - ~selector:[%string "[data-test=%{id}]"] - ~name:"global-keydown-listener" - Vdom.Attr.Global_listeners.For_testing.keydown_type_id - (Js_of_ocaml.Js.Unsafe.coerce fake_event)) + let fake_event = + object%js + val key = Js_of_ocaml.Js.string "Escape" + end + in + Handle.trigger_hook + handle + ~get_vdom + ~selector:[%string "[data-test=%{id}]"] + ~name:"global-keydown-listener" + Vdom.Attr.Global_listeners.For_testing.keydown_type_id + (Js_of_ocaml.Js.Unsafe.coerce fake_event)) ] in List.iter hook_triggers ~f:(fun trigger_hook -> @@ -342,7 +342,7 @@ let%expect_test "Opening from returned effect and closing by clicking outside." Popover.component ~popover_extra_attr:(Value.return (Vdom.Attr.create "data-test" id)) ~close_when_clicked_outside:true - (* NOTE: [close_when_clicked_outside] is set to true. *) + (* NOTE: [close_when_clicked_outside] is set to true. *) ~direction:(Value.return Popover.Direction.Right) ~alignment:(Value.return Popover.Alignment.Center) ~popover:(fun ~close:_ -> Bonsai.const (View.text "Popover content!")) @@ -610,11 +610,11 @@ let%test_module "interactions with [with_model_resetter]" = ;; let incoming - (_, { Popover.Result.open_; close; wrap = _; toggle = _; is_open = _ }, reset) + (_, { Popover.Result.open_; close; wrap = _; toggle = _; is_open = _ }, reset) = function - | Open -> open_ - | Close -> close - | Reset -> reset + | Open -> open_ + | Close -> close + | Reset -> reset ;; end diff --git a/web_ui/query_box/src/bonsai_web_ui_query_box.ml b/web_ui/query_box/src/bonsai_web_ui_query_box.ml index b123dbdb..13498493 100644 --- a/web_ui/query_box/src/bonsai_web_ui_query_box.ml +++ b/web_ui/query_box/src/bonsai_web_ui_query_box.ml @@ -67,20 +67,20 @@ type 'k t = [@@deriving fields ~getters] let create - (type k cmp) - (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) - ?(initial_query = "") - ?(max_visible_items = Value.return 10) - ?(suggestion_list_kind = Value.return Suggestion_list_kind.Transient_overlay) - ?(expand_direction = Value.return Expand_direction.Down) - ?(selected_item_attr = Value.return Attr.empty) - ?(extra_list_container_attr = Value.return Attr.empty) - ?(extra_input_attr = Value.return Attr.empty) - ?(extra_attr = Value.return Attr.empty) - ?(on_blur = Value.return (Effect.return ())) - ~f - ~on_select - () + (type k cmp) + (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) + ?(initial_query = "") + ?(max_visible_items = Value.return 10) + ?(suggestion_list_kind = Value.return Suggestion_list_kind.Transient_overlay) + ?(expand_direction = Value.return Expand_direction.Down) + ?(selected_item_attr = Value.return Attr.empty) + ?(extra_list_container_attr = Value.return Attr.empty) + ?(extra_input_attr = Value.return Attr.empty) + ?(extra_attr = Value.return Attr.empty) + ?(on_blur = Value.return (Effect.return ())) + ~f + ~on_select + () = let%sub suggestion_list_is_initialized, initialize_suggestion_list = Bonsai.state false @@ -109,98 +109,98 @@ let create model action -> - let suggestion_list_state = - (* We normalize which item is selected in case the list has changed + let suggestion_list_state = + (* We normalize which item is selected in case the list has changed since the last action. Normalization just means setting the selected key to the closest thing that actually exists. *) - match model.suggestion_list_state with - | Selected key -> - select_key - ~first_try:(Map.closest_key items `Less_or_equal_to key) - ~then_try:(lazy (Map.closest_key items `Greater_or_equal_to key)) - ~else_use:First_item - | First_item -> First_item - | Closed -> Closed - in - let next_suggestion_list_state () = - match suggestion_list_state with - | Selected key -> - select_key - ~first_try:(Map.closest_key items `Greater_than key) - ~then_try:(lazy (Map.min_elt items)) - ~else_use:(Selected key) - | First_item -> - (match Map.min_elt items with - | None -> First_item - | Some (first_key, _) -> - (match Map.closest_key items `Greater_than first_key with - | None -> Selected first_key - | Some (second_key, _) -> Selected second_key)) - | Closed -> First_item + match model.suggestion_list_state with + | Selected key -> + select_key + ~first_try:(Map.closest_key items `Less_or_equal_to key) + ~then_try:(lazy (Map.closest_key items `Greater_or_equal_to key)) + ~else_use:First_item + | First_item -> First_item + | Closed -> Closed + in + let next_suggestion_list_state () = + match suggestion_list_state with + | Selected key -> + select_key + ~first_try:(Map.closest_key items `Greater_than key) + ~then_try:(lazy (Map.min_elt items)) + ~else_use:(Selected key) + | First_item -> + (match Map.min_elt items with + | None -> First_item + | Some (first_key, _) -> + (match Map.closest_key items `Greater_than first_key with + | None -> Selected first_key + | Some (second_key, _) -> Selected second_key)) + | Closed -> First_item + in + let prev_suggestion_list_state () = + match model.suggestion_list_state with + | Selected key -> + select_key + ~first_try:(Map.closest_key items `Less_than key) + ~then_try:(lazy (Map.max_elt items)) + ~else_use:(Selected key) + | First_item | Closed -> + (match Map.max_elt items with + | None -> First_item + | Some (last_key, _) -> Selected last_key) + in + match action with + | Action.Set_query query -> + let suggestion_list_state = + match suggestion_list_state with + | Selected key -> Model.Selected key + | First_item | Closed -> First_item + in + let offset = model.offset in + { Model.query; suggestion_list_state; offset } + | Open_suggestions -> { model with suggestion_list_state = First_item } + | Close_suggestions -> { model with suggestion_list_state = Closed } + | Move_next -> + let suggestion_list_state = next_suggestion_list_state () in + let offset = + let comparison = + Model.compare_suggestion_list_state + (Map.comparator items).compare + model.suggestion_list_state + suggestion_list_state in - let prev_suggestion_list_state () = - match model.suggestion_list_state with - | Selected key -> - select_key - ~first_try:(Map.closest_key items `Less_than key) - ~then_try:(lazy (Map.max_elt items)) - ~else_use:(Selected key) - | First_item | Closed -> - (match Map.max_elt items with - | None -> First_item - | Some (last_key, _) -> Selected last_key) + if comparison = 0 + then model.offset + else if comparison < 0 + then min (max_visible_items - 1) (model.offset + 1) + else 0 + in + { model with suggestion_list_state; offset } + | Move_prev -> + let suggestion_list_state = prev_suggestion_list_state () in + let offset = + let comparison = + Model.compare_suggestion_list_state + (Map.comparator items).compare + model.suggestion_list_state + suggestion_list_state in - match action with - | Action.Set_query query -> - let suggestion_list_state = - match suggestion_list_state with - | Selected key -> Model.Selected key - | First_item | Closed -> First_item - in - let offset = model.offset in - { Model.query; suggestion_list_state; offset } - | Open_suggestions -> { model with suggestion_list_state = First_item } - | Close_suggestions -> { model with suggestion_list_state = Closed } - | Move_next -> - let suggestion_list_state = next_suggestion_list_state () in - let offset = - let comparison = - Model.compare_suggestion_list_state - (Map.comparator items).compare - model.suggestion_list_state - suggestion_list_state - in - if comparison = 0 - then model.offset - else if comparison < 0 - then min (max_visible_items - 1) (model.offset + 1) - else 0 - in - { model with suggestion_list_state; offset } - | Move_prev -> - let suggestion_list_state = prev_suggestion_list_state () in - let offset = - let comparison = - Model.compare_suggestion_list_state - (Map.comparator items).compare - model.suggestion_list_state - suggestion_list_state - in - if comparison = 0 - then model.offset - else if comparison < 0 - then max_visible_items - 1 - else max 0 (model.offset - 1) - in - { model with suggestion_list_state; offset } - | Move_to { key; offset } -> - if Map.mem items key - then { model with suggestion_list_state = Selected key; offset } - else model - | Move_next_with_fixed_offset -> - { model with suggestion_list_state = next_suggestion_list_state () } - | Move_prev_with_fixed_offset -> - { model with suggestion_list_state = prev_suggestion_list_state () }) + if comparison = 0 + then model.offset + else if comparison < 0 + then max_visible_items - 1 + else max 0 (model.offset - 1) + in + { model with suggestion_list_state; offset } + | Move_to { key; offset } -> + if Map.mem items key + then { model with suggestion_list_state = Selected key; offset } + else model + | Move_next_with_fixed_offset -> + { model with suggestion_list_state = next_suggestion_list_state () } + | Move_prev_with_fixed_offset -> + { model with suggestion_list_state = prev_suggestion_list_state () }) ~f:(fun model inject -> let%sub { Model.query; _ } = return model in let%sub items = @@ -304,8 +304,7 @@ let create let%bind.Effect items = match%bind.Effect get_items with | Active items -> Effect.return items - | Inactive -> - Effect.never + | Inactive -> Effect.never in let%bind.Effect offset = Effect.of_sync_fun (Map.rank items) key in let offset = Option.value offset ~default:0 in @@ -523,14 +522,14 @@ module Collate_map_with_score = struct end let collate - (type k cmp) - (module Cmp : Comparator.S with type t = k and type comparator_witness = cmp) - ~preprocess - ~score - ~query_is_as_strict - ~to_result - input - query + (type k cmp) + (module Cmp : Comparator.S with type t = k and type comparator_witness = cmp) + ~preprocess + ~score + ~query_is_as_strict + ~to_result + input + query = let empty_result = Map.empty (module Scored_key.M (Cmp)) in Bonsai.Incr.compute (Value.both input query) ~f:(fun input_and_query -> @@ -567,30 +566,30 @@ module Collate_map_with_score = struct array ~init:empty_result ~f:(fun index acc (key, data, preprocessed) -> - let score = - (* If the item was already filtered out by a previous query, we can + let score = + (* If the item was already filtered out by a previous query, we can keep filtering it out. If instead it was filtered out by a query that have since discarded (or, possibly, it was never filtered out), then we need to re-evaluate the score. *) - if filtered_out_at_index.(index) < num_queries - then 0 - else ( - let score = score query preprocessed in - filtered_out_at_index.(index) - <- (if score = 0 then num_queries else Int.max_value); - score) - in - if score = 0 - then acc + if filtered_out_at_index.(index) < num_queries + then 0 else ( - (* The first component of the key compares equivalently to the pair + let score = score query preprocessed in + filtered_out_at_index.(index) + <- (if score = 0 then num_queries else Int.max_value); + score) + in + if score = 0 + then acc + else ( + (* The first component of the key compares equivalently to the pair (score, index), but faster, since it is only an integer. Note that the map comparator doesn't need to inspect the key itself, since [index] already captures that ordering. Thus, this whole computation remains fast even if the input map comparator is extremely slow. *) - let new_key = score, key in - Map.add_exn acc ~key:new_key ~data:(to_result preprocessed ~key ~data)))) + let new_key = score, key in + Map.add_exn acc ~key:new_key ~data:(to_result preprocessed ~key ~data)))) ;; end @@ -602,20 +601,20 @@ module Filter_strategy = struct end let stringable - (type k cmp) - (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) - ?initial_query - ?max_visible_items - ?suggestion_list_kind - ?expand_direction - ?selected_item_attr - ?extra_list_container_attr - ?extra_input_attr - ?extra_attr - ?(to_view = fun _ string -> Vdom.Node.text string) - ~filter_strategy - ~on_select - input + (type k cmp) + (module Key : Bonsai.Comparator with type t = k and type comparator_witness = cmp) + ?initial_query + ?max_visible_items + ?suggestion_list_kind + ?expand_direction + ?selected_item_attr + ?extra_list_container_attr + ?extra_input_attr + ?extra_attr + ?(to_view = fun _ string -> Vdom.Node.text string) + ~filter_strategy + ~on_select + input = (* [filter_strategy] is not a [Value.t]; it would be easy to make it one by using [match%sub] here, but then the model would not be shared between the diff --git a/web_ui/query_box/src/bonsai_web_ui_query_box.mli b/web_ui/query_box/src/bonsai_web_ui_query_box.mli index 5da1b579..647538bb 100644 --- a/web_ui/query_box/src/bonsai_web_ui_query_box.mli +++ b/web_ui/query_box/src/bonsai_web_ui_query_box.mli @@ -25,11 +25,11 @@ open Bonsai_web module Suggestion_list_kind : sig type t = | Transient_overlay - (** When set to Transient, the suggestion-list only shows up when the + (** When set to Transient, the suggestion-list only shows up when the textbox is focused, and the list will float over other items on the page.*) | Permanent_fixture - (** Permanent will make the suggestion-list always present, and it + (** Permanent will make the suggestion-list always present, and it will take up space during the layout of the application. *) [@@deriving sexp, compare, enumerate, equal] end @@ -37,10 +37,10 @@ end module Expand_direction : sig type t = | Down - (** Autocomplete options appear below the textbox, with the first item at + (** Autocomplete options appear below the textbox, with the first item at the top of the list. *) | Up - (** Autocomplete options appear above the textbox, with the first item at + (** Autocomplete options appear above the textbox, with the first item at the bottom of the list. *) [@@deriving sexp, compare, enumerate, equal] end @@ -58,32 +58,32 @@ val create : ('k, 'cmp) Bonsai.comparator -> ?initial_query:string -> ?max_visible_items:int Value.t - (** The value defaults to Transient. Read doc comment on the type for + (** The value defaults to Transient. Read doc comment on the type for more info. *) -> ?suggestion_list_kind:Suggestion_list_kind.t Value.t - (** The value defaults to Down. Read doc comment on the type for more info. *) + (** The value defaults to Down. Read doc comment on the type for more info. *) -> ?expand_direction:Expand_direction.t Value.t - (** If provided, the attributes in this value will be attached to + (** If provided, the attributes in this value will be attached to the vdom node representing the currently selected item in the list. *) -> ?selected_item_attr:Vdom.Attr.t Value.t - (** If provided, [extra_list_container_attr] will be added to the + (** If provided, [extra_list_container_attr] will be added to the vdom node containing the list of suggestions. *) -> ?extra_list_container_attr:Vdom.Attr.t Value.t - (** If provided, [extra_input_attr] will be added to the query text input. *) + (** If provided, [extra_input_attr] will be added to the query text input. *) -> ?extra_input_attr:Vdom.Attr.t Value.t - (** If provided [extra_attr] will be added to the outermost div of this component. *) + (** If provided [extra_attr] will be added to the outermost div of this component. *) -> ?extra_attr:Vdom.Attr.t Value.t - (** If provided [on_blur] will be called whenever a blur triggered outside of the + (** If provided [on_blur] will be called whenever a blur triggered outside of the query box (including both input and item list) occurs. *) -> ?on_blur:unit Ui_effect.t Value.t - (** [f] generates the set of completion options by returning + (** [f] generates the set of completion options by returning a map from a user-provided key ['k] to the view for that element in the dropdown list. The currently entered filter from the textbox part of the component is provided as an argument to the function and it is expected that you use this to do your own filtering and return the filtered map. *) -> f:(string Value.t -> ('k, Vdom.Node.t, 'cmp) Map.t Computation.t) - (** [on_select] is called when [enter] is hit when an item is + (** [on_select] is called when [enter] is hit when an item is selected. *) -> on_select:('k -> unit Effect.t) Value.t -> unit @@ -133,8 +133,8 @@ module Collate_map_with_score : sig include Comparator.S - with type t := t - and type comparator_witness = T.comparator_witness comparator_witness + with type t := t + and type comparator_witness = T.comparator_witness comparator_witness end module Map : sig @@ -142,7 +142,6 @@ module Collate_map_with_score : sig end end - (** [collate] sorts and filters the input map according to a [score] function (filtering a result out is done by returning 0 from [score], and transforms the data in the map according to a [to_result] function. diff --git a/web_ui/query_box/test/test_collate_map_with_score.ml b/web_ui/query_box/test/test_collate_map_with_score.ml index 9fd510ce..7f8b9bd8 100644 --- a/web_ui/query_box/test/test_collate_map_with_score.ml +++ b/web_ui/query_box/test/test_collate_map_with_score.ml @@ -5,20 +5,20 @@ open Bonsai.Let_syntax module Collate_map_with_score = Bonsai_web_ui_query_box.Collate_map_with_score let reference_implementation - ~preprocess - ~score - ~query_is_as_strict:_ - ~to_result - input - query + ~preprocess + ~score + ~query_is_as_strict:_ + ~to_result + input + query = let%arr input = input and query = query in Map.to_alist input |> List.map ~f:(fun (key, data) -> - let preprocessed = preprocess ~key ~data in - let score = score query preprocessed in - (score, key), to_result preprocessed ~key ~data) + let preprocessed = preprocess ~key ~data in + let score = score query preprocessed in + (score, key), to_result preprocessed ~key ~data) |> List.filter ~f:(fun ((score, _), _) -> score <> 0) |> List.sort ~compare:(Comparable.lift [%compare: int] ~f:(fun ((score, _), _) -> score)) diff --git a/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.ml b/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.ml index 93922a8e..909fd930 100644 --- a/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.ml +++ b/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.ml @@ -79,16 +79,16 @@ type ('k, 'cmp) comparator = a special "extra target" to the list to enable appending new items to the bottom. *) let list - (type src cmp) - (key : (src, cmp) comparator) - ~(dnd : (src, int) Bonsai_web_ui_drag_and_drop.t Bonsai.Value.t) - ?(enable_debug_overlay = false) - ?(extra_item_attrs = Bonsai.Value.return Attr.empty) - ?(left = `Px 0) - ?(right = `Px 0) - ?(empty_list_placeholder = fun ~item_is_hovered:_ -> Bonsai.const Node.None) - ?(default_item_height = 50) - input + (type src cmp) + (key : (src, cmp) comparator) + ~(dnd : (src, int) Bonsai_web_ui_drag_and_drop.t Bonsai.Value.t) + ?(enable_debug_overlay = false) + ?(extra_item_attrs = Bonsai.Value.return Attr.empty) + ?(left = `Px 0) + ?(right = `Px 0) + ?(empty_list_placeholder = fun ~item_is_hovered:_ -> Bonsai.const Node.None) + ?(default_item_height = 50) + input = let module Key = (val key) in let%sub sizes, size_attr = @@ -423,16 +423,16 @@ module Action = struct end let with_inject - (type src cmp) - (key : (src, cmp) comparator) - ?(sentinel_name = "dnd") - ?enable_debug_overlay - ?extra_item_attrs - ?left - ?right - ?empty_list_placeholder - ?default_item_height - render + (type src cmp) + (key : (src, cmp) comparator) + ?(sentinel_name = "dnd") + ?enable_debug_overlay + ?extra_item_attrs + ?left + ?right + ?empty_list_placeholder + ?default_item_height + render = let module Key = struct include (val key) @@ -511,12 +511,12 @@ let with_inject Bonsai.Incr.compute (Value.both key rendered_ranked_input) ~f:(fun key_and_input -> - let%pattern_bind.Ui_incr key, rendered_ranked_input = key_and_input in - let lookup = - Ui_incr.Map.Lookup.create rendered_ranked_input ~comparator:Key.comparator - in - let%bind.Ui_incr key = key in - Ui_incr.Map.Lookup.find lookup key) + let%pattern_bind.Ui_incr key, rendered_ranked_input = key_and_input in + let lookup = + Ui_incr.Map.Lookup.create rendered_ranked_input ~comparator:Key.comparator + in + let%bind.Ui_incr key = key in + Ui_incr.Map.Lookup.find lookup key) in match%sub result with | Some ((_, view), _) -> return view @@ -532,19 +532,19 @@ let with_inject let%arr rendered_ranked_input = rendered_ranked_input in Map.to_alist rendered_ranked_input |> List.sort ~compare:(fun a b -> - Comparable.lift Int.compare ~f:(fun (_, (_, rank)) -> rank) a b) + Comparable.lift Int.compare ~f:(fun (_, (_, rank)) -> rank) a b) |> List.map ~f:(fun (key, ((extra, _), _)) -> key, extra) in return (Value.map3 ranking view inject ~f:Tuple3.create) ;; let sync_with_set - (type a cmp) - (module Key : Comparator with type t = a and type comparator_witness = cmp) - (input : (a, cmp) Set.t Value.t) - ~inject - ~add - ~remove + (type a cmp) + (module Key : Comparator with type t = a and type comparator_witness = cmp) + (input : (a, cmp) Set.t Value.t) + ~inject + ~add + ~remove = let%sub callback = let%arr inject = inject @@ -569,17 +569,17 @@ let sync_with_set ;; let simple - (type src cmp) - (key : (src, cmp) comparator) - ?sentinel_name - ?enable_debug_overlay - ?extra_item_attrs - ?left - ?right - ?empty_list_placeholder - ?default_item_height - ~render - (input : (src, cmp) Set.t Value.t) + (type src cmp) + (key : (src, cmp) comparator) + ?sentinel_name + ?enable_debug_overlay + ?extra_item_attrs + ?left + ?right + ?empty_list_placeholder + ?default_item_height + ~render + (input : (src, cmp) Set.t Value.t) = let%sub value, view, inject = with_inject @@ -654,23 +654,23 @@ module Multi = struct end let with_inject - (type src cmp which which_cmp) - (key : (src, cmp) comparator) - (which : (which, which_cmp) comparator) - ?(sentinel_name = "dnd") - ?enable_debug_overlay - ?extra_item_attrs - ?left - ?right - ?empty_list_placeholder - ?default_item_height - ~(lists : (which, which_cmp) Set.t Value.t) - (render : - index:int Value.t - -> source:Vdom.Attr.t Value.t - -> which Value.t - -> src Value.t - -> (_ * Vdom.Node.t) Computation.t) + (type src cmp which which_cmp) + (key : (src, cmp) comparator) + (which : (which, which_cmp) comparator) + ?(sentinel_name = "dnd") + ?enable_debug_overlay + ?extra_item_attrs + ?left + ?right + ?empty_list_placeholder + ?default_item_height + ~(lists : (which, which_cmp) Set.t Value.t) + (render : + index:int Value.t + -> source:Vdom.Attr.t Value.t + -> which Value.t + -> src Value.t + -> (_ * Vdom.Node.t) Computation.t) = let module Key = struct include (val key) @@ -705,7 +705,7 @@ module Multi = struct ~equal:[%equal: Model.t] ~default_model:Model.empty ~apply_action:(fun (_ : _ Bonsai.Apply_action_context.t) model actions -> - List.fold actions ~init:model ~f:apply_action) + List.fold actions ~init:model ~f:apply_action) in let%sub dnd = Bonsai_web_ui_drag_and_drop.create @@ -751,14 +751,14 @@ module Multi = struct Bonsai.Incr.compute (Value.both which rendered_ranked_input) ~f:(fun which_and_map -> - let%pattern_bind.Incr which, map = which_and_map in - (* NOTE: This [bind] only runs once (The key (which) from [assoc_set] does + let%pattern_bind.Incr which, map = which_and_map in + (* NOTE: This [bind] only runs once (The key (which) from [assoc_set] does not change). *) - let%bind.Incr current_which = which in - Incr_map.filter_map map ~f:(fun (data, (which, index)) -> - match Which.equal which current_which with - | false -> None - | true -> Some (data, index))) + let%bind.Incr current_which = which in + Incr_map.filter_map map ~f:(fun (data, (which, index)) -> + match Which.equal which current_which with + | false -> None + | true -> Some (data, index))) in let%sub input = Bonsai.assoc @@ -795,7 +795,7 @@ module Multi = struct let%arr rendered_ranked_input = rendered_ranked_input in Map.to_alist rendered_ranked_input |> List.sort ~compare:(fun a b -> - Comparable.lift Int.compare ~f:(fun (_, (_, rank)) -> rank) a b) + Comparable.lift Int.compare ~f:(fun (_, (_, rank)) -> rank) a b) |> List.map ~f:(fun (key, ((extra, _), _)) -> key, extra) in return (Value.map3 value view rendered_ranked_input ~f:Tuple3.create)) @@ -834,25 +834,25 @@ module Multi = struct ;; let simple - (type src cmp which which_cmp) - (key : (src, cmp) comparator) - (which : (which, which_cmp) comparator) - ?sentinel_name - ?enable_debug_overlay - ?extra_item_attrs - ?left - ?right - ?empty_list_placeholder - ?default_item_height - ~(render : - index:int Value.t - -> source:Vdom.Attr.t Value.t - -> which Value.t - -> src Value.t - -> (_ * Vdom.Node.t) Computation.t) - ~(lists : (which, which_cmp) Set.t Value.t) - ~default_list - (input : (src, cmp) Set.t Value.t) + (type src cmp which which_cmp) + (key : (src, cmp) comparator) + (which : (which, which_cmp) comparator) + ?sentinel_name + ?enable_debug_overlay + ?extra_item_attrs + ?left + ?right + ?empty_list_placeholder + ?default_item_height + ~(render : + index:int Value.t + -> source:Vdom.Attr.t Value.t + -> which Value.t + -> src Value.t + -> (_ * Vdom.Node.t) Computation.t) + ~(lists : (which, which_cmp) Set.t Value.t) + ~default_list + (input : (src, cmp) Set.t Value.t) = let%sub value, view, inject = with_inject diff --git a/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.mli b/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.mli index 2539f416..85b2ab26 100644 --- a/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.mli +++ b/web_ui/reorderable_list/src/bonsai_web_ui_reorderable_list.mli @@ -10,7 +10,6 @@ end type ('k, 'cmp) comparator = (module Comparator with type t = 'k and type comparator_witness = 'cmp) - (** A vertical list component which moves items into their proper place during drag and drop. Items use absolute positioning for explicit layout; that is, the nth item is [n * item_height] pixels from the top of the container. @@ -18,33 +17,32 @@ type ('k, 'cmp) comparator = val list : ('source, 'cmp) comparator -> dnd:('source, int) Bonsai_web_ui_drag_and_drop.t Bonsai.Value.t - (** The drag-and-drop universe the list should operate in; other items in the + (** The drag-and-drop universe the list should operate in; other items in the universe may be dragged into the list *) -> ?enable_debug_overlay:bool - (** Display a transparent overlay on targets to make it clear where an item + (** Display a transparent overlay on targets to make it clear where an item may be dropped. *) -> ?extra_item_attrs:Vdom.Attr.t Bonsai.Value.t - (** Extra attributes to put on the wrapper div for each item in the list. For + (** Extra attributes to put on the wrapper div for each item in the list. For example, you might want to make each item animate into and out of position. *) -> ?left:Css_gen.Length.t - (** The space between the left edge of an item and the list container *) + (** The space between the left edge of an item and the list container *) -> ?right:Css_gen.Length.t - (** The space between the right edge of an item and the list container *) + (** The space between the right edge of an item and the list container *) -> ?empty_list_placeholder:(item_is_hovered:bool Value.t -> Vdom.Node.t Computation.t) - (** What to display when there are no items in the list. [item_is_hovered] is + (** What to display when there are no items in the list. [item_is_hovered] is provided in case you wish to change the placeholder based on whether an item is being hovered above the empty list. *) -> ?default_item_height:int - (** The items and drop targets are spaced evenly every item_height. In order + (** The items and drop targets are spaced evenly every item_height. In order to look natural, each item should have height [item_height]. *) -> ('source, Vdom.Node.t * int, 'cmp) Map.t Value.t - (** The items that should be displayed in the list. Each item should have its + (** The items that should be displayed in the list. Each item should have its view and its current rank. Updating the rank of an item must be done via the [on_drop] callback of the drag-and-drop universe. *) -> Vdom.Node.t Bonsai.Computation.t - (** Similar to [list], but creates the drag-and-drop universe and handles the [on_drop] event, making it fully self-contained. *) val simple @@ -118,12 +116,12 @@ module Multi : sig -> 'key Value.t -> ('data * Vdom.Node.t) Computation.t) -> lists:('which, 'which_cmp) Set.t Value.t - (** The set of lists that items can be placed in. *) + (** The set of lists that items can be placed in. *) -> default_list:'which Value.t - (** Initially, all items are placed in [default_list]. *) + (** Initially, all items are placed in [default_list]. *) -> ('key, 'cmp) Set.t Value.t -> (('which, ('key * 'data) list * Vdom.Node.t, 'which_cmp) Map.t * Vdom.Node.t) - Computation.t + Computation.t module Action : sig type ('key, 'which, 'which_cmp) item = @@ -153,7 +151,7 @@ module Multi : sig -> 'key Value.t -> ('data * Vdom.Node.t) Computation.t) -> (('which, ('key * 'data) list * Vdom.Node.t, 'which_cmp) Map.t - * Vdom.Node.t - * (('key, 'which, 'which_cmp) Action.t -> unit Effect.t)) - Computation.t + * Vdom.Node.t + * (('key, 'which, 'which_cmp) Action.t -> unit Effect.t)) + Computation.t end diff --git a/web_ui/reorderable_list/test/bonsai_web_ui_reorderable_list_test.ml b/web_ui/reorderable_list/test/bonsai_web_ui_reorderable_list_test.ml index 1fe1caad..535cc566 100644 --- a/web_ui/reorderable_list/test/bonsai_web_ui_reorderable_list_test.ml +++ b/web_ui/reorderable_list/test/bonsai_web_ui_reorderable_list_test.ml @@ -411,8 +411,8 @@ let%expect_test "removing an item should shift the rank of everything else" = ~sentinel_name:"dnd" ~default_item_height:1 (fun ~index ~source:_ _ -> - let%arr index = index in - index, Vdom.Node.None) + let%arr index = index in + index, Vdom.Node.None) in let handle = Handle.create diff --git a/web_ui/scroll_utilities/bonsai_web_ui_scroll_utilities.ml b/web_ui/scroll_utilities/bonsai_web_ui_scroll_utilities.ml index 455733f0..5ee48f73 100644 --- a/web_ui/scroll_utilities/bonsai_web_ui_scroll_utilities.ml +++ b/web_ui/scroll_utilities/bonsai_web_ui_scroll_utilities.ml @@ -36,7 +36,7 @@ module Scroll_into_view = struct let element_to_scrollable element : < scrollIntoViewIfNeeded : bool Js.t -> unit Js.meth ; scrollIntoView : Js.Unsafe.any -> unit Js.meth > - Js.t + Js.t = Js.Unsafe.coerce element ;; diff --git a/web_ui/search_bar/src/bonsai_web_ui_search_bar.ml b/web_ui/search_bar/src/bonsai_web_ui_search_bar.ml index b198b942..e594b2d3 100644 --- a/web_ui/search_bar/src/bonsai_web_ui_search_bar.ml +++ b/web_ui/search_bar/src/bonsai_web_ui_search_bar.ml @@ -139,21 +139,21 @@ let default_score_choice item_to_string ~input_text item = ;; let create - (type item) - (module Item : Item with type t = item) - ?(max_query_results = 10) - ?(additional_query_results_on_click = 10) - ?(width = Css_gen.Length.percent100) - ?placeholder:(placeholder_ = "") - ?(initial_query = "") - ?(wrap_search_bar = Fn.id) - ?(autocomplete_item = default_autocomplete_item Item.to_string) - ?(filter_choice = default_filter_choice Item.to_string) - ?(score_choice = default_score_choice Item.to_string) - ?(of_string = Fn.const None) - ?(extra_textbox_attr = Vdom.Attr.empty) - () - input + (type item) + (module Item : Item with type t = item) + ?(max_query_results = 10) + ?(additional_query_results_on_click = 10) + ?(width = Css_gen.Length.percent100) + ?placeholder:(placeholder_ = "") + ?(initial_query = "") + ?(wrap_search_bar = Fn.id) + ?(autocomplete_item = default_autocomplete_item Item.to_string) + ?(filter_choice = default_filter_choice Item.to_string) + ?(score_choice = default_score_choice Item.to_string) + ?(of_string = Fn.const None) + ?(extra_textbox_attr = Vdom.Attr.empty) + () + input = let%sub model, inject = let module M = struct @@ -175,40 +175,40 @@ let create (t : item Model.t) (action : Action.t) -> - match input with - | Active input -> - (match (action : Action.t) with - | Set_text_input query -> - Model.set_text_input - ~all_choices:(Input.choices input) - t - query - ~score_choice - ~filter_choice - | Bump_focused_autocomplete_result direction -> - Model.bump_focused_autocomplete_result t direction - | Clear_focused_autocomplete_result -> Model.clear_focused_autocomplete_result t - | Set_focused_autocomplete_result i -> Model.set_focused_autocomplete_result t i - | Close_autocomplete_box -> Model.close_autocomplete_box t - | Clear_input -> Model.clear_input t ~max_query_results - | Set_num_query_results_to_show i -> Model.set_num_query_results_to_show t i - | On_focus -> - Model.set_text_input - ~all_choices:(Input.choices input) - t - (Model.query t) - ~score_choice - ~filter_choice - | On_blur -> Model.hide_autocomplete t) - | Inactive -> - eprint_s - [%message - [%here] - "An action sent to a [state_machine1] has been dropped because its input \ - was not present. This happens when the [state_machine1] is inactive when \ - it receives a message." - (action : Action.t)]; - t) + match input with + | Active input -> + (match (action : Action.t) with + | Set_text_input query -> + Model.set_text_input + ~all_choices:(Input.choices input) + t + query + ~score_choice + ~filter_choice + | Bump_focused_autocomplete_result direction -> + Model.bump_focused_autocomplete_result t direction + | Clear_focused_autocomplete_result -> Model.clear_focused_autocomplete_result t + | Set_focused_autocomplete_result i -> Model.set_focused_autocomplete_result t i + | Close_autocomplete_box -> Model.close_autocomplete_box t + | Clear_input -> Model.clear_input t ~max_query_results + | Set_num_query_results_to_show i -> Model.set_num_query_results_to_show t i + | On_focus -> + Model.set_text_input + ~all_choices:(Input.choices input) + t + (Model.query t) + ~score_choice + ~filter_choice + | On_blur -> Model.hide_autocomplete t) + | Inactive -> + eprint_s + [%message + [%here] + "An action sent to a [state_machine1] has been dropped because its input \ + was not present. This happens when the [state_machine1] is inactive when \ + it receives a message." + (action : Action.t)]; + t) in let%sub on_select_item = let%arr inject = inject @@ -236,12 +236,12 @@ let create [ Vdom.Attr.( on_click (fun _ -> on_select_item item) @ on_mouseover (fun _ -> - inject (Action.Set_focused_autocomplete_result index)) + inject (Action.Set_focused_autocomplete_result index)) @ focused_attr (* Stop the mousedown event, as we handle on_click above, and the blur from mousedown would interact poorly with on_blur for the input *) @ on_mousedown (fun _ -> - Effect.Many [ Effect.Stop_propagation; Effect.Prevent_default ])) + Effect.Many [ Effect.Stop_propagation; Effect.Prevent_default ])) ] [ autocomplete_item item ] in @@ -275,7 +275,7 @@ let create + additional_query_results_on_click)))) (* Stop the mousedown event, as we handle on_click above. *) @ on_mousedown (fun _ -> - Effect.Many [ Effect.Stop_propagation; Effect.Prevent_default ]) + Effect.Many [ Effect.Stop_propagation; Effect.Prevent_default ]) @ class_ "no-cursor" @ style Css_gen.( @@ -356,7 +356,7 @@ let create and inject = inject in let autocomplete_items = if Model.autocomplete_box_visible model - && not (List.is_empty (Model.current_choices model)) + && not (List.is_empty (Model.current_choices model)) then render_autocomplete else [] in @@ -380,10 +380,10 @@ let create @ on_input (fun _ -> set_text) @ on_focus (fun (_ : Js_of_ocaml.Dom_html.focusEvent Js_of_ocaml.Js.t) -> - inject Action.On_focus) + inject Action.On_focus) @ on_blur (fun (_ : Js_of_ocaml.Dom_html.focusEvent Js_of_ocaml.Js.t) -> - inject Action.On_blur) + inject Action.On_blur) @ extra_textbox_attr) ] () diff --git a/web_ui/search_bar/src/bonsai_web_ui_search_bar.mli b/web_ui/search_bar/src/bonsai_web_ui_search_bar.mli index 95403fec..2ab606fd 100644 --- a/web_ui/search_bar/src/bonsai_web_ui_search_bar.mli +++ b/web_ui/search_bar/src/bonsai_web_ui_search_bar.mli @@ -25,27 +25,27 @@ end val create : (module Item with type t = 'item) -> ?max_query_results:int - (** If the input matches more than [max_query_results], only that many will be shown and + (** If the input matches more than [max_query_results], only that many will be shown and the user will have a link to view more. Default is 10. *) -> ?additional_query_results_on_click:int - (** If the user clicks on the link to view more query results, + (** If the user clicks on the link to view more query results, [additional_query_results_on_click] more are shown. Default is 10. *) -> ?width:Css_gen.Length.t -> ?placeholder:string -> ?initial_query:string -> ?wrap_search_bar:(Vdom.Node.t -> Vdom.Node.t) -> ?autocomplete_item:('item -> Vdom.Node.t) - (** Controls how items are displayed in the autocomplete box. *) + (** Controls how items are displayed in the autocomplete box. *) -> ?filter_choice:(input_text:string -> 'item -> bool) - (** Controls whether an item is considered to match a given search text. The default is + (** Controls whether an item is considered to match a given search text. The default is [String.is_substring (Item.to_string item) ~prefix:input_text]. *) -> ?score_choice:(input_text:string -> 'item -> int) - (** Controls whether items are considered to match the given the search text, and also + (** Controls whether items are considered to match the given the search text, and also how they are sorted. A score of 0 means to omit them from the results. *) -> ?of_string:(string -> 'item option) - (** If at any point the user enters a string s such that [of_string s = Some item], then + (** If at any point the user enters a string s such that [of_string s = Some item], then [item] is considered immediately selected. *) diff --git a/web_ui/search_bar/test/test_bonsai_web_ui_search_bar.ml b/web_ui/search_bar/test/test_bonsai_web_ui_search_bar.ml index 74355975..26fb8c53 100644 --- a/web_ui/search_bar/test/test_bonsai_web_ui_search_bar.ml +++ b/web_ui/search_bar/test/test_bonsai_web_ui_search_bar.ml @@ -11,14 +11,14 @@ type t = let initial_choices = [ 1; 2; 3; 40; 100; 1000 ] let create - ?max_query_results - ?additional_query_results_on_click - ?autocomplete_item - ?filter_choice - ?score_choice - ?of_string - ?initial_query - () + ?max_query_results + ?additional_query_results_on_click + ?autocomplete_item + ?filter_choice + ?score_choice + ?of_string + ?initial_query + () = let choices_var = Bonsai.Var.create initial_choices in let component = @@ -40,8 +40,8 @@ let create { Bonsai_web_ui_search_bar.Input.choices ; on_select = (fun i -> - printf "%d chosen\n" i; - Ui_effect.Ignore) + printf "%d chosen\n" i; + Ui_effect.Ignore) }) in let handle = diff --git a/web_ui/tabs/src/bonsai_web_ui_tabs.ml b/web_ui/tabs/src/bonsai_web_ui_tabs.ml index 58d9f3d5..57799b3b 100644 --- a/web_ui/tabs/src/bonsai_web_ui_tabs.ml +++ b/web_ui/tabs/src/bonsai_web_ui_tabs.ml @@ -34,14 +34,14 @@ let tab_state (type t) ?equal (module M : Bonsai.Model with type t = t) ~initial ;; let tab_ui - (type t) - ?decorate - ?additional_button_attributes - (module M : Bonsai.Model with type t = t) - ~all_tabs - ~equal - state - ~f + (type t) + ?decorate + ?additional_button_attributes + (module M : Bonsai.Model with type t = t) + ~all_tabs + ~equal + state + ~f = let default_additional_button_attributes () = Value.return (fun ~is_selected:_ _ -> Vdom.Attr.empty) diff --git a/web_ui/tabs/src/bonsai_web_ui_tabs.mli b/web_ui/tabs/src/bonsai_web_ui_tabs.mli index 8d943ba4..257419a8 100644 --- a/web_ui/tabs/src/bonsai_web_ui_tabs.mli +++ b/web_ui/tabs/src/bonsai_web_ui_tabs.mli @@ -1,7 +1,6 @@ open! Core open! Bonsai_web - module State : sig type 'a t diff --git a/web_ui/toggle/src/bonsai_web_ui_toggle.ml b/web_ui/toggle/src/bonsai_web_ui_toggle.ml index 9d7623ff..dd673f47 100644 --- a/web_ui/toggle/src/bonsai_web_ui_toggle.ml +++ b/web_ui/toggle/src/bonsai_web_ui_toggle.ml @@ -21,9 +21,9 @@ module Colors = struct end module Css = - [%css - stylesheet - {| +[%css +stylesheet + {| .container { position: relative; } diff --git a/web_ui/typeahead/src/styles.ml b/web_ui/typeahead/src/styles.ml index 617ea69f..9a3b6be1 100644 --- a/web_ui/typeahead/src/styles.ml +++ b/web_ui/typeahead/src/styles.ml @@ -1,6 +1,6 @@ open! Core open! Bonsai_web -open Css_gen +open Css_gen let full_width = width Length.percent100 diff --git a/web_ui/typeahead/src/styles.mli b/web_ui/typeahead/src/styles.mli index 88abe6dc..94c75e11 100644 --- a/web_ui/typeahead/src/styles.mli +++ b/web_ui/typeahead/src/styles.mli @@ -13,10 +13,10 @@ val full_width : Css_gen.t (** [typeahead] is used for applying styles to input typeahead elements which should be styled in a manner consistent with Jane_web_style but aren't. *) -val typeahead : Css_gen.t +val typeahead : Css_gen.t (** [pill] and [pill_container] are used to style the pills used to display choices made by the user in the multiselect. *) -val pill : Css_gen.t +val pill : Css_gen.t val pill_container : Css_gen.t diff --git a/web_ui/typeahead/src/typeahead.ml b/web_ui/typeahead/src/typeahead.ml index f30a7652..8004e30d 100644 --- a/web_ui/typeahead/src/typeahead.ml +++ b/web_ui/typeahead/src/typeahead.ml @@ -34,7 +34,7 @@ module Search = struct then ( match state with (* Nothing -> partial -> partial-match*) - | Nothing_found -> Continue (Partial_match value) + | Nothing_found -> Continue (Partial_match value) (* Two partial matches means that we continue, but will only succeed if finding an exact-match *) | Partial_match _ -> Continue Only_exact_matches_allowed @@ -45,8 +45,8 @@ module Search = struct let haystack_result = match state with | Only_exact_matches_allowed -> None - | Nothing_found -> None - | Partial_match value -> Some value + | Nothing_found -> None + | Partial_match value -> Some value in let unknown_option_result = handle_unknown_option needle in (* Use either one of the potential results. If both methods yielded potential @@ -56,24 +56,24 @@ module Search = struct end type 'a t = - { selected : 'a - ; set_selected : 'a -> unit Ui_effect.t + { selected : 'a + ; set_selected : 'a -> unit Ui_effect.t ; current_input : string - ; view : Vdom.Node.t + ; view : Vdom.Node.t } let input - ?(placeholder = "") - ?(value = "") - ~set_focused - ~extra_attrs - ~to_string - ~id - ~handle_unknown_option - ~all_options - ~on_change - ~on_input - () + ?(placeholder = "") + ?(value = "") + ~set_focused + ~extra_attrs + ~to_string + ~id + ~handle_unknown_option + ~all_options + ~on_change + ~on_input + () = Vdom.Node.lazy_ (lazy @@ -81,18 +81,18 @@ let input ~attrs: [ Vdom.Attr.many_without_merge (extra_attrs - @ [ Vdom.Attr.type_ "text" - ; Vdom.Attr.create "list" id - ; Vdom.Attr.placeholder placeholder - (* Both Attr.value and Attr.string_property value must be set. The former only affects + @ [ Vdom.Attr.type_ "text" + ; Vdom.Attr.create "list" id + ; Vdom.Attr.placeholder placeholder + (* Both Attr.value and Attr.string_property value must be set. The former only affects initial control state while the latter affects the control state whilst the form is being used. *) - ; Vdom.Attr.value value - ; Vdom.Attr.on_focus (fun _ -> set_focused true) - ; Vdom.Attr.on_blur (fun _ -> set_focused false) + ; Vdom.Attr.value value + ; Vdom.Attr.on_focus (fun _ -> set_focused true) + ; Vdom.Attr.on_blur (fun _ -> set_focused false) ; Vdom.Attr.string_property "value" value - ; Vdom.Attr.on_input (fun _ -> on_input) - ; Vdom.Attr.on_change (fun _ input -> + ; Vdom.Attr.on_input (fun _ -> on_input) + ; Vdom.Attr.on_change (fun _ input -> let maybe_t = Search.find ~to_string @@ -134,17 +134,17 @@ let show_datalist ~focused ~show_datalist_in_test = ;; let create_internal - (type t) - ?(extra_attrs = Value.return []) - ?placeholder - ?on_select_change - ?to_string - ?to_option_description - ?(handle_unknown_option = Value.return (Fn.const None)) - (module M : Bonsai.Model with type t = t) - ~equal - ~all_options - ~show_datalist_in_test + (type t) + ?(extra_attrs = Value.return []) + ?placeholder + ?on_select_change + ?to_string + ?to_option_description + ?(handle_unknown_option = Value.return (Fn.const None)) + (module M : Bonsai.Model with type t = t) + ~equal + ~all_options + ~show_datalist_in_test = let open! Bonsai.Let_syntax in let to_string = @@ -170,17 +170,17 @@ let create_internal let%sub id = Bonsai.path_id in let%sub input = let%arr set_focused = set_focused - and set_selected = set_selected - and extra_attrs = extra_attrs - and id = id + and set_selected = set_selected + and extra_attrs = extra_attrs + and id = id and handle_unknown_option = handle_unknown_option - and all_options = all_options - and on_select_change = on_select_change - and current_input = current_input - and set_current_input = set_current_input - and to_string = to_string in - let on_input input = set_current_input input in - let on_change t _ = Ui_effect.Many [ set_selected t; on_select_change t ] in + and all_options = all_options + and on_select_change = on_select_change + and current_input = current_input + and set_current_input = set_current_input + and to_string = to_string in + let on_input input = set_current_input input in + let on_change t _ = Ui_effect.Many [ set_selected t; on_select_change t ] in input ?placeholder ~set_focused @@ -201,10 +201,10 @@ let create_internal in match%sub show_datalist with | false -> Bonsai.const (Vdom.Node.text "") - | true -> + | true -> let%arr to_option_description = to_option_description - and id = id - and to_string = to_string + and id = id + and to_string = to_string and all_options = all_options in datalist ~to_option_description ~to_string ~id ~all_options () in @@ -216,7 +216,7 @@ let create_internal let%sub set_selected = let%arr set_selected = set_selected and set_current_input = set_current_input - and to_string = to_string in + and to_string = to_string in fun selected -> Effect.lazy_ (lazy @@ -225,39 +225,39 @@ let create_internal in let%arr selected = selected and current_input = current_input - and view = view - and set_selected = set_selected in + and view = view + and set_selected = set_selected in { selected; current_input; view; set_selected } ;; let input - ?(placeholder = "") - ~current_input - ~inject_current_input - ~extra_attrs - ~to_string - ~split - ~id - ~handle_unknown_option - ~all_options - ~selected_options - ~inject_selected_options - ~on_set_change - ~set_focused - () + ?(placeholder = "") + ~current_input + ~inject_current_input + ~extra_attrs + ~to_string + ~split + ~id + ~handle_unknown_option + ~all_options + ~selected_options + ~inject_selected_options + ~on_set_change + ~set_focused + () = let open! Bonsai.Let_syntax in let%arr current_input = current_input - and inject_current_input = inject_current_input - and handle_unknown_option = handle_unknown_option - and all_options = all_options - and selected_options = selected_options + and inject_current_input = inject_current_input + and handle_unknown_option = handle_unknown_option + and all_options = all_options + and selected_options = selected_options and inject_selected_options = inject_selected_options - and extra_attrs = extra_attrs - and id = id - and on_set_change = on_set_change - and to_string = to_string - and set_focused = set_focused in + and extra_attrs = extra_attrs + and id = id + and on_set_change = on_set_change + and to_string = to_string + and set_focused = set_focused in let on_input input = inject_current_input input in let on_change maybe_t user_input = match maybe_t with @@ -274,7 +274,7 @@ let input Ui_effect.Many [ inject_selected_options selected_options ; (match new_selected_options with - | [] -> inject_current_input user_input + | [] -> inject_current_input user_input | _ :: _ -> inject_current_input "") ] | Some t -> @@ -300,19 +300,19 @@ let input ;; let create_multi_internal - (type comparator_witness t) - ?(extra_attrs = Value.return []) - ?placeholder - ?(on_set_change = Value.return (const Ui_effect.Ignore)) - ?to_string - ?to_option_description - ?(handle_unknown_option = Value.return (Fn.const None)) - ?(split = List.return) - (module M : Bonsai.Comparator - with type comparator_witness = comparator_witness - and type t = t) - ~all_options - ~show_datalist_in_test + (type comparator_witness t) + ?(extra_attrs = Value.return []) + ?placeholder + ?(on_set_change = Value.return (const Ui_effect.Ignore)) + ?to_string + ?to_option_description + ?(handle_unknown_option = Value.return (Fn.const None)) + ?(split = List.return) + (module M : Bonsai.Comparator + with type comparator_witness = comparator_witness + and type t = t) + ~all_options + ~show_datalist_in_test = let open Bonsai.Let_syntax in let module M = struct @@ -380,11 +380,11 @@ let create_multi_internal in match%sub show_datalist with | false -> Bonsai.const (Vdom.Node.datalist []) - | true -> + | true -> let%arr all_options = all_options and selected_options = selected_options - and id = id - and to_string = to_string + and id = id + and to_string = to_string and to_option_description = to_option_description in datalist ~id @@ -398,19 +398,19 @@ let create_multi_internal () in let%arr selected_options = selected_options - and datalist = datalist + and datalist = datalist and inject_selected_options = inject_selected_options - and current_input = current_input - and input = input - and pills = pills in - { selected = selected_options + and current_input = current_input + and input = input + and pills = pills in + { selected = selected_options ; set_selected = inject_selected_options ; current_input - ; view = Vdom.Node.div [ input; datalist; pills ] + ; view = Vdom.Node.div [ input; datalist; pills ] } ;; -let create = create_internal ~show_datalist_in_test:true +let create = create_internal ~show_datalist_in_test:true let create_multi = create_multi_internal ~show_datalist_in_test:true module Private = struct diff --git a/web_ui/typeahead/src/typeahead.mli b/web_ui/typeahead/src/typeahead.mli index e5a1f8ec..c119337f 100644 --- a/web_ui/typeahead/src/typeahead.mli +++ b/web_ui/typeahead/src/typeahead.mli @@ -9,10 +9,10 @@ open! Bonsai_web [current_input] gives access to the current contents of the form's [] element *) type 'a t = - { selected : 'a - ; set_selected : 'a -> unit Ui_effect.t + { selected : 'a + ; set_selected : 'a -> unit Ui_effect.t ; current_input : string - ; view : Vdom.Node.t + ; view : Vdom.Node.t } (** [create] returns a typeahead using native browser controls. diff --git a/web_ui/typeahead/test/typeahead.ml b/web_ui/typeahead/test/typeahead.ml index 80d5264d..fa955b0a 100644 --- a/web_ui/typeahead/test/typeahead.ml +++ b/web_ui/typeahead/test/typeahead.ml @@ -1,7 +1,7 @@ open! Core open! Bonsai_web open! Bonsai_web_test -open Bonsai.Let_syntax +open Bonsai.Let_syntax module Typeahead = Bonsai_web_ui_typeahead.Typeahead let shared_computation ?(to_string = Value.return Data.to_string) () = @@ -82,7 +82,7 @@ let%expect_test "Focusing and un-focusing the input shows and hides the datalist oninput> |}]; - Handle.focus handle ~get_vdom:Fn.id ~selector:"input"; + Handle.focus handle ~get_vdom:Fn.id ~selector:"input"; Handle.show_diff handle; [%expect {| @@ -102,7 +102,7 @@ let%expect_test "Focusing and un-focusing the input shows and hides the datalist +| +| |}]; - Handle.blur handle ~get_vdom:Fn.id ~selector:"input"; + Handle.blur handle ~get_vdom:Fn.id ~selector:"input"; Handle.show_diff handle; [%expect {| @@ -165,7 +165,7 @@ let%expect_test "use setter" = Handle.create (module struct type incoming = Data.t option - type t = Vdom.Node.t * (Data.t option -> unit Ui_effect.t) + type t = Vdom.Node.t * (Data.t option -> unit Ui_effect.t) let view (vdom, _) = let module V = (val Result_spec.vdom Fn.id) in @@ -179,7 +179,7 @@ let%expect_test "use setter" = Handle.show handle; let _before = [%expect.output] in Handle.do_actions handle [ Some Data.Option_A ]; - Handle.show_diff handle; + Handle.show_diff handle; [%expect {|
@@ -201,7 +201,7 @@ let%expect_test "use setter" =
|}]; Handle.do_actions handle [ None ]; - Handle.show_diff handle; + Handle.show_diff handle; [%expect {|
@@ -239,17 +239,17 @@ let%expect_test "Select element using partial input" = [%expect {| () |}]; (* "O" is not unique, nothing happens *) Handle.input_text handle ~get_vdom:Tuple2.get1 ~selector:"input" ~text:"O"; - Handle.show handle; + Handle.show handle; [%expect {| () |}]; (* 'C' is unique, use it! *) Handle.input_text handle ~get_vdom:Tuple2.get1 ~selector:"input" ~text:"C"; - Handle.show handle; + Handle.show handle; [%expect {| (Option_C) |}] ;; let%expect_test "dynamic [to_string]." = - let to_string_var = Bonsai.Var.create Data.to_string in - let to_string = Bonsai.Var.value to_string_var in + let to_string_var = Bonsai.Var.create Data.to_string in + let to_string = Bonsai.Var.value to_string_var in let handle = Handle.create (Result_spec.vdom Fn.id) (view_computation ~to_string ()) in Handle.store_view handle; Bonsai.Var.set to_string_var (fun data -> Data.to_string data ^ "!"); diff --git a/web_ui/typeahead/test/typeahead_multi.ml b/web_ui/typeahead/test/typeahead_multi.ml index 6fc8f709..4f0279d6 100644 --- a/web_ui/typeahead/test/typeahead_multi.ml +++ b/web_ui/typeahead/test/typeahead_multi.ml @@ -1,7 +1,7 @@ open! Core open! Bonsai_web_test open! Bonsai_web -open Bonsai.Let_syntax +open Bonsai.Let_syntax module Typeahead = Bonsai_web_ui_typeahead.Typeahead let shared_computation = @@ -86,7 +86,7 @@ let%expect_test "Focusing and un-focusing the input shows and hides the datalist oninput>
|}]; - Handle.focus handle ~get_vdom:Fn.id ~selector:"input"; + Handle.focus handle ~get_vdom:Fn.id ~selector:"input"; Handle.show_diff handle; [%expect {| @@ -107,7 +107,7 @@ let%expect_test "Focusing and un-focusing the input shows and hides the datalist +| +| |}]; - Handle.blur handle ~get_vdom:Fn.id ~selector:"input"; + Handle.blur handle ~get_vdom:Fn.id ~selector:"input"; Handle.show_diff handle; [%expect {| @@ -170,8 +170,8 @@ let%expect_test "Deselect an element" = Handle.recompute_view handle; input_value handle Data.Option_C; Handle.store_view handle; - Handle.click_on handle ~get_vdom:Fn.id ~selector:"[data-value=Option B]"; - Handle.show_diff handle; + Handle.click_on handle ~get_vdom:Fn.id ~selector:"[data-value=Option B]"; + Handle.show_diff handle; (* Expected change: Option B should disappear from the pill div and reappear in the datalist. *) [%expect @@ -202,7 +202,7 @@ let%expect_test "set the elements" = Handle.create (module struct type incoming = Data.Set.t - type t = Vdom.Node.t * (Data.Set.t -> unit Ui_effect.t) + type t = Vdom.Node.t * (Data.Set.t -> unit Ui_effect.t) let view (vdom, _) = let module V = (val Result_spec.vdom Fn.id) in @@ -215,7 +215,7 @@ let%expect_test "set the elements" = in Handle.store_view handle; Handle.do_actions handle [ Data.Set.of_list [ Data.Option_C ] ]; - Handle.show_diff handle; + Handle.show_diff handle; [%expect {|
@@ -253,10 +253,10 @@ let%expect_test "Select two elements using partial inputs" = Handle.show handle; [%expect {| () |}]; Handle.input_text handle ~get_vdom:Tuple2.get1 ~selector:"input" ~text:"b"; - Handle.show handle; + Handle.show handle; [%expect {| (Option_B) |}]; Handle.input_text handle ~get_vdom:Tuple2.get1 ~selector:"input" ~text:"C"; - Handle.show handle; + Handle.show handle; [%expect {| (Option_B Option_C) |}] ;; diff --git a/web_ui/url_var/src/bonsai_web_ui_url_var.ml b/web_ui/url_var/src/bonsai_web_ui_url_var.ml index 2b5d10ac..0ce70786 100644 --- a/web_ui/url_var/src/bonsai_web_ui_url_var.ml +++ b/web_ui/url_var/src/bonsai_web_ui_url_var.ml @@ -36,8 +36,8 @@ module Components = struct |> Uri.query |> String.Map.of_alist_multi |> Map.filter_map ~f:(function - | [ value ] -> Some value - | _ -> None) + | [ value ] -> Some value + | _ -> None) in let fragment = Uri.fragment uri in { path; query; fragment } @@ -116,12 +116,12 @@ let create_exn' (type a) (module S : S with type t = a) ~on_bad_uri = include S include Binable.Of_sexpable_with_uuid (struct - include S + include S - let caller_identity = - Bin_prot.Shape.Uuid.of_string "918e794b-02c3-4f27-ad86-3f406a41fc4b" - ;; - end) + let caller_identity = + Bin_prot.Shape.Uuid.of_string "918e794b-02c3-4f27-ad86-3f406a41fc4b" + ;; + end) let to_uri_routing = Fn.id let of_uri_routing = Fn.id @@ -186,8 +186,8 @@ module Typed = struct let parse_unicode_slashes s = Re.Str.global_replace unicode_slash_regexp "/" s let of_original_components - ?(encoding_behavior : Uri_parsing.Percent_encoding_behavior.t = Correct) - (original : Components.t) + ?(encoding_behavior : Uri_parsing.Percent_encoding_behavior.t = Correct) + (original : Components.t) = let split_path = match original.path with @@ -202,8 +202,8 @@ module Typed = struct ;; let to_original_components - ?(encoding_behavior : Uri_parsing.Percent_encoding_behavior.t = Correct) - (typed_components : t) + ?(encoding_behavior : Uri_parsing.Percent_encoding_behavior.t = Correct) + (typed_components : t) = { Components.path = (match encoding_behavior with @@ -223,10 +223,10 @@ module Typed = struct include Uri_parsing.Versioned_parser let of_non_typed_parser - ?encoding_behavior - ~(parse_exn : Original_components.t -> 'a) - ~(unparse : 'a -> Original_components.t) - () + ?encoding_behavior + ~(parse_exn : Original_components.t -> 'a) + ~(unparse : 'a -> Original_components.t) + () = let projection = let parse_exn components = @@ -242,12 +242,12 @@ module Typed = struct end let make' - (type a) - (parser : a Uri_parsing.Versioned_parser.t) - ?encoding_behavior - ~(fallback : Exn.t -> Original_components.t -> a) - ~on_fallback_raises - () + (type a) + (parser : a Uri_parsing.Versioned_parser.t) + ?encoding_behavior + ~(fallback : Exn.t -> Original_components.t -> a) + ~on_fallback_raises + () = let projection = Uri_parsing.Versioned_parser.eval ?encoding_behavior parser in let try_with_backup ~f = @@ -283,12 +283,12 @@ module Typed = struct ;; let make - (type a) - ?on_fallback_raises - ?encoding_behavior - (module T : T with type t = a) - (parser : a Uri_parsing.Versioned_parser.t) - ~(fallback : Exn.t -> Original_components.t -> a) + (type a) + ?on_fallback_raises + ?encoding_behavior + (module T : T with type t = a) + (parser : a Uri_parsing.Versioned_parser.t) + ~(fallback : Exn.t -> Original_components.t -> a) : a url_var = let projection = make' parser ?encoding_behavior ~fallback ~on_fallback_raises () in @@ -303,11 +303,11 @@ module Typed = struct ;; let make_projection - (type a) - ?on_fallback_raises - ?encoding_behavior - (parser : a Uri_parsing.Versioned_parser.t) - ~(fallback : Exn.t -> Original_components.t -> a) + (type a) + ?on_fallback_raises + ?encoding_behavior + (parser : a Uri_parsing.Versioned_parser.t) + ~(fallback : Exn.t -> Original_components.t -> a) = make' parser ?encoding_behavior ~fallback ~on_fallback_raises () ;; @@ -356,8 +356,8 @@ module For_testing = struct ;; let make_of_versioned_parser - ?encoding_behavior - (versioned_parser : 'a Typed.Versioned_parser.t) + ?encoding_behavior + (versioned_parser : 'a Typed.Versioned_parser.t) = Uri_parsing.Versioned_parser.eval ?encoding_behavior versioned_parser ;; diff --git a/web_ui/url_var/src/bonsai_web_ui_url_var.mli b/web_ui/url_var/src/bonsai_web_ui_url_var.mli index 06d35151..f6851afe 100644 --- a/web_ui/url_var/src/bonsai_web_ui_url_var.mli +++ b/web_ui/url_var/src/bonsai_web_ui_url_var.mli @@ -16,7 +16,6 @@ module Components : sig -> unit -> t - (** Creates a URI with the the path, query, and fragment added to the URI. *) val to_path_and_query : t -> Uri.t diff --git a/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.ml b/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.ml index 753d7e98..12e5aedb 100644 --- a/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.ml +++ b/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.ml @@ -210,9 +210,9 @@ module Widget (K : Comparator.S) = struct input.Input.children ~init ~f:(fun acc -> function - | key, `Left _vdom -> Acc.remove acc ~key - | key, `Right vdom -> Acc.add acc ~key ~vdom - | key, `Unequal (_old_vdom, current_vdom) -> Acc.change acc ~key ~current_vdom) + | key, `Left _vdom -> Acc.remove acc ~key + | key, `Right vdom -> Acc.add acc ~key ~vdom + | key, `Unequal (_old_vdom, current_vdom) -> Acc.change acc ~key ~current_vdom) in Acc.finalize acc, element) ;; @@ -220,10 +220,10 @@ module Widget (K : Comparator.S) = struct let to_vdom_for_testing = `Custom (fun { Input.children; attr; tag } -> - Vdom.Node.create - tag - ?attrs:(Option.map attr ~f:(fun attr -> [ attr ])) - (Map.data children)) + Vdom.Node.create + tag + ?attrs:(Option.map attr ~f:(fun attr -> [ attr ])) + (Map.data children)) ;; module Input = struct diff --git a/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.mli b/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.mli index 8457fd4a..0a4b98d6 100644 --- a/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.mli +++ b/web_ui/vdom_node_with_map_children/vdom_node_with_map_children.mli @@ -2,7 +2,6 @@ open! Core open! Bonsai_web open! Js_of_ocaml - (** When given a map of vdom nodes, this function will wrap them in an element whose tag is determined by the first argument, and efficiently diff them against new nodes in the future that were created by this function. *) diff --git a/web_ui/view/form/bonsai_web_ui_form_view.ml b/web_ui/view/form/bonsai_web_ui_form_view.ml index 58463d2b..51d37be0 100644 --- a/web_ui/view/form/bonsai_web_ui_form_view.ml +++ b/web_ui/view/form/bonsai_web_ui_form_view.ml @@ -2,9 +2,9 @@ open! Core open Import module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .clear_fieldset_styles { border: 0; margin: 0; diff --git a/web_ui/view/kado/cards.ml b/web_ui/view/kado/cards.ml index db5cf6c2..2660d40a 100644 --- a/web_ui/view/kado/cards.ml +++ b/web_ui/view/kado/cards.ml @@ -3,15 +3,15 @@ open Import module Style = Cards_style let make - constants - ~container_attrs - ~title_attrs - ~content_attrs - ~intent - ~on_click - ~title - ~title_kind - ~content + constants + ~container_attrs + ~title_attrs + ~content_attrs + ~intent + ~on_click + ~title + ~title_kind + ~content = let title_fg, title_bg, title_border = let { Fg_bg.foreground; background }, title_border = diff --git a/web_ui/view/kado/kado.ml b/web_ui/view/kado/kado.ml index 0fcc6f25..feaace24 100644 --- a/web_ui/view/kado/kado.ml +++ b/web_ui/view/kado/kado.ml @@ -77,8 +77,7 @@ let light_mode_constants = ; header_body_border = header_header_border ; body_body_border = extreme_primary_border } - ; is_dark = - false + ; is_dark = false ; form = { error_message = { foreground = `Name "black"; background = `Name "pink" } ; error_toggle_text = `Hex "#f54646" @@ -125,11 +124,11 @@ let v1 ~constants ~codemirror_theme ~is_dark ~name ~version_name ~set_min_height ;; let theme - ?(contrast = Contrast.Standard) - ?(style = Style.Dark) - ?set_min_height_to_100vh - ~version - () + ?(contrast = Contrast.Standard) + ?(style = Style.Dark) + ?set_min_height_to_100vh + ~version + () = let is_dark, constants, name = match style with diff --git a/web_ui/view/kado/kado.mli b/web_ui/view/kado/kado.mli index 4491cedc..ceb4b302 100644 --- a/web_ui/view/kado/kado.mli +++ b/web_ui/view/kado/kado.mli @@ -21,7 +21,7 @@ val theme : ?contrast:Contrast.t -> ?style:Style.t -> ?set_min_height_to_100vh:unit - (** Kado set the default background color of [:root] + (** Kado set the default background color of [:root] to set the background color. This can prove troublesome since css variables cannot currently easily be set if they are read at the top-level. If you change the background color diff --git a/web_ui/view/src/bonsai_web_ui_view.ml b/web_ui/view/src/bonsai_web_ui_view.ml index bfc840f0..48778a2f 100644 --- a/web_ui/view/src/bonsai_web_ui_view.ml +++ b/web_ui/view/src/bonsai_web_ui_view.ml @@ -26,37 +26,37 @@ let intent_colors ((module T) : Theme.t) (intent : Intent.t) = ;; let button - ((module T) : Theme.t) - ?(attrs = []) - ?(disabled = false) - ?intent - ?tooltip - ~on_click - text + ((module T) : Theme.t) + ?(attrs = []) + ?(disabled = false) + ?intent + ?tooltip + ~on_click + text = T.singleton#button ~attrs ~disabled ~intent ~tooltip ~on_click [ Vdom.Node.text text ] ;; let button' - ((module T) : Theme.t) - ?(attrs = []) - ?(disabled = false) - ?intent - ?tooltip - ~on_click - content + ((module T) : Theme.t) + ?(attrs = []) + ?(disabled = false) + ?intent + ?tooltip + ~on_click + content = T.singleton#button ~attrs ~disabled ~intent ~tooltip ~on_click content ;; let tabs - ((module T) : Theme.t) - ?(attrs = []) - ?(per_tab_attrs = fun _ ~is_active:_ -> []) - ~equal - ~on_change - ~active - tabs + ((module T) : Theme.t) + ?(attrs = []) + ?(per_tab_attrs = fun _ ~is_active:_ -> []) + ~equal + ~on_change + ~active + tabs = T.singleton#tabs ~attrs ~per_tab_attrs ~on_change ~equal ~active tabs ;; @@ -66,14 +66,14 @@ module type Enum = sig end let tabs_enum - (type a) - ((module T) : Theme.t) - ?(attrs = []) - ?(per_tab_attrs = fun _ ~is_active:_ -> []) - ?tab_to_vdom - (module A : Enum with type t = a) - ~on_change - ~active + (type a) + ((module T) : Theme.t) + ?(attrs = []) + ?(per_tab_attrs = fun _ ~is_active:_ -> []) + ?tab_to_vdom + (module A : Enum with type t = a) + ~on_change + ~active = let tab_to_vdom = Option.value tab_to_vdom ~default:(fun tab -> @@ -102,12 +102,12 @@ let themed_textf theme ?attrs ?intent ?style ?size format = module Tooltip_direction = Tooltip.Direction let tooltip' - ((module T) : Theme.t) - ?(container_attrs = []) - ?(tooltip_attrs = []) - ?(direction = Tooltip.Direction.Top) - ~tooltip - tipped + ((module T) : Theme.t) + ?(container_attrs = []) + ?(tooltip_attrs = []) + ?(direction = Tooltip.Direction.Top) + ~tooltip + tipped = T.singleton#tooltip ~container_attrs ~tooltip_attrs ~direction ~tipped ~tooltip ;; @@ -119,15 +119,15 @@ let tooltip theme ?container_attrs ?tooltip_attrs ?direction ~tooltip tipped = ;; let card' - ((module T) : Theme.t) - ?(container_attrs = []) - ?(title_attrs = []) - ?(content_attrs = []) - ?intent - ?(title = []) - ?(title_kind = Card_title_kind.Prominent) - ?(on_click = Effect.Ignore) - content + ((module T) : Theme.t) + ?(container_attrs = []) + ?(title_attrs = []) + ?(content_attrs = []) + ?intent + ?(title = []) + ?(title_kind = Card_title_kind.Prominent) + ?(on_click = Effect.Ignore) + content = T.singleton#card ~container_attrs @@ -141,15 +141,15 @@ let card' ;; let card - theme - ?container_attrs - ?title_attrs - ?content_attrs - ?intent - ?title - ?title_kind - ?on_click - content + theme + ?container_attrs + ?title_attrs + ?content_attrs + ?intent + ?title + ?title_kind + ?on_click + content = card' theme diff --git a/web_ui/view/src/bonsai_web_ui_view.mli b/web_ui/view/src/bonsai_web_ui_view.mli index d1d82978..c6df64ae 100644 --- a/web_ui/view/src/bonsai_web_ui_view.mli +++ b/web_ui/view/src/bonsai_web_ui_view.mli @@ -287,7 +287,6 @@ module Tooltip_direction : sig | Right | Bottom | Left - end (** Tooltips can be used to provide more information to a user when they @@ -349,7 +348,7 @@ module Card_title_kind : sig type t = | Prominent (** Rendered in an easier to see bar. Use to make your title stand out. *) | Discreet - (** Title is rendered alongside the top of the border of the card in a more discrete way. Use to give structure to your content. *) + (** Title is rendered alongside the top of the border of the card in a more discrete way. Use to give structure to your content. *) end (** A "card" is a way of highlighting important messages, and to also bring some diff --git a/web_ui/view/src/expert.ml b/web_ui/view/src/expert.ml index a2c29d77..1b9b193d 100644 --- a/web_ui/view/src/expert.ml +++ b/web_ui/view/src/expert.ml @@ -23,9 +23,9 @@ let override_theme ((module M) : Theme.t) ~(f : t -> t) : Theme.t = ;; module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| @layer bonsai_web_ui_view.app { :root:has(.app) { font-family: sans-serif; @@ -131,41 +131,41 @@ let default_theme = method tabs : type a. attrs:Vdom.Attr.t list - -> per_tab_attrs:(a -> is_active:bool -> Vdom.Attr.t list) - -> on_change:(from:a -> to_:a -> unit Effect.t) - -> equal:(a -> a -> bool) - -> active:a - -> (a * Vdom.Node.t) list - -> Vdom.Node.t = + -> per_tab_attrs:(a -> is_active:bool -> Vdom.Attr.t list) + -> on_change:(from:a -> to_:a -> unit Effect.t) + -> equal:(a -> a -> bool) + -> active:a + -> (a * Vdom.Node.t) list + -> Vdom.Node.t = fun ~attrs ~per_tab_attrs ~on_change ~equal ~active tabs -> - let color = self#constants.primary.foreground in - let all_attr = - Vdom.Attr.style (Css_gen.create ~field:"cursor" ~value:"pointer") - in - let active_attr = - Vdom.Attr.style - (Css_gen.border_bottom ~width:(`Px 3) ~color ~style:`Solid ()) - in - let inactive_attr i = - Vdom.Attr.many - [ Vdom.Attr.style - (Css_gen.concat - [ Css_gen.border_bottom ~width:(`Px 1) ~color ~style:`Solid () - ; Css_gen.opacity 0.6 - ]) - ; Vdom.Attr.on_click (fun _ -> on_change ~from:active ~to_:i) - ] - in - List.map tabs ~f:(fun (i, tab) -> - let is_active = equal active i in - Vdom.Node.div - ~attrs: - [ (if is_active then active_attr else inactive_attr i) - ; all_attr - ; Vdom.Attr.many (per_tab_attrs i ~is_active) + let color = self#constants.primary.foreground in + let all_attr = + Vdom.Attr.style (Css_gen.create ~field:"cursor" ~value:"pointer") + in + let active_attr = + Vdom.Attr.style + (Css_gen.border_bottom ~width:(`Px 3) ~color ~style:`Solid ()) + in + let inactive_attr i = + Vdom.Attr.many + [ Vdom.Attr.style + (Css_gen.concat + [ Css_gen.border_bottom ~width:(`Px 1) ~color ~style:`Solid () + ; Css_gen.opacity 0.6 + ]) + ; Vdom.Attr.on_click (fun _ -> on_change ~from:active ~to_:i) ] - [ tab ]) - |> Layout.hbox ~attrs ~gap:(`Em_float 0.5) + in + List.map tabs ~f:(fun (i, tab) -> + let is_active = equal active i in + Vdom.Node.div + ~attrs: + [ (if is_active then active_attr else inactive_attr i) + ; all_attr + ; Vdom.Attr.many (per_tab_attrs i ~is_active) + ] + [ tab ]) + |> Layout.hbox ~attrs ~gap:(`Em_float 0.5) method devbar ~attrs ~count ~intent text = let intent = Option.value intent ~default:Constants.Intent.Error in @@ -292,14 +292,14 @@ let default_theme = (* cards *) method card - ~container_attrs - ~title_attrs - ~content_attrs - ~intent - ~on_click - ~title - ~title_kind - ~content = + ~container_attrs + ~title_attrs + ~content_attrs + ~intent + ~on_click + ~title + ~title_kind + ~content = let open Constants in let module Style = Card_style in let constants = self#constants in diff --git a/web_ui/view/src/form.ml b/web_ui/view/src/form.ml index 32b9798b..e30db1fb 100644 --- a/web_ui/view/src/form.ml +++ b/web_ui/view/src/form.ml @@ -130,11 +130,11 @@ let depth_td' ~depth ~extra_attrs = let depth_td_of_context context = depth_td' ~depth:(Form_context.depth context) let render_label - ?unique_key - ?colspan - ?(extra_attrs = []) - label - ~(depth_td : extra_attrs:Vdom.Attr.t -> ?key:string -> Vdom.Node.t list -> Vdom.Node.t) + ?unique_key + ?colspan + ?(extra_attrs = []) + label + ~(depth_td : extra_attrs:Vdom.Attr.t -> ?key:string -> Vdom.Node.t list -> Vdom.Node.t) = let colspan = Option.value_map colspan ~default:Vdom.Attr.empty ~f:Vdom.Attr.colspan in let for_ = Option.value_map unique_key ~default:Vdom.Attr.empty ~f:Vdom.Attr.for_ in @@ -195,10 +195,10 @@ let render_context_inline self ?unique_key inline_view ~view_context ~eval_conte let empty ~eval_context:_ ~view_context:_ () = [] let collapsible - self - ~eval_context - ~view_context - ({ collapse_label; state } : Form_view.collapsible) + self + ~eval_context + ~view_context + ({ collapse_label; state } : Form_view.collapsible) = let tooltip_and_error = wrap_tooltip_and_error self ~tooltip:view_context.tooltip ~error:view_context.error @@ -248,10 +248,10 @@ let record self ~eval_context ~view_context fields = ;; let variant - self - ~eval_context - ~view_context - ({ clause_selector; selected_clause } : Form_view.variant) + self + ~eval_context + ~view_context + ({ clause_selector; selected_clause } : Form_view.variant) = let rest = match selected_clause with @@ -275,10 +275,10 @@ let option self ~eval_context ~view_context ({ toggle; status } : Form_view.opti ;; let list - self - ~eval_context - ~view_context - ({ list_items; append_item; legacy_button_position } : Form_view.list_view) + self + ~eval_context + ~view_context + ({ list_items; append_item; legacy_button_position } : Form_view.list_view) = let items_and_removals = List.concat_mapi list_items ~f:(fun i { item_view; remove_item } -> @@ -372,17 +372,17 @@ let to_vdom self ?on_submit ~eval_context view = ~depth:0 ~extra_attrs:(Vdom.Attr.colspan 3) [ (match on_submit with - | None -> - Vdom.Node.button - ~attrs:[ button_attr; Vdom.Attr.disabled ] - [ Vdom.Node.text button_text ] - | Some event -> - let event = - Effect.(Many [ event; Prevent_default; Stop_propagation ]) - in - Vdom.Node.button - ~attrs:[ button_attr; Vdom.Attr.on_click (fun _ -> event) ] - [ Vdom.Node.text button_text ]) + | None -> + Vdom.Node.button + ~attrs:[ button_attr; Vdom.Attr.disabled ] + [ Vdom.Node.text button_text ] + | Some event -> + let event = + Effect.(Many [ event; Prevent_default; Stop_propagation ]) + in + Vdom.Node.button + ~attrs:[ button_attr; Vdom.Attr.on_click (fun _ -> event) ] + [ Vdom.Node.text button_text ]) ] ] ] diff --git a/web_ui/view/src/layout.ml b/web_ui/view/src/layout.ml index 92c36af5..7b647400 100644 --- a/web_ui/view/src/layout.ml +++ b/web_ui/view/src/layout.ml @@ -102,18 +102,18 @@ let to_css_gen_vertical_direction : Flex.Vertical_dir.t -> _ = function ;; let box - ~(default_direction : 'direction option) - ~(direction_to_css_gen_direction : - 'direction -> [ `Column | `Column_reverse | `Default | `Row | `Row_reverse ]) - ?(attrs = []) - ?row_gap - ?column_gap - ?main_axis_alignment - ?cross_axis_alignment - ?direction - ?wrap - ?align_content - children + ~(default_direction : 'direction option) + ~(direction_to_css_gen_direction : + 'direction -> [ `Column | `Column_reverse | `Default | `Row | `Row_reverse ]) + ?(attrs = []) + ?row_gap + ?column_gap + ?main_axis_alignment + ?cross_axis_alignment + ?direction + ?wrap + ?align_content + children = let direction = match default_direction, direction with diff --git a/web_ui/view/src/table.ml b/web_ui/view/src/table.ml index 0f628f01..cfe2b06c 100644 --- a/web_ui/view/src/table.ml +++ b/web_ui/view/src/table.ml @@ -173,11 +173,11 @@ module Col = struct end let render - (((module T) : Theme.t) as theme) - ?(table_attrs = []) - ?(row_attrs = fun _ -> []) - cols - xs + (((module T) : Theme.t) as theme) + ?(table_attrs = []) + ?(row_attrs = fun _ -> []) + cols + xs = let mega_group = Col.group' Vdom.Node.none cols in let depth = Col.depth mega_group in @@ -185,12 +185,12 @@ let render let for_each_level level = Col.headers_at_level ~level mega_group |> List.filter_map ~f:(function - (* empty groups have a colspan of 0, don't include them *) - | _, _, 0 -> None - | node, attrs, colspan -> - let node = Option.value node ~default:Vdom.Node.none in - let cell_attr = [ Vdom.Attr.colspan colspan; Vdom.Attr.many attrs ] in - Some (Raw.header_cell ~attrs:cell_attr [ node ])) + (* empty groups have a colspan of 0, don't include them *) + | _, _, 0 -> None + | node, attrs, colspan -> + let node = Option.value node ~default:Vdom.Node.none in + let cell_attr = [ Vdom.Attr.colspan colspan; Vdom.Attr.many attrs ] in + Some (Raw.header_cell ~attrs:cell_attr [ node ])) |> Raw.header_row in let header_rows = List.map (List.range ~stride:(-1) (depth - 1) 0) ~f:for_each_level in @@ -199,9 +199,9 @@ let render let extra_row_attrs = row_attrs row in renderers |> List.map ~f:(fun f -> - match f theme row with - | None -> Raw.data_cell ~attrs:[ body_cell_empty ] [] - | Some (cell, extra_cell_attrs) -> Raw.data_cell ~attrs:extra_cell_attrs [ cell ]) + match f theme row with + | None -> Raw.data_cell ~attrs:[ body_cell_empty ] [] + | Some (cell, extra_cell_attrs) -> Raw.data_cell ~attrs:extra_cell_attrs [ cell ]) |> Raw.data_row ~attrs:extra_row_attrs in let data_rows = List.map xs ~f:for_each_row in @@ -211,9 +211,9 @@ let render (* Default styling *) module Default_table_styling = - [%css - stylesheet - {| +[%css +stylesheet + {| .table { background-color: var(--bg); color: var(--fg); diff --git a/web_ui/view/src/tooltip.ml b/web_ui/view/src/tooltip.ml index 431ef855..b64d4a3d 100644 --- a/web_ui/view/src/tooltip.ml +++ b/web_ui/view/src/tooltip.ml @@ -10,9 +10,9 @@ module Direction = struct end module Style = - [%css - stylesheet - {| +[%css +stylesheet + {| .tooltip_container { --dist: 0.3em; @@ -87,12 +87,12 @@ module Style = |}] let make - (constants : Constants.t) - ~container_attrs - ~tooltip_attrs - ~direction - ~tipped - ~tooltip + (constants : Constants.t) + ~container_attrs + ~tooltip_attrs + ~direction + ~tipped + ~tooltip = let dir_class = match (direction : Direction.t) with diff --git a/web_ui/visibility/bonsai_web_ui_visibility.ml b/web_ui/visibility/bonsai_web_ui_visibility.ml index 14250190..f38eb4c0 100644 --- a/web_ui/visibility/bonsai_web_ui_visibility.ml +++ b/web_ui/visibility/bonsai_web_ui_visibility.ml @@ -37,9 +37,9 @@ module T = struct end let process_entries - (state : State.t Lazy.t) - (entries : IntersectionObserver.intersectionObserverEntry Js.t Js.js_array Js.t) - _observer + (state : State.t Lazy.t) + (entries : IntersectionObserver.intersectionObserverEntry Js.t Js.js_array Js.t) + _observer = let state = Lazy.force state in Array.iter (Js.to_array entries) ~f:(fun entry -> diff --git a/web_ui/widget/src/bonsai_web_ui_widget.ml b/web_ui/widget/src/bonsai_web_ui_widget.ml index 7145fff8..a788c56b 100644 --- a/web_ui/widget/src/bonsai_web_ui_widget.ml +++ b/web_ui/widget/src/bonsai_web_ui_widget.ml @@ -104,10 +104,10 @@ module type S = sig end let component - (type input state) - ?(vdom_for_testing = fun _ -> Vdom.Node.create "widget" []) - (module M : S with type input = input and type state = state) - input + (type input state) + ?(vdom_for_testing = fun _ -> Vdom.Node.create "widget" []) + (module M : S with type input = input and type state = state) + input = let%sub id = Bonsai.Expert.thunk (fun () -> Type_equal.Id.create ~name:"widget" sexp_of_opaque) diff --git a/web_ui/widget/src/bonsai_web_ui_widget.mli b/web_ui/widget/src/bonsai_web_ui_widget.mli index 173ba026..0cf7bfd0 100644 --- a/web_ui/widget/src/bonsai_web_ui_widget.mli +++ b/web_ui/widget/src/bonsai_web_ui_widget.mli @@ -26,10 +26,10 @@ end type ('input, 'state) t = private { view : Vdom.Node.t (** The view of the widget *) ; modify : ('input -> 'state -> unit) -> unit Effect.t - (** A callback for modifying the widget. The most recent inputs and the current state + (** A callback for modifying the widget. The most recent inputs and the current state of the widgets are provided. *) ; read : 'a. ('input -> 'state -> 'a) -> 'a list Effect.t - (** [read] lets you look at the most recent input and current state of any instances + (** [read] lets you look at the most recent input and current state of any instances of the widget. *) }