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
|
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
|
