fix(web-app): Add Reload button that replaces Mechanism-2 of PR ocaml-sf#372

This button triggers a "Fetch_save" and makes a menu appear, allowing
end users to reuse their latest graded code, their latest saved code,
or the initial template code.

This button only shows up when a non-static backend is detected.

Update the French translation as well.

This fixes "bug 3" of issue ocaml-sf#505.

Close ocaml-sf#493
Close ocaml-sf#505

Author: erikmd

src/app/learnocaml_common.ml

@@ -283,13 +283,13 @@ let disable_with_button_group component (buttons, _, _) =
     ((component :> < disabled : bool Js.t Js.prop > Js.t), ref false)
     :: !buttons
 
-let button ~container ~theme ?group ?state ~icon lbl cb =
+let button ?id ~container ~theme ?group ?state ~icon lbl cb =
   let (others, mutex, cnt) as group =
     match group with
     | None -> button_group ()
     | Some group -> group in
   let button =
-    H.(button [
+    H.(button ~a:(match id with Some id -> [ H.a_id id ] | _ -> []) [
         img ~alt:"" ~src:(api_server ^ "/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ;
         txt " " ;
         span ~a:[ a_class [ "label" ] ] [ txt lbl ]
@@ -337,6 +337,32 @@ let dropdown ~id ~title items =
       H.div ~a: [H.a_id id; H.a_class ["dropdown_content"]] items
     ]
 
+let button_dropup ~container ~theme ?state ~icon ~id_menu ~items lbl cb_before =
+  let btn_id = id_menu ^ "-btn" in (* assumed to be unique *)
+  let toggle cb_before () =
+    let menu = find_component id_menu in
+    let disp =
+      match Manip.Css.display menu with
+      | "block" -> "none"
+      | _ ->
+         Lwt.dont_wait (fun () -> cb_before ()) (fun _exc -> ());
+         Lwt_js_events.async (fun () ->
+             Lwt_js_events.click window >|= fun ev ->
+             Js.Opt.case ev##.target (fun () -> ())
+               (fun e ->
+                 if Js.to_string e##.id <> btn_id then
+                   Manip.SetCss.display menu "none"));
+         "block"
+    in
+    Manip.SetCss.display menu disp;
+    Lwt.return_unit
+  in
+  let cb = toggle cb_before in
+  let div_content =
+    H.div ~a: [H.a_id id_menu; H.a_class ["dropup_content"]] items in
+  button ~id:btn_id ~container:container ~theme ?state ~icon lbl cb ;
+  Manip.appendChild container div_content
+
 let gettimeofday () =
   (new%js Js.date_now)##getTime /. 1000.
 
@@ -391,6 +417,8 @@ let set_state_from_save_file ?token save =
   let open Learnocaml_local_storage in
   (match token with None -> () | Some t -> store sync_token t);
   store nickname save.nickname;
+  store all_graded_solutions
+    (SMap.map (fun ans -> ans.Answer.solution) save.all_exercise_states);
   store all_exercise_states
     (SMap.merge (fun _ ans edi ->
          match ans, edi with
@@ -881,6 +909,9 @@ module Editor_button (E : Editor_info) = struct
   let editor_button =
     button ~container:E.buttons_container ~theme:"light"
 
+  let editor_button_dropup =
+    button_dropup ~container:E.buttons_container ~theme:"light"
+
   let cleanup template =
   editor_button
     ~icon: "cleanup" [%i"Reset"] @@ fun () ->
@@ -890,6 +921,66 @@ module Editor_button (E : Editor_info) = struct
          Ace.set_contents E.ace template);
     Lwt.return ()
 
+  let reload token id template =
+    let rec fetch_draft_solution tok () =
+      match tok with
+      | token ->
+         Server_caller.request (Learnocaml_api.Fetch_save token) >>= function
+         | Ok save ->
+            set_state_from_save_file ~token save;
+            Lwt.return_some (save.Save.nickname)
+         | Error (`Not_found _) ->
+            alert ~title:[%i"TOKEN NOT FOUND"]
+              [%i"The entered token couldn't be recognised."];
+            Lwt.return_none
+         | Error e ->
+            lwt_alert ~title:[%i"REQUEST ERROR"] [
+                H.p [H.txt [%i"Could not retrieve data from server"]];
+                H.code [H.txt (Server_caller.string_of_error e)];
+              ] ~buttons:[
+                [%i"Retry"], (fun () -> fetch_draft_solution tok ());
+                [%i"Cancel"], (fun () -> Lwt.return_none);
+              ]
+    in
+    let id_menu = "reload-button-dropup" in (* assumed to be unique *)
+    editor_button_dropup
+      ~icon: "down"
+      ~id_menu
+      ~items: [
+        H.ul [
+            H.li ~a: [ H.a_onclick (fun _ ->
+                confirm ~title:[%i"Reload latest graded code"]
+                  [H.txt [%i"This will replace your code with your last graded code. Are you sure?"]]
+                  (fun () ->
+                    let graded = Learnocaml_local_storage.(retrieve (graded_solution id)) in
+                    Ace.set_contents E.ace graded; Ace.focus E.ace) ; true) ]
+              [ H.txt [%i"Reload latest graded code"] ];
+
+            H.li ~a: [ H.a_onclick (fun _ ->
+                confirm ~title:[%i"Reload latest saved draft"]
+                  [H.txt [%i"This will replace your code with your last saved draft. Are you sure?"]]
+                  (fun () ->
+                    let draft = Learnocaml_local_storage.(retrieve (exercise_state id)).Answer.solution in
+                    Ace.set_contents E.ace draft; Ace.focus E.ace) ; true) ]
+              [ H.txt [%i"Reload latest saved draft"] ];
+
+            H.li ~a: [ H.a_onclick (fun _ ->
+                confirm ~title:[%i"START FROM SCRATCH"]
+                  [H.txt [%i"This will discard all your edits. Are you sure?"]]
+                  (fun () ->
+                    Ace.set_contents E.ace template; Ace.focus E.ace) ; true) ]
+              [ H.txt [%i"Reset to initial template"] ];
+          ]
+      ]
+      [%i"Reload"] @@ fun () ->
+        token >>= function
+          None ->
+          (* We may want to only show "Reset to initial template" in this case,
+             though there is already this code in learnocaml_exercise_main.ml:
+             {| if has_server then EB.reload ... else EB.cleanup ... |}. *)
+           Lwt.return_unit
+        | Some tok -> fetch_draft_solution tok () >|= fun _save -> ()
+
   let download id =
     editor_button
       ~icon: "download" [%i"Download"] @@ fun () ->

src/app/learnocaml_common.mli

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -91,6 +91,7 @@ val disable_with_button_group :
   button_group -> unit
 
 val button :
+  ?id: string ->
   container: 'a Tyxml_js.Html.elt ->
   theme: string ->
   ?group: button_group ->
@@ -105,6 +106,16 @@ val dropdown :
   [< Html_types.div_content_fun ] Tyxml_js.Html.elt list ->
   [> Html_types.div ] Tyxml_js.Html.elt
 
+val button_dropup :
+  container: 'a Tyxml_js.Html5.elt ->
+  theme: string ->
+  ?state: button_state ->
+  icon: string ->
+  id_menu: string ->
+  items: [< Html_types.div_content_fun ] Tyxml_js.Html.elt list ->
+  string -> (unit -> unit Lwt.t) ->
+  unit
+
 val render_rich_text :
   ?on_runnable_clicked: (string -> unit) ->
   Learnocaml_data.Tutorial.text ->
@@ -213,6 +224,7 @@ end
 
 module Editor_button (_ : Editor_info) : sig
   val cleanup : string -> unit
+  val reload : Learnocaml_data.Token.t option Lwt.t -> string -> string -> unit
   val download : string -> unit
   val eval : Learnocaml_toplevel.t -> (string -> unit) -> unit
   val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> (unit -> unit) -> unit

src/app/learnocaml_exercise_main.ml

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019-2020 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -109,7 +109,7 @@ let () =
   let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in
   let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in
   let toplevel_button =
-    button ~container: toplevel_toolbar ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
+    button ?id:None ~container: toplevel_toolbar ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
   let id = match Url.Current.path with
     | "" :: "exercises" :: p | "exercises" :: p ->
         String.concat "/" (List.map Url.urldecode (List.filter ((<>) "") p))
@@ -181,7 +181,9 @@ let () =
   (* ---- editor pane --------------------------------------------------- *)
   let editor, ace = setup_editor solution in
   let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
-  EB.cleanup (Learnocaml_exercise.(access File.template exo));
+  if has_server then
+    EB.reload token id (Learnocaml_exercise.(access File.template exo))
+  else EB.cleanup (Learnocaml_exercise.(access File.template exo));
   EB.sync token id (fun () -> Ace.focus ace; Ace.set_synchronized ace) ;
   EB.download id;
   EB.eval top select_tab;
@@ -215,7 +217,7 @@ let () =
     typecheck true
   end;
   begin toolbar_button
-          ~icon: "reload" [%i"Grade!"] @@ fun () ->
+      ~icon: "reload" [%i"Grade!"] @@ fun () ->
     check_if_need_refresh has_server >>= fun () ->
     let aborted, abort_message =
       let t, u = Lwt.task () in

src/app/learnocaml_index_main.ml

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -485,7 +485,7 @@ let tutorial_tab select (arg, set_arg, _delete_arg) () =
   load_tutorial !current_tutorial_name !current_step_id () >>= fun () ->
   toplevel_launch >>= fun top ->
   let toplevel_button =
-    button ~container: buttons_div ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
+    button ?id:None ~container: buttons_div ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
   init_toplevel_pane toplevel_launch top toplevel_buttons_group toplevel_button ;
   Lwt.return tutorial_div
 
@@ -505,7 +505,7 @@ let toplevel_tab select _ () =
     (fun _ -> Lwt.async select) toplevel_buttons_group "toplevel"
   >>= fun top ->
   Manip.appendChild El.content div ;
-  let button = button ~container: buttons_div ~theme: "dark" ?group:None ?state:None in
+  let button = button ?id:None ~container: buttons_div ~theme: "dark" ?group:None ?state:None in
   init_toplevel_pane (Lwt.return top) top toplevel_buttons_group button ;
   Lwt.return div
 

src/app/learnocaml_local_storage.ml

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -236,6 +236,14 @@ let exercise_list,
     [ "exercise-state" ]
     Answer.enc
 
+let graded_list,
+    graded_solution,
+    all_graded_solutions =
+  listed
+    [ "exercise-graded-list" ]
+    [ "exercise-graded" ]
+    Json_encoding.string
+
 let toplevel_history_list,
     toplevel_history,
     all_toplevel_histories =

src/app/learnocaml_local_storage.mli

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -30,6 +30,17 @@ val exercise_state : string -> Answer.t storage_key
 
 val all_exercise_states : Answer.t SMap.t storage_key
 
+(* The following three accessors are needed because of Answer.solution:
+ -- on server: last graded solution;
+ -- on localStorage: last edited solution,
+    see learnocaml_common.set_state_from_save_file. *)
+
+val graded_list : string list storage_key
+
+val graded_solution : string -> string storage_key
+
+val all_graded_solutions : string SMap.t storage_key
+
 val exercise_toplevel_history : string -> Learnocaml_toplevel_history.snapshot storage_key
 
 val exercise_toplevel_history_list : string list storage_key

src/state/learnocaml_data.mli

@@ -1,6 +1,6 @@
 (* This file is part of Learn-OCaml.
  *
- * Copyright (C) 2019 OCaml Software Foundation.
+ * Copyright (C) 2019-2022 OCaml Software Foundation.
  * Copyright (C) 2016-2018 OCamlPro.
  *
  * Learn-OCaml is distributed under the terms of the MIT license. See the
@@ -30,6 +30,9 @@ module Report = Learnocaml_report
 module Answer: sig
 
   type t = {
+    (* -- on server: last graded solution;
+       -- on localStorage: last edited solution,
+          see learnocaml_common.set_state_from_save_file. *)
     solution: string ;
     grade: int (* \in [0, 100] *) option ;
     report: Report.t option ;

static/css/learnocaml_exercise.css

@@ -69,6 +69,33 @@ body {
     top: 61px;
   }
 }
+/* ---------------- drop up menu ---------------- */
+
+.dropup_content {
+    display: none;
+    position: absolute;
+    bottom: 40px;
+    z-index: 100;
+    background-color: #666;
+    box-shadow: 0 0 10px 2px rgba(0,0,0,0.4);
+    width: max-content;
+    transition: all .3s ease .15s; /* optional */
+}
+
+.dropup_content ul {
+    list-style-type: none;
+    padding: 0px;
+    margin: 0px;
+}
+.dropup_content li {
+    padding: 5px 10px;
+    font-size: 16px;
+}
+.dropup_content li:hover {
+    background-color: rgba(170,204,255,0.5);
+    cursor: pointer;
+}
+
 /* -------------------- tabs and tab buttons ---------------------- */
 #learnocaml-exo-tab-buttons {
   position: absolute;