From 9e7f27c60a425e2baa67cd459d8509a43b1d123d Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 8 Aug 2023 10:40:52 +0200 Subject: Update to brr 0.0.6 --- css/dune | 2 +- css/merger.ml | 2 +- lib/application/dune | 2 +- lib/blog/dune | 2 +- lib/elements/dune | 2 +- lib/elements/input.ml | 2 +- lib/elements/popup.ml | 191 ++++++++++++++++++++++------------------------ lib/elements/timer.ml | 63 +++++++-------- lib/elements/timer.mli | 9 +-- lib/elements/transfert.ml | 32 ++++---- lib/js_lib/dune | 2 +- motus/js/dune | 2 +- motus/js/fieldList.ml | 2 +- motus/js/motus.ml | 67 +++++++--------- script.it/script.ml | 27 +++---- script.it/state/dune | 2 +- 16 files changed, 185 insertions(+), 224 deletions(-) diff --git a/css/dune b/css/dune index 1e32b19..eefb3cd 100755 --- a/css/dune +++ b/css/dune @@ -2,7 +2,7 @@ (name merger) (libraries brr - brr.note + note.brr elements blog application diff --git a/css/merger.ml b/css/merger.ml index 24c10a3..202b3d8 100755 --- a/css/merger.ml +++ b/css/merger.ml @@ -2,7 +2,7 @@ open StdLabels open Js_of_ocaml open Brr open Note -open Brr_note +open Note_brr module Printer = Css_lib.Print let min = Printer.minify_printer diff --git a/lib/application/dune b/lib/application/dune index f403b24..a43aaf3 100755 --- a/lib/application/dune +++ b/lib/application/dune @@ -3,6 +3,6 @@ (libraries brr note - brr.note + note.brr ) ) diff --git a/lib/blog/dune b/lib/blog/dune index 648990f..68e31f6 100755 --- a/lib/blog/dune +++ b/lib/blog/dune @@ -12,7 +12,7 @@ (name blog) (libraries brr - brr.note + note.brr elements ) (preprocess (pps ppx_hash)) diff --git a/lib/elements/dune b/lib/elements/dune index 97d0753..97cca4c 100755 --- a/lib/elements/dune +++ b/lib/elements/dune @@ -2,7 +2,7 @@ (name elements) (libraries brr - brr.note + note.brr js_of_ocaml ) (preprocess (pps ppx_hash js_of_ocaml-ppx)) diff --git a/lib/elements/input.ml b/lib/elements/input.ml index 8c4bcea..2a60625 100755 --- a/lib/elements/input.ml +++ b/lib/elements/input.ml @@ -1,6 +1,6 @@ open Brr -open Brr_note open Note +open Note_brr (** Create a slider element, and a signal with the value. diff --git a/lib/elements/popup.ml b/lib/elements/popup.ml index 28c414e..7b65661 100755 --- a/lib/elements/popup.ml +++ b/lib/elements/popup.ml @@ -1,104 +1,93 @@ open Brr -open Brr_note +open Note_brr module Js = Js_of_ocaml.Js -let create: - ?form:('a Note.signal * El.t) - -> ?valid_on:(bool Note.signal) - -> title:Jstr.t - -> unit - -> 'a option Note.event - = fun ?form ?valid_on ~title () -> - - (* Ensure we keep a track for the signal event. - - This looks a bit like the old memory magment in C, as it require to - destroy the logger each time the popup is removed. *) - let log_opt = Option.map - (fun (values, _) -> Note.S.log values (fun _ -> ())) - form in - - let close_btn = - El.span - ~at:At.[class' (Jstr.v "modal-close")] - [ El.txt' "×"] - - and submit_btn = El.input () - ~at:At.[type' (Jstr.v "submit")] in - - begin match valid_on with - | None -> () - | Some s -> - Elr.def_at - (Jstr.v "disabled") - (Note.S.map - (fun value -> if (not value) then Some (Jstr.empty) else None) - s) - submit_btn - end; - - let container = match form with - | None -> El.div - | Some _ -> El.form - - and body = match form with - | None -> El.div [] - | Some (_, content) -> content - - and footer = match form with - | None -> El.txt Jstr.empty - | Some _ -> - - El.div [ submit_btn ] - ~at:At.[class' (Jstr.v "row")] in - - (* HTML Element creation *) - let el = El.div - ~at:At.[class' (Jstr.v "modal")] - [ container - ~at:At.[class' (Jstr.v "modal-content")] - [ El.div - ~at:At.[class' (Jstr.v "modal-header")] - [ close_btn - ; El.h3 - [ El.txt title ]] - ; El.div - ~at:At.[class' (Jstr.v "modal-body")] - [ body ] - ; El.div - ~at:At.[class' (Jstr.v "modal-footer")] - [ footer ]]] in - - let () = El.append_children (Document.body G.document) - [ el ] in - - (* Add the focus to the first input element inside the form *) - let () = match form with - | Some (_, el) when El.is_el el -> - begin match (El.find_by_tag_name ~root:el (Jstr.v "input")) with - | [] -> () - | hd::_ -> El.set_has_focus true hd - end - | _ -> () - in - - (* Event handler *) - let close_event = Evr.on_el - Ev.click - (fun _ -> - El.remove el; - Option.iter Note.Logr.destroy log_opt; - None) - close_btn - - and submit_event = Evr.on_el - Ev.click - (fun _ -> - El.remove el; - Option.iter Note.Logr.destroy log_opt; - Option.map (fun v -> Note.S.value (fst v)) form) - submit_btn in - - Note.E.select - [ close_event - ; submit_event ] +let create : + ?form:'a Note.signal * El.t + -> ?valid_on:bool Note.signal + -> title:Jstr.t + -> unit + -> 'a option Note.event = + fun ?form ?valid_on ~title () -> + (* Ensure we keep a track for the signal event. + + This looks a bit like the old memory magment in C, as it require to + destroy the logger each time the popup is removed. *) + let log_opt = + Option.map (fun (values, _) -> Note.S.log values (fun _ -> ())) form + in + + let close_btn = + El.span ~at:At.[ class' (Jstr.v "modal-close") ] [ El.txt' "×" ] + and submit_btn = El.input () ~at:At.[ type' (Jstr.v "submit") ] in + + (match valid_on with + | None -> () + | Some s -> + Elr.def_at (Jstr.v "disabled") + (Note.S.map + (fun value -> if not value then Some Jstr.empty else None) + s) + submit_btn); + + let container = + match form with + | None -> El.div + | Some _ -> El.form + and body = + match form with + | None -> El.div [] + | Some (_, content) -> content + and footer = + match form with + | None -> El.txt Jstr.empty + | Some _ -> El.div [ submit_btn ] ~at:At.[ class' (Jstr.v "row") ] + in + + (* HTML Element creation *) + let el = + El.div + ~at:At.[ class' (Jstr.v "modal") ] + [ + container + ~at:At.[ class' (Jstr.v "modal-content") ] + [ + El.div + ~at:At.[ class' (Jstr.v "modal-header") ] + [ close_btn; El.h3 [ El.txt title ] ] + ; El.div ~at:At.[ class' (Jstr.v "modal-body") ] [ body ] + ; El.div ~at:At.[ class' (Jstr.v "modal-footer") ] [ footer ] + ] + ] + in + + let () = El.append_children (Document.body G.document) [ el ] in + + (* Add the focus to the first input element inside the form *) + let () = + match form with + | Some (_, el) when El.is_el el -> ( + match El.find_by_tag_name ~root:el (Jstr.v "input") with + | [] -> () + | hd :: _ -> El.set_has_focus true hd) + | _ -> () + in + + (* Event handler *) + let close_event = + Evr.on_el Ev.click + (fun _ -> + El.remove el; + Option.iter Note.Logr.destroy log_opt; + None) + close_btn + and submit_event = + Evr.on_el Ev.click + (fun _ -> + El.remove el; + Option.iter Note.Logr.destroy log_opt; + Option.map (fun v -> Note.S.value (fst v)) form) + submit_btn + in + + Note.E.select [ close_event; submit_event ] diff --git a/lib/elements/timer.ml b/lib/elements/timer.ml index 28516fc..60872db 100755 --- a/lib/elements/timer.ml +++ b/lib/elements/timer.ml @@ -1,38 +1,31 @@ -open Brr_note_kit +open Note_brr_kit -type t = - { mutable id : Brr.G.timer_id +type t = { + mutable id : Brr.G.timer_id ; send : float Note.E.send ; mutable counter : Time.counter - } - -let create - : unit -> (t * Brr_note_kit.Time.span Note.E.t) - = fun () -> - let event, send = Note.E.create () - and counter = (Time.counter ()) in - {id = (-1); send; counter}, event - -let stop - : t -> unit - = fun {id; _} -> - Brr.G.stop_timer id - -let start - : t -> float -> unit - = fun t d -> - let {id; send; _} = t in - t.counter <- Time.counter (); - - Brr.G.stop_timer id; - let timer_id = Brr.G.set_interval - ~ms:(int_of_float @@ d *. 1000.) - (fun () -> - - let span = Time.counter_value t.counter in - send span) in - t.id <- timer_id - - -let delay : t -> float - = fun t -> Time.counter_value t.counter +} + +let create : unit -> t * Note_brr_kit.Time.span Note.E.t = + fun () -> + let event, send = Note.E.create () and counter = Time.counter () in + ({ id = -1; send; counter }, event) + +let stop : t -> unit = fun { id; _ } -> Brr.G.stop_timer id + +let start : t -> float -> unit = + fun t d -> + let { id; send; _ } = t in + t.counter <- Time.counter (); + + Brr.G.stop_timer id; + let timer_id = + Brr.G.set_interval + ~ms:(int_of_float @@ (d *. 1000.)) + (fun () -> + let span = Time.counter_value t.counter in + send span) + in + t.id <- timer_id + +let delay : t -> float = fun t -> Time.counter_value t.counter diff --git a/lib/elements/timer.mli b/lib/elements/timer.mli index 0509ad0..384243c 100755 --- a/lib/elements/timer.mli +++ b/lib/elements/timer.mli @@ -1,11 +1,8 @@ -open Brr_note_kit +open Note_brr_kit type t val create : unit -> t * Time.span Note.E.t - -val start: t -> float -> unit - -val stop: t -> unit - +val start : t -> float -> unit +val stop : t -> unit val delay : t -> float diff --git a/lib/elements/transfert.ml b/lib/elements/transfert.ml index 878af2d..6eb85f9 100755 --- a/lib/elements/transfert.ml +++ b/lib/elements/transfert.ml @@ -11,7 +11,6 @@ let send_raw : filename:Jstr.t -> Jstr.t -> unit = in El.click a - (** Send a file to the user. *) let send : mime_type:Jstr.t -> filename:Jstr.t -> Jstr.t -> unit = fun ~mime_type ~filename content -> @@ -20,35 +19,30 @@ let send : mime_type:Jstr.t -> filename:Jstr.t -> Jstr.t -> unit = let data = Jv.to_jstr - @@ Jv.call - (Jv.of_string "data:") - "concat" + @@ Jv.call (Jv.of_string "data:") "concat" [| Jv.of_jstr mime_type; Jv.of_jstr (Jstr.v ";base64,"); base64data |] in send_raw ~filename data - (** Load the content at the given URL and return it The response body is only loaded if the result code is 200 *) let get_content_from_url : string -> (int * Jstr.t, Jv.Error.t) result Note.event = fun resource -> - Brr_io.Fetch.Request.v (Jstr.v resource) - |> Brr_io.Fetch.request - |> fun f -> + Brr_io.Fetch.Request.v (Jstr.v resource) |> Brr_io.Fetch.request |> fun f -> Fut.bind f (fun result -> match result with | Error e -> Fut.return (Error e) - | Ok response -> - (* Check the status before loading the response itself *) - ( match Brr_io.Fetch.Response.status response with - | 200 -> - Brr_io.Fetch.Response.as_body response - |> Brr_io.Fetch.Body.text - |> Fut.map - (Result.map (fun v -> - (Brr_io.Fetch.Response.status response, v) ) ) - | other -> Fut.return (Ok (other, Jstr.empty)) ) ) - |> Brr_note.Futr.to_event + | Ok response -> ( + (* Check the status before loading the response itself *) + match Brr_io.Fetch.Response.status response with + | 200 -> + Brr_io.Fetch.Response.as_body response + |> Brr_io.Fetch.Body.text + |> Fut.map + (Result.map (fun v -> + (Brr_io.Fetch.Response.status response, v))) + | other -> Fut.return (Ok (other, Jstr.empty)))) + |> Note_brr.Futr.to_event diff --git a/lib/js_lib/dune b/lib/js_lib/dune index 131a4bf..92c0186 100755 --- a/lib/js_lib/dune +++ b/lib/js_lib/dune @@ -2,7 +2,7 @@ (name js_lib) (libraries brr - brr.note + note.brr js_of_ocaml ) (preprocess (pps js_of_ocaml-ppx)) diff --git a/motus/js/dune b/motus/js/dune index 9dd3113..b7b511a 100644 --- a/motus/js/dune +++ b/motus/js/dune @@ -2,7 +2,7 @@ (name motus) (libraries brr - brr.note + note.brr application elements motus_lib diff --git a/motus/js/fieldList.ml b/motus/js/fieldList.ml index 5af5e92..7453bf5 100644 --- a/motus/js/fieldList.ml +++ b/motus/js/fieldList.ml @@ -1,6 +1,6 @@ open Brr open Note -open Brr_note +open Note_brr open StdLabels type elements = Brr.El.t list diff --git a/motus/js/motus.ml b/motus/js/motus.ml index 5e1252a..47ea15c 100644 --- a/motus/js/motus.ml +++ b/motus/js/motus.ml @@ -1,5 +1,5 @@ open Brr -open Brr_note +open Note_brr open Motus_lib open Note open StdLabels @@ -7,18 +7,15 @@ open StdLabels let ( let=? ) : 'a option -> ('a -> unit) -> unit = fun f opt -> Option.iter opt f - let get_int_value element = let value = El.prop El.Prop.value element in match Jstr.to_int value with | Some v -> v | None -> 0 - let get_element_by_id id = id |> Jv.Id.of_jv |> Jv.to_jstr |> Brr.Document.find_el_by_id Brr.G.document - let rule_to_element rule = match rule with | Criteria.Lenght l -> @@ -26,7 +23,8 @@ let rule_to_element rule = | Contain (c, None) -> Jstr.concat [ Jstr.v "Doit contenir "; Jstr.of_char c ] | Contain (c, Some l) -> Jstr.concat - [ Jstr.v "Doit contenir " + [ + Jstr.v "Doit contenir " ; Jstr.of_char c ; Jstr.v " à la position " ; Jstr.of_int l @@ -35,22 +33,15 @@ let rule_to_element rule = Jstr.concat [ Jstr.v "Ne doit pas contenir "; Jstr.of_char c ] | NotContain (c, Some l) -> Jstr.concat - [ Jstr.v "Ne doit pas contenir " + [ + Jstr.v "Ne doit pas contenir " ; Jstr.of_char c ; Jstr.v " à la position " ; Jstr.of_int l ] - -let main - length_id - send_id - dictionnary_id - proposition_id - rules_id - table_id - next_btn_id - reload = +let main length_id send_id dictionnary_id proposition_id rules_id table_id + next_btn_id reload = let=? length_element = get_element_by_id length_id in let=? send_btn = get_element_by_id send_id in let=? dictionnary_element = get_element_by_id dictionnary_id in @@ -69,8 +60,7 @@ let main let initial_prop = FieldList.build proposition_element length_signal in let start_event = - Evr.on_el - Ev.click + Evr.on_el Ev.click (fun _ -> (* Load the appropriate dictionnary *) let dict_value = @@ -89,7 +79,7 @@ let main |> E.map (fun html_response -> State.App.dispatch (module Initialize) - Initialize.{ length; html_response; sender; proposition } ) ) + Initialize.{ length; html_response; sender; proposition })) send_btn |> E.join in @@ -99,7 +89,7 @@ let main (fun (position, letter, validity) -> State.App.dispatch (module UpdateProposition) - UpdateProposition.{ position; letter; validity } ) + UpdateProposition.{ position; letter; validity }) change_event in @@ -112,37 +102,34 @@ let main in let ev = - State.App.run - ~eq:State.eq - (State.init ()) + State.App.run ~eq:State.eq (State.init ()) (E.select - [ start_event (* Load a fresh dictionnary and start a new analysis *) + [ + start_event (* Load a fresh dictionnary and start a new analysis *) ; change_event' (* Update the proposition *) ; btn_event (* Next line *) ; update_event - ] ) + ]) in (* Display all the rules on the right side *) - Elr.def_children - rules_element + Elr.def_children rules_element (S.map (fun State.{ rules; current_prop; _ } -> let prev_rules = List.map rules ~f:(fun e -> let message = rule_to_element e in - El.li [ El.txt message ] ) + El.li [ El.txt message ]) and new_rules = List.map (State.get_current_rules current_prop) ~f:(fun e -> let message = rule_to_element e in - El.li [ El.txt message ] ) + El.li [ El.txt message ]) in - [ El.div prev_rules; El.hr (); El.div new_rules ] ) - ev ); + [ El.div prev_rules; El.hr (); El.div new_rules ]) + ev); (* Create the letter table *) - Elr.def_children - table_element + Elr.def_children table_element (S.map (fun State.{ propositions; fields; _ } -> let props = propositions in @@ -156,18 +143,19 @@ let main El.input ~at: At. - [ type' (Jstr.v "text") + [ + type' (Jstr.v "text") ; v (Jstr.v "maxLength") (Jstr.v "1") ; value letter ; class' (FieldList.get_class validity) ] () in - El.td [ input ] ) - |> El.tr ) + El.td [ input ]) + |> El.tr) in - El.tr fields :: previous ) - ev ); + El.tr fields :: previous) + ev); let last_element = S.map @@ -176,7 +164,7 @@ let main (ev.State.current_prop, Motus_lib.Wordlist.list_size ev.State.analysis) with | [], _ | _, 1 -> Some (Jstr.v "true") - | _, _ -> None ) + | _, _ -> None) ev in @@ -192,7 +180,6 @@ let main Logr.hold (S.log initial_prop log); Logr.hold (S.log ev log) - let () = let open Jv in let main = obj [| ("run", repr main) |] in diff --git a/script.it/script.ml b/script.it/script.ml index fffc589..5fb4e5c 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -1,7 +1,7 @@ open StdLabels open Note open Brr -open Brr_note +open Note_brr module State = Script_state.State module Selection = Script_state.Selection module Path = Script_path @@ -40,21 +40,21 @@ let canva : (* Mouse events *) let mouse = - Brr_note_kit.Mouse.on_el ~normalize:false (fun x y -> (x, y)) element + Note_brr_kit.Mouse.on_el ~normalize:false (fun x y -> (x, y)) element in let click = - Brr_note_kit.Mouse.left_down mouse |> E.map (fun c -> `MouseDown c) + Note_brr_kit.Mouse.left_down mouse |> E.map (fun c -> `MouseDown c) in - let up = Brr_note_kit.Mouse.left_up mouse |> E.map (fun c -> `Out c) in + let up = Note_brr_kit.Mouse.left_up mouse |> E.map (fun c -> `Out c) in - let position = Brr_note_kit.Mouse.pos mouse in + let position = Note_brr_kit.Mouse.pos mouse in let pos = S.l2 (fun b pos -> if b then Some pos else None) - (Brr_note_kit.Mouse.left mouse) + (Note_brr_kit.Mouse.left mouse) position in @@ -361,13 +361,14 @@ let page_main id = let my_host = Uri.host @@ Window.location @@ G.window in (if Hashtbl.hash my_host = Blog.Hash_host.expected_host then - let target = Brr_webworkers.Worker.as_target worker in - let _ = - Ev.listen Brr_io.Message.Ev.message - (fun t -> Ev.as_type t |> Brr_io.Message.Ev.data |> worker_send) - target - in - ()); + let target = Brr_webworkers.Worker.as_target worker in + let _ = + Ev.listen Brr_io.Message.Ev.message + (fun t -> + Ev.as_type t |> Brr_io.Message.Ev.data |> worker_send) + target + in + ()); (* Add the events to the canva : diff --git a/script.it/state/dune b/script.it/state/dune index d838c04..cfe6b99 100755 --- a/script.it/state/dune +++ b/script.it/state/dune @@ -2,7 +2,7 @@ (name script_state) (libraries brr - brr.note + note.brr blog application worker_messages -- cgit v1.2.3