Skip to content

Commit 91f827b

Browse files
AltGrAltGr
committed
feat(UI): Rework of the exercise index
* Sort dynamically without lengthy reload * Keep the exercise tree and make it collapsible * Add a filter box An option to show exercises that have already been started would be nice as well
1 parent 25780ba commit 91f827b

File tree

3 files changed

+354
-232
lines changed

3 files changed

+354
-232
lines changed

‎src/app/learnocaml_index_main.ml

Lines changed: 205 additions & 133 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,8 @@ module El = struct
5757
(** Elements that are dynamically created (ids only) *)
5858
let exercise_list_id = "learnocaml-main-exercise-list"
5959
let exercise_bar = "learnocaml-main-exercise-bar"
60+
let exercise_pane = "learnocaml-main-exercise-pane"
61+
let filter_box = "learnocaml-filter-box"
6062
let tutorial_id = "learnocaml-main-tutorial"
6163
let lesson_id = "learnocaml-main-lesson"
6264
let toplevel_id = "learnocaml-main-toplevel"
@@ -75,151 +77,221 @@ let get_url token dynamic_url static_url id =
7577
| Some _ -> dynamic_url ^ Url.urlencode id ^ "/"
7678
| None -> api_server ^ "/" ^ static_url ^ Url.urlencode id
7779

78-
let exercises_display index display construct_exo =
79-
let open Tyxml_js.Html5 in
80-
let rec display_by_legacy lvl acc contents =
81-
match contents with
82-
| Exercise.Index.Exercises exercises ->
83-
List.fold_left
84-
(fun acc (exercise_id, meta_opt) ->
85-
match meta_opt with
86-
| None -> acc
87-
| Some meta -> construct_exo exercise_id meta :: acc)
88-
acc exercises
89-
| Exercise.Index.Groups groups ->
90-
let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in
91-
List.fold_left
92-
(fun acc (_, Exercise.Index.{ title ; contents }) ->
93-
display_by_legacy (succ lvl)
94-
(h ~a:[ a_class [ "pack" ] ] [ txt title ] :: acc)
95-
contents)
96-
acc groups
97-
in
98-
let display_by_stars index =
99-
let cat1,cat2,cat3,cat4 = "1 star","2 stars","3 stars","4 stars" in
100-
let add acc id meta =
101-
let stars = meta.Exercise.Meta.stars in
102-
let key = if stars <= 1. then cat1 else
103-
if stars <= 2. then cat2 else
104-
if stars <= 3. then cat3 else cat4 in
105-
SMap.update key
106-
(function None -> Some [(id,meta)]
107-
| Some l -> Some ((id,meta) :: l))
108-
acc
80+
type exercise_ordering = By_category | By_prereq | By_difficulty
81+
82+
let (exercise_filter_signal: string option React.signal), set_exercise_filter =
83+
React.S.create None
84+
85+
let (exercise_sort_signal: exercise_ordering React.signal), set_exercise_sort =
86+
React.S.create By_category
87+
88+
let make_exercises_to_display_signal index =
89+
let get_index exo_sort exo_filter =
90+
let index =
91+
match exo_sort with
92+
| By_category -> index
93+
| By_prereq ->
94+
Exercise.Index.Exercises
95+
Exercise.Graph.(compute_graph index |>
96+
fold (fun acc node ->
97+
let id = node_exercise node in
98+
(id, Some (Exercise.Index.find index id)) :: acc
99+
) [] |>
100+
List.rev)
101+
| By_difficulty ->
102+
let module IntMap = Map.Make(Int) in
103+
let starmap =
104+
Exercise.Index.fold_exercises (fun map id meta ->
105+
IntMap.update
106+
(int_of_float (Float.ceil meta.Exercise.Meta.stars))
107+
(function None -> Some [id, Some meta]
108+
| Some l -> Some ((id, Some meta) :: l))
109+
map)
110+
IntMap.empty index
111+
in
112+
let groups =
113+
IntMap.fold (fun stars exercises acc ->
114+
let title =
115+
if stars = 1 then [%i"1 star"]
116+
else Printf.sprintf [%if"%d stars"] stars
117+
in
118+
(title,
119+
{Exercise.Index.title;
120+
contents = Exercise.Index.Exercises (List.rev exercises)})
121+
:: acc)
122+
starmap []
123+
in
124+
Exercise.Index.Groups (List.rev groups)
125+
in
126+
let index =
127+
match exo_filter with
128+
| None -> index
129+
| Some filt_str ->
130+
Exercise.Index.filter (fun _ meta ->
131+
let re = Re.(compile (no_case (str filt_str))) in
132+
List.exists (Re.execp re)
133+
(meta.Exercise.Meta.title ::
134+
Option.to_list meta.Exercise.Meta.short_description @
135+
List.map fst meta.Exercise.Meta.author @
136+
List.map snd meta.Exercise.Meta.author @
137+
meta.Exercise.Meta.focus @
138+
meta.Exercise.Meta.requirements))
139+
index
109140
in
110-
let by_stars = Exercise.Index.fold_exercises add SMap.empty index |> SMap.bindings in
111-
List.map (fun (star_cat,exos) ->
112-
h1 ~a:[ a_class [ "pack" ] ] [ txt star_cat ] ::
113-
List.map (fun (id,meta) -> construct_exo id meta) exos
114-
) by_stars
115-
|> List.flatten
141+
if index = Exercise.Index.Exercises [] then
142+
Exercise.Index.Groups
143+
["empty_group",
144+
{ Exercise.Index.title = [%i"No exercises found"];
145+
Exercise.Index.contents = Exercise.Index.Exercises []; }]
146+
else index
116147
in
117-
match display with
118-
| `By_legacy -> List.rev (display_by_legacy 1 [] index)
119-
| `By_deps ->
120-
Exercise.Graph.(compute_graph index |>
121-
fold (fun acc node ->
122-
let id = node_exercise node in
123-
construct_exo id (Exercise.Index.find index id) :: acc
124-
) [])
125-
| `By_stars -> display_by_stars index
126-
127-
let exercises_tab token : tab_handler=
128-
fun select_f (get,set,_) () ->
148+
React.S.l2 get_index exercise_sort_signal exercise_filter_signal
149+
150+
let retain_signals = ref (React.S.const ())
151+
(* Used to register signals as GC roots *)
152+
153+
let exercises_tab token : tab_handler =
154+
fun _ _ () ->
129155
let open Tyxml_js.Html5 in
130156
show_loading [%i"Loading exercises"] @@ fun () ->
131157
Lwt_js.sleep 0.5 >>= fun () ->
132158
retrieve (Learnocaml_api.Exercise_index token)
133159
>>= fun (index, deadlines) ->
134-
let display =
135-
match get "display" with
136-
| "legacy" -> `By_legacy
137-
| "deps" -> `By_deps
138-
| "stars" -> `By_stars
139-
| exception Not_found | _ -> `By_legacy
160+
let exercises_to_display_signal =
161+
make_exercises_to_display_signal index
140162
in
141-
let format_exercise_list all_exercise_states =
142-
let format_exercise exercise_id {Exercise.Meta.kind; title; short_description; stars; _ } =
143-
let pct_init =
144-
match SMap.find exercise_id all_exercise_states with
145-
| exception Not_found -> None
146-
| { Answer.grade ; _ } -> grade in
147-
let pct_signal, pct_signal_set = React.S.create pct_init in
148-
Learnocaml_local_storage.(listener (exercise_state exercise_id)) :=
149-
Some (function
150-
| Some { Answer.grade ; _ } -> pct_signal_set grade
151-
| None -> pct_signal_set None) ;
152-
let pct_text_signal =
153-
React.S.map
154-
(function
155-
| None -> "--"
156-
| Some 0 -> "0%"
157-
| Some pct -> string_of_int pct ^ "%")
158-
pct_signal in
159-
let time_left = match List.assoc_opt exercise_id deadlines with
160-
| None -> ""
161-
| Some 0. -> [%i"Exercise closed"]
162-
| Some f -> Printf.sprintf [%if"Time left: %s"]
163-
(string_of_seconds (int_of_float f))
164-
in
165-
let status_classes_signal =
166-
React.S.map
167-
(function
168-
| None -> [ "stats" ]
169-
| Some 0 -> [ "stats" ; "failure" ]
170-
| Some pct when pct >= 100 -> [ "stats" ; "success" ]
171-
| Some _ -> [ "stats" ; "partial" ])
172-
pct_signal in
173-
a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ;
174-
a_class [ "exercise" ] ] [
175-
div ~a:[ a_class [ "descr" ] ] (
176-
h1 [ txt title ] ::
177-
begin match short_description with
178-
| None -> []
179-
| Some text -> [ txt text ]
180-
end
181-
);
182-
div ~a:[ a_class [ "time-left" ] ] [H.txt time_left];
183-
div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [
184-
stars_div stars;
185-
div ~a:[ a_class [ "length" ] ] [
186-
match kind with
187-
| Exercise.Meta.Project -> txt [%i"project"]
188-
| Exercise.Meta.Problem -> txt [%i"problem"]
189-
| Exercise.Meta.Exercise -> txt [%i"exercise"] ] ;
190-
div ~a:[ a_class [ "score" ] ] [
191-
Tyxml_js.R.Html5.txt pct_text_signal
192-
]
193-
] ]
194-
in exercises_display index display format_exercise
163+
let all_exercise_states =
164+
Learnocaml_local_storage.(retrieve all_exercise_states)
165+
in
166+
let format_exercise exercise_id {Exercise.Meta.kind; title; short_description; stars; _ } =
167+
let pct_init =
168+
match SMap.find exercise_id all_exercise_states with
169+
| exception Not_found -> None
170+
| { Answer.grade ; _ } -> grade in
171+
let pct_signal, pct_signal_set = React.S.create pct_init in
172+
Learnocaml_local_storage.(listener (exercise_state exercise_id)) :=
173+
Some (function
174+
| Some { Answer.grade ; _ } -> pct_signal_set grade
175+
| None -> pct_signal_set None) ;
176+
let pct_text_signal =
177+
React.S.map
178+
(function
179+
| None -> "--"
180+
| Some 0 -> "0%"
181+
| Some pct -> string_of_int pct ^ "%")
182+
pct_signal in
183+
let time_left = match List.assoc_opt exercise_id deadlines with
184+
| None -> ""
185+
| Some 0. -> [%i"Exercise closed"]
186+
| Some f -> Printf.sprintf [%if"Time left: %s"]
187+
(string_of_seconds (int_of_float f))
188+
in
189+
let status_classes_signal =
190+
React.S.map
191+
(function
192+
| None -> [ "stats" ]
193+
| Some 0 -> [ "stats" ; "failure" ]
194+
| Some pct when pct >= 100 -> [ "stats" ; "success" ]
195+
| Some _ -> [ "stats" ; "partial" ])
196+
pct_signal in
197+
a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ;
198+
a_class [ "exercise" ] ] [
199+
div ~a:[ a_class [ "descr" ] ] (
200+
h1 [ txt title ] ::
201+
begin match short_description with
202+
| None -> []
203+
| Some text -> [ txt text ]
204+
end
205+
);
206+
div ~a:[ a_class [ "time-left" ] ] [H.txt time_left];
207+
div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [
208+
stars_div stars;
209+
div ~a:[ a_class [ "length" ] ] [
210+
match kind with
211+
| Exercise.Meta.Project -> txt [%i"project"]
212+
| Exercise.Meta.Problem -> txt [%i"problem"]
213+
| Exercise.Meta.Exercise -> txt [%i"exercise"] ] ;
214+
div ~a:[ a_class [ "score" ] ] [
215+
Tyxml_js.R.Html5.txt pct_text_signal
216+
]
217+
] ]
218+
in
219+
let rec format_exercise_list index =
220+
match index with
221+
| Exercise.Index.Exercises el ->
222+
H.ul @@
223+
List.map
224+
(fun (id, meta) -> H.li [format_exercise id (Option.get meta)])
225+
el
226+
| Exercise.Index.Groups gl ->
227+
H.ul @@
228+
List.map (fun (id, grp) ->
229+
let clas =
230+
"group-title" ::
231+
match gl with [] | [_] -> [] | _ -> ["collapsed"]
232+
in
233+
let title =
234+
H.div ~a:[a_id id; a_class clas]
235+
[H.txt grp.Exercise.Index.title];
236+
in
237+
let exos = format_exercise_list grp.Exercise.Index.contents in
238+
Manip.Ev.onclick title
239+
(fun _ ->
240+
ignore (Manip.toggleClass title "collapsed");
241+
false);
242+
H.li [title; exos])
243+
gl
244+
in
245+
let exercise_list_signal =
246+
React.S.l1 format_exercise_list exercises_to_display_signal
195247
in
196-
let list_div =
197-
match format_exercise_list Learnocaml_local_storage.(retrieve all_exercise_states) with
198-
| [] -> H.div [H.txt [%i"No open exercises at the moment"]]
199-
| l ->
200-
let btns =
201-
H.div ~a:[ a_id El.Dyn.exercise_bar ] @@
202-
List.map (fun (id, active, name, callback) ->
203-
let btn = button ~a:[a_id id] [ txt name ] in
204-
if active then Manip.addClass btn "active";
205-
Manip.Ev.onclick btn
206-
(fun _ -> ignore @@ callback () ; true);
207-
btn)
208-
[
209-
"by_legacy", display = `By_legacy, [%i"By legacy"],
210-
(fun () -> set "display" "legacy"; select_f ~clear_cache:true ());
211-
"by_deps", display = `By_deps, [%i"By order"],
212-
(fun () -> set "display" "deps"; select_f ~clear_cache:true ());
213-
"by_deps", display = `By_stars, [%i"By stars"],
214-
(fun () -> set "display" "stars"; select_f ~clear_cache:true ())
215-
]
248+
let btns_sigs =
249+
List.map (fun (id, sort, name) ->
250+
let btn = button ~a:[a_id id] [ txt name ] in
251+
Manip.Ev.onclick btn
252+
(fun _ -> set_exercise_sort sort; true);
253+
let signal =
254+
React.S.map (fun s ->
255+
(if sort = s then Manip.addClass else Manip.removeClass)
256+
btn "active"
257+
) exercise_sort_signal
258+
in
259+
btn, signal)
260+
[
261+
"by_category", By_category, [%i"By category"];
262+
"by_prereq", By_prereq, [%i"By prerequisites"];
263+
"by_difficulty", By_difficulty, [%i"By difficulty"];
264+
]
265+
in
266+
let btns, btns_sigs = List.split btns_sigs in
267+
let btns =
268+
btns @
269+
[
270+
let input_field =
271+
H.input ~a:[H.a_input_type `Search] ()
216272
in
217-
H.div ~a:[H.a_id El.Dyn.exercise_list_id]
218-
(btns :: l)
273+
Manip.Ev.oninput input_field (fun _ev ->
274+
set_exercise_filter (Some (Manip.value input_field));
275+
true);
276+
H.div ~a:[H.a_class ["filter-box"]] [input_field];
277+
]
278+
in
279+
let exercise_list_html =
280+
H.div ~a:[H.a_id El.Dyn.exercise_list_id] btns
281+
in
282+
let pane_div =
283+
H.div ~a:[H.a_id El.Dyn.exercise_pane]
284+
[H.div ~a:[H.a_id El.Dyn.exercise_bar] btns; exercise_list_html]
219285
in
220286
Manip.removeChildren El.content;
221-
Manip.appendChild El.content list_div;
222-
Lwt.return list_div
287+
Manip.appendChild El.content pane_div;
288+
let list_update_signal =
289+
React.S.map (fun l -> Manip.replaceChildren exercise_list_html [l])
290+
exercise_list_signal
291+
in
292+
retain_signals :=
293+
React.S.merge (fun () () -> ()) () (list_update_signal :: btns_sigs);
294+
Lwt.return pane_div
223295

224296
let playground_tab token : tab_handler =
225297
fun _ _ () ->

0 commit comments

Comments
 (0)