fixup! Offer better protections against solution overwriting

Signed-off-by: Yann Regis-Gianas <[email protected]>

Author: yurug

src/app/learnocaml_common.ml

@@ -712,7 +712,7 @@ let mouseover_toggle_signal elt sigvalue setter =
   in
   Manip.Ev.onmouseover elt hdl
 
-(* 
+(*
 
    If a user has made no change to a solution for the exercise [id]
    for 180 seconds, [check_valid_editor_state id] ensures that there is
@@ -724,24 +724,42 @@ let mouseover_toggle_signal elt sigvalue setter =
    student solution when the solution is open in several clients.
 
 *)
+let is_synchronized_with_server_callback = ref (fun () -> false)
+
+let is_synchronized_with_server () = !is_synchronized_with_server_callback ()
+
 let check_valid_editor_state id =
   let last_changed = ref (Unix.gettimeofday ()) in
   fun update_content ->
   let update_local_copy checking_time () =
     match Learnocaml_local_storage.(retrieve (exercise_state id)) with
     | { Answer.mtime; solution; _ } ->
-       if mtime > checking_time then (
-         if Js_utils.confirm
-              [%i "A more recent answer exists on the server. \
-                   Do you want to update the current one?"]
-         then
-           update_content solution;
-       );
-       Lwt.return ()
+        if mtime > checking_time then (
+          let buttons =
+            if is_synchronized_with_server () then
+              [
+                [%i "Fetch from server"],
+                (fun () -> Lwt.return (update_content solution));
+                [%i "Ignore & keep editing"],
+                (fun () -> Lwt.return_unit)
+              ]
+            else
+              [
+                [%i "Ignore & keep editing"],
+                (fun () -> Lwt.return_unit);
+                [%i "Fetch from server & overwrite"],
+                (fun () -> Lwt.return (update_content solution));
+              ]
+         in
+         lwt_alert ~title:"Question"
+           ~buttons
+           [ H.p [H.txt [%i "A more recent answer exists on the server. \
+                             Do you want to fetch the new version?"] ] ]
+       ) else Lwt.return_unit
     | exception Not_found -> Lwt.return ()
   in
   let now = Unix.gettimeofday () in
-  if now -. !last_changed > 180. then (
+  if now -. !last_changed > 30. then (
     let checking_time = !last_changed in
     last_changed := now;
     Lwt.async (update_local_copy checking_time)
@@ -1074,7 +1092,7 @@ let setup_prelude_pane ace prelude =
     (fun _ -> state := not !state ; update () ; true) ;
   Manip.appendChildren prelude_pane
     [ prelude_title ; prelude_container ]
-    
+
 let get_token ?(has_server = true) () =
   if not has_server then
     Lwt.return None
@@ -1093,7 +1111,7 @@ let get_token ?(has_server = true) () =
       >|= fun token ->
       Learnocaml_local_storage.(store sync_token) token;
       Some token
-      
+
 module Display_exercise =
   functor (
     Q: sig

src/app/learnocaml_common.mli

@@ -220,6 +220,8 @@ end
 
 val setup_editor : string -> string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor
 
+val is_synchronized_with_server_callback : (unit -> bool) ref
+
 val typecheck :
   Learnocaml_toplevel.t ->
   'a Ace.editor -> Ocaml_mode.editor -> bool -> unit Lwt.t

src/app/learnocaml_exercise_main.ml

@@ -81,9 +81,9 @@ module Exercise_link =
         ]
         content
   end
-  
-module Display = Display_exercise(Exercise_link)    
-open Display  
+
+module Display = Display_exercise(Exercise_link)
+open Display
 
 let is_readonly = ref false
 
@@ -180,6 +180,7 @@ let () =
                      Tyxml_js.Of_dom.of_iFrame text_iframe ] ;
   (* ---- editor pane --------------------------------------------------- *)
   let editor, ace = setup_editor id solution in
+  is_synchronized_with_server_callback := (fun () -> Ace.is_synchronized ace);
   let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
   EB.cleanup (Learnocaml_exercise.(access File.template exo));
   EB.sync token id (fun () -> Ace.set_synchronized ace) ;

translations/fr.po

@@ -946,10 +946,19 @@ msgstr "lors du test de la solution utilisateur"
 msgid "Do you want to save your work before closing?"
 msgstr "Souhaitez-vous enregistrer votre travail avant de quitter?"
 
-msgid "A more recent answer exists on the server. Do you want to update the current one?"
+msgid "A more recent answer exists on the server. Do you want to fetch the new version?"
 msgstr ""
 "Une version plus récente de cette réponse existe sur le serveur."
-"Voulez-vous la télécharger?"
+"Voulez-vous télécharger la nouvelle version?"
+
+msgid "Fetch from server"
+msgstr "Télécharger depuis le serveur"
+
+msgid "Fetch from server & overwrite"
+msgstr "Télécharger depuis le serveur et écraser"
+
+msgid "Ignore & keep editing"
+msgstr "Ignorer et continuer d'éditer"
 
 #~ msgid "No description available."
 #~ msgstr "Aucune description."