1 files changed, 197 insertions, 0 deletions
diff --git a/motus/js/motus.ml b/motus/js/motus.ml
new file mode 100644
index 0000000..f2995df
--- /dev/null
+++ b/motus/js/motus.ml
@@ -0,0 +1,197 @@
+open Brr
+open Brr_note
+open Motus_lib
+open Note
+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 ->
+      Jstr.concat [ Jstr.v "Doit etre de longueur "; Jstr.of_int l ]
+  | Contain (c, None) -> Jstr.concat [ Jstr.v "Doit contenir "; Jstr.of_char c ]
+  | Contain (c, Some l) ->
+      Jstr.concat
+        [ Jstr.v "Doit contenir "
+        ; Jstr.of_char c
+        ; Jstr.v " à la position "
+        ; Jstr.of_int l
+        ]
+  | NotContain (c, None) ->
+      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.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=? 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
+  let=? proposition_element = get_element_by_id proposition_id in
+  let=? rules_element = get_element_by_id rules_id in
+  let=? table_element = get_element_by_id table_id in
+  let=? next_btn = get_element_by_id next_btn_id in
+  let=? reload = get_element_by_id reload in
+
+  let change_event, sender = E.create () in
+
+  let length_event =
+    Evr.on_el Ev.change (fun _ -> get_int_value length_element) length_element
+  in
+  let length_signal = S.hold (get_int_value length_element) length_event in
+  let initial_prop = FieldList.build proposition_element length_signal in
+
+  let start_event =
+    Evr.on_el
+      Ev.click
+      (fun _ ->
+        (* Load the appropriate dictionnary *)
+        let dict_value =
+          El.prop El.Prop.value dictionnary_element |> Jstr.to_string
+        in
+        let length = get_int_value length_element in
+        let words =
+          match dict_value with
+          | "english" -> "./dicts/american-english_" ^ string_of_int length
+          | _ -> "./dicts/french_" ^ string_of_int length
+        in
+
+        let proposition = S.value initial_prop in
+
+        Elements.Transfert.get_content_from_url words
+        |> E.map (fun content ->
+               State.App.dispatch
+                 (module Initialize)
+                 Initialize.{ length; content; sender; proposition } ) )
+      send_btn
+    |> E.join
+  in
+
+  let change_event' =
+    E.map
+      (fun (position, letter, validity) ->
+        State.App.dispatch
+          (module UpdateProposition)
+          UpdateProposition.{ position; letter; validity } )
+      change_event
+  in
+
+  let btn_event =
+    Evr.on_el Ev.click (fun _ -> State.App.dispatch (module Next) ()) next_btn
+  in
+
+  let update_event =
+    Evr.on_el Ev.click (fun _ -> State.App.dispatch (module Reload) ()) reload
+  in
+
+  let ev =
+    State.App.run
+      ~eq:State.eq
+      (State.init ())
+      (E.select
+         [ 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
+    (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 ] )
+         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 ] )
+         in
+         [ El.div prev_rules; El.hr (); El.div new_rules ] )
+       ev );
+
+  (* Create the letter table *)
+  Elr.def_children
+    table_element
+    (S.map
+       (fun State.{ propositions; fields; _ } ->
+         let props = propositions in
+         let previous =
+           List.map props ~f:(fun proposition ->
+               List.map proposition ~f:(fun prop ->
+                   let letter, validity =
+                     Option.value ~default:(Jstr.empty, State.Missing) prop
+                   in
+                   let input =
+                     El.input
+                       ~at:
+                         At.
+                           [ type' (Jstr.v "text")
+                           ; v (Jstr.v "maxLength") (Jstr.v "1")
+                           ; value letter
+                           ; class' (FieldList.get_class validity)
+                           ]
+                       ()
+                   in
+                   El.td [ input ] )
+               |> El.tr )
+         in
+         El.tr fields :: previous )
+       ev );
+
+  let last_element =
+    S.map
+      (fun ev ->
+        match (ev.State.current_prop, ev.State.analysis.number) with
+        | [], _ | _, 1 -> Some (Jstr.v "true")
+        | _, _ -> None )
+      ev
+  in
+
+  (* Hide the next btn when there is no proposition *)
+  Elr.def_at (Jstr.v "hidden") last_element next_btn;
+  Elr.def_at (Jstr.v "hidden") last_element reload;
+
+  let log state =
+    ignore state;
+    ()
+  in
+
+  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
+  set global "lib" main