diff --git a/demo-repository/lessons/lesson_demo.json b/demo-repository/lessons/demo.json similarity index 100% rename from demo-repository/lessons/lesson_demo.json rename to demo-repository/lessons/demo.json diff --git a/learn-ocaml.opam b/learn-ocaml.opam index a2f1dc610..19c67b877 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -39,6 +39,7 @@ depends: [ "ssl" {= "0.5.5"} "magic-mime" "markup" + "markup-lwt" "ocaml" {= "4.05.0"} "ocamlfind" {build} "ocp-indent-nlfork" diff --git a/learn-ocaml.opam.locked b/learn-ocaml.opam.locked index eabfb195c..19f82d5f8 100644 --- a/learn-ocaml.opam.locked +++ b/learn-ocaml.opam.locked @@ -59,6 +59,7 @@ depends: [ "js_of_ocaml-toplevel" {= "3.3.0"} "js_of_ocaml-tyxml" {= "3.3.0"} "jsonm" {= "1.0.1"} + "markup-lwt" {= "0.5.0"} "logs" {= "0.7.0"} "lwt" {= "4.2.1"} "lwt_react" {= "1.1.3"} diff --git a/src/app/dune b/src/app/dune index f82e580e3..e48a6d160 100644 --- a/src/app/dune +++ b/src/app/dune @@ -3,10 +3,12 @@ (wrapped false) (flags :standard -warn-error -9-27-32) (modules Learnocaml_local_storage + Learnocaml_config Server_caller Learnocaml_common) (preprocess (per_module ((pps js_of_ocaml.ppx) + Learnocaml_config Learnocaml_local_storage Server_caller) ((pps ppx_ocplib_i18n js_of_ocaml.ppx) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index 7234955da..bd9c10aff 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -10,6 +10,7 @@ open Js_of_ocaml open Js_utils open Lwt.Infix open Learnocaml_data +open Learnocaml_config module H = Tyxml_js.Html @@ -172,7 +173,7 @@ let show_loading ?(id = "ocp-loading-layer") contents f = Manip.(removeClass elt "loaded") ; Manip.(addClass elt "loading") ; let chamo_src = - "/icons/tryocaml_loading_" ^ string_of_int (Random.int 9 + 1) ^ ".gif" in + api_server ^ "/icons/tryocaml_loading_" ^ string_of_int (Random.int 9 + 1) ^ ".gif" in Manip.replaceChildren elt H.[ div ~a: [ a_id "chamo" ] [ img ~alt: "loading" ~src: chamo_src () ] ; @@ -287,7 +288,7 @@ let button ~container ~theme ?group ?state ~icon lbl cb = | Some group -> group in let button = H.(button [ - img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + img ~alt:"" ~src:(api_server ^ "/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; txt " " ; span ~a:[ a_class [ "label" ] ] [ txt lbl ] ]) in @@ -386,7 +387,7 @@ let extract_text_from_rich_text text = let set_state_from_save_file ?token save = let open Learnocaml_data.Save in let open Learnocaml_local_storage in - match token with None -> () | Some t -> store sync_token t; + (match token with None -> () | Some t -> store sync_token t); store nickname save.nickname; store all_exercise_states (SMap.merge (fun _ ans edi -> @@ -455,6 +456,24 @@ let rec sync_save token save_file = let sync token = sync_save token (get_state_as_save_file ()) let sync_exercise token ?answer ?editor id = + let handle_serverless () = + (* save the text at least locally (but not the report & grade, that could + be misleading) *) + let txt = match editor, answer with + | Some t, _ -> Some t + | _, Some a -> Some a.Answer.solution + | _ -> None + in + match txt with + | Some txt -> + let key = Learnocaml_local_storage.exercise_state id in + let a0 = Learnocaml_local_storage.retrieve key in + Learnocaml_local_storage.store key + {a0 with Answer. + solution = txt; + mtime = gettimeofday () } + | None -> () + in let nickname = Learnocaml_local_storage.(retrieve nickname) in let toplevel_history = SMap.find_opt id Learnocaml_local_storage.(retrieve all_toplevel_histories) @@ -471,26 +490,15 @@ let sync_exercise token ?answer ?editor id = all_toplevel_histories = SMap.empty; all_exercise_toplevel_histories = opt_to_map toplevel_history; } in - Lwt.catch (fun () -> sync_save token save_file) - (fun e -> - (* save the text at least locally (but not the report & grade, that could - be misleading) *) - let txt = match editor, answer with - | Some t, _ -> Some t - | _, Some a -> Some a.Answer.solution - | _ -> None - in - (match txt with - | Some txt -> - let key = Learnocaml_local_storage.exercise_state id in - let a0 = Learnocaml_local_storage.retrieve key in - Learnocaml_local_storage.store key - {a0 with Answer. - solution = txt; - mtime = gettimeofday () } - | None -> ()); - raise e) - + match token with + | Some token -> + Lwt.catch (fun () -> sync_save token save_file) + (fun e -> + handle_serverless (); + raise e) + | None -> set_state_from_save_file save_file; + handle_serverless (); + Lwt.return save_file let string_of_seconds seconds = let days = seconds / 24 / 60 / 60 in @@ -531,13 +539,13 @@ let stars_div stars = let num = 5 * int_of_float (stars *. 2.) in let num = max (min num 40) 0 in let alt = Format.asprintf [%if"difficulty: %d / 40"] num in - let src = Format.asprintf "/icons/stars_%02d.svg" num in + let src = Format.asprintf "%s/icons/stars_%02d.svg" api_server num in H.img ~alt ~src () ] let exercise_text ex_meta exo = let mathjax_url = - "/js/mathjax/MathJax.js?delayStartupUntil=configured" + api_server ^ "/js/mathjax/MathJax.js?delayStartupUntil=configured" in let mathjax_config = "MathJax.Hub.Config({\n\ @@ -572,7 +580,7 @@ let exercise_text ex_meta exo = \ %s - exercise text\ \ - \ + \ \ \ @@ -582,6 +590,7 @@ let exercise_text ex_meta exo = \ " ex_meta.Exercise.Meta.title + api_server mathjax_config mathjax_url descr @@ -970,23 +979,26 @@ let setup_prelude_pane ace prelude = (fun _ -> state := not !state ; update () ; true) ; Manip.appendChildren prelude_pane [ prelude_title ; prelude_container ] - -let get_token () = - try - Learnocaml_local_storage.(retrieve sync_token) |> - Lwt.return - with Not_found -> - retrieve (Learnocaml_api.Nonce ()) - >>= fun nonce -> - ask_string ~title:"Secret" - [H.txt [%i"Enter the secret"]] - >>= fun secret -> - retrieve - (Learnocaml_api.Create_token (Sha.sha512 (nonce ^ Sha.sha512 secret), None, None)) - >|= fun token -> - Learnocaml_local_storage.(store sync_token) token; - token - + +let get_token ?(has_server = true) () = + if not has_server then + Lwt.return None + else + try + Some Learnocaml_local_storage.(retrieve sync_token) |> + Lwt.return + with Not_found -> + retrieve (Learnocaml_api.Nonce ()) + >>= fun nonce -> + ask_string ~title:"Secret" + [H.txt [%i"Enter the secret"]] + >>= fun secret -> + retrieve + (Learnocaml_api.Create_token (Sha.sha512 (nonce ^ Sha.sha512 secret), None, None)) + >|= fun token -> + Learnocaml_local_storage.(store sync_token) token; + Some token + module Display_exercise = functor ( Q: sig @@ -1014,7 +1026,7 @@ module Display_exercise = let num = 5 * int_of_float (ex_meta.Meta.stars *. 2.) in let num = max (min num 40) 0 in let alt = Format.asprintf [%if"difficulty: %d / 40"] num in - let src = Format.asprintf "/icons/stars_%02d.svg" num in + let src = Format.asprintf "%s/icons/stars_%02d.svg" api_server num in img ~alt ~src () in div ~a:[ a_class [ "stars" ] ] [ @@ -1062,7 +1074,7 @@ module Display_exercise = let get_skill_index token = let index = lazy ( - retrieve (Learnocaml_api.Exercise_index token) + retrieve (Learnocaml_api.Exercise_index (Some token)) >|= fun (index, _) -> Exercise.Index.fold_exercises (fun (req, focus) id meta -> let add sk id map = diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 060654329..275f2c8cf 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -128,7 +128,7 @@ val sync: Token.t -> Save.t Lwt.t (** The same, but limiting the submission to the given exercise, using the given answer if any, and the given editor text, if any. *) val sync_exercise: - Token.t -> ?answer:Learnocaml_data.Answer.t -> ?editor:string -> + Token.t option -> ?answer:Learnocaml_data.Answer.t -> ?editor:string -> Learnocaml_data.Exercise.id -> Save.t Lwt.t @@ -209,8 +209,8 @@ end module Editor_button (E : Editor_info) : sig val cleanup : string -> unit val download : string -> unit - val eval : Learnocaml_toplevel.t -> (string -> unit) -> unit - val sync : Token.t Lwt.t -> Learnocaml_data.SMap.key -> unit + val eval : Learnocaml_toplevel.t -> (string -> 'a) -> unit + val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> unit end val setup_editor : string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor @@ -223,7 +223,7 @@ val set_nickname_div : unit -> unit val setup_prelude_pane : 'a Ace.editor -> string -> unit -val get_token : unit -> Learnocaml_data.student Learnocaml_data.token Lwt.t +val get_token : ?has_server:bool -> unit -> Learnocaml_data.student Learnocaml_data.token option Lwt.t module Display_exercise :functor (Q : sig @@ -274,6 +274,6 @@ module Display_exercise :functor (string Tyxml_js.Html5.wrap * string Tyxml_js.Html5.wrap) list -> [> `PCDATA | `Span ] Tyxml_js.Html5.elt list val display_meta : - 'a Learnocaml_data.token -> + 'a Learnocaml_data.token option -> Learnocaml_data.Exercise.Meta.t -> string -> unit Lwt.t end diff --git a/src/app/learnocaml_config.ml b/src/app/learnocaml_config.ml new file mode 100644 index 000000000..89914f87a --- /dev/null +++ b/src/app/learnocaml_config.ml @@ -0,0 +1,20 @@ +(* This file is part of Learn-OCaml + * + * Copyright (C) 2020 Alban Gruin. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +class type learnocaml_config = object + method enableTryocaml: bool Js.optdef_prop + method enableLessons: bool Js.optdef_prop + method enableExercises: bool Js.optdef_prop + method enableToplevel: bool Js.optdef_prop + method enablePlayground: bool Js.optdef_prop + method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop + method txtNickname: Js.js_string Js.t Js.optdef_prop + method root: Js.js_string Js.t Js.optdef_prop +end + +let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config" +let api_server = Js.(to_string (Optdef.get config##.root (fun () -> string ""))) diff --git a/src/app/learnocaml_config.mli b/src/app/learnocaml_config.mli new file mode 100644 index 000000000..8950e1227 --- /dev/null +++ b/src/app/learnocaml_config.mli @@ -0,0 +1,24 @@ +(* This file is part of Learn-OCaml + * + * Copyright (C) 2020 Alban Gruin. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(* This is not transpiled to learnocaml-static.js, but is an interface + to the values stored in this file. It is "statically linked" with + learnocaml-common.ml. *) + +class type learnocaml_config = object + method enableTryocaml: bool Js.optdef_prop + method enableLessons: bool Js.optdef_prop + method enableExercises: bool Js.optdef_prop + method enableToplevel: bool Js.optdef_prop + method enablePlayground: bool Js.optdef_prop + method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop + method txtNickname: Js.js_string Js.t Js.optdef_prop + method root: Js.js_string Js.t Js.optdef_prop +end + +val config : learnocaml_config Js.t +val api_server : string diff --git a/src/app/learnocaml_description_main.ml b/src/app/learnocaml_description_main.ml index b039f497e..8ee7bcbee 100644 --- a/src/app/learnocaml_description_main.ml +++ b/src/app/learnocaml_description_main.ml @@ -30,7 +30,7 @@ let () = try begin let token = Learnocaml_data.Token.parse (arg "token") in let exercise_fetch = - retrieve (Learnocaml_api.Exercise (token, id)) + retrieve (Learnocaml_api.Exercise (Some token, id)) in init_tabs (); exercise_fetch >>= fun (ex_meta, exo, _deadline) -> @@ -47,7 +47,7 @@ let () = d##write (Js.string (exercise_text ex_meta exo)); d##close) ; (* display meta *) - display_meta token ex_meta id + display_meta (Some token) ex_meta id end with Not_found -> Lwt.return @@ diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index 421aa2078..db13a77a1 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -11,24 +11,28 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Learnocaml_data +open Learnocaml_config module H = Tyxml_js.Html let init_tabs, select_tab = mk_tab_handlers "text" [ "toplevel" ; "report" ; "editor"; "meta" ] -let check_if_need_refresh () = - let local_server_id = Learnocaml_local_storage.(retrieve server_id) in - retrieve @@ Learnocaml_api.Version () - >|= fun (_, server_id) -> - if local_server_id <> server_id then - let title = [%i "WARNING: You have an older grader version than the server"] - and ok_label = [%i "Refresh the page"] - and refresh () = Dom_html.window##.location##reload - and cancel_label = [%i "I will do it myself!"] - and message = [%i "The server has been updated, please refresh the page to make sure you are using the latest version of Learn-OCaml server (none of your work will be lost)."] in - let contents = [ H.p [H.txt (String.trim message) ] ] in - confirm ~title ~ok_label ~cancel_label contents refresh +let check_if_need_refresh has_server = + if has_server then + let local_server_id = Learnocaml_local_storage.(retrieve server_id) in + retrieve @@ Learnocaml_api.Version () + >|= (fun (_, server_id) -> + if local_server_id <> server_id then + let title = [%i "WARNING: You have an older grader version than the server"] + and ok_label = [%i "Refresh the page"] + and refresh () = Dom_html.window##.location##reload + and cancel_label = [%i "I will do it myself!"] + and message = [%i "The server has been updated, please refresh the page to make sure you are using the latest version of Learn-OCaml server (none of your work will be lost)."] in + let contents = [ H.p [H.txt (String.trim message) ] ] in + confirm ~title ~ok_label ~cancel_label contents refresh) + else + Lwt.return_unit let get_grade = let get_worker = get_worker_code "learnocaml-grader-worker.js" in @@ -91,11 +95,11 @@ let () = run_async_with_log @@ fun () -> set_string_translations_exercises (); Learnocaml_local_storage.init (); - retrieve (Learnocaml_api.Version ()) - >|= fun (_,server_id) -> - Learnocaml_local_storage.(store server_id) server_id; - let token = get_token () - + Server_caller.request (Learnocaml_api.Version ()) >>= + (function + | Ok (_, server_id) -> Learnocaml_local_storage.(store server_id) server_id; Lwt.return_true + | Error _ -> Lwt.return_false) >>= fun has_server -> + let token = get_token ~has_server () in (* ---- launch everything --------------------------------------------- *) let toplevel_buttons_group = button_group () in @@ -195,7 +199,7 @@ let () = begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> Dom_html.window##.location##assign - (Js.string "/index.html#activity=exercises") ; + (Js.string (api_server ^ "/index.html#activity=exercises")) ; Lwt.return () end ; let messages = Tyxml_js.Html5.ul [] in @@ -209,9 +213,8 @@ let () = typecheck true end; begin toolbar_button - ~icon: "reload" [%i"Grade!"] @@ fun () -> - check_if_need_refresh () - >>= fun () -> + ~icon: "reload" [%i"Grade!"] @@ fun () -> + check_if_need_refresh has_server >>= fun () -> let aborted, abort_message = let t, u = Lwt.task () in let btn = Tyxml_js.Html5.(button [ txt [%i"abort"] ]) in @@ -286,4 +289,3 @@ let () = typecheck false >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; Lwt.return () -;; diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 046fa19b3..cf67f896c 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -11,6 +11,7 @@ open Js_utils open Lwt open Learnocaml_data open Learnocaml_common +open Learnocaml_config module H = Tyxml_js.Html5 @@ -61,6 +62,11 @@ end let show_loading msg = show_loading ~id:El.loading_id H.[ul [li [txt msg]]] +let get_url token dynamic_url static_url id = + match token with + | Some _ -> dynamic_url ^ Url.urlencode id ^ "/" + | None -> api_server ^ "/" ^ static_url ^ Url.urlencode id + let exercises_tab token _ _ () = show_loading [%i"Loading exercises"] @@ fun () -> Lwt_js.sleep 0.5 >>= fun () -> @@ -107,7 +113,7 @@ let exercises_tab token _ _ () = | Some pct when pct >= 100 -> [ "stats" ; "success" ] | Some _ -> [ "stats" ; "partial" ]) pct_signal in - a ~a:[ a_href ("/exercises/" ^ Url.urlencode exercise_id ^ "/") ; + a ~a:[ a_href (get_url token "/exercises/" "exercise.html#id=" exercise_id) ; a_class [ "exercise" ] ] [ div ~a:[ a_class [ "descr" ] ] ( h1 [ txt title ] :: @@ -149,7 +155,7 @@ let exercises_tab token _ _ () = Manip.appendChild El.content list_div; Lwt.return list_div -let playground_tab _ _ () = +let playground_tab token _ _ () = show_loading [%i"Loading playground"] @@ fun () -> Lwt_js.sleep 0.5 >>= fun () -> retrieve (Learnocaml_api.Playground_index ()) @@ -159,7 +165,7 @@ let playground_tab _ _ () = let open Tyxml_js.Html5 in let title = pmeta.Playground.Meta.title in let short_description = pmeta.Playground.Meta.short_description in - a ~a:[ a_href ("/playground/" ^ Url.urlencode id ^ "/") ; + a ~a:[ a_href (get_url token "/playground/" "playground.html#id=" id) ; a_class [ "exercise" ] ] [ div ~a:[ a_class [ "descr" ] ] ( h1 [ txt title ] :: @@ -591,29 +597,17 @@ let init_token_dialog () = Manip.SetCss.display login_overlay "none"; token -let init_sync_token button_state = +let init_sync_token button_group = catch (fun () -> begin try Lwt.return Learnocaml_local_storage.(retrieve sync_token) with Not_found -> init_token_dialog () end >>= fun token -> - enable_button button_state ; + enable_button_group button_group ; Lwt.return (Some token)) (fun _ -> Lwt.return None) -class type learnocaml_config = object - method enableTryocaml: bool Js.optdef_prop - method enableLessons: bool Js.optdef_prop - method enableExercises: bool Js.optdef_prop - method enableToplevel: bool Js.optdef_prop - method enablePlayground: bool Js.optdef_prop - method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop - method txtNickname: Js.js_string Js.t Js.optdef_prop -end - -let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config" - let set_string_translations () = let configured v s = Js.Optdef.case v (fun () -> s) Js.to_string in let translations = [ @@ -667,8 +661,8 @@ let () = Js.string ("Learn OCaml" ^ " v."^Learnocaml_api.version); Manip.setInnerText El.version ("v."^Learnocaml_api.version); Learnocaml_local_storage.init () ; - let sync_button_state = button_state () in - disable_button sync_button_state ; + let sync_button_group = button_group () in + disable_button_group sync_button_group; let menu_hidden = ref true in let no_tab_selected () = Manip.removeChildren El.content ; @@ -686,13 +680,13 @@ let () = then [ "tryocaml", ([%i"Try OCaml"], tryocaml_tab) ] else []) @ (if get_opt config##.enableLessons then [ "lessons", ([%i"Lessons"], lessons_tab) ] else []) @ - (match token, get_opt config##.enableExercises with - | Some token, true -> [ "exercises", ([%i"Exercises"], exercises_tab token) ] - | _ -> []) @ + (if get_opt config##.enableExercises then + ["exercises", ([%i"Exercises"], exercises_tab token)] + else []) @ (if get_opt config##.enableToplevel then [ "toplevel", ([%i"Toplevel"], toplevel_tab) ] else []) @ (if get_opt config##.enablePlayground - then [ "playground", ([%i"Playground"], playground_tab) ] else []) @ + then [ "playground", ([%i"Playground"], playground_tab token) ] else []) @ (match token with | Some t when Token.is_teacher t -> [ "teacher", ([%i"Teach"], teacher_tab t) ] @@ -810,7 +804,7 @@ let () = Lwt.return_unit) in List.iter (fun (text, icon, f) -> - button ~container:El.sync_buttons ~theme:"white" ~icon text f) + button ~container:El.sync_buttons ~theme:"white" ~group:sync_button_group ~icon text f) [ [%i"Show token"], "token", (fun () -> show_token_dialog (get_stored_token ()); @@ -861,7 +855,10 @@ let () = xset El.content (fun s -> s##.style##.left := Js.string ""); Manip.SetCss.display El.show_panel "none"; true); - init_sync_token sync_button_state >|= init_tabs >>= fun tabs -> + Server_caller.request (Learnocaml_api.Version ()) >>= + (function + | Ok _ -> init_sync_token sync_button_group >|= init_tabs + | Error _ -> Lwt.return (init_tabs None)) >>= fun tabs -> try let activity = arg "activity" in let (_, select) = List.assoc activity tabs in diff --git a/src/app/learnocaml_playground_main.ml b/src/app/learnocaml_playground_main.ml index 8d94e8acb..19edd7830 100644 --- a/src/app/learnocaml_playground_main.ml +++ b/src/app/learnocaml_playground_main.ml @@ -11,6 +11,7 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Learnocaml_data +open Learnocaml_config module H = Tyxml_js.Html @@ -70,7 +71,7 @@ let main () = begin toolbar_button ~icon: "list" [%i"Playground"] @@ fun () -> Dom_html.window##.location##assign - (Js.string "/index.html#activity=playground") ; + (Js.string (api_server ^ "/index.html#activity=playground")) ; Lwt.return () end ; let typecheck = typecheck top ace editor in diff --git a/src/app/learnocaml_student_view.ml b/src/app/learnocaml_student_view.ml index 902c14200..6b116b628 100644 --- a/src/app/learnocaml_student_view.ml +++ b/src/app/learnocaml_student_view.ml @@ -347,7 +347,7 @@ let stats_tab assignments answers = ] let init_exercises_and_stats_tabs teacher_token student_token answers = - retrieve (Learnocaml_api.Exercise_index teacher_token) + retrieve (Learnocaml_api.Exercise_index (Some teacher_token)) >>= fun (index, _) -> retrieve (Learnocaml_api.Exercise_status_index teacher_token) >>= fun status -> @@ -483,7 +483,7 @@ let () = | None -> () | Some ex_id -> Lwt.async @@ fun () -> - retrieve (Learnocaml_api.Exercise (teacher_token, ex_id)) + retrieve (Learnocaml_api.Exercise (Some teacher_token, ex_id)) >>= fun (meta, exo, _) -> clear_tabs (); let ans = SMap.find_opt ex_id save.Save.all_exercise_states in diff --git a/src/app/learnocaml_teacher_tab.ml b/src/app/learnocaml_teacher_tab.ml index 398b33be9..db47f5eaa 100644 --- a/src/app/learnocaml_teacher_tab.ml +++ b/src/app/learnocaml_teacher_tab.ml @@ -1317,7 +1317,7 @@ let rec teacher_tab token _select _params () = ] in let fetch_exercises = - retrieve (Learnocaml_api.Exercise_index token) + retrieve (Learnocaml_api.Exercise_index (Some token)) >|= fun (index, _) -> exercises_index := index in diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 1e7b10213..4b1837588 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -72,9 +72,8 @@ let () = (Printexc.to_string e)) | _ -> None -let urlpath = - let api_server = "" in - fun p -> String.concat "/" (api_server::p) +let urlpath p = + String.concat "/" (Learnocaml_config.api_server :: p) let request req = let do_req = function diff --git a/src/app/server_caller.mli b/src/app/server_caller.mli index a9b7497ec..ee9473af4 100644 --- a/src/app/server_caller.mli +++ b/src/app/server_caller.mli @@ -24,7 +24,7 @@ exception Cannot_fetch of string val request_exn: 'a Learnocaml_api.request -> 'a Lwt.t val[@deprecated] fetch_exercise: - Token.t -> Exercise.id -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t + Token.t option -> Exercise.id -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t val[@deprecated] fetch_lesson_index: unit -> Lesson.Index.t Lwt.t val[@deprecated] fetch_lesson : string -> Lesson.t Lwt.t diff --git a/src/grader/dune b/src/grader/dune index 9096f8eaf..d5a7dbf3e 100644 --- a/src/grader/dune +++ b/src/grader/dune @@ -142,7 +142,8 @@ ocplib-ocamlres ezjsonm lwt_utils - learnocaml_report) + learnocaml_report + learnocaml_data) (modules Grading_cli Grader_cli) ) diff --git a/src/grader/grader_cli.ml b/src/grader/grader_cli.ml index 688ea473a..709f1a641 100644 --- a/src/grader/grader_cli.ml +++ b/src/grader/grader_cli.ml @@ -47,7 +47,7 @@ let read_student_file exercise_dir path = else Lwt_io.with_file ~mode:Lwt_io.Input fn Lwt_io.read -let grade ?(print_result=false) ?dirname exercise output_json = +let grade ?(print_result=false) ?dirname meta exercise output_json = Lwt.catch (fun () -> let code_to_grade = match !grade_student with @@ -150,8 +150,8 @@ let grade ?(print_result=false) ?dirname exercise output_json = Lwt.return (Ok ()) | Some json_file -> let json = - Json_encoding.construct Learnocaml_exercise.encoding - Learnocaml_exercise.(update File.max_score max exercise) + Json_encoding.(construct (tup3 Learnocaml_data.Exercise.Meta.enc Learnocaml_exercise.encoding (option float))) + (meta, Learnocaml_exercise.(update File.max_score max exercise), None) in let json = match json with | `A _ | `O _ as d -> d @@ -178,4 +178,9 @@ let grade ?(print_result=false) ?dirname exercise output_json = let grade_from_dir ?(print_result=false) exercise_dir output_json = let exercise_dir = remove_trailing_slash exercise_dir in read_exercise exercise_dir >>= fun exo -> - grade ~print_result ~dirname:exercise_dir exo output_json + Lwt_io.(with_file ~mode:Input (String.concat Filename.dir_sep [exercise_dir; "meta.json"]) read) >>= fun content -> + let meta = (match content with + | "" -> `O [] + | s -> Ezjsonm.from_string s) + |> Json_encoding.destruct Learnocaml_data.Exercise.Meta.enc in + grade ~print_result ~dirname:exercise_dir meta exo output_json diff --git a/src/grader/grader_cli.mli b/src/grader/grader_cli.mli index 9f1abd31e..e66095ef7 100644 --- a/src/grader/grader_cli.mli +++ b/src/grader/grader_cli.mli @@ -39,7 +39,7 @@ val dump_dot: string option ref (** Runs the grading process *) val grade: - ?print_result:bool -> ?dirname:string -> Learnocaml_exercise.t -> string option -> + ?print_result:bool -> ?dirname:string -> Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option -> (unit, int) result Lwt.t val grade_from_dir: diff --git a/src/main/dune b/src/main/dune index a5ca480fc..949b77c6b 100644 --- a/src/main/dune +++ b/src/main/dune @@ -15,6 +15,8 @@ (modules Learnocaml_main) (libraries cmdliner sha + markup + markup-lwt learnocaml_process_repository_lib learnocaml_server_lib learnocaml_server_args diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 5e32a5abb..d4518988c 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -175,7 +175,7 @@ module ConfigFile = struct type t = { server: Uri.t; - token: Token.t; + token: Token.t option; } let local_path, user_path = @@ -197,7 +197,7 @@ module ConfigFile = struct (fun (server, token) -> {server; token}) @@ obj2 (req "server" (conv Uri.to_string Uri.of_string string)) - (req "token" Token.(conv to_string parse string)) + (req "token" (option Token.(conv to_string parse string))) let read file = Lwt_io.with_file ~mode:Lwt_io.Input file Lwt_io.read >|= @@ -210,7 +210,6 @@ module ConfigFile = struct Json_encoding.construct enc t |> function | `O _ | `A _ as json -> Lwt_io.write oc (Ezjsonm.to_string json) | _ -> assert false - end module Console = struct @@ -503,20 +502,27 @@ let upload_report server token ex solution report = (Token.to_string token) | e -> Lwt.fail e -let check_server_version server = +let check_server_version ?(allow_static=false) server = Lwt.catch (fun () -> fetch server (Api.Version ()) >|= fun (server_version,_) -> if server_version <> Api.version then (Printf.eprintf "API version mismatch: client v.%s and server v.%s\n" Api.version server_version; - exit 1)) + exit 1) + else + true) @@ fun e -> - Printf.eprintf "[ERROR] Could not reach server: %s\n" - (match e with - | Unix.Unix_error (err, _, _) -> Unix.error_message err - | Failure m -> m - | e -> Printexc.to_string e); - exit 1 + if not allow_static then + begin + Printf.eprintf "[ERROR] Could not reach server: %s\n" + (match e with + | Unix.Unix_error (err, _, _) -> Unix.error_message err + | Failure m -> m + | e -> Printexc.to_string e); + exit 1 + end + else + Lwt.return_false let get_server = let default_server = Uri.of_string "http://learn-ocaml.org" in @@ -545,55 +551,18 @@ let get_nonce_and_create_token server nickname secret_candidate = fetch server (Api.Create_token (Sha.sha512 (nonce ^ secret_candidate), None, nickname)) -let init ?(local=false) ?server ?token () = - let path = if local then ConfigFile.local_path else ConfigFile.user_path in - let server = get_server server in - let get_new_token nickname = - Printf.printf "Please provide the secret: "; - match Console.input ~default:None (fun s -> Some s) with - | Some secret_candidate -> - get_nonce_and_create_token server nickname secret_candidate - | None -> failwith "Please provide a secret" - in - let get_token () = - match token with - | Some t -> Lwt.return t - | None -> - Printf.eprintf - "Please provide your user token on %s (leave empty to generate one): %!" - (Uri.to_string server); - match - Console.input ~default:None - (fun s -> Some (Token.parse s)) - with - | Some t -> Lwt.return t - | None -> - Printf.eprintf "Please enter a nickname: %!"; - get_new_token - (Console.input - (fun s -> if String.length s < 2 then None else Some s)) - in - check_server_version server >>= - get_token >>= fun token -> - let config = { ConfigFile. server; token } in - ConfigFile.write path config >|= fun () -> - Printf.eprintf "Configuration written to %s\n%!" path; - config - -let get_config_option ?local ?(save_back=false) server_opt token_opt = +let get_config_option ?local ?(save_back=false) ?(allow_static=false) server_opt token_opt = match ConfigFile.path ?local () with | Some f -> ConfigFile.read f >>= fun c -> - let c = match server_opt with - | None -> c - | Some server -> { c with ConfigFile.server } - in - let c = match token_opt with - | None -> c - | Some token -> { c with ConfigFile.token} + let c = match server_opt, token_opt with + | Some server, Some _ -> { ConfigFile.server=server; ConfigFile.token=token_opt } + | Some server, None -> { c with ConfigFile.server } + | None, Some _ -> { c with ConfigFile.token=token_opt} + | None, None -> c in - check_server_version c.ConfigFile.server - >>= fun () -> + check_server_version ~allow_static c.ConfigFile.server + >>= fun _ -> ( if save_back then @@ -605,8 +574,8 @@ let get_config_option ?local ?(save_back=false) server_opt token_opt = >|= fun () -> Some c | None -> Lwt.return_none -let get_config ?local ?(save_back=false) server_opt token_opt = - get_config_option ?local ~save_back server_opt token_opt +let get_config ?local ?(save_back=false) ?(allow_static=false) server_opt token_opt = + get_config_option ?local ~save_back ~allow_static server_opt token_opt >>= function | Some c -> Lwt.return c | None -> Lwt.fail_with "No config file found. Please do `learn-ocaml-client init`" @@ -624,9 +593,9 @@ let man p = [ $(i,https://github.com/ocaml-sf/learn-ocaml/issues)"; ] -let get_config_o ?save_back o = +let get_config_o ?save_back ?(allow_static=false) o = let open Args_global in - get_config ~local:o.local ?save_back o.server_url o.token + get_config ~local:o.local ?save_back ~allow_static o.server_url o.token module Init = struct open Args_global @@ -648,9 +617,13 @@ module Init = struct | Some s -> Lwt.return s in get_server () >>= fun server -> - check_server_version server >>= fun () -> - get_token server >>= fun token -> - let config = { ConfigFile. server; token } in + check_server_version ~allow_static:true server >>= fun has_server -> + let token = if has_server then + get_token server >>= Lwt.return_some + else + Lwt.return_none in + token >>= fun token -> + let config = { ConfigFile. server; token=token } in ConfigFile.write path config >|= fun () -> Printf.eprintf "Configuration written to %s.\n%!" path; 0 @@ -672,7 +645,7 @@ module Grade = struct let grade go eo = Console.enable_colors := eo.color; Console.enable_utf8 := eo.color; - get_config_o go + get_config_o ~allow_static:true go >>= fun { ConfigFile.server; token } -> let status_line = if eo.verbosity >= 2 then Printf.eprintf "%s..\n" else Console.status_line @@ -733,9 +706,11 @@ module Grade = struct (Printf.eprintf "Results NOT saved to server (deadline expired)\n"; Lwt.return 1) else - upload_report server token exercise solution report >>= fun _ -> - Printf.eprintf "Results saved to server\n"; - Lwt.return 0 + match token with + | Some token -> + upload_report server token exercise solution report >>= fun _ -> + Printf.eprintf "Results saved to server\n"; Lwt.return 0 + | None -> Lwt.return 0 let man = man @@ -760,7 +735,9 @@ module Print_token = struct let print_tok o = get_config_o o >>= fun config -> - Lwt_io.print (Token.to_string config.ConfigFile.token ^ "\n") + (match config.ConfigFile.token with + | Some token -> Lwt_io.print (Token.to_string token ^ "\n") + | None -> Lwt_io.print "Static server -- no token\n") >|= fun () -> 0 let explanation = "Just print the configured user token." @@ -791,7 +768,7 @@ end module Set_options = struct let set_opts o = - get_config_o ~save_back:true o + get_config_o ~save_back:true ~allow_static:true o >|= fun _ -> 0 let man = @@ -864,8 +841,9 @@ module Fetch = struct let fetch o lst = get_config_o o >>= fun { ConfigFile.server; token } -> - fetch_save server token - >>= write_save_files lst + match token with + | Some token -> fetch_save server token >>= write_save_files lst + | None -> Lwt.return 0 let man = man @@ -927,7 +905,7 @@ module Template = struct | None -> Lwt.fail_with "You must provide an exercise id" >|= fun () -> 2 | Some exercise_id -> - get_config_o o + get_config_o ~allow_static:true o >>= fun { server; token } -> fetch_exercise server token exercise_id >>= fun (_meta, exercise, _deadline) -> @@ -953,9 +931,9 @@ module Exercise_list = struct let doc= "Get a structured json containing a list of the exercises of the server" let exercise_list o = - get_config_o o + get_config_o ~allow_static:true o >>= fun {ConfigFile.server;token} -> - fetch server (Learnocaml_api.Exercise_index (token)) + fetch server (Learnocaml_api.Exercise_index token) >>= (fun index-> let open Json_encoding in let ezjsonm = (Json_encoding.construct diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 99488ad02..d680e51d5 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -180,6 +180,11 @@ module Args = struct value & opt int 1 & info ["jobs";"j"] ~docv:"INT" ~doc: "Number of building jobs to run in parallel" + let root = + value & opt string "" & info ["root"] ~docv:"ROOT" ~doc: + "Set the root of all documents. Use only for static deployment.\ + Should not end with a trailing slash." + type t = { contents_dir: string; try_ocaml: bool option; @@ -187,14 +192,15 @@ module Args = struct exercises: bool option; playground: bool option; toplevel: bool option; + root: string } let builder_conf = let apply - contents_dir try_ocaml lessons exercises playground toplevel - = { contents_dir; try_ocaml; lessons; exercises; playground; toplevel } + contents_dir try_ocaml lessons exercises playground toplevel root + = { contents_dir; try_ocaml; lessons; exercises; playground; toplevel; root } in - Term.(const apply $contents_dir $try_ocaml $lessons $exercises $playground $toplevel) + Term.(const apply $contents_dir $try_ocaml $lessons $exercises $playground $toplevel $root) let repo_conf = let apply repo_dir exercises_filtered jobs = @@ -240,6 +246,30 @@ end open Args +let process_html_file orig_file dest_file root = + let transform_tag e tag attrs attr = + let attr_pair = ("", attr) in + match List.assoc_opt attr_pair attrs with + | Some url -> `Start_element ((e, tag), (attr_pair, root ^ url) :: (List.remove_assoc attr_pair attrs)) + | None -> `Start_element ((e, tag), attrs) in + Lwt_io.open_file ~mode:Lwt_io.Input orig_file >>= fun ofile -> + Lwt_io.open_file ~mode:Lwt_io.Output dest_file >>= fun wfile -> + let document = Markup_lwt.lwt_stream (Lwt_io.read_chars ofile) in + Markup.parse_html document + |> Markup.signals + |> Markup.map (function + | `Start_element ((e, "link"), attrs) -> transform_tag e "link" attrs "href" + | `Start_element ((e, "script"), attrs) -> transform_tag e "script" attrs "src" + | `Start_element ((e, "img"), attrs) -> transform_tag e "img" attrs "src" + | `Start_element ((e, "a"), attrs) -> transform_tag e "a" attrs "href" + | t -> t) + |> Markup.pretty_print + |> Markup.write_html + |> Markup_lwt.to_lwt_stream + |> Lwt_io.write_chars wfile >>= fun () -> + Lwt_io.close ofile >>= fun () -> + Lwt_io.close wfile + let main o = Printf.printf "Learnocaml v.%s running.\n" Learnocaml_api.version; let grade () = @@ -292,6 +322,13 @@ let main o = let json_config = ServerData.build_config preconfig in Learnocaml_store.write_to_file ServerData.config_enc json_config www_server_config >>= fun () -> + Lwt_unix.files_of_directory o.builder.Builder.contents_dir + |> Lwt_stream.iter_s (fun file -> + if Filename.extension file = ".html" then + process_html_file (o.builder.Builder.contents_dir/file) + (o.app_dir/file) o.builder.Builder.root + else + Lwt.return_unit) >>= fun () -> let if_enabled opt dir f = (match opt with | None -> Lwt.catch (fun () -> @@ -325,13 +362,15 @@ let main o = \ enablePlayground: %b,\n\ \ enableLessons: %b,\n\ \ enableExercises: %b,\n\ - \ enableToplevel: %b\n\ + \ enableToplevel: %b,\n\ + \ root: \"%s\"\n\ }\n" (tutorials_ret <> None) (playground_ret <> None) (lessons_ret <> None) (exercises_ret <> None) - (o.builder.Builder.toplevel <> Some false) >>= fun () -> + (o.builder.Builder.toplevel <> Some false) + o.builder.Builder.root >>= fun () -> Lwt.return (tutorials_ret <> Some false && exercises_ret <> Some false))) else Lwt.return true diff --git a/src/repo/dune b/src/repo/dune index 9e10ce37a..3d7e1b651 100644 --- a/src/repo/dune +++ b/src/repo/dune @@ -51,6 +51,7 @@ markup grading_cli learnocaml_repository + learnocaml_store learnocaml_data learnocaml_tutorial_parser) ) diff --git a/src/repo/learnocaml_index.ml b/src/repo/learnocaml_index.ml index f5cf49dd7..2c0305780 100644 --- a/src/repo/learnocaml_index.ml +++ b/src/repo/learnocaml_index.ml @@ -12,17 +12,17 @@ let exercises_dir = "exercises" let exercise_path id = exercises_dir ^ "/" ^ id ^ ".json" -let playground_dir = "playground" +let playground_dir = "playgrounds" let playground_path id = playground_dir ^ "/" ^ id ^ ".json" -let playground_index_path = "playground.json" +let playground_index_path = "playgrounds.json" let lesson_index_path = "lessons.json" let lessons_dir = "lessons" -let lesson_path id = lessons_dir ^ "/" ^ "lesson_" ^ id ^ ".json" +let lesson_path id = lessons_dir ^ "/" ^ id ^ ".json" let tutorial_index_path = "tutorials.json" diff --git a/src/repo/learnocaml_process_exercise_repository.ml b/src/repo/learnocaml_process_exercise_repository.ml index c4682c297..214ce859b 100644 --- a/src/repo/learnocaml_process_exercise_repository.ml +++ b/src/repo/learnocaml_process_exercise_repository.ml @@ -59,7 +59,7 @@ let print_grader_error exercise = function let spawn_grader dump_outputs dump_reports - ?print_result ?dirname exercise output_json = + ?print_result ?dirname meta exercise output_json = let rec sleep () = if !n_processes <= 0 then Lwt_main.yield () >>= sleep @@ -76,7 +76,7 @@ let spawn_grader Grader_cli.display_callback := false; Lwt_main.run (Lwt.catch (fun () -> - Grader_cli.grade ?print_result ?dirname exercise output_json + Grader_cli.grade ?print_result ?dirname meta exercise output_json >|= fun r -> print_grader_error exercise r; match r with @@ -185,6 +185,9 @@ let main dest_dir = fill_structure SMap.empty structure >>= fun (all_exercises, index) -> to_file Index.enc (dest_dir / Learnocaml_index.exercise_index_path) index >>= fun () -> dump_dot index >>= fun () -> + Learnocaml_store.Exercise.Index.get_from_index index >>= fun index -> + to_file Json_encoding.(tup2 Learnocaml_store.Exercise.Index.enc (assoc float)) (dest_dir / "exercise-index.json") (index, []) + >>= fun () -> SSet.iter (fun id -> if not (SMap.mem id all_exercises) then Format.printf "[Warning] Filtered exercise '%s' not found.@." id) @@ -218,10 +221,10 @@ let main dest_dir = if !n_processes = 1 then Lwt_list.map_s, fun dump_outputs dump_reports ?print_result ?dirname - exercise json_path -> + meta exercise json_path -> Grader_cli.dump_outputs := dump_outputs; Grader_cli.dump_reports := dump_reports; - Grader_cli.grade ?print_result ?dirname exercise json_path + Grader_cli.grade ?print_result ?dirname meta exercise json_path >|= fun r -> print_grader_error exercise r; r else Lwt_list.map_p, @@ -243,7 +246,7 @@ let main dest_dir = Lwt.return true end else begin grade dump_outputs dump_reports - ~dirname:(!exercises_dir / id) exercise (Some json_path) + ~dirname:(!exercises_dir / id) (Index.find index id) exercise (Some json_path) >>= function | Ok () -> Format.printf "%-24s [OK]@." id ; diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 2b7301a29..29b15c2df 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -415,7 +415,7 @@ module Request_handler = struct content_type = "text/csv"; caching = Nocache} - | Api.Exercise_index token -> + | Api.Exercise_index (Some token) -> Exercise.Index.get () >>= fun index -> Token.check_teacher token >>= (function | true -> Lwt.return (index, []) @@ -431,7 +431,10 @@ module Request_handler = struct k true) index (fun index -> Lwt.return (index, !deadlines))) >>= respond_json cache - | Api.Exercise (token, id) -> + | Api.Exercise_index None -> + lwt_fail (`Forbidden, "Forbidden") + + | Api.Exercise (Some token, id) -> (Exercise.Status.is_open id token >>= function | `Open | `Deadline _ as o -> Exercise.Meta.get id >>= fun meta -> @@ -440,7 +443,9 @@ module Request_handler = struct (meta, ex, match o with `Deadline t -> Some (max t 0.) | `Open -> None) | `Closed -> - lwt_fail (`Forbidden, "Exercise closed")) + lwt_fail (`Forbidden, "Exercise closed")) + | Api.Exercise (None, _) -> + lwt_fail (`Forbidden, "Forbidden") | Api.Lesson_index () -> Lesson.Index.get () >>= respond_json cache diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 71364c8cd..63043e4c3 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -37,9 +37,9 @@ type _ request = teacher token * Exercise.id list * Token.t list -> string request | Exercise_index: - 'a token -> (Exercise.Index.t * (Exercise.id * float) list) request + 'a token option -> (Exercise.Index.t * (Exercise.id * float) list) request | Exercise: - 'a token * string -> (Exercise.Meta.t * Exercise.t * float option) request + 'a token option * string -> (Exercise.Meta.t * Exercise.t * float option) request | Lesson_index: unit -> (string * string) list request @@ -119,7 +119,7 @@ module Conversions (Json: JSON_CODEC) = struct | Students_csv _ -> str | Exercise_index _ -> - json (J.tup2 Exercise.Index.enc (J.assoc J.float)) + json (J.tup2 Exercise.Index.enc (J.assoc J.float)) | Exercise _ -> json (J.tup3 Exercise.Meta.enc Exercise.enc (J.option J.float)) | Lesson_index _ -> @@ -206,10 +206,15 @@ module Conversions (Json: JSON_CODEC) = struct (J.dft "students" (J.list Token.enc) [])) (exercises, students)) - | Exercise_index token -> - get ~token ["exercise-index.json"] - | Exercise (token, id) -> - get ~token ("exercises" :: String.split_on_char '/' (id^".json")) + | Exercise_index (Some token) -> + get ~token ["exercise-index.json"] + | Exercise_index None -> + get ["exercise-index.json"] + + | Exercise (Some token, id) -> + get ~token ("exercises" :: String.split_on_char '/' (id^".json")) + | Exercise (None, id) -> + get ("exercises" :: String.split_on_char '/' (id^".json")) | Lesson_index () -> get ["lessons.json"] @@ -325,15 +330,15 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct Students_csv (token, exercises, students) |> k | exception e -> Invalid_request (Printexc.to_string e) |> k) - | `GET, ["exercise-index.json"], Some token -> - Exercise_index token |> k + | `GET, ["exercise-index.json"], token -> + Exercise_index token |> k | `GET, ("exercises"::path), token -> (match last path with | Some s when String.lowercase_ascii (Filename.extension s) = ".json" -> (match token with | Some token -> let id = Filename.chop_suffix (String.concat "/" path) ".json" in - Exercise (token, id) |> k + Exercise (Some token, id) |> k | None -> Invalid_request "Missing token" |> k) | Some "" -> Static ["exercise.html"] |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 9bf082e8e..b51db4eb2 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -53,9 +53,9 @@ type _ request = teacher token * Exercise.id list * Token.t list -> string request | Exercise_index: - 'a token -> (Exercise.Index.t * (Exercise.id * float) list) request + 'a token option -> (Exercise.Index.t * (Exercise.id * float) list) request | Exercise: - 'a token * string -> (Exercise.Meta.t * Exercise.t * float option) request + 'a token option * string -> (Exercise.Meta.t * Exercise.t * float option) request | Lesson_index: unit -> (string * string) list request diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index ee26343ad..20ca030e1 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -257,9 +257,7 @@ module Exercise = struct module Index = struct include Exercise.Index - - let get () = - Lazy.force !index >>= fun index -> + let get_from_index index = Exercise.Index.mapk_exercises (fun id m k -> Status.get id >>= fun s -> { m with Meta.requirements = Status.skills_prereq m s; @@ -268,6 +266,9 @@ module Exercise = struct index Lwt.return + let get () = + Lazy.force !index >>= get_from_index + let reload () = read_static_file Learnocaml_index.exercise_index_path Exercise.Index.enc >|= fun i -> index := lazy (Lwt.return i) @@ -282,7 +283,9 @@ module Exercise = struct let get id = Lwt.catch - (fun () -> read_static_file (Learnocaml_index.exercise_path id) enc) + (fun () -> read_static_file (Learnocaml_index.exercise_path id) + J.(tup3 Meta.enc enc (option float)) >>= fun (_, ex, _) -> + Lwt.return ex) (function | Unix.Unix_error _ -> Lwt.fail Not_found | e -> Lwt.fail e) diff --git a/src/state/learnocaml_store.mli b/src/state/learnocaml_store.mli index ce7d26a55..f6bbd440b 100644 --- a/src/state/learnocaml_store.mli +++ b/src/state/learnocaml_store.mli @@ -83,6 +83,7 @@ module Exercise: sig module Index: sig include module type of struct include Exercise.Index end + val get_from_index: t -> t Lwt.t val get: unit -> t Lwt.t val reload: unit -> unit Lwt.t end diff --git a/static/description.html b/static/description.html index ea5880bdd..bc56aab26 100644 --- a/static/description.html +++ b/static/description.html @@ -12,6 +12,7 @@ + diff --git a/static/exercise.html b/static/exercise.html index dd5024331..4f7fa580a 100644 --- a/static/exercise.html +++ b/static/exercise.html @@ -11,6 +11,7 @@ + @@ -32,7 +33,7 @@
diff --git a/static/partition-view.html b/static/partition-view.html index 688a87515..beda4f4d1 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -11,6 +11,7 @@ + diff --git a/static/playground.html b/static/playground.html index 059f95f45..fe7c7923c 100644 --- a/static/playground.html +++ b/static/playground.html @@ -10,6 +10,7 @@ + @@ -31,7 +32,7 @@
diff --git a/static/student-view.html b/static/student-view.html index 0ff06d6c5..e274a1172 100644 --- a/static/student-view.html +++ b/static/student-view.html @@ -11,6 +11,7 @@ +