diff options
Diffstat (limited to 'lib')
| -rwxr-xr-x | lib/application/application.ml | 1 | ||||
| -rwxr-xr-x | lib/elements/input.ml | 88 | ||||
| -rwxr-xr-x | lib/elements/transfert.ml | 73 |
3 files changed, 90 insertions, 72 deletions
diff --git a/lib/application/application.ml b/lib/application/application.ml index b6ece93..8787d39 100755 --- a/lib/application/application.ml +++ b/lib/application/application.ml @@ -18,6 +18,7 @@ struct in Note.S.accum ?eq init action + let dispatch : (module Procesor with type t = 's) -> 's -> event = fun (type s) (module P : Procesor with type t = s) v -> E (v, (module P)) end diff --git a/lib/elements/input.ml b/lib/elements/input.ml index 62175d5..5def7d4 100755 --- a/lib/elements/input.ml +++ b/lib/elements/input.ml @@ -2,25 +2,26 @@ open Brr open Brr_note open Note -(** Create a slider element, and a signal with the value *) -let slider - : at:Brr.At.t list -> Brr.El.t * float S.t - - = fun ~at -> - let slider = - El.input ~at () in - - let init_value = (Jstr.to_float (El.prop El.Prop.value slider)) in - - let event = - Evr.on_el - Ev.input (fun _ -> - let raw_value = El.prop El.Prop.value slider in - Jstr.to_float raw_value) - slider - |> S.hold init_value - in - slider, event +(** Create a slider element, and a signal with the value. + + [at] is the attribute list given to the element *) +let slider : at:Brr.At.t list -> Brr.El.t * float S.t = + fun ~at -> + let slider = El.input ~at () in + + let init_value = Jstr.to_float (El.prop El.Prop.value slider) in + + let event = + Evr.on_el + Ev.input + (fun _ -> + let raw_value = El.prop El.Prop.value slider in + Jstr.to_float raw_value ) + slider + |> S.hold init_value + in + (slider, event) + type file = { file : File.t @@ -28,15 +29,13 @@ type file = } (** Read the content from the file *) -let file_loader - : file Note.E.send -> File.t -> unit - = fun event file -> - let blob = File.as_blob file in - Fut.await - (Blob.text blob) - (Result.iter - (fun content -> - event ({file; content}) )) +let file_loader : file Note.E.send -> File.t -> unit = + fun event file -> + let blob = File.as_blob file in + Fut.await + (Blob.text blob) + (Result.iter (fun content -> event { file; content })) + (** Create an imput which load a file. @@ -44,27 +43,22 @@ let file_loader files, and an event which gives access to the file. *) -let file_loader - : Jstr.t -> Brr.El.t * file Note.event - = fun selector -> - - let add_file_event, add_file_sender = Note.E.create () in +let file_loader : Jstr.t -> Brr.El.t * file Note.event = + fun selector -> + let add_file_event, add_file_sender = Note.E.create () in - let i = El.input () - ~at:[ At.type' (Jstr.v "file") - ; (At.v (Jstr.v "accept")) selector - ] in + let i = + El.input + () + ~at:[ At.type' (Jstr.v "file"); (At.v (Jstr.v "accept")) selector ] + in - (* The event return a list of files. + (* The event return a list of files. - We are only interested by a single on, and keep only the first from the - list. *) - let on_change files = - file_loader add_file_sender (List.hd files) in + We are only interested by a single on, and keep only the first from the + list. *) + let on_change files = file_loader add_file_sender (List.hd files) in - Ev.listen - Ev.change - (fun _e -> on_change (El.Input.files i)) (El.as_target i); + Ev.listen Ev.change (fun _e -> on_change (El.Input.files i)) (El.as_target i); - ( i - , add_file_event ) + (i, add_file_event) diff --git a/lib/elements/transfert.ml b/lib/elements/transfert.ml index 3001e32..878af2d 100755 --- a/lib/elements/transfert.ml +++ b/lib/elements/transfert.ml @@ -1,31 +1,54 @@ open Brr -let send_raw - : filename:Jstr.t -> Jstr.t -> unit - = fun ~filename data -> - (* Create the link to download the the element, and simulate a click on it *) - let a = El.a - ~at:At.[ href Jv.Id.(of_jv @@ to_jv data) - ; v (Jstr.v "download") filename ] - [] in - El.click a +let send_raw : filename:Jstr.t -> Jstr.t -> unit = + fun ~filename data -> + (* Create the link to download the the element, and simulate a click on it *) + let a = + El.a + ~at: + At.[ href Jv.Id.(of_jv @@ to_jv data); v (Jstr.v "download") filename ] + [] + 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 -> - let btoa = Jv.get Jv.global "btoa" in - let base64data = Jv.apply btoa - [| Jv.of_jstr content |] in +let send : mime_type:Jstr.t -> filename:Jstr.t -> Jstr.t -> unit = + fun ~mime_type ~filename content -> + let btoa = Jv.get Jv.global "btoa" in + let base64data = Jv.apply btoa [| Jv.of_jstr content |] in + + let data = + Jv.to_jstr + @@ Jv.call + (Jv.of_string "data:") + "concat" + [| Jv.of_jstr mime_type; Jv.of_jstr (Jstr.v ";base64,"); base64data |] + in + + send_raw ~filename data - let data = Jv.to_jstr @@ 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 -> + 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 |