aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xcss/dune2
-rwxr-xr-xcss/merger.ml2
-rwxr-xr-xlib/application/dune2
-rwxr-xr-xlib/blog/dune2
-rwxr-xr-xlib/elements/dune2
-rwxr-xr-xlib/elements/input.ml2
-rwxr-xr-xlib/elements/popup.ml191
-rwxr-xr-xlib/elements/timer.ml63
-rwxr-xr-xlib/elements/timer.mli9
-rwxr-xr-xlib/elements/transfert.ml32
-rwxr-xr-xlib/js_lib/dune2
-rw-r--r--motus/js/dune2
-rw-r--r--motus/js/fieldList.ml2
-rw-r--r--motus/js/motus.ml67
-rwxr-xr-xscript.it/script.ml27
-rwxr-xr-xscript.it/state/dune2
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 14:23:39 +0000