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 --- 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 ++++---- 6 files changed, 136 insertions(+), 163 deletions(-) (limited to 'lib/elements') 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 -- cgit v1.2.3