aboutsummaryrefslogtreecommitdiff
path: root/motus/js/motus.ml
blob: 5e1252aacc42959cfde40644e809ddb578820505 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
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 html_response ->
               State.App.dispatch
                 (module Initialize)
                 Initialize.{ length; html_response; 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, Validity.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, Motus_lib.Wordlist.list_size ev.State.analysis)
        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