summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rwxr-xr-xlib/application/application.ml1
-rwxr-xr-xlib/elements/input.ml88
-rwxr-xr-xlib/elements/transfert.ml73
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