From 21887b6a754420ddb357de3a851416b521e7c90e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 24 Jun 2019 01:19:18 +0200 Subject: [PATCH 01/91] feat: learn-ocaml-editor version 0.1.0 * Rebased on 8ba4e3a52783638302b049beb7821f2692a39a7e Co-authored-by: Manuel Cabarcos-Baulina Co-authored-by: Romain Grimal Co-authored-by: Damien Guagno Co-authored-by: Alexandre Perge Co-authored-by: Sophie Rumin --- Makefile | 18 +- demo-repository/editor/index.json | 5 + demo-repository/exercises/demo/title.txt | 2 +- demo-repository/exercises/index.json | 2 +- demo-repository/exercises/manu/descr.html | 36 ++ demo-repository/exercises/manu/meta.json | 1 + demo-repository/exercises/manu/prelude.ml | 2 + demo-repository/exercises/manu/prepare.ml | 0 demo-repository/exercises/manu/solution.ml | 16 + demo-repository/exercises/manu/template.ml | 2 + demo-repository/exercises/manu/test.ml | 12 + demo-repository/exercises/manu/title.txt | 1 + demo-repository/exercises/test/descr.html | 34 ++ demo-repository/exercises/test/meta.json | 1 + demo-repository/exercises/test/prelude.ml | 2 + demo-repository/exercises/test/prepare.ml | 0 demo-repository/exercises/test/solution.ml | 1 + demo-repository/exercises/test/template.ml | 2 + demo-repository/exercises/test/test.ml | 11 + demo-repository/exercises/test/title.txt | 1 + src/ace-lib/ocaml_mode.mli | 1 + src/app/.depend | 1 + src/app/build.ocp | 2 + src/app/learnocaml_exercise_main.ml | 39 +- src/app/learnocaml_index_main.ml | 191 +++++- src/app/learnocaml_local_storage.ml | 17 + src/app/learnocaml_local_storage.mli | 8 + src/app/learnocaml_sync.ml | 60 +- src/app/learnocaml_sync.mli | 8 +- src/app/server_caller.ml | 20 + src/app/server_caller.mli | 3 + src/editor/build.ocp | 68 +++ src/editor/editor.ml | 650 +++++++++++++++++++++ src/editor/new_exercise.ml | 178 ++++++ src/grader/build.ocp | 2 +- src/grader/grader_jsoo_messages.ml | 15 + src/grader/grader_jsoo_messages.mli | 7 + src/grader/grading_jsoo.ml | 2 + src/grader/grading_jsoo.mli | 2 + src/repo/learnocaml_exercise.ml | 3 +- src/repo/learnocaml_exercise.mli | 2 + src/repo/learnocaml_index.mli | 4 + src/state/learnocaml_exercise_state.ml | 44 ++ src/state/learnocaml_exercise_state.mli | 23 + src/utils/build.ocp | 1 + static/css/learnocaml_exercise.css | 543 +++++++++++++++++ static/editor.html | 162 +++++ static/icons/icon_cleanup_black.svg | 79 +++ static/icons/icon_cleanup_dark.svg | 79 +++ static/icons/icon_cleanup_light.svg | 79 +++ static/icons/icon_cleanup_white.svg | 79 +++ static/icons/icon_down_black.svg | 72 +++ static/icons/icon_down_dark.svg | 72 +++ static/icons/icon_down_light.svg | 72 +++ static/icons/icon_down_white.svg | 72 +++ static/icons/icon_download_black.svg | 70 +++ static/icons/icon_download_dark.svg | 70 +++ static/icons/icon_download_light.svg | 70 +++ static/icons/icon_download_white.svg | 70 +++ static/icons/icon_left_black.svg | 72 +++ static/icons/icon_left_dark.svg | 72 +++ static/icons/icon_left_light.svg | 72 +++ static/icons/icon_left_white.svg | 72 +++ static/icons/icon_list_black.svg | 90 +++ static/icons/icon_list_dark.svg | 90 +++ static/icons/icon_list_light.svg | 90 +++ static/icons/icon_list_white.svg | 90 +++ static/icons/icon_menu_black.svg | 91 +++ static/icons/icon_menu_dark.svg | 91 +++ static/icons/icon_menu_light.svg | 91 +++ static/icons/icon_menu_white.svg | 91 +++ static/icons/icon_reload_black.svg | 80 +++ static/icons/icon_reload_dark.svg | 80 +++ static/icons/icon_reload_light.svg | 80 +++ static/icons/icon_reload_white.svg | 80 +++ static/icons/icon_right_black.svg | 72 +++ static/icons/icon_right_dark.svg | 72 +++ static/icons/icon_right_light.svg | 72 +++ static/icons/icon_right_white.svg | 72 +++ static/icons/icon_run_black.svg | 72 +++ static/icons/icon_run_dark.svg | 72 +++ static/icons/icon_run_light.svg | 72 +++ static/icons/icon_run_white.svg | 72 +++ static/icons/icon_save_black.svg | 70 +++ static/icons/icon_save_dark.svg | 70 +++ static/icons/icon_save_light.svg | 70 +++ static/icons/icon_save_white.svg | 70 +++ static/icons/icon_sync_black.svg | 97 +++ static/icons/icon_sync_dark.svg | 97 +++ static/icons/icon_sync_light.svg | 97 +++ static/icons/icon_sync_white.svg | 97 +++ static/icons/icon_typecheck_black.svg | 81 +++ static/icons/icon_typecheck_dark.svg | 81 +++ static/icons/icon_typecheck_light.svg | 81 +++ static/icons/icon_typecheck_white.svg | 81 +++ static/icons/icon_up_black.svg | 72 +++ static/icons/icon_up_dark.svg | 72 +++ static/icons/icon_up_light.svg | 72 +++ static/icons/icon_up_white.svg | 72 +++ static/icons/icon_upload_black.svg | 71 +++ static/icons/icon_upload_dark.svg | 71 +++ static/icons/icon_upload_light.svg | 71 +++ static/icons/icon_upload_white.svg | 71 +++ static/index.html | 1 + static/new_exercise.html | 85 +++ 105 files changed, 6621 insertions(+), 26 deletions(-) create mode 100644 demo-repository/editor/index.json create mode 100644 demo-repository/exercises/manu/descr.html create mode 100644 demo-repository/exercises/manu/meta.json create mode 100644 demo-repository/exercises/manu/prelude.ml create mode 100644 demo-repository/exercises/manu/prepare.ml create mode 100644 demo-repository/exercises/manu/solution.ml create mode 100644 demo-repository/exercises/manu/template.ml create mode 100644 demo-repository/exercises/manu/test.ml create mode 100644 demo-repository/exercises/manu/title.txt create mode 100644 demo-repository/exercises/test/descr.html create mode 100644 demo-repository/exercises/test/meta.json create mode 100644 demo-repository/exercises/test/prelude.ml create mode 100644 demo-repository/exercises/test/prepare.ml create mode 100644 demo-repository/exercises/test/solution.ml create mode 100644 demo-repository/exercises/test/template.ml create mode 100644 demo-repository/exercises/test/test.ml create mode 100644 demo-repository/exercises/test/title.txt create mode 100644 src/editor/build.ocp create mode 100644 src/editor/editor.ml create mode 100644 src/editor/new_exercise.ml create mode 100644 static/editor.html create mode 100644 static/icons/icon_cleanup_black.svg create mode 100644 static/icons/icon_cleanup_dark.svg create mode 100644 static/icons/icon_cleanup_light.svg create mode 100644 static/icons/icon_cleanup_white.svg create mode 100644 static/icons/icon_down_black.svg create mode 100644 static/icons/icon_down_dark.svg create mode 100644 static/icons/icon_down_light.svg create mode 100644 static/icons/icon_down_white.svg create mode 100644 static/icons/icon_download_black.svg create mode 100644 static/icons/icon_download_dark.svg create mode 100644 static/icons/icon_download_light.svg create mode 100644 static/icons/icon_download_white.svg create mode 100644 static/icons/icon_left_black.svg create mode 100644 static/icons/icon_left_dark.svg create mode 100644 static/icons/icon_left_light.svg create mode 100644 static/icons/icon_left_white.svg create mode 100644 static/icons/icon_list_black.svg create mode 100644 static/icons/icon_list_dark.svg create mode 100644 static/icons/icon_list_light.svg create mode 100644 static/icons/icon_list_white.svg create mode 100644 static/icons/icon_menu_black.svg create mode 100644 static/icons/icon_menu_dark.svg create mode 100644 static/icons/icon_menu_light.svg create mode 100644 static/icons/icon_menu_white.svg create mode 100644 static/icons/icon_reload_black.svg create mode 100644 static/icons/icon_reload_dark.svg create mode 100644 static/icons/icon_reload_light.svg create mode 100644 static/icons/icon_reload_white.svg create mode 100644 static/icons/icon_right_black.svg create mode 100644 static/icons/icon_right_dark.svg create mode 100644 static/icons/icon_right_light.svg create mode 100644 static/icons/icon_right_white.svg create mode 100644 static/icons/icon_run_black.svg create mode 100644 static/icons/icon_run_dark.svg create mode 100644 static/icons/icon_run_light.svg create mode 100644 static/icons/icon_run_white.svg create mode 100644 static/icons/icon_save_black.svg create mode 100644 static/icons/icon_save_dark.svg create mode 100644 static/icons/icon_save_light.svg create mode 100644 static/icons/icon_save_white.svg create mode 100644 static/icons/icon_sync_black.svg create mode 100644 static/icons/icon_sync_dark.svg create mode 100644 static/icons/icon_sync_light.svg create mode 100644 static/icons/icon_sync_white.svg create mode 100644 static/icons/icon_typecheck_black.svg create mode 100644 static/icons/icon_typecheck_dark.svg create mode 100644 static/icons/icon_typecheck_light.svg create mode 100644 static/icons/icon_typecheck_white.svg create mode 100644 static/icons/icon_up_black.svg create mode 100644 static/icons/icon_up_dark.svg create mode 100644 static/icons/icon_up_light.svg create mode 100644 static/icons/icon_up_white.svg create mode 100644 static/icons/icon_upload_black.svg create mode 100644 static/icons/icon_upload_dark.svg create mode 100644 static/icons/icon_upload_light.svg create mode 100644 static/icons/icon_upload_white.svg create mode 100644 static/new_exercise.html diff --git a/Makefile b/Makefile index d2a96f6cd..5a8924dd3 100644 --- a/Makefile +++ b/Makefile @@ -22,7 +22,7 @@ build-deps: build: @ocp-build init - @ocp-build + @ocp-build -scan process-repo: install _obuild/*/learnocaml-process-repository.byte -j ${PROCESSING_JOBS} \ @@ -37,15 +37,28 @@ static: @${MAKE} -C static install: static - @mkdir -p ${DEST_DIR} + @mkdir -p $(DEST_DIR) + _obuild/*/learnocaml-process-repository.byte -j ${PROCESSING_JOBS} \ + -exercises-dir ${EXERCISES_DIR} \ + -tutorials-dir ${TUTORIALS_DIR} \ + -dest-dir ${DEST_DIR} \ + -dump-outputs ${EXERCISES_DIR} \ + -dump-reports ${EXERCISES_DIR} cp -r static/* ${DEST_DIR} cp ${LESSONS_DIR}/* ${DEST_DIR} @cp _obuild/*/learnocaml-main.js ${DEST_DIR}/js/ + @cp _obuild/*/editor.js ${DEST_DIR}/js/ + @cp _obuild/*/new_exercise.js ${DEST_DIR}/js/ @cp _obuild/*/learnocaml-exercise.js ${DEST_DIR}/js/ @cp _obuild/*/learnocaml-toplevel-worker.js ${DEST_DIR}/js/ @cp _obuild/*/learnocaml-grader-worker.js ${DEST_DIR}/js/ @cp _obuild/*/learnocaml-simple-server.byte . + + @cp _obuild/*/editor.js ${DEST_DIR}/js/ + @cp _obuild/*/new_exercise.js ${DEST_DIR}/js/ + + .PHONY: learn-ocaml.install travis learn-ocaml.install: static @echo 'bin: [' >$@ @@ -91,6 +104,7 @@ clean: ${EXERCISES_DIR}/%.*, \ ${wildcard ${EXERCISES_DIR}/*/meta.json}} -find -name \*~ -delete + -find -name \#\*\# -delete travis: # From https://stackoverflow.com/questions/21053657/how-to-run-travis-ci-locally BUILDID="build-$$RANDOM"; \ diff --git a/demo-repository/editor/index.json b/demo-repository/editor/index.json new file mode 100644 index 000000000..11a9be507 --- /dev/null +++ b/demo-repository/editor/index.json @@ -0,0 +1,5 @@ +{ "learnocaml_version": "1", + "groups": + { "demo": + { "title": "Demo editor pack", + "exercises": [] } } } diff --git a/demo-repository/exercises/demo/title.txt b/demo-repository/exercises/demo/title.txt index 49c7b4b85..33638a766 100644 --- a/demo-repository/exercises/demo/title.txt +++ b/demo-repository/exercises/demo/title.txt @@ -1 +1 @@ -Demo of the exercise environment +Demos of the exercise environment diff --git a/demo-repository/exercises/index.json b/demo-repository/exercises/index.json index 71e96ad78..0e77ac4d0 100644 --- a/demo-repository/exercises/index.json +++ b/demo-repository/exercises/index.json @@ -2,4 +2,4 @@ "groups": { "demo": { "title": "Demo exercise pack", - "exercises": [ "demo" ] } } } + "exercises": [ "demo","manu", "test" ] } } } diff --git a/demo-repository/exercises/manu/descr.html b/demo-repository/exercises/manu/descr.html new file mode 100644 index 000000000..8de47f71d --- /dev/null +++ b/demo-repository/exercises/manu/descr.html @@ -0,0 +1,36 @@ +

+ This exercise is just the manu's demo +

+ +

The task

+ +

+ Exo by manu +

+ +
    +
  1. + Write a function med of type int list -> float. + That computes the median +
  2. + +
+ +

+ The preloaded template contains a minor syntax error and is only a + partially valid answer. These errors were introduced in order to let + you experiment with the error reporting mechanism and the grading + report. Try the Check button, for instance. +
+ Feel free to introduce more errors and to stress the system, + the resulting grade for this exercise will not be taken into account + in the global grade and you might submit as many solutions as you + wish. +
+ If you end up writing an infinite computation, the system will + detect it after a while and ask you to stop the script. It will + slow your browser down until that point, since everything is done + on your side, via your JavaScript engine. + So don't worry, you can try and break the system as much as you + want, it should not break anything on our servers. +

diff --git a/demo-repository/exercises/manu/meta.json b/demo-repository/exercises/manu/meta.json new file mode 100644 index 000000000..fe42d9d15 --- /dev/null +++ b/demo-repository/exercises/manu/meta.json @@ -0,0 +1 @@ +{"learnocaml_version":"1","kind":"exercise","stars":1} diff --git a/demo-repository/exercises/manu/prelude.ml b/demo-repository/exercises/manu/prelude.ml new file mode 100644 index 000000000..8436a905e --- /dev/null +++ b/demo-repository/exercises/manu/prelude.ml @@ -0,0 +1,2 @@ +(* Some code is loaded in the toplevel before your code. *) +let greetings = "Hello world!" diff --git a/demo-repository/exercises/manu/prepare.ml b/demo-repository/exercises/manu/prepare.ml new file mode 100644 index 000000000..e69de29bb diff --git a/demo-repository/exercises/manu/solution.ml b/demo-repository/exercises/manu/solution.ml new file mode 100644 index 000000000..79fdeacec --- /dev/null +++ b/demo-repository/exercises/manu/solution.ml @@ -0,0 +1,16 @@ +let rec get i =function + []->failwith "indice invalide" + | x::list ->if i=1 then x else get (i-1) list;; + +let rec getd i =function + [] ->failwith "indice invalide" + | x::[]->failwith "indice invalide" + | x::y::list ->if i=1 then (x,y) else getd (i-1) (y::list) + ;; +let med list= let l=List.sort ( - ) list in + let length=List.length l in + if length mod 2 =0 then + let (a,b) = getd (length/2) l in (float a+. float b)/.2. + + else + float ( get (( length-1)/2 +1) l) ;; diff --git a/demo-repository/exercises/manu/template.ml b/demo-repository/exercises/manu/template.ml new file mode 100644 index 000000000..102f8afc6 --- /dev/null +++ b/demo-repository/exercises/manu/template.ml @@ -0,0 +1,2 @@ + +let med = diff --git a/demo-repository/exercises/manu/test.ml b/demo-repository/exercises/manu/test.ml new file mode 100644 index 000000000..d52e448e9 --- /dev/null +++ b/demo-repository/exercises/manu/test.ml @@ -0,0 +1,12 @@ +open Test_lib +open Report + +let () = + set_result @@ + ast_sanity_check code_ast @@ fun () -> + [ Section + ([ Text "Function:" ; Code "med" ], + test_function_1_against_solution + [%ty : int list -> float ] "med" ~gen:20 + [] ) ; + ] diff --git a/demo-repository/exercises/manu/title.txt b/demo-repository/exercises/manu/title.txt new file mode 100644 index 000000000..ae8b95645 --- /dev/null +++ b/demo-repository/exercises/manu/title.txt @@ -0,0 +1 @@ +Manu's Demo diff --git a/demo-repository/exercises/test/descr.html b/demo-repository/exercises/test/descr.html new file mode 100644 index 000000000..f87dd2d6d --- /dev/null +++ b/demo-repository/exercises/test/descr.html @@ -0,0 +1,34 @@ +

+ This exercise is just a test for the exercise environment. +

+ +

The task

+ +

+ rev d'une liste +

+ +
    +
  1. + Write a function rev of type 'int list -> 'int list. +
  2. +
+ +

+ The preloaded template contains a minor syntax error and is only a + partially valid answer. These errors were introduced in order to let + you experiment with the error reporting mechanism and the grading + report. Try the Check button, for instance. +
+ Feel free to introduce more errors and to stress the system, + the resulting grade for this exercise will not be taken into account + in the global grade and you might submit as many solutions as you + wish. +
+ If you end up writing an infinite computation, the system will + detect it after a while and ask you to stop the script. It will + slow your browser down until that point, since everything is done + on your side, via your JavaScript engine. + So don't worry, you can try and break the system as much as you + want, it should not break anything on our servers. +

diff --git a/demo-repository/exercises/test/meta.json b/demo-repository/exercises/test/meta.json new file mode 100644 index 000000000..febae404b --- /dev/null +++ b/demo-repository/exercises/test/meta.json @@ -0,0 +1 @@ +{"learnocaml_version":"1","kind":"exercise","stars":2.5} diff --git a/demo-repository/exercises/test/prelude.ml b/demo-repository/exercises/test/prelude.ml new file mode 100644 index 000000000..601458991 --- /dev/null +++ b/demo-repository/exercises/test/prelude.ml @@ -0,0 +1,2 @@ +(* Some code is loaded in the toplevel before your code. *) +let greetings = "Hello world?" diff --git a/demo-repository/exercises/test/prepare.ml b/demo-repository/exercises/test/prepare.ml new file mode 100644 index 000000000..e69de29bb diff --git a/demo-repository/exercises/test/solution.ml b/demo-repository/exercises/test/solution.ml new file mode 100644 index 000000000..b6ddd7c84 --- /dev/null +++ b/demo-repository/exercises/test/solution.ml @@ -0,0 +1 @@ +let rev=List.rev;; diff --git a/demo-repository/exercises/test/template.ml b/demo-repository/exercises/test/template.ml new file mode 100644 index 000000000..7825687c6 --- /dev/null +++ b/demo-repository/exercises/test/template.ml @@ -0,0 +1,2 @@ + +let rev l= diff --git a/demo-repository/exercises/test/test.ml b/demo-repository/exercises/test/test.ml new file mode 100644 index 000000000..4362f1458 --- /dev/null +++ b/demo-repository/exercises/test/test.ml @@ -0,0 +1,11 @@ +open Test_lib +open Report + +let () = + set_result @@ + ast_sanity_check code_ast @@ fun () -> + [ Section + ([ Text "Function:" ; Code "rev" ], + test_function_1_against_solution ~gen:0 + [%ty : int list -> int list ] "rev" + [ [3;5;9] ; [] ; [3;5;9;8;5];[9];[7;5] ] )]; diff --git a/demo-repository/exercises/test/title.txt b/demo-repository/exercises/test/title.txt new file mode 100644 index 000000000..06a88f1d6 --- /dev/null +++ b/demo-repository/exercises/test/title.txt @@ -0,0 +1 @@ +Demo of the exercise list rec diff --git a/src/ace-lib/ocaml_mode.mli b/src/ace-lib/ocaml_mode.mli index 8d5415431..75a29aa14 100644 --- a/src/ace-lib/ocaml_mode.mli +++ b/src/ace-lib/ocaml_mode.mli @@ -33,6 +33,7 @@ type warning = { } val create_ocaml_editor: Dom_html.divElement Js.t -> editor + val get_editor: editor -> editor Ace.editor val report_error: editor -> ?set_class: bool -> error option -> warning list -> unit Lwt.t diff --git a/src/app/.depend b/src/app/.depend index 4accdae4e..99bbd4a2b 100644 --- a/src/app/.depend +++ b/src/app/.depend @@ -8,3 +8,4 @@ learnocaml_main.cmx : server_index.cmx ../../src/jslib/lwt_request.cmx \ ../../src/jslib/js_utils.cmx server_index.cmi : client_index.cmi : + diff --git a/src/app/build.ocp b/src/app/build.ocp index 4373d6bf7..c29acd13f 100644 --- a/src/app/build.ocp +++ b/src/app/build.ocp @@ -68,6 +68,7 @@ begin program "learnocaml-exercise" "learnocaml-toplevel" "js_of_ocaml.ppx" "ocplib_i18n" + "omd" ] files = [ "learnocaml_exercise_main.ml" ( comp = [ ppx_ocplib_i18n ppx_js ] ) @@ -85,3 +86,4 @@ begin program "learnocaml-exercise" ) ] end + diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index 8a0ff1d21..36f8f15b8 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -18,6 +18,17 @@ open Js_utils open Lwt.Infix open Learnocaml_common +open Learnocaml_exercise_state +let get_titre id = Learnocaml_local_storage.(retrieve (editor_state id)).titre + +let get_diff id = Learnocaml_local_storage.(retrieve (editor_state id)).diff +let get_solution id = Learnocaml_local_storage.(retrieve (editor_state id)).solution +let get_question id = Learnocaml_local_storage.(retrieve (editor_state id)).question +let get_template id = Learnocaml_local_storage.(retrieve (editor_state id)).template +let get_test id = Learnocaml_local_storage.(retrieve (editor_state id)).test +let get_prelude id = Learnocaml_local_storage.(retrieve (editor_state id)).prelude +let get_prepare id = Learnocaml_local_storage.(retrieve (editor_state id)).prepare + let init_tabs, select_tab = let names = [ "text" ; "toplevel" ; "report" ; "editor" ] in @@ -121,8 +132,34 @@ let () = let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in let toplevel_button = button ~container: toplevel_toolbar ~theme: "dark" in let editor_button = button ~container: editor_toolbar ~theme: "light" in + let transResultOption = function + |None -> false + |Some s-> true in + let idEditor s = transResultOption (Regexp.string_match (Regexp.regexp "^[\.]+") s 0) in let id = arg "id" in - let exercise_fetch = Server_caller.fetch_exercise id in + + let exercise_fetch = match idEditor id with + | false -> Server_caller.fetch_exercise id + | _ -> let id = String.sub id 1 ((String.length id)-1) in + let exo0 ()= + let titre = get_titre id in + let question =get_question id in + let question =Omd.to_html (Omd.of_string question) in + + let exo1= Learnocaml_exercise.set Learnocaml_exercise.id id Learnocaml_exercise.empty in + let exo2= Learnocaml_exercise.set Learnocaml_exercise.title titre exo1 in + let exo3 =Learnocaml_exercise.set Learnocaml_exercise.max_score 1 exo2 in + let exo4 =Learnocaml_exercise.set Learnocaml_exercise.prepare (get_prepare id) exo3 in + let exo5 =Learnocaml_exercise.set Learnocaml_exercise.prelude (get_prelude id) exo4 in + let exo6 =Learnocaml_exercise.set Learnocaml_exercise.solution (get_solution id) exo5 in + let exo7 =Learnocaml_exercise.set Learnocaml_exercise.test (get_test id) exo6 in + let exo8 =Learnocaml_exercise.set Learnocaml_exercise.template (get_template id) exo7 in + Learnocaml_exercise.set Learnocaml_exercise.descr (question) exo8 + in + Lwt.return (exo0 () ) +in + let id =if idEditor id then String.sub id 1 ((String.length id)-1) else id in + let after_init top = exercise_fetch >>= fun exo -> begin match Learnocaml_exercise.(get prelude) exo with diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index eef2d33aa..d9b9921f4 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -21,6 +21,7 @@ open Learnocaml_index open Learnocaml_common module StringMap = Map.Make (String) + let exercises_tab _ _ () = show_loading ~id:"learnocaml-main-loading" @@ -62,7 +63,7 @@ let exercises_tab _ _ () = | Some pct when pct >= 100 -> [ "stats" ; "success" ] | Some _ -> [ "stats" ; "partial" ]) pct_signal in - a ~a:[ a_href ("exercise.html#id=" ^ exercise_id ^ "&action=open") ; + a ~a:[ a_href ("exercise.html#id=" ^ exercise_id ^ "&action=open") ; a_class [ "exercise" ] ] [ div ~a:[ a_class [ "descr" ] ] [ h1 [ pcdata exercise_title ] ; @@ -90,7 +91,7 @@ let exercises_tab _ _ () = acc) exercises acc | Groups groups -> - let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in + let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in StringMap.fold (fun _ { group_title ; group_contents } acc -> format_contents (succ lvl) @@ -103,6 +104,162 @@ let exercises_tab _ _ () = (format_exercise_list Learnocaml_local_storage.(retrieve all_exercise_states)) in Manip.appendChild content_div list_div ; hide_loading ~id:"learnocaml-main-loading" () ; + Lwt.return list_div +;; + + + + (*let editor_tab _ _ () = + show_loading ~id:"learnocaml-main-loading" + Tyxml_js.Html5.[ ul [ li [ pcdata "Loading editor" ] ] ]; + Lwt_js.sleep 0.5 >>= fun () -> + let div = Tyxml_js.Html5.(div ~a: [ a_id "learnocaml-main-editor" ]) [] in + hide_loading ~id:"learnocaml-main-loading" (); + Lwt.return div;; *) + + + + +let init ()= Learnocaml_local_storage.(store (index_state "index")) {Learnocaml_exercise_state.exos=StringMap.empty;mtime=gettimeofday ()};; + +(*test*) +let editor_tab _ _ () = + Learnocaml_local_storage.init (); + let pct_init=None in + let pct_signal, pct_signal_set = React.S.create pct_init in + Learnocaml_local_storage.(listener (index_state "index")) := + Some (fun _-> pct_signal_set None) ; + + let ()= + match Learnocaml_local_storage.(retrieve (index_state "index")) with + |exception Not_found -> init () + |_->() + in + Server_caller.fetch_editor_index () >>= fun index -> + show_loading ~id:"learnocaml-main-loading" + Tyxml_js.Html5.[ ul [ li [ pcdata "Loading editor" ] ] ] ; + + Lwt_js.sleep 0.5 >>= fun () -> + let content_div = find_component "learnocaml-main-content" in + let format_exercise_list all_exercise_states = + let rec format_contents lvl acc contents = + let open Tyxml_js.Html5 in + match contents with + | Learnocaml_exercises exercises -> + StringMap.fold + (fun exercise_id { exercise_kind ; + exercise_title ; + exercise_short_description ; + exercise_stars } acc -> + let pct_init =None in + let pct_signal, pct_signal_set = React.S.create pct_init in + Learnocaml_local_storage.(listener (editor_state exercise_id)) := + Some (fun _-> pct_signal_set None) ; + let status_classes_signal = + React.S.map + (function + | None -> [ "stats" ] + | Some 0 -> [ "stats" ; "failure" ] + | Some pct when pct >= 100 -> [ "stats" ; "success" ] + | Some _ -> [ "stats" ; "partial" ]) + pct_signal in + (div ~a:[a_id ("button_delete")] [ + let button =button ~a:[a_id exercise_id] [img ~src:("icons/icon_cleanup_dark.svg") ~alt:"" () ; pcdata "" ]in + Manip.Ev.onclick button + (fun _ -> + (* begin + let messages = Tyxml_js.Html5.ul [] in + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_no = Tyxml_js.Html5.(button [ pcdata "No" ]) in + Manip.Ev.onclick btn_no ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in + Manip.Ev.onclick btn_yes (fun _ -> + let rmv= + match Learnocaml_local_storage.(retrieve (index_state "index")) with + |{Learnocaml_exercise_state.exos ;mtime}-> exos + in + let exos = StringMap.remove exercise_id rmv in + let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in + Learnocaml_local_storage.(store (index_state "index")) index; + Learnocaml_local_storage.(delete (editor_state exercise_id)); + Dom_html.window##.location##reload ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata "Are you sure you want to delete the exercise ?\n" ; + btn_yes ; + pcdata " " ; + btn_no ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + *) + let rmv= + match Learnocaml_local_storage.(retrieve (index_state "index")) with + |{Learnocaml_exercise_state.exos ;mtime}-> exos + in + let exos = StringMap.remove exercise_id rmv in + let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in + Learnocaml_local_storage.(store (index_state "index")) index; + Learnocaml_local_storage.(delete (editor_state exercise_id)); + Dom_html.window##.location##reload ; +(* + end ;*) + true) ;button + ] ) :: + a ~a:[ a_href ("editor.html#id="^exercise_id^"&action=open") ; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata exercise_title ] ; + p [ match exercise_short_description with + | None -> pcdata "No description available." + | Some text -> pcdata text ] ; + + ] ; + + div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ + div ~a:[ a_class [ "stars" ] ] [ + let num = 5 * int_of_float (exercise_stars *. 2.) in + let num = max (min num 40) 0 in + let alt = Format.asprintf "difficulty: %d / 40" num in + let src = Format.asprintf "icons/stars_%02d.svg" num in + img ~alt ~src () + ] ; + div ~a:[ a_class [ "length" ] ] [ + match exercise_kind with + | Project -> pcdata "editor project" + | Problem -> pcdata "editor problem" + | Learnocaml_exercise -> pcdata "editor exercise" ] ; + + ]; + + ] :: + acc) + exercises acc + | Groups groups -> + let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in + StringMap.fold + (fun _ { group_title ; group_contents } acc -> + format_contents (succ lvl) + (h ~a:[ a_class [ "pack" ] ] [ pcdata group_title ] :: acc) + group_contents) + groups acc in + let open Tyxml_js.Html5 in + List.rev (format_contents 1 [a ~a:[ a_href ("new_exercise.html#&action=open") ; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata "New exercise" ]; + p [pcdata "Create a new exercise"];]; + ]] index) in + let list_div = + Tyxml_js.Html5.(div ~a: [ Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) + (format_exercise_list Learnocaml_local_storage.(retrieve all_exercise_states)) in + Manip.appendChild content_div list_div ; + hide_loading ~id:"learnocaml-main-loading" () ; Lwt.return list_div ;; @@ -257,6 +414,10 @@ let lessons_tab select (arg, set_arg, delete_arg) () = Lwt.return lesson_div ;; + + + + let tryocaml_tab select (arg, set_arg, delete_arg) () = let open Learnocaml_tutorial in let navigation_div = @@ -574,10 +735,17 @@ let init_sync_token button_state = Lwt.return ()) (fun _ -> Lwt.return ()) -let set_state_from_save_file - { Learnocaml_sync.all_exercise_states ; - all_toplevel_histories ; - all_exercise_toplevel_histories } = +let set_state_from_save_file { + Learnocaml_sync.all_index_states; + all_editor_states; + all_exercise_states ; + all_toplevel_histories ; + all_exercise_toplevel_histories + } = + Learnocaml_local_storage.(store all_index_states) + all_index_states ; + Learnocaml_local_storage.(store all_editor_states) + all_editor_states ; Learnocaml_local_storage.(store all_exercise_states) all_exercise_states ; Learnocaml_local_storage.(store all_toplevel_histories) @@ -586,7 +754,12 @@ let set_state_from_save_file all_exercise_toplevel_histories let get_state_as_save_file () = - { Learnocaml_sync.all_exercise_states = + {Learnocaml_sync.all_index_states = + Learnocaml_local_storage.(retrieve all_index_states); + Learnocaml_sync.all_editor_states = + Learnocaml_local_storage.(retrieve all_editor_states) ; + + Learnocaml_sync.all_exercise_states = Learnocaml_local_storage.(retrieve all_exercise_states) ; all_toplevel_histories = Learnocaml_local_storage.(retrieve all_toplevel_histories) ; @@ -694,11 +867,13 @@ let () = Manip.removeClass menu "hidden" ; Lwt.return () end ; + let tabs = [ "tryocaml", ([%i"Try OCaml"], tryocaml_tab) ; "lessons", ([%i"Lessons"], lessons_tab) ; "exercises", ([%i"Exercises"], exercises_tab) ; - "toplevel", ([%i"Toplevel"], toplevel_tab) ] in + "toplevel", ([%i"Toplevel"], toplevel_tab) ; + "editor", ([%i"Editor"], editor_tab)] in let tabs = let container = find_component "learnocaml-tab-buttons-container" in let content_div = find_component "learnocaml-main-content" in diff --git a/src/app/learnocaml_local_storage.ml b/src/app/learnocaml_local_storage.ml index b8e0693b2..e70dc155a 100644 --- a/src/app/learnocaml_local_storage.ml +++ b/src/app/learnocaml_local_storage.ml @@ -212,6 +212,14 @@ let listed list_key item_prefix ?default enc = store ; retrieve ; delete ; listeners = [] } in list, item, assoc +let index_list, + index_state, + all_index_states= + listed + [ "index-state-list" ] + [ "editor-state" ] + Learnocaml_exercise_state.index_state_enc + let exercise_list, exercise_state, all_exercise_states = @@ -220,6 +228,15 @@ let exercise_list, [ "exercise-state" ] Learnocaml_exercise_state.exercise_state_enc +let editor_list, + editor_state, + all_editor_states= + listed + [ "editor-state-list" ] + [ "editor-state" ] + Learnocaml_exercise_state.editor_state_enc + + let toplevel_history_list, toplevel_history, all_toplevel_histories = diff --git a/src/app/learnocaml_local_storage.mli b/src/app/learnocaml_local_storage.mli index 83b746298..8008824c6 100644 --- a/src/app/learnocaml_local_storage.mli +++ b/src/app/learnocaml_local_storage.mli @@ -29,6 +29,14 @@ val listener : 'a storage_key -> ('a option -> unit) option ref val cached_exercise : string -> Learnocaml_exercise.t storage_key +val editor_state : string -> Learnocaml_exercise_state.editor_state storage_key + +val all_editor_states : Learnocaml_exercise_state.editor_state Map.Make (String).t storage_key + +val index_state :string->Learnocaml_exercise_state.index_state storage_key + +val all_index_states : Learnocaml_exercise_state.index_state Map.Make (String).t storage_key + val exercise_state : string -> Learnocaml_exercise_state.exercise_state storage_key val all_exercise_states : Learnocaml_exercise_state.exercise_state Map.Make (String).t storage_key diff --git a/src/app/learnocaml_sync.ml b/src/app/learnocaml_sync.ml index 31a6fdf1f..b9fe54fbf 100644 --- a/src/app/learnocaml_sync.ml +++ b/src/app/learnocaml_sync.ml @@ -18,7 +18,11 @@ module StringMap = Map.Make (String) type save_file = - { all_exercise_states : + { all_index_states: + Learnocaml_exercise_state.index_state Map.Make (String).t ; + all_editor_states : + Learnocaml_exercise_state.editor_state Map.Make (String).t ; + all_exercise_states : Learnocaml_exercise_state.exercise_state Map.Make (String).t ; all_toplevel_histories : Learnocaml_toplevel_history.snapshot Map.Make (String).t ; @@ -37,28 +41,43 @@ let map_enc enc = let save_file_enc = let open Json_encoding in conv - (fun { all_exercise_states ; + (fun { all_index_states ; + all_editor_states ; + all_exercise_states ; all_toplevel_histories ; all_exercise_toplevel_histories } -> - (all_exercise_states, + (all_index_states , + all_editor_states , + all_exercise_states, all_toplevel_histories, all_exercise_toplevel_histories)) - (fun (all_exercise_states, + (fun (all_index_states , + all_editor_states, + all_exercise_states, all_toplevel_histories, all_exercise_toplevel_histories) -> - { all_exercise_states ; + { all_index_states ; + all_editor_states ; + all_exercise_states ; all_toplevel_histories ; all_exercise_toplevel_histories }) @@ - (obj3 + (obj5 + (dft "index" (map_enc Learnocaml_exercise_state.index_state_enc) StringMap.empty ) + (dft "editor" (map_enc Learnocaml_exercise_state.editor_state_enc) StringMap.empty) (dft "exercises" (map_enc Learnocaml_exercise_state.exercise_state_enc) StringMap.empty) (dft "toplevel-histories" (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty) (dft "exercise-toplevel-histories" (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty)) let sync - { all_exercise_states = all_exercise_states_a ; + + { all_index_states =all_index_states_a ; + all_editor_states =all_editor_states_a ; + all_exercise_states = all_exercise_states_a ; all_toplevel_histories = all_toplevel_histories_a ; all_exercise_toplevel_histories = all_exercise_toplevel_histories_a } - { all_exercise_states = all_exercise_states_b ; + { all_index_states= all_index_states_b; + all_editor_states= all_editor_states_b ; + all_exercise_states = all_exercise_states_b ; all_toplevel_histories = all_toplevel_histories_b ; all_exercise_toplevel_histories = all_exercise_toplevel_histories_b } = let sync_snapshot snapshot_a snapshot_b = @@ -67,12 +86,25 @@ let sync snapshot_a else snapshot_b in - let sync_exercise_state state_a state_b = + let sync_exercise_state (state_a :Learnocaml_exercise_state.exercise_state) (state_b : Learnocaml_exercise_state.exercise_state) = let open Learnocaml_exercise_state in if state_a.mtime > state_b.mtime then state_a else state_b in + let sync_editor_state (state_a:Learnocaml_exercise_state.editor_state) (state_b:Learnocaml_exercise_state.editor_state) = + let open Learnocaml_exercise_state in + if state_a.mtime > state_b.mtime then + state_a + else + state_b in + let sync_index_state (state_a :Learnocaml_exercise_state.index_state) (state_b : Learnocaml_exercise_state.index_state) = + let open Learnocaml_exercise_state in + if state_a.mtime > state_b.mtime then + state_a + else + state_b in + let sync_map sync_item index_a index_b = let open Learnocaml_exercise_state in StringMap.merge @@ -81,7 +113,15 @@ let sync | None, Some i | Some i, None -> Some i | Some a, Some b -> Some (sync_item a b)) index_a index_b in - { all_exercise_states = + { all_index_states= + sync_map sync_index_state + all_index_states_a + all_index_states_b ; + all_editor_states = + sync_map sync_editor_state + all_editor_states_a + all_editor_states_b ; + all_exercise_states = sync_map sync_exercise_state all_exercise_states_a all_exercise_states_b ; diff --git a/src/app/learnocaml_sync.mli b/src/app/learnocaml_sync.mli index ed428c399..c58a5c3e6 100644 --- a/src/app/learnocaml_sync.mli +++ b/src/app/learnocaml_sync.mli @@ -15,14 +15,20 @@ * You should have received a copy of the GNU Affero General Public License * along with this program. If not, see . *) + type save_file = - { all_exercise_states : + { all_index_states : + Learnocaml_exercise_state.index_state Map.Make(String).t; + all_editor_states : + Learnocaml_exercise_state.editor_state Map.Make (String).t ; + all_exercise_states : Learnocaml_exercise_state.exercise_state Map.Make (String).t ; all_toplevel_histories : Learnocaml_toplevel_history.snapshot Map.Make (String).t ; all_exercise_toplevel_histories : Learnocaml_toplevel_history.snapshot Map.Make (String).t } + val save_file_enc : save_file Json_encoding.encoding val sync : save_file -> save_file -> save_file diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 25ebe6a3f..028eed81d 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -62,6 +62,26 @@ let fetch_exercise_index () = Learnocaml_index.exercise_index_enc Learnocaml_index.exercise_index_path +let fetch_editor_index ()= + let index= + match Learnocaml_local_storage.(retrieve (index_state "index")) + with + {Learnocaml_exercise_state.exos;mtime}->exos + + in + let open Learnocaml_index in + let json = + Json_repr_browser.Json_encoding.construct + exercise_index_enc (Learnocaml_exercises index) + in + try Lwt.return (Json_repr_browser.Json_encoding.destruct exercise_index_enc json) with exn -> + let msg = + Format.asprintf "bad structure for %s@.%a" + "index" + (fun ppf -> Json_encoding.print_error ppf) exn in + Lwt.fail (Cannot_fetch msg) +;; + let fetch_exercise id = fetch_and_decode_json Learnocaml_exercise.enc diff --git a/src/app/server_caller.mli b/src/app/server_caller.mli index 8be482c88..319c3166d 100644 --- a/src/app/server_caller.mli +++ b/src/app/server_caller.mli @@ -20,6 +20,9 @@ exception Cannot_fetch of string val fetch : string -> string Lwt.t val fetch_exercise_index : unit -> Learnocaml_index.group_contents Lwt.t + +val fetch_editor_index : unit -> Learnocaml_index.group_contents Lwt.t + val fetch_exercise : string -> Learnocaml_exercise.t Lwt.t diff --git a/src/editor/build.ocp b/src/editor/build.ocp new file mode 100644 index 000000000..d9a4eace3 --- /dev/null +++ b/src/editor/build.ocp @@ -0,0 +1,68 @@ +begin program "new_exercise" + comp_requires = "ppx_ocplib_i18n:asm" + requires = [ + "ezjsonm" + "grading-jsoo" + "ace" + "learnocaml-state" + "learnocaml-repository" + "learnocaml-app-common" + "learnocaml-toplevel" + "jsutils" + "jsutils" + "ppx_metaquot_lib" + "js_of_ocaml.ppx" + "ocplib_i18n" + "ocplib-json-typed.browser" + + ] + files = [ + "new_exercise.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) + ] + build_rules = [ + "%{new_exercise_FULL_DST_DIR}%/new_exercise.js" ( + build_target = true + sources = %byte_exe( p = "new_exercise" ) + commands = [ { + "js_of_ocaml" + "+cstruct/cstruct.js" + "%{ace_FULL_SRC_DIR}%/ace_bindings.js" + %byte_exe( p = "new_exercise" ) + } ] + ) + ] +end + +begin program "editor" + comp_requires = "ppx_ocplib_i18n:asm" + + requires = [ + "ezjsonm" + "grading-jsoo" + "ace" + "learnocaml-repository" + "learnocaml-app-common" + "learnocaml-toplevel" + "ocplib_i18n" + "js_of_ocaml.ppx" + "ocplib-json-typed.browser" + "omd" + ] + files = [ + "editor.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) + ] + build_rules = [ + "%{editor_FULL_DST_DIR}%/editor.js" ( + build_target = true + sources = %byte_exe( p = "editor" ) + commands = [ { + "js_of_ocaml" + "+cstruct/cstruct.js" + "%{ace_FULL_SRC_DIR}%/ace_bindings.js" + %byte_exe( p = "editor" ) + } ] + ) + ] +end + + diff --git a/src/editor/editor.ml b/src/editor/editor.ml new file mode 100644 index 000000000..bdaa15492 --- /dev/null +++ b/src/editor/editor.ml @@ -0,0 +1,650 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2016 OCamlPro. + * + * Learn-OCaml is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your op1tion) any later version. + * + * Learn-OCaml is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with this program. If not, see . *) + +open Js_utils +open Lwt.Infix +open Learnocaml_common +open Learnocaml_exercise_state + +(* +module Report = Learnocaml_report + +let test_lib ?callback ?(timeout: int option) + (module Introspection : Introspection_intf.INTROSPECTION) = + let set_progress = + match callback with + | None -> (fun _ -> ()) + | Some set_progress -> set_progress in + + let results : Learnocaml_report.report option ref = ref None in + + let module M (* : Params *) = struct + let results = results + let set_progress = set_progress + let timeout = timeout + module Introspection = Introspection + end in + let module TL = Test_lib.Make(M) in +(module TL : Test_lib.S) +*) + +(* +module Dummy_Functor (Introspection : + Introspection_intf.INTROSPECTION) = struct + module Dummy_Params = struct + let results = ref None + let set_progress _ = () + module Introspection = Introspection + end + module Test_lib = Test_lib.Make(Dummy_Params) + module Report = Learnocaml_report +*) + + +module StringMap = Map.Make (String) + +let get_titre id = Learnocaml_local_storage.(retrieve (editor_state id)).titre + +let get_diff id = Learnocaml_local_storage.(retrieve (editor_state id)).diff +let get_solution id = Learnocaml_local_storage.(retrieve (editor_state id)).solution +let get_question id = Learnocaml_local_storage.(retrieve (editor_state id)).question +let get_template id = Learnocaml_local_storage.(retrieve (editor_state id)).template +let get_test id = Learnocaml_local_storage.(retrieve (editor_state id)).test +let get_prelude id = Learnocaml_local_storage.(retrieve (editor_state id)).prelude +let get_prepare id = Learnocaml_local_storage.(retrieve (editor_state id)).prepare + + +let string_of_char ch = String.make 1 ch ;; + +let failchar = [' ';'f';'a';'i';'l';'w';'i';'t';'h';' ';'"';'T';'O';'D';'O';'"';'\n'] ;; + +let tail l = match l with +|[]->[] +|e::l->l ;; + +let rec concatenation listech = match listech with +|[]->"" +|c::l -> (string_of_char c)^(concatenation l);; + +let rec decompositionSol str n = +if (n+1= String.length str) then [(str.[n])] +else ( (str.[n])::(decompositionSol str (n+1)) );; + +let rec commentaire listech cpt = match listech with +|[]->[] +|'*'::')'::l -> if cpt = 0 then l else commentaire l (cpt-1) +|'('::'*'::l -> commentaire l (cpt+1) +|c::l->commentaire l cpt;; + +let rec premierLet listech = match listech with +|[]->[] +|'('::'*'::l -> premierLet (commentaire l 0) +|c::'l'::'e'::'t'::' '::l -> if (c='\n'||c=' ') then ('l'::'e'::'t'::' '::l) else premierLet l +|'l'::'e'::'t'::' '::l -> 'l'::'e'::'t'::' '::l +|' '::l-> premierLet l +|'\n'::l-> premierLet l +|_->[];; + +let rec validationLet listech = match listech with +|[]->false +|' '::l->validationLet l +|'\n'::l->validationLet l +|'('::l->validationLet l +|'l'::'e'::'t'::l->false +|_-> true +;; + +let rec rechercheEgal listech = match listech with +|[]->0 +|'='::l->1 +|' '::'l'::'e'::'t'::' '::l->2 +|'\n'::'l'::'e'::'t'::' '::l->2 +|c::l->rechercheEgal l ;; + +let rec rechercheLet listech b = match listech with +|[] -> [] +|'('::'*'::l -> rechercheLet (commentaire l 0) b +|';'::';'::l -> rechercheLet l true +|'='::l -> rechercheLet l (validationLet l) +|_::'t'::'h'::'e'::'n'::_::l -> rechercheLet l (validationLet l) +|_::'e'::'l'::'s'::'e'::_::l -> rechercheLet l (validationLet l) +|_::'i'::'n'::_::l -> rechercheLet l (validationLet l) +|'-'::'>'::l->rechercheLet l (validationLet l) +|'l'::'e'::'t'::' '::l ->if b && ((rechercheEgal l)=1) then 'l'::'e'::'t'::' '::l else (if ((rechercheEgal l)=0) then rechercheLet l false else rechercheLet l true) +|c::suite -> rechercheLet suite b +;; + +let rec decomposition2 listech = match listech with + |[] -> [] + |'='::l -> ['='] + |c::l-> c :: (decomposition2 l) ;; + +let decompoFirst listech = match listech with +|[]-> [] +|_->(decomposition2 listech)@failchar ;; + +let rec genLet listech = + let liste = rechercheLet listech true in + match liste with + |[]->[] + |_-> (decomposition2 liste)@failchar@(genLet (tail liste)) ;; + +let rec genTemplate chaine = if chaine="" then "" else + concatenation (genLet (decompositionSol chaine 0));; + +let init_tabs, select_tab = + let names = [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; "question" ; "prelude" ; "prepare" ] in + let current = ref "toplevel" in + let select_tab name = + set_arg "tab" name ; + Manip.removeClass + (find_component ("learnocaml-exo-button-" ^ !current)) + "front-tab" ; + Manip.removeClass + (find_component ("learnocaml-exo-tab-" ^ !current)) + "front-tab" ; + Manip.enable + (find_component ("learnocaml-exo-button-" ^ !current)) ; + Manip.addClass + (find_component ("learnocaml-exo-button-" ^ name)) + "front-tab" ; + Manip.addClass + (find_component ("learnocaml-exo-tab-" ^ name)) + "front-tab" ; + Manip.disable + (find_component ("learnocaml-exo-button-" ^ name)) ; + current := name in + let init_tabs () = + current := begin try + let requested = arg "tab" in + if List.mem requested names then requested else "toplevel" + with Not_found -> "toplevel" + end ; + List.iter + (fun name -> + Manip.removeClass + (find_component ("learnocaml-exo-button-" ^ name)) + "front-tab" ; + Manip.removeClass + (find_component ("learnocaml-exo-tab-" ^ name)) + "front-tab" ; + Manip.Ev.onclick + (find_component ("learnocaml-exo-button-" ^ name)) + (fun _ -> select_tab name ; true)) + names ; + select_tab !current in + init_tabs, select_tab + +let display_report exo report = + let score, failed = Learnocaml_report.result_of_report report in + let report_button = find_component "learnocaml-exo-button-report" in + Manip.removeClass report_button "success" ; + Manip.removeClass report_button "failure" ; + Manip.removeClass report_button "partial" ; + let grade = score * 100 / 100 (*(Learnocaml_exercise.(get max_score) exo)*) in + if grade >= 100 then begin + Manip.addClass report_button "success" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata "Report" ] + end else if grade = 0 then begin + Manip.addClass report_button "failure" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata "Report" ] + end else begin + Manip.addClass report_button "partial" ; + let pct = Format.asprintf "%2d%%" grade in + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata "Report" ; + span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] + end ; + let report_container = find_component "learnocaml-exo-tab-report" in + Manip.setInnerHtml report_container + (Format.asprintf "%a" Learnocaml_report.(output_html_of_report ~bare: true) report) ; + grade + +let () = + Lwt.async_exception_hook := begin function + | Failure message -> fatal message + | Server_caller.Cannot_fetch message -> fatal message + | exn -> fatal (Printexc.to_string exn) + end ; + Lwt.async @@ fun () -> + Learnocaml_local_storage.init () ; + + (* ---- launch everything --------------------------------------------- *) + let toplevel_buttons_group = button_group () in + disable_button_group toplevel_buttons_group (* enabled after init *) ; + let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in + let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in + let template_toolbar = find_component "learnocaml-exo-template-toolbar" in + let prelude_toolbar = find_component "learnocaml-exo-prelude-toolbar" in + let prepare_toolbar = find_component "learnocaml-exo-prepare-toolbar" in + let test_toolbar = find_component "learnocaml-exo-test-toolbar" in + let toplevel_button = button ~container: toplevel_toolbar ~theme: "dark" in + let editor_button = button ~container: editor_toolbar ~theme: "light" in + let test_button = button ~container: test_toolbar ~theme: "light" in + let template_button = button ~container: template_toolbar ~theme: "light" in + let prelude_button = button ~container: prelude_toolbar ~theme: "light" in + let prepare_button = button ~container: prepare_toolbar ~theme: "light" in + let id = arg "id" in + + let after_init top = + begin + Lwt.return true + end >>= fun r1 -> + Learnocaml_toplevel.load ~print_outcome:false top + "" >>= fun r2 -> + if not r1 || not r2 then failwith "error in prelude" ; + Learnocaml_toplevel.set_checking_environment top >>= fun () -> + Lwt.return () in + let timeout_prompt = + Learnocaml_toplevel.make_timeout_popup + ~on_show: (fun () -> select_tab "toplevel") + () in + let flood_prompt = + Learnocaml_toplevel.make_flood_popup + ~on_show: (fun () -> select_tab "toplevel") + () in + let history = + let storage_key = + Learnocaml_local_storage.exercise_toplevel_history id in + let on_update self = + Learnocaml_local_storage.store storage_key + (Learnocaml_toplevel_history.snapshot self) in + let snapshot = + Learnocaml_local_storage.retrieve storage_key in + Learnocaml_toplevel_history.create + ~gettimeofday + ~on_update + ~max_size: 99 + ~snapshot () in + + let toplevel_launch = + Learnocaml_toplevel.create + ~after_init ~timeout_prompt ~flood_prompt + ~on_disable_input: (fun _ -> disable_button_group toplevel_buttons_group) + ~on_enable_input: (fun _ -> enable_button_group toplevel_buttons_group) + ~container:(find_component "learnocaml-exo-toplevel-pane") + ~history () in + init_tabs () ; + toplevel_launch >>= fun top -> + + + (* ---- toplevel pane ------------------------------------------------- *) + begin toplevel_button + ~group: toplevel_buttons_group + ~icon: "cleanup" "Clear" @@ fun () -> + Learnocaml_toplevel.clear top ; + Lwt.return () + end ; + begin toplevel_button + ~icon: "reload" "Reset" @@ fun () -> + toplevel_launch >>= fun top -> + disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + end ; + begin toplevel_button + ~group: toplevel_buttons_group + ~icon: "run" "Eval phrase" @@ fun () -> + Learnocaml_toplevel.execute top ; + Lwt.return () + end ; + + + (* ---- test pane --------------------------------------------------- *) + let editor_test = find_component "learnocaml-exo-test-pane" in + let editor_t = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_test) in + let ace_t = Ocaml_mode.get_editor editor_t in + Ace.set_contents ace_t (get_test id); + Ace.set_font_size ace_t 18; + + (* let typecheck set_class = + Learnocaml_toplevel.check top (Ace.get_contents ace_t) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor_t error warnings >>= fun () -> + Ace.focus ace_t ; + Lwt.return () in *) + begin test_button + ~group: toplevel_buttons_group + ~icon: "typecheck" "Check" @@ fun () -> + Lwt.return () + end ; + + (* ---- template pane --------------------------------------------------- *) + let editor_template = find_component "learnocaml-exo-template-pane" in + let editor_temp = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_template) in + let ace_temp = Ocaml_mode.get_editor editor_temp in + Ace.set_contents ace_temp + ( get_template id ) ; + Ace.set_font_size ace_temp 18; + + + let typecheck set_class = + Learnocaml_toplevel.check top (Ace.get_contents ace_temp) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor_temp error warnings >>= fun () -> + Ace.focus ace_temp ; + Lwt.return () in + begin template_button + ~group: toplevel_buttons_group + ~icon: "typecheck" "Check" @@ fun () -> + typecheck true + end ; + + (*-------question pane -------------------------------------------------*) + let editor_question = find_component "learnocaml-exo-tab-question" in + let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in + Ace.set_contents ace_quest (get_question id) ; + Ace.set_font_size ace_quest 18; + + (* ---- prelude pane --------------------------------------------------- *) + let editor_prelude = find_component "learnocaml-exo-prelude-pane" in + let editor_prel = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_prelude) in + let ace_prel = Ocaml_mode.get_editor editor_prel in + Ace.set_contents ace_prel + ( get_prelude id ) ; + Ace.set_font_size ace_prel 18; + + + (* ---- prepare pane --------------------------------------------------- *) + let editor_prepare = find_component "learnocaml-exo-prepare-pane" in + let editor_prep = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_prepare) in + let ace_prep = Ocaml_mode.get_editor editor_prep in + Ace.set_contents ace_prep + ( get_prepare id ) ; + Ace.set_font_size ace_prep 18; + + (* ---- editor pane --------------------------------------------------- *) + let editor_pane = find_component "learnocaml-exo-editor-pane" in + let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in + let ace = Ocaml_mode.get_editor editor in + + let recovering () = + let solution = Ace.get_contents ace in + let titre = get_titre id in + let question = Ace.get_contents ace_quest in + let template = Ace.get_contents ace_temp in + let test = Ace.get_contents ace_t in + let prepare= Ace.get_contents ace_prep in + let prelude =Ace.get_contents ace_prel in + let diff = + match Learnocaml_local_storage.(retrieve (editor_state id)) with + | { Learnocaml_exercise_state.diff } -> diff + | exception Not_found -> None in + Learnocaml_local_storage.(store (editor_state id)) + { Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ;prepare;prelude; + mtime = gettimeofday () } in + + Ace.set_contents ace (get_solution id); + Ace.set_font_size ace 18; + let messages = Tyxml_js.Html5.ul [] in + begin editor_button + ~icon: "sync" "Gen. template" @@ fun () -> + select_tab "template"; + if (Ace.get_contents ace_temp) = "" then + Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ) + else + begin + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_cancel = Tyxml_js.Html5.(button [ pcdata "Cancel" ]) in + Manip.Ev.onclick btn_cancel ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in + Manip.Ev.onclick btn_yes (fun _ -> Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ); + hide_loading ~id:"learnocaml-exo-loading" (); + true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata "Do you want to crush template ?\n" ; + btn_yes ; + pcdata " " ; + btn_cancel ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") + end; + Lwt.return () + end ; + + begin editor_button + ~icon: "save" "Save" @@ fun () -> + recovering () ; + Lwt.return () + end ; + + begin editor_button + ~icon: "download" "Download" @@ fun () -> + recovering () ; + let name = id ^ ".json" in + let content =Learnocaml_local_storage.(retrieve (editor_state id)) in + let json = + Json_repr_browser.Json_encoding.construct + Learnocaml_exercise_state.editor_state_enc + content in + let contents = + (Js._JSON##stringify (json)) in + Learnocaml_common.fake_download ~name ~contents ; + Lwt.return () + end ; + + (* let lib = " module Test_lib = Test_lib.Make(struct\n\ + \ let results = results\n\ + \ let set_progress = set_progress\n\ + \ module Introspection = Introspection\n\ + end)" in *) + let typecheck set_class = + Learnocaml_toplevel.check top (Ace.get_contents ace) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor error warnings >>= fun () -> + Ace.focus ace ; + Lwt.return () in + begin editor_button + ~group: toplevel_buttons_group + ~icon: "typecheck" "Check" @@ fun () -> + typecheck true + end ; + begin toplevel_button + ~group: toplevel_buttons_group + ~icon: "run" "Eval code" @@ fun () -> + Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= fun _ -> + Lwt.return () + end ; + (* ---- main toolbar -------------------------------------------------- *) + let exo_toolbar = find_component "learnocaml-exo-toolbar" in + let toolbar_button = button ~container: exo_toolbar ~theme: "light" in + begin toolbar_button + ~icon: "left" "Metadata" @@ fun () -> + recovering () ; + Dom_html.window##.location##assign + (Js.string ("new_exercise.html#id=" ^ id ^ "&action=open")); + Lwt.return () + end; + + begin toolbar_button + ~icon: "upload" "Export" @@ fun ()-> + recovering () ; + Dom_html.window##.location##assign + (Js.string ("exercise.html#id=." ^ id ^ "&action=open")); + Lwt.return_unit + end; + + let messages = Tyxml_js.Html5.ul [] in + begin toolbar_button + ~icon: "list" "Exercises" @@ fun () -> + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_cancel = Tyxml_js.Html5.(button [ pcdata "Cancel" ]) in + Manip.Ev.onclick btn_cancel ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in + Manip.Ev.onclick btn_yes (fun _ -> + recovering () ; + Dom_html.window##.location##assign + (Js.string "index.html#activity=editor") ; true) ; + let btn_no = Tyxml_js.Html5.(button [ pcdata "No" ]) in + Manip.Ev.onclick btn_no (fun _ -> + Dom_html.window##.location##assign + (Js.string "index.html#activity=editor") ; true); + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata "Do you want to save before closing?\n" ; + btn_yes ; + pcdata " " ; + btn_no ; + pcdata " " ; + btn_cancel ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + Lwt.return () + end ; + + let messages = Tyxml_js.Html5.ul [] in + let callback text = + Manip.appendChild messages Tyxml_js.Html5.(li [ pcdata text ]) in + let exo ()= + let titre = get_titre id in + let description="" in + + let exo1= Learnocaml_exercise.set Learnocaml_exercise.id id Learnocaml_exercise.empty in + let exo2= Learnocaml_exercise.set Learnocaml_exercise.title titre exo1 in + let exo3 =Learnocaml_exercise.set Learnocaml_exercise.max_score 1 exo2 in + let exo4 =Learnocaml_exercise.set Learnocaml_exercise.prepare (get_prepare id) exo3 in + let exo5 =Learnocaml_exercise.set Learnocaml_exercise.prelude (get_prelude id) exo4 in + let exo6 =Learnocaml_exercise.set Learnocaml_exercise.solution (get_solution id) exo5 in + let exo7 =Learnocaml_exercise.set Learnocaml_exercise.test (get_test id) exo6 in + let exo8 =Learnocaml_exercise.set Learnocaml_exercise.template (get_template id) exo7 in + Learnocaml_exercise.set Learnocaml_exercise.descr description exo8 + in + + let worker () = ref (Grading_jsoo.get_grade ~callback (exo () ) ) in + begin toolbar_button + ~icon: "reload" "Grade!" @@ fun () -> + + + let aborted, abort_message = + let t, u = Lwt.task () in + let btn = Tyxml_js.Html5.(button [ pcdata "abort" ]) in + Manip.Ev.onclick btn (fun _ -> Lwt.wakeup u () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata "Grading is taking a lot of time, " ; + btn ; + pcdata " ?" ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "Launching the grader" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ messages ; abort_message ] ; + Lwt_js.sleep 1. >>= fun () -> + let solution = Ace.get_contents ace in + Learnocaml_toplevel.check top solution >>= fun res -> + match res with + | Toploop_results.Ok ((), _) -> + let grading = + !(worker ()) solution >>= fun (report, _, _, _) -> + Lwt.return report in + let abortion = + Lwt_js.sleep 5. >>= fun () -> + Manip.SetCss.opacity abort_message (Some "1") ; + aborted >>= fun () -> + Lwt.return Learnocaml_report.[ Message ([ Text "Grading aborted by user." ], Failure) ] in + Lwt.pick [ grading ; abortion ] >>= fun report -> + let grade = display_report (exo () ) report in + (worker() ) := Grading_jsoo.get_grade ~callback ( exo () ) ; + Learnocaml_local_storage.(store (exercise_state id)) + { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; + mtime = gettimeofday () } ; + select_tab "report" ; + Lwt_js.yield () >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" () ; + Lwt.return () + | Toploop_results.Error _ -> + let msg = + Learnocaml_report.[ Text "Error in your code." ; Break ; + Text "Cannot start the grader if your code does not typecheck." ] in + let report = Learnocaml_report.[ Message (msg, Failure) ] in + let grade = display_report (exo () ) report in + Learnocaml_local_storage.(store (exercise_state id)) + { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; + mtime = gettimeofday () } ; + select_tab "report" ; + Lwt_js.yield () >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" () ; + typecheck true + end ; + + (* ---- return -------------------------------------------------------- *) + toplevel_launch >>= fun _ -> + typecheck false >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" () ; + + Lwt.return () ;; diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml new file mode 100644 index 000000000..bc4e2941c --- /dev/null +++ b/src/editor/new_exercise.ml @@ -0,0 +1,178 @@ +open Js_of_ocaml +open Str +open Js_of_ocaml +open Dom_html +open Learnocaml_common + +module StringMap = Map.Make (String) + +let setInnerHtml elt s = + elt##.innerHTML:= Js.string s + +let transResultOption = function + |None -> false + |Some s-> true;; +let idOk s = transResultOption (Regexp.string_match (Regexp.regexp "^[a-z0-9_-]+$") s 0);; +let titreOk s = (transResultOption (Regexp.string_match (Regexp.regexp "^[^ \t]") s 0)) && + (transResultOption (Regexp.string_match (Regexp.regexp ".*[^ \t]$") s 0));; + +let toString = function + |None -> failwith "incorrect_input" + |Some input -> Js.to_string input##.value +let toStringOpt = function + | None -> None + | Some input -> Some (Js.to_string input##.value) +let toFloatOpt = function + | None -> None + | Some input -> float_of_string_opt (Js.to_string input##.value) +let previousId = match (arg "id") with + |exception Not_found -> "" + |s -> s +let save = getElementById "save" +let identifier = getElementById_coerce "identifier" CoerceTo.input +let title = getElementById_coerce "title" CoerceTo.input +let descr = getElementById_coerce "description" CoerceTo.textarea +let difficulty = getElementById_coerce "difficulty" CoerceTo.select +let solution, question, template, test, previousTitre, previousDiff, prelude, prepare = + match Learnocaml_local_storage.(retrieve (editor_state previousId)) with + | exception Not_found -> "", "", "", "", "",None,"","" + | {Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ; + mtime;prelude;prepare } -> solution, question, template, test, titre, diff, prelude, prepare + +let id_error = getElementById "id_error" +let title_error = getElementById "title_error" + +let previousDescr= + let open Learnocaml_exercise_state in + let exos=Learnocaml_local_storage.(retrieve (index_state "index")).exos in + let open Learnocaml_index in + let exo = + match (StringMap.find_opt previousId exos) with + |None -> {exercise_kind=Learnocaml_exercise;exercise_title="";exercise_short_description=None;exercise_stars=1.5} + |Some s->s + in exo.exercise_short_description + +let _ = match previousDescr with + | Some d -> setInnerHtml (getElementById "description") d + | None -> setInnerHtml (getElementById "description") "" + +let _= match identifier with + None ->() + | Some input->input##.value:=Js.string previousId + +let _= match title with + None ->() + | Some input->input##.value:=Js.string previousTitre + +let d=match previousDiff with + None-> 0.0 + |Some f->f + +let _ =match difficulty with + |None-> () + |Some select->select##.value:=Js.string (string_of_float d) + +let _ = save##.onclick:= handler (fun _ -> + let id = toString identifier in + let titre = toString title in + let description = toStringOpt descr in + let diff = toFloatOpt difficulty in + let store () =if (previousId!="") then Learnocaml_local_storage.(delete (editor_state previousId)); + Learnocaml_local_storage.(store (editor_state id)) + { Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ; prelude;prepare; + mtime = gettimeofday () } in + let idUnique () =if id = previousId then true else + match Learnocaml_local_storage.(retrieve (editor_state id)) with + | exception Not_found -> true + | _ -> false in + + let titleUnique () = + let exos= + match Learnocaml_local_storage.(retrieve (index_state "index")) with + |{Learnocaml_exercise_state.exos ;mtime}-> exos + in + let open Learnocaml_index in + if previousTitre=titre then true else + match StringMap.find_first_opt (fun key->(StringMap.find key exos).exercise_title=titre) exos with + None->true + | _ -> false + in + let store2 () = + let exercise_title = titre in + let stars = match diff with None -> failwith "" | Some f -> f in + let exercise_stars = stars in + let open Learnocaml_index in + let exercise_kind = Learnocaml_exercise in + let exercise_short_description = description in + let exo = {exercise_kind; exercise_stars; exercise_title; exercise_short_description} in + match Learnocaml_local_storage.(retrieve (index_state "index")) with + | {Learnocaml_exercise_state.exos; mtime} -> + let anciensexos = if (previousId!="") then StringMap.remove previousId exos else exos in + let exos = StringMap.add id exo anciensexos in + let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in + Learnocaml_local_storage.(store (index_state "index")) index; + in + let id_correct = idOk id in + let id_unique = idUnique () in + let title_correct = titreOk titre in + let title_unique = titleUnique () in + if not id_correct && not title_correct then + begin + setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ + and only lower case letters, numerals, dashes \ + and underscores are allowed"; + setInnerHtml title_error "Incorrect title: a title can't be empty, \ + or begin or end with a space or a tab" + end + else if not id_correct && title_correct && not title_unique then + begin + setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ + and only lower case letters, numerals, dashes \ + and underscores are allowed"; + setInnerHtml title_error "This title is already used, please choose another one" + end + else if not id_correct && title_correct && title_unique then + begin + setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ + and only lower case letters, numerals, dashes \ + and underscores are allowed"; + setInnerHtml title_error "" + end + else if id_correct && not id_unique && not title_correct then + begin + setInnerHtml id_error "This identifier is already used, please choose another one"; + setInnerHtml title_error "Incorrect title: a title can't be empty, \ + or begin or end with a space or a tab" + end + else if id_correct && not id_unique && title_correct && not title_unique then + begin + setInnerHtml id_error "This identifier is already used, please choose another one"; + setInnerHtml title_error "This title is already used, please choose another one" + end + else if id_correct && not id_unique && title_correct && title_unique then + begin + setInnerHtml id_error "This identifier is already used, please choose another one"; + setInnerHtml title_error "" + end + else if id_correct && id_unique && not title_correct then + begin + setInnerHtml id_error ""; + setInnerHtml title_error "Incorrect title: a title can't be empty, \ + or begin or end with a space or a tab" + end + else if id_correct && id_unique && title_correct && not title_unique then + begin + setInnerHtml id_error ""; + setInnerHtml title_error "This title is already used, please choose another one" + end + else + begin + setInnerHtml id_error ""; + setInnerHtml title_error ""; + store (); + store2 (); + Dom_html.window##.location##assign + (Js.string ("editor.html#id=" ^ id ^ "&action=open")); + end + ; Js._true +) diff --git a/src/grader/build.ocp b/src/grader/build.ocp index 8ba05828a..cbdc9feea 100644 --- a/src/grader/build.ocp +++ b/src/grader/build.ocp @@ -13,7 +13,7 @@ begin library "testing" files = [ "introspection_intf.mli" "introspection.ml" ( comp += [ "-ppx" %asm_exe( p = "ppx_metaquot") ] ) - "test_lib.ml" ( comp += [ "-ppx" %asm_exe( p = "ppx_metaquot") ] ) + "test_lib.ml" ( comp += [ "-ppx" %asm_exe( p = "ppx_metaquot") ]) ] end diff --git a/src/grader/grader_jsoo_messages.ml b/src/grader/grader_jsoo_messages.ml index aba3c6781..4b66e7d74 100644 --- a/src/grader/grader_jsoo_messages.ml +++ b/src/grader/grader_jsoo_messages.ml @@ -22,8 +22,23 @@ type from_worker = | Callback of string | Answer of Learnocaml_report.report * string * string * string +type to_worker_edit = + { solution : string ; + solutionBis : string } + + + open Json_encoding +let to_worker_edit_enc = + conv + (fun { solution ; solutionBis } -> (solution, solutionBis)) + (fun (solution, solutionBis) -> { solution ; solutionBis }) + (obj2 + (req "solution" string) + (req "solutionBis" string)) + + let to_worker_enc = conv (fun { solution ; exercise } -> (solution, exercise)) diff --git a/src/grader/grader_jsoo_messages.mli b/src/grader/grader_jsoo_messages.mli index 45225ec69..e74280b46 100644 --- a/src/grader/grader_jsoo_messages.mli +++ b/src/grader/grader_jsoo_messages.mli @@ -18,9 +18,16 @@ type to_worker = { exercise : Learnocaml_exercise.t ; solution : string } + +type to_worker_edit = + { solution : string ; + solutionBis : string } + type from_worker = | Callback of string | Answer of Learnocaml_report.report * string * string * string val to_worker_enc : to_worker Json_encoding.encoding +val to_worker_edit_enc : to_worker_edit Json_encoding.encoding + val from_worker_enc : from_worker Json_encoding.encoding diff --git a/src/grader/grading_jsoo.ml b/src/grader/grading_jsoo.ml index ea731d3d4..13eb850ca 100644 --- a/src/grader/grading_jsoo.ml +++ b/src/grader/grading_jsoo.ml @@ -46,3 +46,5 @@ let get_grade worker##terminate ; Lwt.fail Timeout in Lwt.pick [ timer ; t ] + + diff --git a/src/grader/grading_jsoo.mli b/src/grader/grading_jsoo.mli index 33b8cfad4..977122e90 100644 --- a/src/grader/grading_jsoo.mli +++ b/src/grader/grading_jsoo.mli @@ -24,3 +24,5 @@ val get_grade : ?timeout: float -> Learnocaml_exercise.t -> string -> (Learnocaml_report.report * string * string * string) Lwt.t + + diff --git a/src/repo/learnocaml_exercise.ml b/src/repo/learnocaml_exercise.ml index bfd979036..42f29f777 100644 --- a/src/repo/learnocaml_exercise.ml +++ b/src/repo/learnocaml_exercise.ml @@ -17,7 +17,7 @@ module StringMap = Map.Make (String) type t = string StringMap.t - +let (empty :t)=StringMap.empty type 'a field = { key : string ; ciphered : bool ; @@ -190,3 +190,4 @@ let enc = Not_found -> None in read ~read_field ~id ~decipher: true ()) (assoc string) + diff --git a/src/repo/learnocaml_exercise.mli b/src/repo/learnocaml_exercise.mli index f855ab069..870464893 100644 --- a/src/repo/learnocaml_exercise.mli +++ b/src/repo/learnocaml_exercise.mli @@ -22,6 +22,8 @@ type t (** An exercise field accessor *) type 'a field +val empty : t + (** Get was called on a missing undefaulted field *) exception Missing_field of string diff --git a/src/repo/learnocaml_index.mli b/src/repo/learnocaml_index.mli index c14a827d3..aeb86d0bc 100644 --- a/src/repo/learnocaml_index.mli +++ b/src/repo/learnocaml_index.mli @@ -74,3 +74,7 @@ val lesson_path : string -> string val tutorial_index_path : string val tutorial_path : string -> string + +val map_enc :'a Json_encoding.encoding -> 'a Map.Make(String).t Json_encoding.encoding + +val exercise_enc :exercise Json_encoding.encoding diff --git a/src/state/learnocaml_exercise_state.ml b/src/state/learnocaml_exercise_state.ml index cf082bec0..c8343823d 100644 --- a/src/state/learnocaml_exercise_state.ml +++ b/src/state/learnocaml_exercise_state.ml @@ -42,3 +42,47 @@ let exercise_state_enc = (req "solution" string) (opt "report" Learnocaml_report.report_enc) (dft "mtime" float 0.)) +;; + + +type editor_state = + { id : string ; + titre : string; + prepare :string; + diff : float option ; + solution : string ; + question : string ; + template : string ; + test : string ; + prelude : string; + mtime : float } + +open Json_encoding + +let editor_state_enc = + + conv + (fun {id ; titre ; prepare; diff;solution ; question ;template ; test;prelude ; mtime } -> + (id , titre , prepare, diff, solution , question , template , test, prelude , mtime)) + (fun (id , titre , prepare, diff, solution , question , template , test, prelude , mtime) -> + {id ; titre ; prepare; diff;solution ; question ;template ; test; prelude ; mtime }) + (obj10 + (req "id" string) + (req "titre" string) + (req "prepare" string) + (opt "diff" float ) + (req "solution" string) + (req "question" string) + (req "template" string) + (req "test" string) + (req "prelude" string) + (dft "mtime" float 0.)) + +open Learnocaml_index;; +type index_state= + { + exos: exercise Map.Make (String).t ; + mtime :float + + } +let index_state_enc = conv (fun {exos;mtime}->(exos,mtime) ) (fun (exos,mtime)->{exos;mtime}) (obj2 (req "exercises" (map_enc exercise_enc)) (dft "mtime" float 0.)) diff --git a/src/state/learnocaml_exercise_state.mli b/src/state/learnocaml_exercise_state.mli index 87564aead..d546561cb 100644 --- a/src/state/learnocaml_exercise_state.mli +++ b/src/state/learnocaml_exercise_state.mli @@ -22,3 +22,26 @@ type exercise_state = mtime : float } val exercise_state_enc : exercise_state Json_encoding.encoding + +type editor_state = + { id : string ; + titre : string; + prepare : string ; + diff : float option; + solution : string ; + question : string ; + template : string ; + test : string ; + prelude : string ; + mtime : float } + +val editor_state_enc : editor_state Json_encoding.encoding +open Learnocaml_index +type index_state = + { + exos : Learnocaml_index.exercise Map.Make(String).t; + mtime : float; + } + + +val index_state_enc : index_state Json_encoding.encoding diff --git a/src/utils/build.ocp b/src/utils/build.ocp index fa81bd390..cfb3a4b97 100644 --- a/src/utils/build.ocp +++ b/src/utils/build.ocp @@ -41,3 +41,4 @@ begin library "xor" "base64" ] end + diff --git a/static/css/learnocaml_exercise.css b/static/css/learnocaml_exercise.css index 17f0a3cca..34a41d80e 100644 --- a/static/css/learnocaml_exercise.css +++ b/static/css/learnocaml_exercise.css @@ -129,6 +129,37 @@ body { z-index: 998; opacity: 1; } + +/* petit changement */ + #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template { + border-bottom: none; + background: #bbb; + } + #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template::after { + display: none; + } + #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-template { + z-index: 998; + opacity: 1; + } + + + + #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test { + border-bottom: none; + background: #bbb; + } + #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test::after { + display: none; + } + #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-test { + z-index: 998; + opacity: 1; + } + +/* fin changement */ + + #learnocaml-exo-tabs > * { left: 800px; top: 40px; right: 0px; bottom: 0px; } @@ -224,6 +255,148 @@ body { display: none; } } +/*--------------------- template ---------------------------------- */ +#learnocaml-exo-tab-buttons > #learnocaml-exo-button-template { + background: #444; + color: white; +} +#learnocaml-exo-tab-template > .template-pane { + position: absolute; + left: 0; top: 0; bottom: 40px; width: 100%; + background: #666; + color: #fff; + z-index: 1002; +} +#learnocaml-exo-tab-template > .buttons { + position: absolute; + left: 0; bottom: 0px; width: 100%; height: 40px; + background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px); + color: #fff; + line-height: 40px; + display: flex; + flex-direction: row; + z-index: 1003; +} +#learnocaml-exo-tab-template > .buttons::after { + position: absolute; + bottom: 40px; left: 0px; height: 5px; width: 100%; + background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px); + content:""; +} +#learnocaml-exo-tab-template > .buttons > button { + flex: 1; + background: none; + border: none; + color: #eee; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + border-top: 1px #eee solid; + position: relative; + padding: 0; +} +#learnocaml-exo-tab-template > .buttons > button:not(:first-child) { + border-left: 1px #eee solid; +} +@media (max-width: 550px) { + #learnocaml-exo-tab-template > .buttons > button > .label { + display: none; + } +} + +/*--------------------- prepare ---------------------------------- */ +#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prepare { + background: #444; + color: white; +} +#learnocaml-exo-tab-prepare > .prepare-pane { + position: absolute; + left: 0; top: 0; bottom: 40px; width: 100%; + background: #666; + color: #fff; + z-index: 1002; +} +#learnocaml-exo-tab-prepare > .buttons { + position: absolute; + left: 0; bottom: 0px; width: 100%; height: 40px; + background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px); + color: #fff; + line-height: 40px; + display: flex; + flex-direction: row; + z-index: 1003; +} +#learnocaml-exo-tab-prepare > .buttons::after { + position: absolute; + bottom: 40px; left: 0px; height: 5px; width: 100%; + background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px); + content:""; +} +#learnocaml-exo-tab-prepare > .buttons > button { + flex: 1; + background: none; + border: none; + color: #eee; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + border-top: 1px #eee solid; + position: relative; + padding: 0; +} +#learnocaml-exo-tab-prepare > .buttons > button:not(:first-child) { + border-left: 1px #eee solid; +} +@media (max-width: 550px) { + #learnocaml-exo-tab-prepare > .buttons > button > .label { + display: none; + } +} + +/*--------------------- prelude ---------------------------------- */ +#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prelude { + background: #444; + color: white; +} +#learnocaml-exo-tab-prelude > .prelude-pane { + position: absolute; + left: 0; top: 0; bottom: 40px; width: 100%; + background: #666; + color: #fff; + z-index: 1002; +} +#learnocaml-exo-tab-prelude > .buttons { + position: absolute; + left: 0; bottom: 0px; width: 100%; height: 40px; + background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px); + color: #fff; + line-height: 40px; + display: flex; + flex-direction: row; + z-index: 1003; +} +#learnocaml-exo-tab-prelude > .buttons::after { + position: absolute; + bottom: 40px; left: 0px; height: 5px; width: 100%; + background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px); + content:""; +} +#learnocaml-exo-tab-prelude > .buttons > button { + flex: 1; + background: none; + border: none; + color: #eee; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + border-top: 1px #eee solid; + position: relative; + padding: 0; +} +#learnocaml-exo-tab-prelude > .buttons > button:not(:first-child) { + border-left: 1px #eee solid; +} +@media (max-width: 550px) { + #learnocaml-exo-tab-prelude > .buttons > button > .label { + display: none; + } +} + + /* -------------------- toplevel tab ------------------------------ */ #learnocaml-exo-tab-toplevel > .toplevel-pane { position: absolute; @@ -280,6 +453,60 @@ body { content: ""; background: linear-gradient(to bottom, rgba(0,0,0,0.5) 0, transparent 5px) ; } + + +/* attention changement */ + +#learnocaml-exo-tab-buttons > #learnocaml-exo-button-test { + background: #444; + color: white; +} +#learnocaml-exo-tab-test > .test-pane { + position: absolute; + left: 0; top: 0; bottom: 40px; width: 100%; + background: #666; + color: #fff; + z-index: 1002; +} +#learnocaml-exo-tab-test > .buttons { + position: absolute; + left: 0; bottom: 0px; width: 100%; height: 40px; + background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px); + color: #fff; + line-height: 40px; + display: flex; + flex-direction: row; + z-index: 1003; +} +#learnocaml-exo-tab-test > .buttons::after { + position: absolute; + bottom: 40px; left: 0px; height: 5px; width: 100%; + background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px); + content:""; +} +#learnocaml-exo-tab-test > .buttons > button { + flex: 1; + background: none; + border: none; + color: #eee; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + border-top: 1px #eee solid; + position: relative; + padding: 0; +} +#learnocaml-exo-tab-test > .buttons > button:not(:first-child) { + border-left: 1px #eee solid; +} +@media (max-width: 550px) { + #learnocaml-exo-tab-test > .buttons > button > .label { + display: none; + } +} + +/* fin du changement */ + + + /* -------------------- report tab -------------------------------- */ #learnocaml-exo-tab-report { border: none; @@ -457,6 +684,321 @@ body { } +/* petit changement */ + +#learnocaml-exo-test-pane { + font-size: 18px; + font-family: 'Inconsolata', monospace; +} +#learnocaml-exo-test-pane .ace_gutter { + background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ; + color: #ccc; +} +#learnocaml-exo-test-pane .ace_gutter-active-line { + background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ; + color: #888; +} +#learnocaml-exo-test-pane .ace_gutter-cell { + padding: 0 14px 0 0; +} +#learnocaml-exo-test-pane .ace_gutter-cell.ace_warning { + background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ; +} +#learnocaml-exo-test-pane .ace_gutter-cell.ace_error { + background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ; +} +#learnocaml-exo-test-pane .ace_comment { color: #aaa; font-style: italic; } +#learnocaml-exo-test-pane .ace_keyword { color: #e80; font-weight:bold; } +#learnocaml-exo-test-pane .ace_constant { color: #acf; } +#learnocaml-exo-test-pane .ace_string { color: #acf; } +#learnocaml-exo-test-pane .ace_function { color: #fff; } +#learnocaml-exo-test-pane .ace_type { color: #fff; } +#learnocaml-exo-test-pane .ace_operator { color: #fff; } +#learnocaml-exo-test-pane .ace_meta { color: #fff; } +#learnocaml-exo-test-pane .ace_variable { color: #fff; } +#learnocaml-exo-test-pane .ace_text { color: #fff; } +#learnocaml-exo-test-pane .error { + border-bottom: 2px #b00 solid; + position: absolute; +} + +#learnocaml-exo-test-pane .warning { + border-bottom: 2px #ca0 solid; + position: absolute; +} + +#learnocaml-exo-test-pane .ace_selection { background: #e80; opacity: 0.4; } +#learnocaml-exo-test-pane .ace_active-line { background: #acf; opacity: 0.2; } +#learnocaml-exo-test-pane .ace_selected-word { background: #e80; opacity: 0.2; } + +#learnocaml-exo-test-pane.ocaml-check-success::after, +#learnocaml-exo-test-pane.ocaml-check-warn::after, +#learnocaml-exo-test-pane.ocaml-check-error::after { + animation: 1s check_status_animation; + animation-fill-mode: forwards; + position: absolute; + margin: -100px 0 0 0; + top: 50%; + text-align: center; + font-size: 200px; + line-height: 200px; + width: 100%; +} + +#learnocaml-exo-test-pane.ocaml-check-success::after { + content: "✌"; + color: #0a0; + text-shadow: 0px 0px 40px #6F6; +} + +#learnocaml-exo-test-pane.ocaml-check-warn::after { + content: "✋"; + color: #ec0; + text-shadow: 0px 0px 40px #Fe6; +} + +#learnocaml-exo-test-pane.ocaml-check-error::after { + content: "☠"; + color: #b00; + text-shadow: 0px 0px 40px #F66; +} + +/* pour template */ +#learnocaml-exo-template-pane { + font-size: 18px; + font-family: 'Inconsolata', monospace; +} +#learnocaml-exo-template-pane .ace_gutter { + background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ; + color: #ccc; +} +#learnocaml-exo-template-pane .ace_gutter-active-line { + background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ; + color: #888; +} +#learnocaml-exo-template-pane .ace_gutter-cell { + padding: 0 14px 0 0; +} +#learnocaml-exo-template-pane .ace_gutter-cell.ace_warning { + background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ; +} +#learnocaml-exo-template-pane .ace_gutter-cell.ace_error { + background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ; +} +#learnocaml-exo-template-pane .ace_comment { color: #aaa; font-style: italic; } +#learnocaml-exo-template-pane .ace_keyword { color: #e80; font-weight:bold; } +#learnocaml-exo-template-pane .ace_constant { color: #acf; } +#learnocaml-exo-template-pane .ace_string { color: #acf; } +#learnocaml-exo-template-pane .ace_function { color: #fff; } +#learnocaml-exo-template-pane .ace_type { color: #fff; } +#learnocaml-exo-template-pane .ace_operator { color: #fff; } +#learnocaml-exo-template-pane .ace_meta { color: #fff; } +#learnocaml-exo-template-pane .ace_variable { color: #fff; } +#learnocaml-exo-template-pane .ace_text { color: #fff; } +#learnocaml-exo-template-pane .error { + border-bottom: 2px #b00 solid; + position: absolute; +} + +#learnocaml-exo-template-pane .warning { + border-bottom: 2px #ca0 solid; + position: absolute; +} + +#learnocaml-exo-template-pane .ace_selection { background: #e80; opacity: 0.4; } +#learnocaml-exo-template-pane .ace_active-line { background: #acf; opacity: 0.2; } +#learnocaml-exo-template-pane .ace_selected-word { background: #e80; opacity: 0.2; } + +#learnocaml-exo-template-pane.ocaml-check-success::after, +#learnocaml-exo-template-pane.ocaml-check-warn::after, +#learnocaml-exo-template-pane.ocaml-check-error::after { + animation: 1s check_status_animation; + animation-fill-mode: forwards; + position: absolute; + margin: -100px 0 0 0; + top: 50%; + text-align: center; + font-size: 200px; + line-height: 200px; + width: 100%; +} + +#learnocaml-exo-template-pane.ocaml-check-success::after { + content: "✌"; + color: #0a0; + text-shadow: 0px 0px 40px #6F6; +} + +#learnocaml-exo-template-pane.ocaml-check-warn::after { + content: "✋"; + color: #ec0; + text-shadow: 0px 0px 40px #Fe6; +} + +#learnocaml-exo-template-pane.ocaml-check-error::after { + content: "☠"; + color: #b00; + text-shadow: 0px 0px 40px #F66; +} + +/*prepare*/ + +#learnocaml-exo-prepare-pane { + font-size: 18px; + font-family: 'Inconsolata', monospace; +} +#learnocaml-exo-prepare-pane .ace_gutter { + background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ; + color: #ccc; +} +#learnocaml-exo-prepare-pane .ace_gutter-active-line { + background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ; + color: #888; +} +#learnocaml-exo-prepare-pane .ace_gutter-cell { + padding: 0 14px 0 0; +} +#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_warning { + background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ; +} +#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_error { + background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ; +} +#learnocaml-exo-prepare-pane .ace_comment { color: #aaa; font-style: italic; } +#learnocaml-exo-prepare-pane .ace_keyword { color: #e80; font-weight:bold; } +#learnocaml-exo-prepare-pane .ace_constant { color: #acf; } +#learnocaml-exo-prepare-pane .ace_string { color: #acf; } +#learnocaml-exo-prepare-pane .ace_function { color: #fff; } +#learnocaml-exo-prepare-pane .ace_type { color: #fff; } +#learnocaml-exo-prepare-pane .ace_operator { color: #fff; } +#learnocaml-exo-prepare-pane .ace_meta { color: #fff; } +#learnocaml-exo-prepare-pane .ace_variable { color: #fff; } +#learnocaml-exo-prepare-pane .ace_text { color: #fff; } +#learnocaml-exo-prepare-pane .error { + border-bottom: 2px #b00 solid; + position: absolute; +} + +#learnocaml-exo-prepare-pane .warning { + border-bottom: 2px #ca0 solid; + position: absolute; +} + +#learnocaml-exo-prepare-pane .ace_selection { background: #e80; opacity: 0.4; } +#learnocaml-exo-prepare-pane .ace_active-line { background: #acf; opacity: 0.2; } +#learnocaml-exo-prepare-pane .ace_selected-word { background: #e80; opacity: 0.2; } + +#learnocaml-exo-prepare-pane.ocaml-check-success::after, +#learnocaml-exo-prepare-pane.ocaml-check-warn::after, +#learnocaml-exo-prepare-pane.ocaml-check-error::after { + animation: 1s check_status_animation; + animation-fill-mode: forwards; + position: absolute; + margin: -100px 0 0 0; + top: 50%; + text-align: center; + font-size: 200px; + line-height: 200px; + width: 100%; +} + +#learnocaml-exo-prepare-pane.ocaml-check-success::after { + content: "✌"; + color: #0a0; + text-shadow: 0px 0px 40px #6F6; +} + +#learnocaml-exo-prepare-pane.ocaml-check-warn::after { + content: "✋"; + color: #ec0; + text-shadow: 0px 0px 40px #Fe6; +} + +#learnocaml-exo-prepare-pane.ocaml-check-error::after { + content: "☠"; + color: #b00; + text-shadow: 0px 0px 40px #F66; +} + +/*prelude*/ + +#learnocaml-exo-prelude-pane { + font-size: 18px; + font-family: 'Inconsolata', monospace; +} +#learnocaml-exo-prelude-pane .ace_gutter { + background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ; + color: #ccc; +} +#learnocaml-exo-prelude-pane .ace_gutter-active-line { + background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ; + color: #888; +} +#learnocaml-exo-prelude-pane .ace_gutter-cell { + padding: 0 14px 0 0; +} +#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_warning { + background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ; +} +#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_error { + background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ; +} +#learnocaml-exo-prelude-pane .ace_comment { color: #aaa; font-style: italic; } +#learnocaml-exo-prelude-pane .ace_keyword { color: #e80; font-weight:bold; } +#learnocaml-exo-prelude-pane .ace_constant { color: #acf; } +#learnocaml-exo-prelude-pane .ace_string { color: #acf; } +#learnocaml-exo-prelude-pane .ace_function { color: #fff; } +#learnocaml-exo-prelude-pane .ace_type { color: #fff; } +#learnocaml-exo-prelude-pane .ace_operator { color: #fff; } +#learnocaml-exo-prelude-pane .ace_meta { color: #fff; } +#learnocaml-exo-prelude-pane .ace_variable { color: #fff; } +#learnocaml-exo-prelude-pane .ace_text { color: #fff; } +#learnocaml-exo-prelude-pane .error { + border-bottom: 2px #b00 solid; + position: absolute; +} + +#learnocaml-exo-prelude-pane .warning { + border-bottom: 2px #ca0 solid; + position: absolute; +} + +#learnocaml-exo-prelude-pane .ace_selection { background: #e80; opacity: 0.4; } +#learnocaml-exo-prelude-pane .ace_active-line { background: #acf; opacity: 0.2; } +#learnocaml-exo-prelude-pane .ace_selected-word { background: #e80; opacity: 0.2; } + +#learnocaml-exo-prelude-pane.ocaml-check-success::after, +#learnocaml-exo-prelude-pane.ocaml-check-warn::after, +#learnocaml-exo-prelude-pane.ocaml-check-error::after { + animation: 1s check_status_animation; + animation-fill-mode: forwards; + position: absolute; + margin: -100px 0 0 0; + top: 50%; + text-align: center; + font-size: 200px; + line-height: 200px; + width: 100%; +} + +#learnocaml-exo-prelude-pane.ocaml-check-success::after { + content: "✌"; + color: #0a0; + text-shadow: 0px 0px 40px #6F6; +} + +#learnocaml-exo-prelude-pane.ocaml-check-warn::after { + content: "✋"; + color: #ec0; + text-shadow: 0px 0px 40px #Fe6; +} + +#learnocaml-exo-prelude-pane.ocaml-check-error::after { + content: "☠"; + color: #b00; + text-shadow: 0px 0px 40px #F66; +} + @keyframes check_status_animation { 0% { opacity: 0; z-index: 9999; } 49% { opacity: 1; transform: scale(2); z-index: 9999; } @@ -470,3 +1012,4 @@ body { 99% { opacity: 0; transform: scale(2); z-index: 9999; } 100% { opacity: 0; z-index: -9999; } } +/* fin changement */ diff --git a/static/editor.html b/static/editor.html new file mode 100644 index 000000000..b0f838591 --- /dev/null +++ b/static/editor.html @@ -0,0 +1,162 @@ + + + + + + Learn OCaml by OCamlPro - Exercise + + + + + + + + + + + +
+ + + + + +
+ +
+
+
  • Preparing the environment
+
+ + + +
+ + + + + + + + + + + + + +
+
+ +
+
Editor
+
+ + + + + + + + + + + + + + + + + +
+
+
+
+ + + + + +
+
+ + + + + + + + + + + + + +
+
+ +
+ + + + + Click the Grade! button to test your solution + +
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ + +
+
Editor
+
+
+ + + + +
+ + diff --git a/static/icons/icon_cleanup_black.svg b/static/icons/icon_cleanup_black.svg new file mode 100644 index 000000000..171e7551e --- /dev/null +++ b/static/icons/icon_cleanup_black.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_cleanup_dark.svg b/static/icons/icon_cleanup_dark.svg new file mode 100644 index 000000000..da0aac638 --- /dev/null +++ b/static/icons/icon_cleanup_dark.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_cleanup_light.svg b/static/icons/icon_cleanup_light.svg new file mode 100644 index 000000000..193a45550 --- /dev/null +++ b/static/icons/icon_cleanup_light.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_cleanup_white.svg b/static/icons/icon_cleanup_white.svg new file mode 100644 index 000000000..36e2c2043 --- /dev/null +++ b/static/icons/icon_cleanup_white.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_down_black.svg b/static/icons/icon_down_black.svg new file mode 100644 index 000000000..1df28d721 --- /dev/null +++ b/static/icons/icon_down_black.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_down_dark.svg b/static/icons/icon_down_dark.svg new file mode 100644 index 000000000..61932bf68 --- /dev/null +++ b/static/icons/icon_down_dark.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_down_light.svg b/static/icons/icon_down_light.svg new file mode 100644 index 000000000..c65bf25bc --- /dev/null +++ b/static/icons/icon_down_light.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_down_white.svg b/static/icons/icon_down_white.svg new file mode 100644 index 000000000..3506af3bc --- /dev/null +++ b/static/icons/icon_down_white.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_download_black.svg b/static/icons/icon_download_black.svg new file mode 100644 index 000000000..49801524c --- /dev/null +++ b/static/icons/icon_download_black.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_download_dark.svg b/static/icons/icon_download_dark.svg new file mode 100644 index 000000000..2465863e9 --- /dev/null +++ b/static/icons/icon_download_dark.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_download_light.svg b/static/icons/icon_download_light.svg new file mode 100644 index 000000000..e9ef959a6 --- /dev/null +++ b/static/icons/icon_download_light.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_download_white.svg b/static/icons/icon_download_white.svg new file mode 100644 index 000000000..0c79dd1da --- /dev/null +++ b/static/icons/icon_download_white.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_left_black.svg b/static/icons/icon_left_black.svg new file mode 100644 index 000000000..1b4394d7d --- /dev/null +++ b/static/icons/icon_left_black.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_left_dark.svg b/static/icons/icon_left_dark.svg new file mode 100644 index 000000000..119301b32 --- /dev/null +++ b/static/icons/icon_left_dark.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_left_light.svg b/static/icons/icon_left_light.svg new file mode 100644 index 000000000..7c53d429e --- /dev/null +++ b/static/icons/icon_left_light.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_left_white.svg b/static/icons/icon_left_white.svg new file mode 100644 index 000000000..e1464669a --- /dev/null +++ b/static/icons/icon_left_white.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_list_black.svg b/static/icons/icon_list_black.svg new file mode 100644 index 000000000..5c0e565b8 --- /dev/null +++ b/static/icons/icon_list_black.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_list_dark.svg b/static/icons/icon_list_dark.svg new file mode 100644 index 000000000..9d05e06d0 --- /dev/null +++ b/static/icons/icon_list_dark.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_list_light.svg b/static/icons/icon_list_light.svg new file mode 100644 index 000000000..14a210596 --- /dev/null +++ b/static/icons/icon_list_light.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_list_white.svg b/static/icons/icon_list_white.svg new file mode 100644 index 000000000..b30e332fb --- /dev/null +++ b/static/icons/icon_list_white.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_menu_black.svg b/static/icons/icon_menu_black.svg new file mode 100644 index 000000000..d8bd12126 --- /dev/null +++ b/static/icons/icon_menu_black.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/static/icons/icon_menu_dark.svg b/static/icons/icon_menu_dark.svg new file mode 100644 index 000000000..ec7bcd09e --- /dev/null +++ b/static/icons/icon_menu_dark.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/static/icons/icon_menu_light.svg b/static/icons/icon_menu_light.svg new file mode 100644 index 000000000..138f10946 --- /dev/null +++ b/static/icons/icon_menu_light.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/static/icons/icon_menu_white.svg b/static/icons/icon_menu_white.svg new file mode 100644 index 000000000..45b6cb1ef --- /dev/null +++ b/static/icons/icon_menu_white.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/static/icons/icon_reload_black.svg b/static/icons/icon_reload_black.svg new file mode 100644 index 000000000..90544a6ab --- /dev/null +++ b/static/icons/icon_reload_black.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_reload_dark.svg b/static/icons/icon_reload_dark.svg new file mode 100644 index 000000000..9d298824c --- /dev/null +++ b/static/icons/icon_reload_dark.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_reload_light.svg b/static/icons/icon_reload_light.svg new file mode 100644 index 000000000..1c4e3d430 --- /dev/null +++ b/static/icons/icon_reload_light.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_reload_white.svg b/static/icons/icon_reload_white.svg new file mode 100644 index 000000000..a935030b5 --- /dev/null +++ b/static/icons/icon_reload_white.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/static/icons/icon_right_black.svg b/static/icons/icon_right_black.svg new file mode 100644 index 000000000..f0aba78ab --- /dev/null +++ b/static/icons/icon_right_black.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_right_dark.svg b/static/icons/icon_right_dark.svg new file mode 100644 index 000000000..a657b05dd --- /dev/null +++ b/static/icons/icon_right_dark.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_right_light.svg b/static/icons/icon_right_light.svg new file mode 100644 index 000000000..056dd0659 --- /dev/null +++ b/static/icons/icon_right_light.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_right_white.svg b/static/icons/icon_right_white.svg new file mode 100644 index 000000000..b01367fef --- /dev/null +++ b/static/icons/icon_right_white.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_run_black.svg b/static/icons/icon_run_black.svg new file mode 100644 index 000000000..cf0922e5f --- /dev/null +++ b/static/icons/icon_run_black.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_run_dark.svg b/static/icons/icon_run_dark.svg new file mode 100644 index 000000000..54f30b62a --- /dev/null +++ b/static/icons/icon_run_dark.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_run_light.svg b/static/icons/icon_run_light.svg new file mode 100644 index 000000000..860e9dd0d --- /dev/null +++ b/static/icons/icon_run_light.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_run_white.svg b/static/icons/icon_run_white.svg new file mode 100644 index 000000000..700b093d8 --- /dev/null +++ b/static/icons/icon_run_white.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_save_black.svg b/static/icons/icon_save_black.svg new file mode 100644 index 000000000..a1f2c106f --- /dev/null +++ b/static/icons/icon_save_black.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_save_dark.svg b/static/icons/icon_save_dark.svg new file mode 100644 index 000000000..1dc7acdec --- /dev/null +++ b/static/icons/icon_save_dark.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_save_light.svg b/static/icons/icon_save_light.svg new file mode 100644 index 000000000..46c10d2e6 --- /dev/null +++ b/static/icons/icon_save_light.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_save_white.svg b/static/icons/icon_save_white.svg new file mode 100644 index 000000000..5a45c191c --- /dev/null +++ b/static/icons/icon_save_white.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_sync_black.svg b/static/icons/icon_sync_black.svg new file mode 100644 index 000000000..1fa5dc6ee --- /dev/null +++ b/static/icons/icon_sync_black.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/static/icons/icon_sync_dark.svg b/static/icons/icon_sync_dark.svg new file mode 100644 index 000000000..371dc5dd6 --- /dev/null +++ b/static/icons/icon_sync_dark.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/static/icons/icon_sync_light.svg b/static/icons/icon_sync_light.svg new file mode 100644 index 000000000..9d1fb4121 --- /dev/null +++ b/static/icons/icon_sync_light.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/static/icons/icon_sync_white.svg b/static/icons/icon_sync_white.svg new file mode 100644 index 000000000..26f543247 --- /dev/null +++ b/static/icons/icon_sync_white.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/static/icons/icon_typecheck_black.svg b/static/icons/icon_typecheck_black.svg new file mode 100644 index 000000000..4b55e0dfc --- /dev/null +++ b/static/icons/icon_typecheck_black.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_typecheck_dark.svg b/static/icons/icon_typecheck_dark.svg new file mode 100644 index 000000000..02a976de9 --- /dev/null +++ b/static/icons/icon_typecheck_dark.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_typecheck_light.svg b/static/icons/icon_typecheck_light.svg new file mode 100644 index 000000000..0c67302c1 --- /dev/null +++ b/static/icons/icon_typecheck_light.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_typecheck_white.svg b/static/icons/icon_typecheck_white.svg new file mode 100644 index 000000000..64095fc9a --- /dev/null +++ b/static/icons/icon_typecheck_white.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/static/icons/icon_up_black.svg b/static/icons/icon_up_black.svg new file mode 100644 index 000000000..795f2dfdb --- /dev/null +++ b/static/icons/icon_up_black.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_up_dark.svg b/static/icons/icon_up_dark.svg new file mode 100644 index 000000000..41b9e8f2d --- /dev/null +++ b/static/icons/icon_up_dark.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_up_light.svg b/static/icons/icon_up_light.svg new file mode 100644 index 000000000..6192a0d86 --- /dev/null +++ b/static/icons/icon_up_light.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_up_white.svg b/static/icons/icon_up_white.svg new file mode 100644 index 000000000..7f3fca207 --- /dev/null +++ b/static/icons/icon_up_white.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_upload_black.svg b/static/icons/icon_upload_black.svg new file mode 100644 index 000000000..09ff5ecea --- /dev/null +++ b/static/icons/icon_upload_black.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_upload_dark.svg b/static/icons/icon_upload_dark.svg new file mode 100644 index 000000000..0f18ee57a --- /dev/null +++ b/static/icons/icon_upload_dark.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_upload_light.svg b/static/icons/icon_upload_light.svg new file mode 100644 index 000000000..20e33d311 --- /dev/null +++ b/static/icons/icon_upload_light.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/icons/icon_upload_white.svg b/static/icons/icon_upload_white.svg new file mode 100644 index 000000000..1d5b0d70d --- /dev/null +++ b/static/icons/icon_upload_white.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/static/index.html b/static/index.html index bedcaf5eb..db2d7a788 100644 --- a/static/index.html +++ b/static/index.html @@ -35,6 +35,7 @@ +
diff --git a/static/new_exercise.html b/static/new_exercise.html new file mode 100644 index 000000000..353a25875 --- /dev/null +++ b/static/new_exercise.html @@ -0,0 +1,85 @@ + + + + + + Learn OCaml by OCamlPro - Exercise + + + + + + + + + +
+ + + + + +
+
+ +
+
+

New Exercise

+ +

+ + + +

+

+ + + +

+

+ + +

+

+ + +

+ + + + + +
+ + From 58f6eb2bf5c58be74bf7c9516684cd331c4738f3 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 24 Jun 2019 01:52:10 +0200 Subject: [PATCH 02/91] feat: learn-ocaml-editor version 0.2.0 Co-authored-by: Manuel Cabarcos-Baulina Co-authored-by: Romain Grimal Co-authored-by: Alexandre Perge Co-authored-by: Sophie Rumin --- .gitignore | 10 +- Makefile | 2 + demo-repository/exercises/manu/template.ml | 2 +- demo-repository/exercises/manu/test.ml | 2 +- docs/howto-edit-exercises.md | 97 ++ src/ace-lib/ace.ml | 6 +- src/ace-lib/ocaml_mode.ml | 6 +- src/app/build.ocp | 4 + src/app/learnocaml_common.ml | 50 +- src/app/learnocaml_common.mli | 15 +- src/app/learnocaml_exercise_main.ml | 158 +- src/app/learnocaml_index_main.ml | 419 ++--- src/app/learnocaml_local_storage.ml | 2 +- src/app/learnocaml_sync.ml | 39 +- src/app/server_caller.ml | 24 +- src/editor/build.ocp | 99 +- src/editor/editor.ml | 1066 ++++++++----- src/editor/editor_lib.ml | 750 +++++++++ src/editor/editor_lib.mli | 109 ++ src/editor/new_exercise.ml | 269 ++-- src/editor/test_spec.ml | 269 ++++ src/editor/test_spec.mli | 4 + src/editor/testhaut.ml | 445 ++++++ src/grader/grader_cli.ml | 18 +- src/grader/grader_jsoo_worker.ml | 4 +- src/grader/grading.ml | 9 +- src/grader/grading_jsoo.ml | 3 +- src/grader/introspection.ml | 51 +- src/grader/test_lib.ml | 451 ++++-- src/grader/test_lib.mli | 11 + src/main/learnocaml_main.ml | 71 +- src/ppx-metaquot/genlifter.ml | 31 +- src/ppx-metaquot/ppx_metaquot.ml | 6 +- src/ppx-metaquot/ty.ml | 2 +- src/repo/learnocaml_exercise.ml | 5 +- src/repo/learnocaml_index.ml | 3 +- src/repo/learnocaml_index.mli | 2 +- .../learnocaml_process_exercise_repository.ml | 51 +- .../learnocaml_process_tutorial_repository.ml | 24 +- src/repo/learnocaml_tutorial_parser.ml | 40 +- src/repo/learnocaml_tutorial_reader_main.ml | 36 +- src/simple-server/learnocaml_simple_server.ml | 9 +- src/state/learnocaml_exercise_state.ml | 249 ++- src/state/learnocaml_exercise_state.mli | 61 +- src/state/learnocaml_report.ml | 37 +- src/toplevel/build.ocp | 1 + src/toplevel/learnocaml_toplevel.ml | 23 +- src/toplevel/learnocaml_toplevel.mli | 4 + src/toplevel/learnocaml_toplevel_input.ml | 13 +- src/toplevel/learnocaml_toplevel_input.mli | 2 +- src/toplevel/learnocaml_toplevel_output.ml | 46 +- src/toplevel/learnocaml_toplevel_output.mli | 4 +- .../learnocaml_toplevel_worker_caller.ml | 5 +- .../learnocaml_toplevel_worker_main.ml | 24 +- src/toploop/toploop_ext.ml | 4 +- src/toploop/toploop_unix.ml | 3 +- src/utils/build.ocp | 13 + src/utils/js_utils.ml | 55 +- src/utils/js_utils.mli | 1 + src/utils/lwt_request.ml | 32 +- src/utils/ppx_ocplib_i18n.ml | 3 +- src/utils/translate.ml | 21 + src/utils/translate.mli | 13 + src/utils/xor.ml | 2 +- static/css/learnocaml_common.css | 18 +- static/css/learnocaml_editor.css | 1417 +++++++++++++++++ static/css/learnocaml_exercise.css | 566 +------ static/css/learnocaml_new_exercise.css | 87 + static/css/learnocaml_test.css | 506 ++++++ static/editor.html | 99 +- static/exercise.html | 15 +- static/icons/favicon.ico | Bin 0 -> 1150 bytes static/icons/icon_cleanup_black.svg | 79 - static/icons/icon_cleanup_dark.svg | 79 - static/icons/icon_cleanup_light.svg | 79 - static/icons/icon_cleanup_white.svg | 79 - static/icons/icon_down_black.svg | 72 - static/icons/icon_down_dark.svg | 72 - static/icons/icon_down_light.svg | 72 - static/icons/icon_down_white.svg | 72 - static/icons/icon_download_black.svg | 70 - static/icons/icon_download_dark.svg | 70 - static/icons/icon_download_light.svg | 70 - static/icons/icon_download_white.svg | 70 - static/icons/icon_left_black.svg | 72 - static/icons/icon_left_dark.svg | 72 - static/icons/icon_left_light.svg | 72 - static/icons/icon_left_white.svg | 72 - static/icons/icon_list_black.svg | 90 -- static/icons/icon_list_dark.svg | 90 -- static/icons/icon_list_light.svg | 90 -- static/icons/icon_list_white.svg | 90 -- static/icons/icon_menu_black.svg | 91 -- static/icons/icon_menu_dark.svg | 91 -- static/icons/icon_menu_light.svg | 91 -- static/icons/icon_menu_white.svg | 91 -- static/icons/icon_reload_black.svg | 80 - static/icons/icon_reload_dark.svg | 80 - static/icons/icon_reload_light.svg | 80 - static/icons/icon_reload_white.svg | 80 - static/icons/icon_right_black.svg | 72 - static/icons/icon_right_dark.svg | 72 - static/icons/icon_right_light.svg | 72 - static/icons/icon_right_white.svg | 72 - static/icons/icon_run_black.svg | 72 - static/icons/icon_run_dark.svg | 72 - static/icons/icon_run_light.svg | 72 - static/icons/icon_run_white.svg | 72 - static/icons/icon_save_black.svg | 70 - static/icons/icon_save_dark.svg | 70 - static/icons/icon_save_light.svg | 70 - static/icons/icon_save_white.svg | 70 - static/icons/icon_sync_black.svg | 97 -- static/icons/icon_sync_dark.svg | 97 -- static/icons/icon_sync_light.svg | 97 -- static/icons/icon_sync_white.svg | 97 -- static/icons/icon_typecheck_black.svg | 81 - static/icons/icon_typecheck_dark.svg | 81 - static/icons/icon_typecheck_light.svg | 81 - static/icons/icon_typecheck_white.svg | 81 - static/icons/icon_up_black.svg | 72 - static/icons/icon_up_dark.svg | 72 - static/icons/icon_up_light.svg | 72 - static/icons/icon_up_white.svg | 72 - static/icons/icon_upload_black.svg | 71 - static/icons/icon_upload_dark.svg | 71 - static/icons/icon_upload_light.svg | 71 - static/icons/icon_upload_white.svg | 71 - static/index.html | 3 + static/new_exercise.html | 33 +- static/test.html | 168 ++ translations/fr.po | 629 ++++++-- 132 files changed, 6893 insertions(+), 6294 deletions(-) create mode 100644 docs/howto-edit-exercises.md create mode 100644 src/editor/editor_lib.ml create mode 100644 src/editor/editor_lib.mli create mode 100644 src/editor/test_spec.ml create mode 100644 src/editor/test_spec.mli create mode 100644 src/editor/testhaut.ml create mode 100644 src/utils/translate.ml create mode 100644 src/utils/translate.mli create mode 100644 static/css/learnocaml_editor.css create mode 100644 static/css/learnocaml_new_exercise.css create mode 100644 static/css/learnocaml_test.css create mode 100644 static/icons/favicon.ico delete mode 100644 static/icons/icon_cleanup_black.svg delete mode 100644 static/icons/icon_cleanup_dark.svg delete mode 100644 static/icons/icon_cleanup_light.svg delete mode 100644 static/icons/icon_cleanup_white.svg delete mode 100644 static/icons/icon_down_black.svg delete mode 100644 static/icons/icon_down_dark.svg delete mode 100644 static/icons/icon_down_light.svg delete mode 100644 static/icons/icon_down_white.svg delete mode 100644 static/icons/icon_download_black.svg delete mode 100644 static/icons/icon_download_dark.svg delete mode 100644 static/icons/icon_download_light.svg delete mode 100644 static/icons/icon_download_white.svg delete mode 100644 static/icons/icon_left_black.svg delete mode 100644 static/icons/icon_left_dark.svg delete mode 100644 static/icons/icon_left_light.svg delete mode 100644 static/icons/icon_left_white.svg delete mode 100644 static/icons/icon_list_black.svg delete mode 100644 static/icons/icon_list_dark.svg delete mode 100644 static/icons/icon_list_light.svg delete mode 100644 static/icons/icon_list_white.svg delete mode 100644 static/icons/icon_menu_black.svg delete mode 100644 static/icons/icon_menu_dark.svg delete mode 100644 static/icons/icon_menu_light.svg delete mode 100644 static/icons/icon_menu_white.svg delete mode 100644 static/icons/icon_reload_black.svg delete mode 100644 static/icons/icon_reload_dark.svg delete mode 100644 static/icons/icon_reload_light.svg delete mode 100644 static/icons/icon_reload_white.svg delete mode 100644 static/icons/icon_right_black.svg delete mode 100644 static/icons/icon_right_dark.svg delete mode 100644 static/icons/icon_right_light.svg delete mode 100644 static/icons/icon_right_white.svg delete mode 100644 static/icons/icon_run_black.svg delete mode 100644 static/icons/icon_run_dark.svg delete mode 100644 static/icons/icon_run_light.svg delete mode 100644 static/icons/icon_run_white.svg delete mode 100644 static/icons/icon_save_black.svg delete mode 100644 static/icons/icon_save_dark.svg delete mode 100644 static/icons/icon_save_light.svg delete mode 100644 static/icons/icon_save_white.svg delete mode 100644 static/icons/icon_sync_black.svg delete mode 100644 static/icons/icon_sync_dark.svg delete mode 100644 static/icons/icon_sync_light.svg delete mode 100644 static/icons/icon_sync_white.svg delete mode 100644 static/icons/icon_typecheck_black.svg delete mode 100644 static/icons/icon_typecheck_dark.svg delete mode 100644 static/icons/icon_typecheck_light.svg delete mode 100644 static/icons/icon_typecheck_white.svg delete mode 100644 static/icons/icon_up_black.svg delete mode 100644 static/icons/icon_up_dark.svg delete mode 100644 static/icons/icon_up_light.svg delete mode 100644 static/icons/icon_up_white.svg delete mode 100644 static/icons/icon_upload_black.svg delete mode 100644 static/icons/icon_upload_dark.svg delete mode 100644 static/icons/icon_upload_light.svg delete mode 100644 static/icons/icon_upload_white.svg create mode 100644 static/test.html diff --git a/.gitignore b/.gitignore index 85a8f3f90..b923fe012 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,6 @@ *~ +\#*\# +.\#* _obuild _opam @@ -22,10 +24,10 @@ www/ sync/ -static/*_black.svg -static/*_dark.svg -static/*_light.svg -static/*_white.svg +static/icons/*_black.svg +static/icons/*_dark.svg +static/icons/*_light.svg +static/icons/*_white.svg static/Fontin* translations/*.pot diff --git a/Makefile b/Makefile index 5a8924dd3..48900cdee 100644 --- a/Makefile +++ b/Makefile @@ -57,6 +57,7 @@ install: static @cp _obuild/*/editor.js ${DEST_DIR}/js/ @cp _obuild/*/new_exercise.js ${DEST_DIR}/js/ + @cp _obuild/*/testhaut.js ${DEST_DIR}/js/ .PHONY: learn-ocaml.install travis @@ -105,6 +106,7 @@ clean: ${wildcard ${EXERCISES_DIR}/*/meta.json}} -find -name \*~ -delete -find -name \#\*\# -delete + -find -name .\#\* -delete travis: # From https://stackoverflow.com/questions/21053657/how-to-run-travis-ci-locally BUILDID="build-$$RANDOM"; \ diff --git a/demo-repository/exercises/manu/template.ml b/demo-repository/exercises/manu/template.ml index 102f8afc6..050285422 100644 --- a/demo-repository/exercises/manu/template.ml +++ b/demo-repository/exercises/manu/template.ml @@ -1,2 +1,2 @@ -let med = +let med = diff --git a/demo-repository/exercises/manu/test.ml b/demo-repository/exercises/manu/test.ml index d52e448e9..04175f652 100644 --- a/demo-repository/exercises/manu/test.ml +++ b/demo-repository/exercises/manu/test.ml @@ -9,4 +9,4 @@ let () = test_function_1_against_solution [%ty : int list -> float ] "med" ~gen:20 [] ) ; - ] + ] diff --git a/docs/howto-edit-exercises.md b/docs/howto-edit-exercises.md new file mode 100644 index 000000000..3e8b86afa --- /dev/null +++ b/docs/howto-edit-exercises.md @@ -0,0 +1,97 @@ +How to edit an exercise from the learn-ocaml platform? +====================================================== + +This tutorial explains how to create or edit an automatically graded exercise from the learn-ocaml platform. + +Step 0 : Preliminaries + +- An exercise description is composed of 8 files. + +- `descr.html` contains the exercise statement as a sequence of + HTML elements (that can be grafted in a `div`). + + - `meta.json` contains metadata about the exercise. + + - `prelude.ml` is an OCaml code fragment loaded in the toplevel before + the student answer. + + - `prepare.ml` is an OCaml code fragment inserted after the prelude when + the student answer is graded. + + - `solution.ml` is your answer to the exercise. + + - `template.ml` is the OCaml code fragment that initializes a fresh + student answer. + + - `test.ml` is the grader code. + + - `title.txt` is a one-line file containing the title of the exercise. + +### Do it yourself ! + +With the Editor view, this structure is grouped for facilitate you the creation of an exercise without forget a file for example. +For the moment, your list of exercises is probably empty but it will be populated by the next step of this tutorial. + +## Step 1: Create a new exercise + +As the first time you just need to click on "New exercise". You go to be redirected towards a form of metadatas. + +- Fields to be filled + + - id : this is the identifier of the exercise. Careful, he must be unique, consisted of small letter, figure dash or underscore. + + - title : this is the title of the exercise, it is thanks to him that you will reconignize the exercise in the list. Careful, he must be unique. + + - description : a short description of the exercise, which will be posted in the list of the exercises created below its title. (Optional) + + - difficulty : a note between 0 and 4 allowing to place the difficulty of the exercise. + +- Different buttons + + - Cancel : if you wish to cancel the cration of an exercise and to return to the main menu. + + - Save : if you wish to validate and pass following the creation of an exercise. + +Congratulation you have just created an exercise ! +For draft your exercise meeting in the step 2. + +## Step 2 : Write your exercise + +Now that you find yourselves in the view of edition of a exercise you can see various tabs. But let us proceed by stage. + +1. First of all, position you in the tab Question where you have to write in Markdown (or HTML if you prefer) the various questions which will be asked to the pupil. Attention to write well the name of the various functions to have the same base for the correction. + +2. Now that you have establishes the various functions which the student has to write. We recommend to you of draft them you even. +For it return on the tab Solution (or the left tab if you have the screen separated in two) and write the code of the various functions as on a basic publisher. + + - button Check allows to verify if your solution is syntactically correct. + +3. If wish to be sure that the student leaves on good bases to draft his code. We advise you to write him a template whom he can complete with his own solution.It is in the tab Template that all this takes place. + + - button Generate Template permit to write automatic the temple from your solution + +4. Now that the solution is to write it is necessary to be able to test it. for it you have two possibilities: + + - High-level (tab Test): you don't know too much the syntax in use, or you wish to save time. This solution is made for you. You can generate automaticaly tests for every function of your solution (button Generate), or you can create them manually thanks to the headband New Question. + + - Solution: In this case you wish to test the solution of the student with your solution. For it you can supply a set of test (Arguments) or create randomly sets of tests. + + - Specification: Here you wish to look if the solution of the student verifies certain properties (as the double of the argument, a number bigger than 5). For it you can supply a set of test (Arguments) or create randomly sets of tests, et you have to give the specification of the function. + + - Suite: In this last case, you wish compared the solution of the student with results directly. For it you have to supply a set of couple (entered, taken out) + +Watch out! In it is three cases you have to respect the syntax which is you explain directly on the platform. + +If you have end to write all the tests you can compile for cross directly of this code high level in a code low level. + + - Low-level (tab Test.ml): you known the syntax to write the tests to be made for the solution. Then you can write if you wish directly the code in this buffer. + +Here is you now wrote a ready for use exercise. But be you safe that he is correct? If you wish verify him, let us pass in the step 3. + +## Step 3 : Test your exercise! + +- Grade: First of all you can test your solution with her even, it allows to verify that the test is correct. If you haven't all the points it is that there is an error in the sets of tests. + +- Experiment: You have an ended exercise and you wish to test it from the point of view of a pupil? We invite you to click on this button to realize this experience. + +Congratulation you have just ended the creation of an exercise! diff --git a/src/ace-lib/ace.ml b/src/ace-lib/ace.ml index 34be3d576..9629bf192 100644 --- a/src/ace-lib/ace.ml +++ b/src/ace-lib/ace.ml @@ -142,7 +142,8 @@ let set_mark editor ?loc ?(type_ = Message) msg = | None -> () | Some range -> editor.marks <- - session##(addMarker range (Js.string type_) (Js.string "text") (Js._false)) :: + session##(addMarker range (Js.string type_) + (Js.string "text") Js._false) :: editor.marks let set_background_color editor color = @@ -191,7 +192,8 @@ let add_keybinding { editor } let command : _ command Js.t = Js.Unsafe.obj [||] in let binding : binding Js.t = Js.Unsafe.obj [||] in command##.name := Js.string name; - command##.exec := Js.wrap_callback (fun ed _args -> exec (fst ed##.customData)); + command##.exec := Js.wrap_callback + (fun ed _args -> exec (fst ed##.customData)); iter_option (fun ro -> command##.readOnly := Js.bool ro) ro; iter_option (fun s -> command##.scrollIntoView := Js.string s) diff --git a/src/ace-lib/ocaml_mode.ml b/src/ace-lib/ocaml_mode.ml index 2a5dce37b..82079e053 100644 --- a/src/ace-lib/ocaml_mode.ml +++ b/src/ace-lib/ocaml_mode.ml @@ -279,7 +279,8 @@ let get_line_tokens line st row doc = | Some (tok, lex_ctxt, stream) -> let block = IndentBlock.update !config.indent st.block stream tok; in let tok, block, offset = - if not first || all_spaces line || IndentBlock.is_in_comment block then + if not first || all_spaces line || + IndentBlock.is_in_comment block then tok, block, offset else if not !config.forced then (* Update ocp-indent context with current indentation. *) @@ -303,7 +304,8 @@ let get_line_tokens line st row doc = let col = Nstream.(Region.start_column tok.region) in if IndentBlock.is_at_top block then mark_phrase doc (Ace.create_position row (col + offset)); - if !debug_indent > 1 && tok.token <> EOL && tok.token <> ESCAPED_EOL then + if !debug_indent > 1 && tok.token <> EOL && + tok.token <> ESCAPED_EOL then IndentBlock.dump block; let st = { block; lex_ctxt; } in match tok.token with diff --git a/src/app/build.ocp b/src/app/build.ocp index c29acd13f..c71a91c59 100644 --- a/src/app/build.ocp +++ b/src/app/build.ocp @@ -39,6 +39,8 @@ begin program "learnocaml-main" "learnocaml-toplevel" "js_of_ocaml.ppx" "ocplib_i18n" + "translate" + "editor_lib" ] files = [ "learnocaml_index_main.ml" ( comp = [ ppx_js ppx_ocplib_i18n ]) @@ -69,6 +71,8 @@ begin program "learnocaml-exercise" "js_of_ocaml.ppx" "ocplib_i18n" "omd" + "editor_lib" + "translate" ] files = [ "learnocaml_exercise_main.ml" ( comp = [ ppx_ocplib_i18n ppx_js ] ) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index 9f5193d96..d770b1a94 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -37,13 +37,14 @@ let fake_download ~name ~contents = Js.Unsafe.global ##. _Blob in let blob = new%js blob (Js.array [| contents |]) in let url = - Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject blob |] in + Js.Unsafe.meth_call (Js.Unsafe.global##._URL) + "createObjectURL" [| Js.Unsafe.inject blob |] in let link = Dom_html.createA Dom_html.document in link##.href := url ; Js.Unsafe.set link (Js.string "download") (Js.string name) ; - ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; + ignore (Dom_html.document##.body##(appendChild (link :> Dom.node Js.t))) ; ignore (Js.Unsafe.meth_call link "click" [||]) ; - ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t)))) + ignore (Dom_html.document##.body##(removeChild (link :> Dom.node Js.t))) let fake_upload () = let input_files_load = @@ -57,12 +58,13 @@ let fake_upload () = Js.Opt.case (ev##.target) fail @@ fun target -> Js.Opt.case (Dom_html.CoerceTo.input target) fail @@ fun input -> Js.Optdef.case (input##.files) fail @@ fun files -> - Js.Opt.case (files##(item (0))) fail @@ fun file -> + Js.Opt.case (files##(item 0)) fail @@ fun file -> let name = Js.to_string file##.name in let fileReader = new%js File.fileReader in fileReader##.onload := Dom.handler (fun ev -> Js.Opt.case (ev##.target) fail @@ fun target -> - Js.Opt.case (File.CoerceTo.string (target##.result)) fail @@ fun result -> + Js.Opt.case (File.CoerceTo.string (target##.result)) fail @@ + fun result -> Lwt.wakeup result_wakener (name, result) ; Js._true) ; fileReader##(readAsText file) ; @@ -221,9 +223,43 @@ let button ~container ~theme ?group ?state ~icon lbl cb = | Some group -> group in let button = Tyxml_js.Html.(button [ - img ~alt:(lbl ^ " icon") ~src:("icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + img ~alt:(lbl ^ " icon") + ~src:("icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; pcdata " " ; - span ~a:[ a_class [ "label" ] ] [ pcdata lbl ] + span ~a:[ a_class [ "label" ] ] [ pcdata lbl ]; + ]) in + Manip.Ev.onclick button + (fun _ -> + begin Lwt.async @@ fun () -> + Lwt_mutex.with_lock mutex @@ fun () -> + disabling_button_group group cb + end ; + true) ; + let dom_button = + (Tyxml_js.To_dom.of_button button + :> < disabled : bool Js.t Js.prop > Js.t) in + let self_disabled = + match state with + | None -> ref false + | Some (disabled, self) -> + self := Some (group, dom_button) ; + disabled in + others := (dom_button, self_disabled) :: !others ; + if !self_disabled || !cnt > 0 then + dom_button##.disabled := Js.bool true ; + Manip.appendChild container button + +let button2 ~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 = + Tyxml_js.Html.(button ~a:[a_id "grade_id"] [ + img ~alt:(lbl ^ " icon") + ~src:("icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + pcdata " " ; + span ~a:[ a_class [ "label" ] ] [ pcdata lbl ]; ]) in Manip.Ev.onclick button (fun _ -> diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index e2458cc90..5074d547a 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -15,7 +15,7 @@ * You should have received a copy of the GNU Affero General Public License * along with this program. If not, see . *) -val find_div_or_append_to_body : string -> [> Html_types.div ] Tyxml_js.Html.elt +val find_div_or_append_to_body : string -> [> Html_types.div] Tyxml_js.Html.elt val find_component : string -> 'a Tyxml_js.Html.elt @@ -23,13 +23,13 @@ val gettimeofday : unit -> float val fake_download : name: string -> contents: Js.js_string Js.t -> unit -val fake_upload : unit -> (string * Js.js_string Js.t ) Lwt.t +val fake_upload : unit -> (string * Js.js_string Js.t) Lwt.t val fatal : string -> unit val hide_loading : ?id: string -> unit -> unit -val show_loading : ?id: string -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt list -> unit +val show_loading : ?id: string -> [< Html_types.div_content_fun] Tyxml_js.Html.elt list -> unit val set_assoc : string -> 'a -> (string * 'a) list -> (string * 'a) list @@ -74,6 +74,15 @@ val button : string -> (unit -> unit Lwt.t) -> unit +val button2 : + container: 'a Tyxml_js.Html.elt -> + theme: string -> + ?group: button_group -> + ?state: button_state -> + icon:string -> + string -> (unit -> unit Lwt.t) -> + unit + val render_rich_text : ?on_runnable_clicked: (string -> unit) -> Learnocaml_index.text -> diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index 36f8f15b8..3afaa6135 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -19,19 +19,12 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Learnocaml_exercise_state -let get_titre id = Learnocaml_local_storage.(retrieve (editor_state id)).titre - -let get_diff id = Learnocaml_local_storage.(retrieve (editor_state id)).diff -let get_solution id = Learnocaml_local_storage.(retrieve (editor_state id)).solution -let get_question id = Learnocaml_local_storage.(retrieve (editor_state id)).question -let get_template id = Learnocaml_local_storage.(retrieve (editor_state id)).template -let get_test id = Learnocaml_local_storage.(retrieve (editor_state id)).test -let get_prelude id = Learnocaml_local_storage.(retrieve (editor_state id)).prelude -let get_prepare id = Learnocaml_local_storage.(retrieve (editor_state id)).prepare +open Editor_lib +let ref_grade = ref 150 ;; let init_tabs, select_tab = - let names = [ "text" ; "toplevel" ; "report" ; "editor" ] in + let names = ["text" ; "toplevel" ; "report" ; "editor"] in let current = ref "text" in let select_tab name = set_arg "tab" name ; @@ -73,13 +66,30 @@ let init_tabs, select_tab = select_tab !current in init_tabs, select_tab + let transResultOption = function + |None -> false + |Some s-> true ;; + +(* experiment button of editor.html redirects to the html associated to this ml + to know if we are in this page because of that we decide + to put a '.' before the id + therefore idEditor looks for a '.' before the id *) + +let idEditor s = transResultOption + (Regexp.string_match (Regexp.regexp "^[.]+") s 0) ;; +let id = arg "id" ;; + let display_report exo report = + + let score_maxi = if idEditor id then int_of_string (arg "score") + else (Learnocaml_exercise.(get max_score) exo) in + let score, failed = Learnocaml_report.result_of_report report in let report_button = find_component "learnocaml-exo-button-report" in Manip.removeClass report_button "success" ; Manip.removeClass report_button "failure" ; Manip.removeClass report_button "partial" ; - let grade = score * 100 / (Learnocaml_exercise.(get max_score) exo) in + let grade = if score_maxi = 0 then 0 else score * 100 / score_maxi in if grade >= 100 then begin Manip.addClass report_button "success" ; Manip.replaceChildren report_button @@ -97,23 +107,10 @@ let display_report exo report = end ; let report_container = find_component "learnocaml-exo-tab-report" in Manip.setInnerHtml report_container - (Format.asprintf "%a" Learnocaml_report.(output_html_of_report ~bare: true) report) ; + (Format.asprintf "%a" + Learnocaml_report.(output_html_of_report ~bare: true) report) ; grade -let set_string_translations () = - let translations = [ - "txt_preparing", [%i"Preparing the environment"]; - "learnocaml-exo-button-editor", [%i"Editor"]; - "learnocaml-exo-button-toplevel", [%i"Toplevel"]; - "learnocaml-exo-button-report", [%i"Report"]; - "learnocaml-exo-button-text", [%i"Exercise"]; - "learnocaml-exo-editor-pane", [%i"Editor"]; - "txt_grade_report", [%i"Click the Grade button to get your report"]; - ] in - List.iter - (fun (id, text) -> - Manip.setInnerHtml (find_component id) text) - translations let () = Lwt.async_exception_hook := begin function @@ -121,9 +118,20 @@ let () = | Server_caller.Cannot_fetch message -> fatal message | exn -> fatal (Printexc.to_string exn) end ; - (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); + (match Js_utils.get_lang() with + | Some l -> Ocplib_i18n.set_lang l + | None -> ()); Lwt.async @@ fun () -> - set_string_translations (); + let translations = [ + "txt_preparing", [%i"Preparing the environment"]; + "learnocaml-exo-button-editor", [%i"Editor"]; + "learnocaml-exo-button-toplevel", [%i"Toplevel"]; + "learnocaml-exo-button-report", [%i"Report"]; + "learnocaml-exo-button-text", [%i"Exercise"]; + "learnocaml-exo-editor-pane", [%i"Editor"]; + "txt_grade_report", [%i"Click the Grade! button to get your report"]; + ] in + Translate.set_string_translations translations; Learnocaml_local_storage.init () ; (* ---- launch everything --------------------------------------------- *) let toplevel_buttons_group = button_group () in @@ -132,34 +140,13 @@ let () = let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in let toplevel_button = button ~container: toplevel_toolbar ~theme: "dark" in let editor_button = button ~container: editor_toolbar ~theme: "light" in - let transResultOption = function - |None -> false - |Some s-> true in - let idEditor s = transResultOption (Regexp.string_match (Regexp.regexp "^[\.]+") s 0) in - let id = arg "id" in - + +(* if we came from a true exercise we search in the server. + In the other case we get the exercise information from the Local storage *) let exercise_fetch = match idEditor id with | false -> Server_caller.fetch_exercise id - | _ -> let id = String.sub id 1 ((String.length id)-1) in - let exo0 ()= - let titre = get_titre id in - let question =get_question id in - let question =Omd.to_html (Omd.of_string question) in - - let exo1= Learnocaml_exercise.set Learnocaml_exercise.id id Learnocaml_exercise.empty in - let exo2= Learnocaml_exercise.set Learnocaml_exercise.title titre exo1 in - let exo3 =Learnocaml_exercise.set Learnocaml_exercise.max_score 1 exo2 in - let exo4 =Learnocaml_exercise.set Learnocaml_exercise.prepare (get_prepare id) exo3 in - let exo5 =Learnocaml_exercise.set Learnocaml_exercise.prelude (get_prelude id) exo4 in - let exo6 =Learnocaml_exercise.set Learnocaml_exercise.solution (get_solution id) exo5 in - let exo7 =Learnocaml_exercise.set Learnocaml_exercise.test (get_test id) exo6 in - let exo8 =Learnocaml_exercise.set Learnocaml_exercise.template (get_template id) exo7 in - Learnocaml_exercise.set Learnocaml_exercise.descr (question) exo8 - in - Lwt.return (exo0 () ) -in - let id =if idEditor id then String.sub id 1 ((String.length id)-1) else id in - + | _ -> let proper_id = String.sub id 1 ((String.length id)-1) in + Lwt.return (exo_creator proper_id ) in let after_init top = exercise_fetch >>= fun exo -> begin match Learnocaml_exercise.(get prelude) exo with @@ -205,7 +192,10 @@ in init_tabs () ; toplevel_launch >>= fun top -> exercise_fetch >>= fun exo -> - let solution = match Learnocaml_local_storage.(retrieve (exercise_state id)) with + + + let solution = + match Learnocaml_local_storage.(retrieve (exercise_state id)) with | { Learnocaml_exercise_state.report = Some report ; solution } -> let _ : int = display_report exo report in Some solution @@ -222,7 +212,8 @@ in begin toplevel_button ~icon: "reload" [%i"Reset"] @@ fun () -> toplevel_launch >>= fun top -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + disabling_button_group toplevel_buttons_group + (fun () -> Learnocaml_toplevel.reset top) end ; begin toplevel_button ~group: toplevel_buttons_group @@ -279,7 +270,8 @@ in \ %s - exercise text\ \ - \ + \ \ \ \ @@ -294,7 +286,8 @@ in d##close) ; (* ---- editor pane --------------------------------------------------- *) let editor_pane = find_component "learnocaml-exo-editor-pane" in - let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in + let editor = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_pane) in let ace = Ocaml_mode.get_editor editor in Ace.set_contents ace (match solution with @@ -361,12 +354,22 @@ in (* ---- main toolbar -------------------------------------------------- *) let exo_toolbar = find_component "learnocaml-exo-toolbar" in let toolbar_button = button ~container: exo_toolbar ~theme: "light" in + let () = if idEditor id then + begin + let id = String.sub id 1 ((String.length id)-1) in + begin toolbar_button + ~icon: "upload" [%i"Edit"] @@ fun ()-> + Dom_html.window##.location##assign + (Js.string ("editor.html#id=" ^ id ^ "&action=open")); + Lwt.return_unit + end; + end in begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> Dom_html.window##.location##assign (Js.string "index.html#activity=exercises") ; Lwt.return () - end ; + end; (* marque fin de la barre au dessus de celle a creer *) let messages = Tyxml_js.Html5.ul [] in let callback text = Manip.appendChild messages Tyxml_js.Html5.(li [ pcdata text ]) in @@ -399,26 +402,36 @@ in Lwt_js.sleep 5. >>= fun () -> Manip.SetCss.opacity abort_message (Some "1") ; aborted >>= fun () -> - Lwt.return Learnocaml_report.[ Message ([ Text [%i"Grading aborted by user."] ], Failure) ] in + Lwt.return Learnocaml_report.[ Message + ([ Text [%i"Grading aborted by user."] ], Failure) ] in Lwt.pick [ grading ; abortion ] >>= fun report -> - let grade = display_report exo report in - worker := Grading_jsoo.get_grade ~callback exo ; - Learnocaml_local_storage.(store (exercise_state id)) - { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; - mtime = gettimeofday () } ; + let _ = display_report exo report in + (* if not(idEditor id) then *) + begin + worker := Grading_jsoo.get_grade ~callback exo ; + (* Learnocaml_local_storage.(store (exercise_state id)) + { Learnocaml_exercise_state.grade = Some grade ; + solution ; report = Some report ; + mtime = gettimeofday () } *) + end; select_tab "report" ; Lwt_js.yield () >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; Lwt.return () | Toploop_results.Error _ -> - let msg = + let msg = Learnocaml_report.[ Text [%i"Error in your code."] ; Break ; - Text [%i"Cannot start the grader if your code does not typecheck."] ] in + Text [%i"Cannot start the grader \ + if your code does not typecheck."] ] in let report = Learnocaml_report.[ Message (msg, Failure) ] in - let grade = display_report exo report in - Learnocaml_local_storage.(store (exercise_state id)) - { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; - mtime = gettimeofday () } ; + let _ = display_report exo report in + (* if not(idEditor id) then + begin + Learnocaml_local_storage.(store (exercise_state id)) + { Learnocaml_exercise_state.grade = Some grade ; + solution ; report = Some report ; + mtime = gettimeofday () } + end ; *) select_tab "report" ; Lwt_js.yield () >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; @@ -428,5 +441,4 @@ in toplevel_launch >>= fun _ -> typecheck false >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; - Lwt.return () -;; + Lwt.return () ;; diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index d9b9921f4..99f8cee66 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -19,9 +19,9 @@ open Js_utils open Lwt open Learnocaml_index open Learnocaml_common - +open Editor_lib module StringMap = Map.Make (String) - + let exercises_tab _ _ () = show_loading ~id:"learnocaml-main-loading" @@ -44,9 +44,11 @@ let exercises_tab _ _ () = | exception Not_found -> None | { Learnocaml_exercise_state.grade } -> grade in let pct_signal, pct_signal_set = React.S.create pct_init in - Learnocaml_local_storage.(listener (exercise_state exercise_id)) := + Learnocaml_local_storage.(listener + (exercise_state exercise_id)) := Some (function - | Some { Learnocaml_exercise_state.grade } -> pct_signal_set grade + | Some { Learnocaml_exercise_state.grade } -> + pct_signal_set grade | None -> pct_signal_set None) ; let pct_text_signal = React.S.map @@ -63,7 +65,8 @@ let exercises_tab _ _ () = | Some pct when pct >= 100 -> [ "stats" ; "success" ] | Some _ -> [ "stats" ; "partial" ]) pct_signal in - a ~a:[ a_href ("exercise.html#id=" ^ exercise_id ^ "&action=open") ; + a ~a:[ a_href ("exercise.html#id=" ^ exercise_id ^ + "&action=open") ; a_class [ "exercise" ] ] [ div ~a:[ a_class [ "descr" ] ] [ h1 [ pcdata exercise_title ] ; @@ -100,168 +103,213 @@ let exercises_tab _ _ () = groups acc in List.rev (format_contents 1 [] index) in let list_div = - Tyxml_js.Html5.(div ~a: [ Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) - (format_exercise_list Learnocaml_local_storage.(retrieve all_exercise_states)) in + Tyxml_js.Html5.(div ~a: + [ Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) + (format_exercise_list + Learnocaml_local_storage.(retrieve all_exercise_states)) in Manip.appendChild content_div list_div ; hide_loading ~id:"learnocaml-main-loading" () ; - Lwt.return list_div -;; - - - - (*let editor_tab _ _ () = - show_loading ~id:"learnocaml-main-loading" - Tyxml_js.Html5.[ ul [ li [ pcdata "Loading editor" ] ] ]; - Lwt_js.sleep 0.5 >>= fun () -> - let div = Tyxml_js.Html5.(div ~a: [ a_id "learnocaml-main-editor" ]) [] in - hide_loading ~id:"learnocaml-main-loading" (); - Lwt.return div;; *) - - - - -let init ()= Learnocaml_local_storage.(store (index_state "index")) {Learnocaml_exercise_state.exos=StringMap.empty;mtime=gettimeofday ()};; - -(*test*) -let editor_tab _ _ () = + Lwt.return list_div;; + + +let init () = + Learnocaml_local_storage.(store (index_state "index")) + {Learnocaml_exercise_state.exos = StringMap.empty; mtime = gettimeofday ()};; + +let delete_button_handler exercise_id = + (fun _ -> + begin + let messages = Tyxml_js.Html5.ul [] in + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in + Manip.Ev.onclick btn_no ( fun _ -> + hide_loading ~id:"learnocaml-main-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in + Manip.Ev.onclick btn_yes (fun _ -> + remove_exo exercise_id; + Dom_html.window##.location##reload ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata [%i"Are you sure you want \ + to delete this exercise?\n"] ; + btn_yes ; + pcdata " " ; + btn_no ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-main-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + end ; + true) ;; + +let rec editor_tab _ _ () = Learnocaml_local_storage.init (); - let pct_init=None in + let pct_init = None in let pct_signal, pct_signal_set = React.S.create pct_init in Learnocaml_local_storage.(listener (index_state "index")) := Some (fun _-> pct_signal_set None) ; - - let ()= - match Learnocaml_local_storage.(retrieve (index_state "index")) with - |exception Not_found -> init () - |_->() - in - Server_caller.fetch_editor_index () >>= fun index -> - show_loading ~id:"learnocaml-main-loading" - Tyxml_js.Html5.[ ul [ li [ pcdata "Loading editor" ] ] ] ; - - Lwt_js.sleep 0.5 >>= fun () -> - let content_div = find_component "learnocaml-main-content" in - let format_exercise_list all_exercise_states = - let rec format_contents lvl acc contents = - let open Tyxml_js.Html5 in - match contents with - | Learnocaml_exercises exercises -> - StringMap.fold - (fun exercise_id { exercise_kind ; - exercise_title ; - exercise_short_description ; - exercise_stars } acc -> + let () = + match Learnocaml_local_storage.(retrieve (index_state "index")) with + | exception Not_found -> init () + | _ -> () in + Server_caller.fetch_editor_index () >>= fun index -> + show_loading ~id:"learnocaml-main-loading" + Tyxml_js.Html5.[ ul [ li [ pcdata [%i"Loading editor"]]]] ; + Lwt_js.sleep 0.5 >>= fun () -> + let content_div = find_component "learnocaml-main-content" in + let format_exercise_list all_exercise_states = + let rec format_contents lvl acc contents = + let open Tyxml_js.Html5 in + match contents with + | Learnocaml_exercises exercises -> + StringMap.fold + (fun exercise_id { exercise_kind ; + exercise_title ; + exercise_short_description ; + exercise_stars } acc -> let pct_init =None in - let pct_signal, pct_signal_set = React.S.create pct_init in + let pct_signal, pct_signal_set = React.S.create pct_init in Learnocaml_local_storage.(listener (editor_state exercise_id)) := Some (fun _-> pct_signal_set None) ; let status_classes_signal = React.S.map (function - | None -> [ "stats" ] - | Some 0 -> [ "stats" ; "failure" ] - | Some pct when pct >= 100 -> [ "stats" ; "success" ] - | Some _ -> [ "stats" ; "partial" ]) + | None -> [ "stats" ] + | Some 0 -> [ "stats" ; "failure" ] + | Some pct when pct >= 100 -> [ "stats" ; "success" ] + | Some _ -> [ "stats" ; "partial" ]) pct_signal in - (div ~a:[a_id ("button_delete")] [ - let button =button ~a:[a_id exercise_id] [img ~src:("icons/icon_cleanup_dark.svg") ~alt:"" () ; pcdata "" ]in - Manip.Ev.onclick button - (fun _ -> - (* begin - let messages = Tyxml_js.Html5.ul [] in - let aborted, abort_message = - let t, u = Lwt.task () in - let btn_no = Tyxml_js.Html5.(button [ pcdata "No" ]) in - Manip.Ev.onclick btn_no ( fun _ -> - hide_loading ~id:"learnocaml-exo-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in - Manip.Ev.onclick btn_yes (fun _ -> - let rmv= - match Learnocaml_local_storage.(retrieve (index_state "index")) with - |{Learnocaml_exercise_state.exos ;mtime}-> exos - in - let exos = StringMap.remove exercise_id rmv in - let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in - Learnocaml_local_storage.(store (index_state "index")) index; - Learnocaml_local_storage.(delete (editor_state exercise_id)); - Dom_html.window##.location##reload ; true) ; - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata "Are you sure you want to delete the exercise ?\n" ; - btn_yes ; - pcdata " " ; - btn_no ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "" ] ] ; - show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1") ; - *) - let rmv= - match Learnocaml_local_storage.(retrieve (index_state "index")) with - |{Learnocaml_exercise_state.exos ;mtime}-> exos - in - let exos = StringMap.remove exercise_id rmv in - let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in - Learnocaml_local_storage.(store (index_state "index")) index; - Learnocaml_local_storage.(delete (editor_state exercise_id)); - Dom_html.window##.location##reload ; -(* - end ;*) - true) ;button - ] ) :: - a ~a:[ a_href ("editor.html#id="^exercise_id^"&action=open") ; + div ~a:[a_id "toolbar"; a_class ["button"]] [ + (div ~a:[a_id "button_delete"] [ + let button = button ~a:[a_id exercise_id] + [img ~src:"icons/icon_cleanup_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick button + (delete_button_handler exercise_id) ;button + ] ); + (div ~a:[a_id "button_download"] [ + let button = button ~a:[a_id exercise_id] + [img ~src:"icons/icon_download_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick button + (fun _ -> + let name = exercise_id ^ ".json" in + let content = + Learnocaml_local_storage.(retrieve + (editor_state exercise_id)) in + let json = + Json_repr_browser.Json_encoding.construct + Learnocaml_exercise_state.editor_state_enc + content in + let contents = + (Js._JSON##stringify json) in + Learnocaml_common.fake_download ~name ~contents; + true) ;button + ] )] :: + a ~a:[ a_href ("editor.html#id="^exercise_id^"&action=open") ; a_class [ "exercise" ] ] [ - div ~a:[ a_class [ "descr" ] ] [ - h1 [ pcdata exercise_title ] ; - p [ match exercise_short_description with - | None -> pcdata "No description available." - | Some text -> pcdata text ] ; - - ] ; - - div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ - div ~a:[ a_class [ "stars" ] ] [ - let num = 5 * int_of_float (exercise_stars *. 2.) in - let num = max (min num 40) 0 in - let alt = Format.asprintf "difficulty: %d / 40" num in - let src = Format.asprintf "icons/stars_%02d.svg" num in - img ~alt ~src () - ] ; - div ~a:[ a_class [ "length" ] ] [ - match exercise_kind with - | Project -> pcdata "editor project" - | Problem -> pcdata "editor problem" - | Learnocaml_exercise -> pcdata "editor exercise" ] ; - - ]; - - ] :: - acc) - exercises acc - | Groups groups -> - let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in - StringMap.fold - (fun _ { group_title ; group_contents } acc -> + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata exercise_title ] ; + p [ match exercise_short_description with + | None -> pcdata [%i"No description available."] + | Some text -> pcdata text ] ; + ] ; + div ~a:[ Tyxml_js.R.Html5.a_class status_classes_signal ] [ + div ~a:[ a_class [ "stars" ] ] [ + let num = 5 * int_of_float (exercise_stars *. 2.) in + let num = max (min num 40) 0 in + let alt = + Format.asprintf "difficulty: %d / 40" num in + let src = + Format.asprintf "icons/stars_%02d.svg" num in + img ~alt ~src () + ] ; + div ~a:[ a_class [ "length" ] ] [ + match exercise_kind with + | Project -> pcdata "editor project" + | Problem -> pcdata "editor problem" + | Learnocaml_exercise -> + pcdata "editor exercise" ] ; + ]; + ] :: + acc) + exercises acc + | Groups groups -> + let h = match lvl with 1 -> h1 | 2 -> h2 | _ -> h3 in + StringMap.fold + (fun _ { group_title ; group_contents } acc -> format_contents (succ lvl) (h ~a:[ a_class [ "pack" ] ] [ pcdata group_title ] :: acc) group_contents) - groups acc in - let open Tyxml_js.Html5 in - List.rev (format_contents 1 [a ~a:[ a_href ("new_exercise.html#&action=open") ; - a_class [ "exercise" ] ] [ - div ~a:[ a_class [ "descr" ] ] [ - h1 [ pcdata "New exercise" ]; - p [pcdata "Create a new exercise"];]; - ]] index) in - let list_div = - Tyxml_js.Html5.(div ~a: [ Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) - (format_exercise_list Learnocaml_local_storage.(retrieve all_exercise_states)) in - Manip.appendChild content_div list_div ; - hide_loading ~id:"learnocaml-main-loading" () ; - Lwt.return list_div -;; + groups acc in + let open Tyxml_js.Html5 in + let restore_bar = a ~a:[ a_onclick (fun _ -> + let _ = begin + Learnocaml_common.fake_upload () >>= fun (_, contents) -> + let open Learnocaml_exercise_state in + let save_file = + Json_repr_browser.Json_encoding.destruct + Learnocaml_exercise_state.editor_state_enc + (Js._JSON##(parse contents)) in + let messages = Tyxml_js.Html5.ul [] in + if idUnique save_file.metadata.id && + titleUnique save_file.metadata.titre then + begin + Learnocaml_local_storage.(store + (editor_state save_file.metadata.id) save_file); + store_in_index save_file.metadata; + Dom_html.window##.location##reload; + Lwt.return_unit + end + else + begin + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_ok = Tyxml_js.Html5.(button [ pcdata [%i"OK"] ]) in + Manip.Ev.onclick btn_ok (fun _ -> hide_loading + ~id:"learnocaml-main-loading" () ; + true) ; + + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata [%i"Identifier and/or title \ + not unique\n"] ; + btn_ok + ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-main-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1"); + Lwt.return_unit + end; + Lwt.return (); + end in (); + true); a_class [ "exercise"] ] + [ div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata [%i"Import an exercise"] ]; + p [pcdata [%i"Import a new exercise \ + from a json file"]]]] in + List.rev (format_contents 1 + [a ~a:[ a_href "new_exercise.html#&action=open"; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata [%i"New exercise"] ]; + p [pcdata [%i"Create \ + a new exercise"]]]]; + restore_bar] index) in + let list_div = + Tyxml_js.Html5.(div ~a: + [ Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) + (format_exercise_list + Learnocaml_local_storage.(retrieve all_exercise_states)) in + Manip.appendChild content_div list_div ; + hide_loading ~id:"learnocaml-main-loading" () ; + Lwt.return list_div;; let lessons_tab select (arg, set_arg, delete_arg) () = let open Learnocaml_lesson in @@ -287,7 +335,8 @@ let lessons_tab select (arg, set_arg, delete_arg) () = | [ _ ] (* assumes single id *) -> None, None | (one, _) :: (two, _) :: _ when id = one -> None, Some two | (one, _) :: (two, _) :: [] when id = two -> Some one, None - | (one, _) :: (two, _) :: (three, _) :: _ when id = two -> Some one, Some three + | (one, _) :: (two, _) :: (three, _) :: _ when id = two -> + Some one, Some three | _ :: rest -> loop rest in loop index in let selector = @@ -382,7 +431,8 @@ let lessons_tab select (arg, set_arg, delete_arg) () = Manip.appendChild navigation_div selector ; disable_with_button_group (Tyxml_js.To_dom.of_select selector) group ; (Tyxml_js.To_dom.of_select selector)##.onchange := - Dom_html.handler (fun _ -> Lwt.async (load_lesson ~loading: true) ; Js._true) ; + Dom_html.handler + (fun _ -> Lwt.async (load_lesson ~loading: true) ; Js._true) ; begin button ~group ~state: next_button_state ~container: navigation_div ~theme: "black" ~icon: "right" [%i"Next"] @@ fun () -> @@ -402,20 +452,17 @@ let lessons_tab select (arg, set_arg, delete_arg) () = begin try let id = match arg "lesson" with | id -> id - | exception Not_found -> match index with - | [] -> raise Not_found - | (id, _) :: _ -> id in + | exception Not_found -> + (match index with + | [] -> raise Not_found + | (id, _) :: _ -> id) in let option = Tyxml_js.To_dom.of_option (List.assoc id options) in option##.selected := Js._true ; load_lesson ~loading: false () with Not_found -> failwith "lesson not found" end >>= fun () -> hide_loading ~id:"learnocaml-main-loading" () ; - Lwt.return lesson_div -;; - - - + Lwt.return lesson_div ;; let tryocaml_tab select (arg, set_arg, delete_arg) () = @@ -573,7 +620,8 @@ let tryocaml_tab select (arg, set_arg, delete_arg) () = let elt = Tyxml_js.Html.pre [ Tyxml_js.Html.pcdata code ] in if runnable then begin Manip.addClass elt "runnable" ; - Manip.Ev.onclick elt (fun _ -> on_runnable_clicked code ; true) + Manip.Ev.onclick elt + (fun _ -> on_runnable_clicked code ; true) end ; elt | Enum items -> @@ -637,7 +685,8 @@ let tryocaml_tab select (arg, set_arg, delete_arg) () = ~container: buttons_div ~theme: "dark" ~icon:"reload" [%i"Reset"] @@ fun () -> toplevel_launch >>= fun top -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + disabling_button_group toplevel_buttons_group + (fun () -> Learnocaml_toplevel.reset top) end ; begin button ~container: buttons_div ~theme: "dark" @@ -648,8 +697,7 @@ let tryocaml_tab select (arg, set_arg, delete_arg) () = end ; toplevel_launch >>= fun _ -> hide_loading ~id:"learnocaml-main-loading" () ; - Lwt.return tutorial_div -;; + Lwt.return tutorial_div;; let toplevel_tab select _ () = let content_div = find_component "learnocaml-main-content" in @@ -699,8 +747,9 @@ let toplevel_tab select _ () = Lwt.return () end ; begin button - ~icon:"reload" [%i"Reset"] @@ fun () -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + ~icon:"reload" [%i"Reset"] @@ + fun () -> disabling_button_group toplevel_buttons_group + (fun () -> Learnocaml_toplevel.reset top) end ; begin button ~group: toplevel_buttons_group ~icon: "run" [%i"Eval phrase"] @@ fun () -> @@ -708,8 +757,7 @@ let toplevel_tab select _ () = Lwt.return () end ; hide_loading ~id:"learnocaml-main-loading" () ; - Lwt.return div -;; + Lwt.return div;; let token_format = Json_encoding.(obj1 (req "token" string)) @@ -723,10 +771,12 @@ let init_sync_token button_state = begin try Lwt.return Learnocaml_local_storage.(retrieve sync_token) with Not_found -> - Lwt_request.get ~headers: [] ~url: "/sync/gimme" ~args: [] >>= fun token -> + Lwt_request.get ~headers: [] ~url: "/sync/gimme" + ~args: [] >>= fun token -> let token = Js.string token in let json = Js._JSON##(parse token) in - let token = Json_repr_browser.Json_encoding.destruct token_format json in + let token = + Json_repr_browser.Json_encoding.destruct token_format json in Learnocaml_local_storage.(store sync_token) token ; Lwt.return token end >>= fun token -> @@ -780,7 +830,16 @@ let sync () = set_state_from_save_file save_file ; Server_caller.upload_save_file ~token save_file -let set_string_translations () = +let () = + Lwt.async_exception_hook := begin function + | Failure message -> fatal message + | Server_caller.Cannot_fetch message -> fatal message + | exn -> fatal (Printexc.to_string exn) + end ; + (match Js_utils.get_lang() with + | Some l -> Ocplib_i18n.set_lang l + | None -> ()); + Lwt.async @@ fun () -> let translations = [ "txt_welcome", [%i"Welcome to LearnOCaml by OCamlPro."]; @@ -805,20 +864,7 @@ let set_string_translations () = [%i"Save online using the \"sync\" button above."]; ] in - List.iter - (fun (id, text) -> - Manip.setInnerHtml (find_component id) text) - translations - -let () = - Lwt.async_exception_hook := begin function - | Failure message -> fatal message - | Server_caller.Cannot_fetch message -> fatal message - | exn -> fatal (Printexc.to_string exn) - end ; - (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); - Lwt.async @@ fun () -> - set_string_translations (); + Translate.set_string_translations translations; Learnocaml_local_storage.init () ; let sync_button_state = button_state () in disable_button sync_button_state ; @@ -937,5 +983,4 @@ let () = Tyxml_js.Html5.(div ~a: [ a_class [ "placeholder" ] ]) Tyxml_js.Html5.[ div [ pcdata [%i"Choose an activity."] ]] in Manip.appendChild content_div div ; - Lwt.return () -;; + Lwt.return () ;; diff --git a/src/app/learnocaml_local_storage.ml b/src/app/learnocaml_local_storage.ml index e70dc155a..535a00d86 100644 --- a/src/app/learnocaml_local_storage.ml +++ b/src/app/learnocaml_local_storage.ml @@ -219,7 +219,7 @@ let index_list, [ "index-state-list" ] [ "editor-state" ] Learnocaml_exercise_state.index_state_enc - + let exercise_list, exercise_state, all_exercise_states = diff --git a/src/app/learnocaml_sync.ml b/src/app/learnocaml_sync.ml index b9fe54fbf..3e1d74493 100644 --- a/src/app/learnocaml_sync.ml +++ b/src/app/learnocaml_sync.ml @@ -19,10 +19,10 @@ module StringMap = Map.Make (String) type save_file = { all_index_states: - Learnocaml_exercise_state.index_state Map.Make (String).t ; + Learnocaml_exercise_state.index_state Map.Make (String).t ; all_editor_states : - Learnocaml_exercise_state.editor_state Map.Make (String).t ; - all_exercise_states : + Learnocaml_exercise_state.editor_state Map.Make (String).t ; + all_exercise_states : Learnocaml_exercise_state.exercise_state Map.Make (String).t ; all_toplevel_histories : Learnocaml_toplevel_history.snapshot Map.Make (String).t ; @@ -62,14 +62,18 @@ let save_file_enc = all_toplevel_histories ; all_exercise_toplevel_histories }) @@ (obj5 - (dft "index" (map_enc Learnocaml_exercise_state.index_state_enc) StringMap.empty ) - (dft "editor" (map_enc Learnocaml_exercise_state.editor_state_enc) StringMap.empty) - (dft "exercises" (map_enc Learnocaml_exercise_state.exercise_state_enc) StringMap.empty) - (dft "toplevel-histories" (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty) - (dft "exercise-toplevel-histories" (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty)) + (dft "index" + (map_enc Learnocaml_exercise_state.index_state_enc) StringMap.empty) + (dft "editor" + (map_enc Learnocaml_exercise_state.editor_state_enc) StringMap.empty) + (dft "exercises" + (map_enc Learnocaml_exercise_state.exercise_state_enc) StringMap.empty) + (dft "toplevel-histories" + (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty) + (dft "exercise-toplevel-histories" + (map_enc Learnocaml_toplevel_history.snapshot_enc) StringMap.empty)) let sync - { all_index_states =all_index_states_a ; all_editor_states =all_editor_states_a ; all_exercise_states = all_exercise_states_a ; @@ -86,25 +90,28 @@ let sync snapshot_a else snapshot_b in - let sync_exercise_state (state_a :Learnocaml_exercise_state.exercise_state) (state_b : Learnocaml_exercise_state.exercise_state) = + let sync_exercise_state (state_a :Learnocaml_exercise_state.exercise_state) + (state_b : Learnocaml_exercise_state.exercise_state) = let open Learnocaml_exercise_state in if state_a.mtime > state_b.mtime then state_a else state_b in - let sync_editor_state (state_a:Learnocaml_exercise_state.editor_state) (state_b:Learnocaml_exercise_state.editor_state) = + let sync_editor_state (state_a:Learnocaml_exercise_state.editor_state) + (state_b:Learnocaml_exercise_state.editor_state) = let open Learnocaml_exercise_state in if state_a.mtime > state_b.mtime then state_a else state_b in - let sync_index_state (state_a :Learnocaml_exercise_state.index_state) (state_b : Learnocaml_exercise_state.index_state) = + let sync_index_state (state_a :Learnocaml_exercise_state.index_state) + (state_b : Learnocaml_exercise_state.index_state) = let open Learnocaml_exercise_state in if state_a.mtime > state_b.mtime then state_a else - state_b in - + state_b in + let sync_map sync_item index_a index_b = let open Learnocaml_exercise_state in StringMap.merge @@ -116,11 +123,11 @@ let sync { all_index_states= sync_map sync_index_state all_index_states_a - all_index_states_b ; + all_index_states_b ; all_editor_states = sync_map sync_editor_state all_editor_states_a - all_editor_states_b ; + all_editor_states_b ; all_exercise_states = sync_map sync_exercise_state all_exercise_states_a diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 028eed81d..89b36ba4f 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -62,25 +62,27 @@ let fetch_exercise_index () = Learnocaml_index.exercise_index_enc Learnocaml_index.exercise_index_path -let fetch_editor_index ()= +open Learnocaml_exercise_state + +let fetch_index id= + let open Learnocaml_exercise_state in let index= - match Learnocaml_local_storage.(retrieve (index_state "index")) - with - {Learnocaml_exercise_state.exos;mtime}->exos - - in + Learnocaml_local_storage.(retrieve (index_state id)).exos in + let open Learnocaml_index in let json = Json_repr_browser.Json_encoding.construct - exercise_index_enc (Learnocaml_exercises index) - in - try Lwt.return (Json_repr_browser.Json_encoding.destruct exercise_index_enc json) with exn -> + exercise_index_enc (Learnocaml_exercises index) in + try Lwt.return (Json_repr_browser.Json_encoding.destruct + exercise_index_enc json) with exn -> let msg = Format.asprintf "bad structure for %s@.%a" "index" (fun ppf -> Json_encoding.print_error ppf) exn in - Lwt.fail (Cannot_fetch msg) -;; + Lwt.fail (Cannot_fetch msg);; + +let fetch_editor_index () = fetch_index "index";; + let fetch_exercise id = fetch_and_decode_json diff --git a/src/editor/build.ocp b/src/editor/build.ocp index d9a4eace3..5cefc1d0e 100644 --- a/src/editor/build.ocp +++ b/src/editor/build.ocp @@ -9,12 +9,12 @@ begin program "new_exercise" "learnocaml-app-common" "learnocaml-toplevel" "jsutils" - "jsutils" "ppx_metaquot_lib" "js_of_ocaml.ppx" "ocplib_i18n" "ocplib-json-typed.browser" - + "translate" + "editor_lib" ] files = [ "new_exercise.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) @@ -33,6 +33,88 @@ begin program "new_exercise" ] end +begin program "testhaut" + comp_requires = "ppx_ocplib_i18n:asm" + requires = [ + "ezjsonm" + "grading-jsoo" + "ace" + "learnocaml-state" + "learnocaml-repository" + "learnocaml-app-common" + "learnocaml-toplevel" + "jsutils" + "jsutils" + "ppx_metaquot_lib" + "js_of_ocaml.ppx" + "ocplib_i18n" + "ocplib-json-typed.browser" + "editor_lib" + "translate" + "test-spec" + ] + files = [ + "testhaut.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) + ] + build_rules = [ + "%{testhaut_FULL_DST_DIR}%/testhaut.js" ( + build_target = true + sources = %byte_exe( p = "testhaut" ) + commands = [ { + "js_of_ocaml" + "+cstruct/cstruct.js" + "+dynlink.js" + "+toplevel.js" + "--toplevel" + "--nocmis" + "%{ace_FULL_SRC_DIR}%/ace_bindings.js" + %byte_exe( p = "testhaut" ) + } ] + ) + ] +end + +begin library "editor_lib" + comp_requires = [ "ppx_ocplib_i18n:asm" "ppx_metaquot:asm" ] + + files = [ + "editor_lib.ml" ( comp = [ ppx_js ppx_ocplib_i18n "-ppx" %asm_exe( p = "ppx_metaquot") ] ) + ] + requires = [ + "ace" + "learnocaml-repository" + "ocplib_i18n" + "js_of_ocaml.ppx" + "learnocaml-app-common" + "translate" + "omd" + ] + +end + + +begin library "test-spec" + comp_requires = "ppx_metaquot:asm" "ppx_ocplib_i18n:asm" + link += [ "-linkall" ] + requires = [ + "ty" + "toploop" + "ppx_metaquot" + "ppx_metaquot_lib" + "ocplib-json-typed" + "learnocaml-state" + "learnocaml-repository" + "testing" + "ocplib_i18n" + "editor_lib" + "translate" + ] + files = [ + "test_spec.ml" ( comp += [ ppx_js "-ppx" %asm_exe( p = "ppx_metaquot") ppx_ocplib_i18n ] ) + ] +end + + begin program "editor" comp_requires = "ppx_ocplib_i18n:asm" @@ -47,6 +129,11 @@ begin program "editor" "js_of_ocaml.ppx" "ocplib-json-typed.browser" "omd" + "testing" + "grading" + "editor_lib" + "test-spec" + "translate" ] files = [ "editor.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) @@ -58,11 +145,13 @@ begin program "editor" commands = [ { "js_of_ocaml" "+cstruct/cstruct.js" - "%{ace_FULL_SRC_DIR}%/ace_bindings.js" + "+dynlink.js" + "+toplevel.js" + "--toplevel" + "--nocmis" + "%{ace_FULL_SRC_DIR}%/ace_bindings.js" %byte_exe( p = "editor" ) } ] ) ] end - - diff --git a/src/editor/editor.ml b/src/editor/editor.ml index bdaa15492..e066278bb 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -19,138 +19,102 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Learnocaml_exercise_state - -(* -module Report = Learnocaml_report - -let test_lib ?callback ?(timeout: int option) - (module Introspection : Introspection_intf.INTROSPECTION) = - let set_progress = - match callback with - | None -> (fun _ -> ()) - | Some set_progress -> set_progress in - - let results : Learnocaml_report.report option ref = ref None in - - let module M (* : Params *) = struct - let results = results - let set_progress = set_progress - let timeout = timeout - module Introspection = Introspection - end in - let module TL = Test_lib.Make(M) in -(module TL : Test_lib.S) -*) - -(* -module Dummy_Functor (Introspection : - Introspection_intf.INTROSPECTION) = struct - module Dummy_Params = struct - let results = ref None - let set_progress _ = () - module Introspection = Introspection - end - module Test_lib = Test_lib.Make(Dummy_Params) - module Report = Learnocaml_report -*) - +open Js_of_ocaml +open Editor_lib +open Dom_html module StringMap = Map.Make (String) -let get_titre id = Learnocaml_local_storage.(retrieve (editor_state id)).titre - -let get_diff id = Learnocaml_local_storage.(retrieve (editor_state id)).diff -let get_solution id = Learnocaml_local_storage.(retrieve (editor_state id)).solution -let get_question id = Learnocaml_local_storage.(retrieve (editor_state id)).question -let get_template id = Learnocaml_local_storage.(retrieve (editor_state id)).template -let get_test id = Learnocaml_local_storage.(retrieve (editor_state id)).test -let get_prelude id = Learnocaml_local_storage.(retrieve (editor_state id)).prelude -let get_prepare id = Learnocaml_local_storage.(retrieve (editor_state id)).prepare - - -let string_of_char ch = String.make 1 ch ;; - -let failchar = [' ';'f';'a';'i';'l';'w';'i';'t';'h';' ';'"';'T';'O';'D';'O';'"';'\n'] ;; - -let tail l = match l with -|[]->[] -|e::l->l ;; - -let rec concatenation listech = match listech with -|[]->"" -|c::l -> (string_of_char c)^(concatenation l);; - -let rec decompositionSol str n = -if (n+1= String.length str) then [(str.[n])] -else ( (str.[n])::(decompositionSol str (n+1)) );; - -let rec commentaire listech cpt = match listech with -|[]->[] -|'*'::')'::l -> if cpt = 0 then l else commentaire l (cpt-1) -|'('::'*'::l -> commentaire l (cpt+1) -|c::l->commentaire l cpt;; - -let rec premierLet listech = match listech with -|[]->[] -|'('::'*'::l -> premierLet (commentaire l 0) -|c::'l'::'e'::'t'::' '::l -> if (c='\n'||c=' ') then ('l'::'e'::'t'::' '::l) else premierLet l -|'l'::'e'::'t'::' '::l -> 'l'::'e'::'t'::' '::l -|' '::l-> premierLet l -|'\n'::l-> premierLet l -|_->[];; - -let rec validationLet listech = match listech with -|[]->false -|' '::l->validationLet l -|'\n'::l->validationLet l -|'('::l->validationLet l -|'l'::'e'::'t'::l->false -|_-> true -;; - -let rec rechercheEgal listech = match listech with -|[]->0 -|'='::l->1 -|' '::'l'::'e'::'t'::' '::l->2 -|'\n'::'l'::'e'::'t'::' '::l->2 -|c::l->rechercheEgal l ;; - -let rec rechercheLet listech b = match listech with -|[] -> [] -|'('::'*'::l -> rechercheLet (commentaire l 0) b -|';'::';'::l -> rechercheLet l true -|'='::l -> rechercheLet l (validationLet l) -|_::'t'::'h'::'e'::'n'::_::l -> rechercheLet l (validationLet l) -|_::'e'::'l'::'s'::'e'::_::l -> rechercheLet l (validationLet l) -|_::'i'::'n'::_::l -> rechercheLet l (validationLet l) -|'-'::'>'::l->rechercheLet l (validationLet l) -|'l'::'e'::'t'::' '::l ->if b && ((rechercheEgal l)=1) then 'l'::'e'::'t'::' '::l else (if ((rechercheEgal l)=0) then rechercheLet l false else rechercheLet l true) -|c::suite -> rechercheLet suite b -;; - -let rec decomposition2 listech = match listech with - |[] -> [] - |'='::l -> ['='] - |c::l-> c :: (decomposition2 l) ;; - -let decompoFirst listech = match listech with -|[]-> [] -|_->(decomposition2 listech)@failchar ;; - -let rec genLet listech = - let liste = rechercheLet listech true in - match liste with - |[]->[] - |_-> (decomposition2 liste)@failchar@(genLet (tail liste)) ;; - -let rec genTemplate chaine = if chaine="" then "" else - concatenation (genLet (decompositionSol chaine 0));; - +let quality_function = "\nlet avoid_thentrue = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Don't write any of the following code:\";\n Code \"[if ... then true else ...;\n if ... then false else ...;\n if ... then ... else true;\n if ... then ... else false]\"; Text \"\nInstead, use the Boolean operators (&&), (||), not.\"], Success ~-4) ]\n end\n\nlet check_thentrue e =\n Parsetree.(\n match e with\n | {pexp_desc = Pexp_ifthenelse (_, e1, (Some e2))} ->\n begin\n match e1 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e1\n | _ -> []\n end @ begin\n match e2 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e2\n | _ -> []\n end\n | _ -> [])\n\nlet avoid_list1app = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Don't write:\";\n Code \"[x] @ l\";\n Text \". Write instead:\";\n Code \"x :: l\";\n Text \".\"], Success ~-4) ]\n end\n\nlet check_list1app e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_apply (app0, [(_, lst1); _]) ->\n (match app0.pexp_desc, lst1.pexp_desc with\n | Pexp_ident {Asttypes.txt = app0'},\n Pexp_construct ({Asttypes.txt = (Longident.Lident \"::\")}, Some lst1')\n when List.mem (Longident.flatten app0') [[\"List\"; \"append\"]; [\"@\"]] ->\n (match lst1'.pexp_desc with\n | Pexp_tuple [_; nil0] ->\n (match nil0.pexp_desc with\n | Pexp_construct ({Asttypes.txt = (Longident.Lident \"[]\")}, None) ->\n avoid_list1app e\n | _ -> [])\n | _ -> [])\n | _ -> [])\n | _ -> []) + +let avoid_eqphy = let already = ref false in fun _ -> + if !already then [] else begin + already := true ; + Learnocaml_report.[ Message ([ Text \"* Don't use the physical equality\"; + Code \"(==)\"; + Text \". Instead, use the structural equality\"; + Code \"(=)\"; + Text \".\"], Success ~-1) ] + end + +let avoid_neqphy = let already = ref false in fun _ -> + if !already then [] else begin + already := true ; + Learnocaml_report.[ Message ([ Text \"* Don't use the physical inequality\"; + Code \"(!=)\"; + Text \". Instead, use the structural inequality\"; + Code \"(<>)\"; + Text \".\"], Success ~-1) ] + end + +let check_eqphy e = + Parsetree.( + match e.pexp_desc with + | Pexp_ident {Asttypes.txt = Longident.Lident \"==\"} -> avoid_eqphy e + | _ -> []) + +let check_neqphy e = + Parsetree.( + match e.pexp_desc with + | Pexp_ident {Asttypes.txt = Longident.Lident \"!=\"} -> avoid_neqphy e + | _ -> [])" + +let imperative_function = "let ast_imperative_check ast =\n + let chk_expr e =\n + Parsetree.(\n + match e with\n + | {pexp_desc = Pexp_sequence _} -> forbid_syntax \";\" e\n + | {pexp_desc = Pexp_while _} -> forbid_syntax \"while\" e\n + | {pexp_desc = Pexp_for _} -> forbid_syntax \"for\" e\n + | {pexp_desc = Pexp_array _} -> forbid_syntax \"array\" e\n + | _ -> [] ) in\n + let imperative_report =\n + ast_check_structure\n + ~on_expression:chk_expr\n + ast |> List.sort_uniq compare in\n + if snd (Learnocaml_report.result_of_report imperative_report) then\n + imperative_report\n + else\n + []\n" + + +let id = arg "id" + + +(*_____________________Functions for the Generate button_____________________*) + +(* Every couple is saved into the local storage *) + +let rec save_questions listeQuestions id = match listeQuestions with + | [] -> () + | (nom, string_type) :: suite -> + let name = nom in + let ty = string_type in + let input = "[]" in + let extra_alea = 10 in + let question = TestAgainstSol + {name; ty; suite = input; gen = extra_alea; + tester = ""; sampler = ""} in + let testhaut = get_testhaut id in + let question_id = compute_question_id testhaut in + let new_testhaut = StringMap.add question_id question testhaut in + let () = save_testhaut new_testhaut id in + save_questions suite id + +(*----------------------------------------------------------------------*) + +let grade_black = ref (fun () -> ()) +let grade_red = ref (fun () -> ()) let init_tabs, select_tab = - let names = [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; "question" ; "prelude" ; "prepare" ] in - let current = ref "toplevel" in + let names = [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; + "question" ; "prelude" ; "prepare" ; "testhaut" ] in + let current = ref "question" in let select_tab name = set_arg "tab" name ; + if name = "testhaut" then + !grade_red () + else + !grade_black (); Manip.removeClass (find_component ("learnocaml-exo-button-" ^ !current)) "front-tab" ; @@ -171,9 +135,9 @@ let init_tabs, select_tab = let init_tabs () = current := begin try let requested = arg "tab" in - if List.mem requested names then requested else "toplevel" - with Not_found -> "toplevel" - end ; + if List.mem requested names then requested else "question" + with Not_found -> "question" + end ; List.iter (fun name -> Manip.removeClass @@ -189,31 +153,33 @@ let init_tabs, select_tab = select_tab !current in init_tabs, select_tab + let display_report exo report = - let score, failed = Learnocaml_report.result_of_report report in + (* let score, failed = Learnocaml_report.result_of_report report in *) let report_button = find_component "learnocaml-exo-button-report" in Manip.removeClass report_button "success" ; Manip.removeClass report_button "failure" ; Manip.removeClass report_button "partial" ; - let grade = score * 100 / 100 (*(Learnocaml_exercise.(get max_score) exo)*) in + let grade = 100 in if grade >= 100 then begin Manip.addClass report_button "success" ; Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata "Report" ] + Tyxml_js.Html5.[ pcdata [%i"Report"] ] end else if grade = 0 then begin Manip.addClass report_button "failure" ; Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata "Report" ] + Tyxml_js.Html5.[ pcdata [%i"Report"] ] end else begin Manip.addClass report_button "partial" ; let pct = Format.asprintf "%2d%%" grade in Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata "Report" ; + Tyxml_js.Html5.[ pcdata [%i"Report"] ; span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] end ; let report_container = find_component "learnocaml-exo-tab-report" in Manip.setInnerHtml report_container - (Format.asprintf "%a" Learnocaml_report.(output_html_of_report ~bare: true) report) ; + (Format.asprintf "%a" + Learnocaml_report.(output_html_of_report ~bare: true) report) ; grade let () = @@ -223,9 +189,46 @@ let () = | exn -> fatal (Printexc.to_string exn) end ; Lwt.async @@ fun () -> - Learnocaml_local_storage.init () ; - + Translate.set_lang (); + let translations = [ + "txt_preparing", [%i"Preparing the environment"]; + "learnocaml-exo-button-editor", [%i"Solution"]; + "learnocaml-exo-button-template", [%i"Template"]; + "learnocaml-exo-button-prelude", [%i"Prelude"]; + "learnocaml-exo-button-prepare", [%i"Prepare"]; + "learnocaml-exo-button-toplevel", [%i"Toplevel"]; + "learnocaml-exo-button-question", [%i"Question"]; + "learnocaml-exo-button-test", [%i"Test.ml"]; + "learnocaml-exo-button-testhaut", [%i"Test"]; + "learnocaml-exo-button-report", [%i"Report"]; + "learnocaml-exo-editor-pane", [%i"Editor"]; + "txt_grade_report", [%i"Click the Grade! button to test your solution"]; + "learnocaml-exo-test-pane", [%i"Editor"]; + ] in + Translate.set_string_translations translations; + let translations = [ + "learnocaml-exo-button-editor", + [%i"Type here the solution of the exercise"]; + "learnocaml-exo-button-template", + [%i"Type here or generate the template \ + the student will complete or correct"]; + "learnocaml-exo-button-prelude", + [%i"Type here the definitions of types and \ + functions given to the student"]; + "learnocaml-exo-button-prepare", + [%i"Type here hidden definitions given to the student"]; + "learnocaml-exo-button-question", + [%i"Type here the wording of the exercise in Markdown"]; + "learnocaml-exo-button-test", + [%i"Type here the tests code"]; + "learnocaml-exo-button-testhaut", + [%i"Generate here the tests code"]; + ] in + Translate.set_title_translations translations; + Learnocaml_local_storage.init () ; + (* ---- launch everything --------------------------------------------- *) + let toplevel_buttons_group = button_group () in disable_button_group toplevel_buttons_group (* enabled after init *) ; let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in @@ -234,21 +237,22 @@ let () = let prelude_toolbar = find_component "learnocaml-exo-prelude-toolbar" in let prepare_toolbar = find_component "learnocaml-exo-prepare-toolbar" in let test_toolbar = find_component "learnocaml-exo-test-toolbar" in + let testhaut_toolbar = find_component "learnocaml-exo-testhaut-toolbar" in let toplevel_button = button ~container: toplevel_toolbar ~theme: "dark" in let editor_button = button ~container: editor_toolbar ~theme: "light" in let test_button = button ~container: test_toolbar ~theme: "light" in + let testhaut_button = button ~container: testhaut_toolbar ~theme: "light" in let template_button = button ~container: template_toolbar ~theme: "light" in let prelude_button = button ~container: prelude_toolbar ~theme: "light" in let prepare_button = button ~container: prepare_toolbar ~theme: "light" in - let id = arg "id" in let after_init top = - begin + begin Lwt.return true end >>= fun r1 -> Learnocaml_toplevel.load ~print_outcome:false top "" >>= fun r2 -> - if not r1 || not r2 then failwith "error in prelude" ; + if not r1 || not r2 then failwith [%i"unexpected error"]; Learnocaml_toplevel.set_checking_environment top >>= fun () -> Lwt.return () in let timeout_prompt = @@ -283,368 +287,704 @@ let () = init_tabs () ; toplevel_launch >>= fun top -> - (* ---- toplevel pane ------------------------------------------------- *) + begin toplevel_button ~group: toplevel_buttons_group - ~icon: "cleanup" "Clear" @@ fun () -> + ~icon: "cleanup" [%i"Clear"] @@ fun () -> Learnocaml_toplevel.clear top ; Lwt.return () end ; begin toplevel_button - ~icon: "reload" "Reset" @@ fun () -> - toplevel_launch >>= fun top -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + ~icon: "reload" [%i"Reset"] @@ fun () -> + (* toplevel_launch >>= fun top -> SHOULD BE UNNECESSARY *) + disabling_button_group toplevel_buttons_group + (fun () -> Learnocaml_toplevel.reset top) end ; begin toplevel_button ~group: toplevel_buttons_group - ~icon: "run" "Eval phrase" @@ fun () -> + ~icon: "run" [%i"Eval phrase"] @@ fun () -> Learnocaml_toplevel.execute top ; Lwt.return () end ; - (* ---- test pane --------------------------------------------------- *) + let editor_test = find_component "learnocaml-exo-test-pane" in - let editor_t = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_test) in + let editor_t = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_test) in let ace_t = Ocaml_mode.get_editor editor_t in - Ace.set_contents ace_t (get_test id); + let contents= + let a = get_testml id in + if a = "" then + [%i"(* Grader and tests code *)\n"] + else + a in + + Ace.set_contents ace_t contents; Ace.set_font_size ace_t 18; - - (* let typecheck set_class = - Learnocaml_toplevel.check top (Ace.get_contents ace_t) >>= fun res -> - let error, warnings = - match res with - | Toploop_results.Ok ((), warnings) -> None, warnings - | Toploop_results.Error (err, warnings) -> Some err, warnings in - let transl_loc { Toploop_results.loc_start ; loc_end } = - { Ocaml_mode.loc_start ; loc_end } in - let error = match error with - | None -> None - | Some { Toploop_results.locs ; msg ; if_highlight } -> - Some { Ocaml_mode.locs = List.map transl_loc locs ; - msg = (if if_highlight <> "" then if_highlight else msg) } in - let warnings = - List.map - (fun { Toploop_results.locs ; msg ; if_highlight } -> - { Ocaml_mode.loc = transl_loc (List.hd locs) ; - msg = (if if_highlight <> "" then if_highlight else msg) }) - warnings in - Ocaml_mode.report_error ~set_class editor_t error warnings >>= fun () -> - Ace.focus ace_t ; - Lwt.return () in *) - begin test_button - ~group: toplevel_buttons_group - ~icon: "typecheck" "Check" @@ fun () -> - Lwt.return () - end ; - (* ---- template pane --------------------------------------------------- *) - let editor_template = find_component "learnocaml-exo-template-pane" in - let editor_temp = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_template) in - let ace_temp = Ocaml_mode.get_editor editor_temp in - Ace.set_contents ace_temp - ( get_template id ) ; - Ace.set_font_size ace_temp 18; - - let typecheck set_class = - Learnocaml_toplevel.check top (Ace.get_contents ace_temp) >>= fun res -> - let error, warnings = - match res with - | Toploop_results.Ok ((), warnings) -> None, warnings - | Toploop_results.Error (err, warnings) -> Some err, warnings in - let transl_loc { Toploop_results.loc_start ; loc_end } = - { Ocaml_mode.loc_start ; loc_end } in - let error = match error with - | None -> None - | Some { Toploop_results.locs ; msg ; if_highlight } -> - Some { Ocaml_mode.locs = List.map transl_loc locs ; - msg = (if if_highlight <> "" then if_highlight else msg) } in - let warnings = - List.map - (fun { Toploop_results.locs ; msg ; if_highlight } -> - { Ocaml_mode.loc = transl_loc (List.hd locs) ; - msg = (if if_highlight <> "" then if_highlight else msg) }) - warnings in - Ocaml_mode.report_error ~set_class editor_temp error warnings >>= fun () -> - Ace.focus ace_temp ; - Lwt.return () in - begin template_button + begin test_button ~group: toplevel_buttons_group - ~icon: "typecheck" "Check" @@ fun () -> - typecheck true + ~icon: "typecheck" [%i"Check"] @@ fun () -> + typecheck_spec true ace_t editor_t top end ; (*-------question pane -------------------------------------------------*) - let editor_question = find_component "learnocaml-exo-tab-question" in + let editor_question = find_component "learnocaml-exo-question-mark" in let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in - Ace.set_contents ace_quest (get_question id) ; + let question = + let a = get_question id in + if a = "" then [%i"# Questions\n\n\ + You can write here your questions using\n\ + the **Markdown** markup language\n"] + else a in + + Ace.set_contents ace_quest question ; Ace.set_font_size ace_quest 18; + let question = get_question id in + let question =Omd.to_html (Omd.of_string question) in + + let text_container = find_component "learnocaml-exo-question-html" in + let text_iframe = Dom_html.createIframe Dom_html.document in + Manip.replaceChildren text_container + Tyxml_js.Html5.[ Tyxml_js.Of_dom.of_iFrame text_iframe ] ; + Js.Opt.case + (text_iframe##.contentDocument) + (fun () -> failwith "cannot edit iframe document") + (fun d -> + let html = Format.asprintf + "\ + \ + %s - exercise text\ + \ + \ + \ + \ + %s\ + \ + " + (get_titre id) + question in + d##open_; + d##write (Js.string html); + d##close); + + let old_text = ref "" in + + let onload () = + let rec dyn_preview = + let text = Ace.get_contents ace_quest in + if text <> !old_text then begin + Js.Opt.case + (text_iframe##.contentDocument) + (fun () -> failwith "cannot edit iframe document") + (fun d -> + let html = Format.asprintf + "\ + \ + %s - exercise text\ + \ + \ + \ + \ + %s\ + \ + " + (get_titre id) + (Omd.to_html (Omd.of_string text)) in + d##open_; + d##write (Js.string html); + d##close); + old_text := text + end in + dyn_preview; () in + (* ---- prelude pane --------------------------------------------------- *) + let editor_prelude = find_component "learnocaml-exo-prelude-pane" in - let editor_prel = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_prelude) in + let editor_prel = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_prelude) in let ace_prel = Ocaml_mode.get_editor editor_prel in - Ace.set_contents ace_prel - ( get_prelude id ) ; + let contents= + let a = get_prelude id in + if a = "" then + [%i"(* Local definitions the student\n\ + will be able to see *)\n"] + else + a in + Ace.set_contents ace_prel contents ; Ace.set_font_size ace_prel 18; - - (* ---- prepare pane --------------------------------------------------- *) + let typecheck set_class = typecheck set_class ace_prel editor_prel top in + begin prelude_button + ~group: toplevel_buttons_group + ~icon: "typecheck" [%i"Check"] @@ fun () -> + typecheck true + end; + + (* ---- prepare pane --------------------------------------------------- *) + let editor_prepare = find_component "learnocaml-exo-prepare-pane" in - let editor_prep = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_prepare) in + let editor_prep = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_prepare) in let ace_prep = Ocaml_mode.get_editor editor_prep in - Ace.set_contents ace_prep - ( get_prepare id ) ; + let contents= + let a= get_prepare id in + if a = "" then + [%i"(* Local definitions the student\n\ + won't be able to see *)\n"] + else + a in + Ace.set_contents ace_prep contents ; Ace.set_font_size ace_prep 18; + let typecheck set_class = + Editor_lib.typecheck set_class ace_prep editor_prep top in + begin prepare_button + ~group: toplevel_buttons_group + ~icon: "typecheck" [%i"Check"] @@ fun () -> + typecheck true + end ; + (* ---- editor pane --------------------------------------------------- *) + let editor_pane = find_component "learnocaml-exo-editor-pane" in - let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in + let editor = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_pane) in let ace = Ocaml_mode.get_editor editor in - let recovering () = - let solution = Ace.get_contents ace in - let titre = get_titre id in - let question = Ace.get_contents ace_quest in - let template = Ace.get_contents ace_temp in - let test = Ace.get_contents ace_t in - let prepare= Ace.get_contents ace_prep in - let prelude =Ace.get_contents ace_prel in - let diff = - match Learnocaml_local_storage.(retrieve (editor_state id)) with - | { Learnocaml_exercise_state.diff } -> diff - | exception Not_found -> None in - Learnocaml_local_storage.(store (editor_state id)) - { Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ;prepare;prelude; - mtime = gettimeofday () } in - - Ace.set_contents ace (get_solution id); + let contents = + let a= get_solution id in + if a = "" then + [%i"(* Your solution *)\n"] + else + a in + Ace.set_contents ace contents; Ace.set_font_size ace 18; + + (* ---- template pane --------------------------------------------------- *) + + let editor_template = find_component "learnocaml-exo-template-pane" in + let editor_temp = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_template) in + let ace_temp = Ocaml_mode.get_editor editor_temp in + let contents= + let a = get_template id in + if a = "" then + [%i"(* Code the student will have\n\ + when he will start the exercise *)\n"] + else + a in + Ace.set_contents ace_temp contents ; + Ace.set_font_size ace_temp 18; + let messages = Tyxml_js.Html5.ul [] in - begin editor_button - ~icon: "sync" "Gen. template" @@ fun () -> - select_tab "template"; - if (Ace.get_contents ace_temp) = "" then + begin template_button + ~icon: "sync" [%i"Gen. template"] @@ fun () -> + if (Ace.get_contents ace_temp) = "" then Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ) else begin let aborted, abort_message = let t, u = Lwt.task () in - let btn_cancel = Tyxml_js.Html5.(button [ pcdata "Cancel" ]) in - Manip.Ev.onclick btn_cancel ( fun _ -> - hide_loading ~id:"learnocaml-exo-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in - Manip.Ev.onclick btn_yes (fun _ -> Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ); - hide_loading ~id:"learnocaml-exo-loading" (); - true) ; + let btn_cancel = Tyxml_js.Html5.(button [ pcdata [%i"Cancel"] ]) in + Manip.Ev.onclick btn_cancel + (fun _ -> hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in + Manip.Ev.onclick btn_yes + (fun _ -> Ace.set_contents ace_temp + (genTemplate (Ace.get_contents ace)); + hide_loading ~id:"learnocaml-exo-loading" (); + true); let div = Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata "Do you want to crush template ?\n" ; - btn_yes ; - pcdata " " ; - btn_cancel ]) in + [pcdata [%i"Do you want to crush the template?\n"]; + btn_yes ; + pcdata " " ; + btn_cancel ]) in Manip.SetCss.opacity div (Some "0") ; t, div in Manip.replaceChildren messages Tyxml_js.Html5.[ li [ pcdata "" ] ] ; show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1") + Manip.SetCss.opacity abort_message (Some "1") end; Lwt.return () end ; + let typecheck set_class = + Editor_lib.typecheck set_class ace_temp editor_temp top in + begin template_button + ~group: toplevel_buttons_group + ~icon: "typecheck" [%i"Check"] @@ fun () -> + typecheck true + end ; + + (* ---- testhaut pane --------------------------------------------------- *) + + let editor_testhaut = find_component "learnocaml-exo-testhaut-edit" in + let editor_th =Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div editor_testhaut ) in + let ace_testhaut = Ocaml_mode.get_editor editor_th in + let buffer = match get_buffer id with + | buff -> if buff="" then + [%i"(* Incipit: contains local definitions\n\ + that will be reachable when you will create\n\ + a new question *)\n"] + else buff in + Ace.set_contents ace_testhaut buffer ; + Ace.set_font_size ace_testhaut 18; + + let _ = testhaut_init + (find_component "learnocaml-exo-testhaut-pane") id in (); + + begin testhaut_button + ~group: toplevel_buttons_group + ~icon: "sync" [%i"Generate"] @@ fun () -> + let sol = genTemplate (Ace.get_contents ace) in + if sol<>"" then + begin + disabling_button_group toplevel_buttons_group + (fun () -> Learnocaml_toplevel.reset top) >>= fun () -> + Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= + fun ok -> + if ok then + let res_aux = decompositionSol (get_answer top) 0 in + (*Avec prise en compte des types polymorphes :*) + let res = redondance (polymorph_detector (get_questions + (get_all_val (get_only_fct res_aux []) []) [] )) in + save_questions res id; + Manip.removeChildren + (find_component "learnocaml-exo-testhaut-pane"); + (testhaut_init (find_component "learnocaml-exo-testhaut-pane") id) + else (select_tab "toplevel" ; Lwt.return ()) + end + else Lwt.return (); + end; + let quality = + match getElementById_coerce "quality_box" CoerceTo.input with + | None -> failwith "unknown element quality_box" + | Some s -> s in + let imperative = + match getElementById_coerce "imperative_box" CoerceTo.input with + | None -> failwith "unknown element imperative_box" + | Some s -> s in + + let ast_fonction () = + let quality = + match getElementById_coerce "quality_box" CoerceTo.input with + | None -> failwith "unknown element quality_box" + | Some s -> s in + let imperative = + match getElementById_coerce "imperative_box" CoerceTo.input with + | None -> failwith "unknown element imperative_box" + | Some s -> s in + let fonction = if Js.to_bool(quality##.checked) then + quality_function + else + "" in + let fonction = if Js.to_bool(imperative##.checked) then + fonction ^ imperative_function + else + fonction ^ "" in + let fonction = fonction ^ "\n\nlet ast_quality ast =" in + let fonction = + if Js.to_bool(imperative##.checked) then + fonction ^ "let imperative_report = \n + let tempReport = ast_imperative_check ast in \n + if tempReport = [] then []\n + else (Message\n + ([ Text \"Some imperative features were detected:\" ],\n + Success ~-4)) :: tempReport\n" + else + fonction ^ " let imperative_report = []\n" in + let fonction = + if Js.to_bool(quality##.checked) then + fonction ^ " and report =\n + let tempReport = ast_check_structure\n + ~on_expression: + (check_thentrue @@@ check_list1app @@@\n + check_eqphy @@@ check_neqphy)\n + ast |> List.sort_uniq compare\n + in\n + if tempReport = [] then []\n + else (Message\n + ([Text \"Some undesirable code patterns were detected:\"],\n + Failure)) :: tempReport\n" + else fonction ^ " and report = []\n" in + let fonction = fonction ^ "in if imperative_report = [] && report = [] then + [ Message ([ Text \"OK (no forbidden construct detected)\"], Success 0) ] + else imperative_report @ report;;" in + fonction in + let ast_code () = + let quality = + match getElementById_coerce "quality_box" CoerceTo.input with + | None -> failwith "unknown element quality_box" + | Some s -> s in + let imperative = + match getElementById_coerce "imperative_box" CoerceTo.input with + | None -> failwith "unknown element imperative_box" + | Some s -> s in + let fonction = + if Js.to_bool(quality##.checked) || Js.to_bool(imperative##.checked) then + "Section ([Text \"Code quality:\" ], ast_quality code_ast)" + else + "" in + fonction in + let compile_aux () = + let tests=test_prel^(ast_fonction ()) in + let tests=tests^" \n "^(get_buffer id)^" \n" in + let tests= + StringMap.fold (fun qid -> fun quest -> fun str -> + str ^ (Test_spec.question_typed quest qid)^" \n") + (get_testhaut id) tests in + let tests=tests^init^"[ \n " in + let tests= + StringMap.fold (fun qid->fun quest-> fun str -> + let name=match quest with + | TestAgainstSol a->a.name + | TestAgainstSpec a ->a.name + | TestSuite a -> a.name in + (* refactor what it's up in editor_lib *) + str ^ (section name ("test_question question"^qid ) )) + (get_testhaut id) tests in + tests^ (ast_code ()) ^ " ]" + in + begin testhaut_button + ~group: toplevel_buttons_group + ~icon: "typecheck" [%i"Check"] @@ fun () -> + show_loading ~id:"learnocaml-exo-loading" + Tyxml_js.Html5.[ ul [ li [ pcdata "checking" ] ] ] ; + let str = with_test_lib_prepare (compile_aux () ) + in + Learnocaml_toplevel.check top str >>= fun res-> + typecheck_dialog_box "learnocaml-exo-loading" res + end ; + + let recovering () = + let solution = Ace.get_contents ace in + let titre = get_titre id in + let incipit= Ace.get_contents ace_testhaut in + let question = Ace.get_contents ace_quest in + let template = Ace.get_contents ace_temp in + let testml = Ace.get_contents ace_t in + let testhaut= get_testhaut id in + let prepare= Ace.get_contents ace_prep in + let prelude =Ace.get_contents ace_prel in + let test ={testml;testhaut} in + let diff = get_diff id in + let description=get_description id in + let metadata ={id;titre;description;diff} in + let checkbox = {imperative= Js.to_bool imperative##.checked; + undesirable=Js.to_bool quality##.checked} in + Learnocaml_local_storage.(store (editor_state id)) + { Learnocaml_exercise_state.metadata; incipit; solution; question; + template; test; prepare; prelude; checkbox; mtime = gettimeofday () } in + recovering_callback:=recovering ; + + + let compile () = + let tests = compile_aux () in + match Learnocaml_local_storage.(retrieve (editor_state id) ) with + | {metadata; prepare; incipit; solution; question; + template; test; prelude; checkbox; mtime}-> + let mtime=gettimeofday () in + let test ={testml=tests; testhaut=test.testhaut} in + let nvexo= {metadata; incipit; prepare; solution; question; + template; test; prelude; checkbox; mtime} in + Learnocaml_local_storage.(store (editor_state id)) nvexo; + Ace.set_contents ace_t (get_testml id); + select_tab "test" + in + begin testhaut_button + ~group: toplevel_buttons_group + ~icon: "run" [%i"Compile"] @@ fun () -> + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in + Manip.Ev.onclick btn_no ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in + Manip.Ev.onclick btn_yes (fun _ -> + hide_loading ~id:"learnocaml-exo-loading" (); + compile () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata + [%i"Are you sure you want to overwrite the contents of Test.ml?\n"]; + btn_yes ; + pcdata " " ; + btn_no; ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + Lwt.return () + end ; + begin testhaut_button + ~group: toplevel_buttons_group + ~icon: "cleanup" [%i "Delete all"] @@ fun () -> + let delete_all_questions () = + save_testhaut StringMap.empty id; + Manip.removeChildren (find_component "learnocaml-exo-testhaut-pane"); + let _ = testhaut_init + (find_component "learnocaml-exo-testhaut-pane") id in () in + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in + Manip.Ev.onclick btn_no ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in + Manip.Ev.onclick btn_yes (fun _ -> + hide_loading ~id:"learnocaml-exo-loading" (); + delete_all_questions () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [pcdata [%i"Are you sure you want to delete all the questions?\n"]; + btn_yes; + pcdata " " ; + btn_no; ]) in + Manip.SetCss.opacity div (Some "0"); + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ]; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ]; + Manip.SetCss.opacity abort_message (Some "1"); + Lwt.return () + end; begin editor_button - ~icon: "save" "Save" @@ fun () -> + ~icon: "save" [%i"Save"] @@ fun () -> recovering () ; Lwt.return () end ; - + begin editor_button - ~icon: "download" "Download" @@ fun () -> + ~icon: "download" [%i"Download"] @@ fun () -> recovering () ; let name = id ^ ".json" in - let content =Learnocaml_local_storage.(retrieve (editor_state id)) in + let content =Learnocaml_local_storage.(retrieve (editor_state id)) in let json = Json_repr_browser.Json_encoding.construct Learnocaml_exercise_state.editor_state_enc content in let contents = - (Js._JSON##stringify (json)) in + (Js._JSON##stringify json) in Learnocaml_common.fake_download ~name ~contents ; Lwt.return () end ; - (* let lib = " module Test_lib = Test_lib.Make(struct\n\ - \ let results = results\n\ - \ let set_progress = set_progress\n\ - \ module Introspection = Introspection\n\ - end)" in *) - let typecheck set_class = - Learnocaml_toplevel.check top (Ace.get_contents ace) >>= fun res -> - let error, warnings = - match res with - | Toploop_results.Ok ((), warnings) -> None, warnings - | Toploop_results.Error (err, warnings) -> Some err, warnings in - let transl_loc { Toploop_results.loc_start ; loc_end } = - { Ocaml_mode.loc_start ; loc_end } in - let error = match error with - | None -> None - | Some { Toploop_results.locs ; msg ; if_highlight } -> - Some { Ocaml_mode.locs = List.map transl_loc locs ; - msg = (if if_highlight <> "" then if_highlight else msg) } in - let warnings = - List.map - (fun { Toploop_results.locs ; msg ; if_highlight } -> - { Ocaml_mode.loc = transl_loc (List.hd locs) ; - msg = (if if_highlight <> "" then if_highlight else msg) }) - warnings in - Ocaml_mode.report_error ~set_class editor error warnings >>= fun () -> - Ace.focus ace ; - Lwt.return () in + let typecheck set_class = Editor_lib.typecheck set_class ace editor top in begin editor_button ~group: toplevel_buttons_group - ~icon: "typecheck" "Check" @@ fun () -> + ~icon: "typecheck" [%i"Check"] @@ fun () -> typecheck true end ; begin toplevel_button ~group: toplevel_buttons_group - ~icon: "run" "Eval code" @@ fun () -> + ~icon: "run" [%i"Eval code"] @@ fun () -> Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= fun _ -> Lwt.return () end ; + (* ---- main toolbar -------------------------------------------------- *) + let exo_toolbar = find_component "learnocaml-exo-toolbar" in let toolbar_button = button ~container: exo_toolbar ~theme: "light" in + let toolbar_button2 = button2 ~container: exo_toolbar ~theme: "light" in begin toolbar_button - ~icon: "left" "Metadata" @@ fun () -> + ~icon: "left" [%i"Metadata"] @@ fun () -> recovering () ; Dom_html.window##.location##assign (Js.string ("new_exercise.html#id=" ^ id ^ "&action=open")); Lwt.return () end; - + begin toolbar_button - ~icon: "upload" "Export" @@ fun ()-> - recovering () ; - Dom_html.window##.location##assign - (Js.string ("exercise.html#id=." ^ id ^ "&action=open")); + ~icon: "upload" [%i"Experiment"] @@ fun ()-> + recovering (); + + let aborted, abort_message = + let t, u = Lwt.task () in + let btn = Tyxml_js.Html5.(button [ pcdata [%i"abort"] ]) in + Manip.Ev.onclick btn (fun _ -> Lwt.wakeup u () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata [%i"Grading is taking a lot of time, "] ; + btn ; + pcdata "?" ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + let worker = ref (Grading_jsoo.get_grade (exo_creator id)) in + let correction = + Learnocaml_exercise.get Learnocaml_exercise.solution (exo_creator id) in + let grading = + !worker correction >>= fun (report, _, _, _) -> + Lwt.return report in + let abortion = + Lwt_js.sleep 5. >>= fun () -> + Manip.SetCss.opacity abort_message (Some "1") ; + aborted >>= fun () -> + Lwt.return Learnocaml_report.[ Message + ([ Text [%i"Grading aborted by user."] ], Failure) ] in + Lwt.pick [ grading ; abortion ] >>= fun report_correction -> + let score_maxi, failed2 = + Learnocaml_report.result_of_report report_correction in + Dom_html.window##.location##assign + (Js.string ("exercise.html#id=." ^ id ^ "&score=" ^ + (string_of_int score_maxi) ^ "&action=open")); Lwt.return_unit - end; - + end; + let messages = Tyxml_js.Html5.ul [] in begin toolbar_button - ~icon: "list" "Exercises" @@ fun () -> + ~icon: "list" [%i"Exercises"] @@ fun () -> let aborted, abort_message = let t, u = Lwt.task () in - let btn_cancel = Tyxml_js.Html5.(button [ pcdata "Cancel" ]) in + let btn_cancel = Tyxml_js.Html5.(button [ pcdata [%i"Cancel"] ]) in Manip.Ev.onclick btn_cancel ( fun _ -> hide_loading ~id:"learnocaml-exo-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata "Yes" ]) in + let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in Manip.Ev.onclick btn_yes (fun _ -> recovering () ; Dom_html.window##.location##assign (Js.string "index.html#activity=editor") ; true) ; - let btn_no = Tyxml_js.Html5.(button [ pcdata "No" ]) in - Manip.Ev.onclick btn_no (fun _ -> + let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in + Manip.Ev.onclick btn_no (fun _ -> Dom_html.window##.location##assign (Js.string "index.html#activity=editor") ; true); let div = Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata "Do you want to save before closing?\n" ; + [ pcdata [%i"Do you want to save before closing?\n"] ; btn_yes ; pcdata " " ; btn_no ; pcdata " " ; btn_cancel ]) in Manip.SetCss.opacity div (Some "0") ; - t, div in + t, div in Manip.replaceChildren messages Tyxml_js.Html5.[ li [ pcdata "" ] ] ; show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; Manip.SetCss.opacity abort_message (Some "1") ; Lwt.return () end ; - let messages = Tyxml_js.Html5.ul [] in let callback text = Manip.appendChild messages Tyxml_js.Html5.(li [ pcdata text ]) in - let exo ()= - let titre = get_titre id in - let description="" in - - let exo1= Learnocaml_exercise.set Learnocaml_exercise.id id Learnocaml_exercise.empty in - let exo2= Learnocaml_exercise.set Learnocaml_exercise.title titre exo1 in - let exo3 =Learnocaml_exercise.set Learnocaml_exercise.max_score 1 exo2 in - let exo4 =Learnocaml_exercise.set Learnocaml_exercise.prepare (get_prepare id) exo3 in - let exo5 =Learnocaml_exercise.set Learnocaml_exercise.prelude (get_prelude id) exo4 in - let exo6 =Learnocaml_exercise.set Learnocaml_exercise.solution (get_solution id) exo5 in - let exo7 =Learnocaml_exercise.set Learnocaml_exercise.test (get_test id) exo6 in - let exo8 =Learnocaml_exercise.set Learnocaml_exercise.template (get_template id) exo7 in - Learnocaml_exercise.set Learnocaml_exercise.descr description exo8 - in - - let worker () = ref (Grading_jsoo.get_grade ~callback (exo () ) ) in - begin toolbar_button - ~icon: "reload" "Grade!" @@ fun () -> - + let worker () = ref (Grading_jsoo.get_grade ~callback (exo_creator id) ) in + let grade () = let aborted, abort_message = let t, u = Lwt.task () in - let btn = Tyxml_js.Html5.(button [ pcdata "abort" ]) in + let btn = Tyxml_js.Html5.(button [ pcdata [%i "abort" ]]) in Manip.Ev.onclick btn (fun _ -> Lwt.wakeup u () ; true) ; let div = Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata "Grading is taking a lot of time, " ; + [ pcdata [%i"Grading is taking a lot of time, "] ; btn ; - pcdata " ?" ]) in + pcdata "?" ]) in Manip.SetCss.opacity div (Some "0") ; t, div in Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "Launching the grader" ] ] ; - show_loading ~id:"learnocaml-exo-loading" [ messages ; abort_message ] ; + Tyxml_js.Html5.[ li [ pcdata [%i"Launching the grader"] ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ messages ; abort_message ]; Lwt_js.sleep 1. >>= fun () -> let solution = Ace.get_contents ace in Learnocaml_toplevel.check top solution >>= fun res -> match res with | Toploop_results.Ok ((), _) -> - let grading = - !(worker ()) solution >>= fun (report, _, _, _) -> - Lwt.return report in - let abortion = - Lwt_js.sleep 5. >>= fun () -> - Manip.SetCss.opacity abort_message (Some "1") ; - aborted >>= fun () -> - Lwt.return Learnocaml_report.[ Message ([ Text "Grading aborted by user." ], Failure) ] in - Lwt.pick [ grading ; abortion ] >>= fun report -> - let grade = display_report (exo () ) report in - (worker() ) := Grading_jsoo.get_grade ~callback ( exo () ) ; - Learnocaml_local_storage.(store (exercise_state id)) - { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; - mtime = gettimeofday () } ; - select_tab "report" ; - Lwt_js.yield () >>= fun () -> - hide_loading ~id:"learnocaml-exo-loading" () ; - Lwt.return () + let grading = + !(worker ()) solution >>= fun (report, _, _, _) -> + Lwt.return report in + let abortion = + Lwt_js.sleep 5. >>= fun () -> + Manip.SetCss.opacity abort_message (Some "1") ; + aborted >>= fun () -> + Lwt.return Learnocaml_report.[ Message + ([ Text [%i"Grading aborted by user."] ], Failure) ] in + Lwt.pick [ grading ; abortion ] >>= fun report -> + let grade = display_report (exo_creator id) report in + (worker() ) := Grading_jsoo.get_grade ~callback (exo_creator id) ; + Learnocaml_local_storage.(store (exercise_state id)) + { Learnocaml_exercise_state.grade = Some grade; + solution; report = Some report ; mtime = gettimeofday () } ; + select_tab "report" ; + Lwt_js.yield () >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" () ; + Lwt.return () | Toploop_results.Error _ -> - let msg = - Learnocaml_report.[ Text "Error in your code." ; Break ; - Text "Cannot start the grader if your code does not typecheck." ] in - let report = Learnocaml_report.[ Message (msg, Failure) ] in - let grade = display_report (exo () ) report in - Learnocaml_local_storage.(store (exercise_state id)) - { Learnocaml_exercise_state.grade = Some grade ; solution ; report = Some report ; - mtime = gettimeofday () } ; - select_tab "report" ; - Lwt_js.yield () >>= fun () -> - hide_loading ~id:"learnocaml-exo-loading" () ; - typecheck true + select_tab "report" ; + Lwt_js.yield () >>= fun () -> + hide_loading ~id:"learnocaml-exo-loading" () ; + typecheck true in + begin toolbar_button2 + ~icon: "reload" [%i"Grade!"] @@ fun () -> + recovering (); + if arg "tab" = "testhaut" then + begin + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_cancel = Tyxml_js.Html5.(button [ pcdata [%i"Cancel"] ]) in + Manip.Ev.onclick btn_cancel ( fun _ -> + hide_loading ~id:"learnocaml-exo-loading" () ; true) ; + let btn_compile = Tyxml_js.Html5.(button [ pcdata [%i"Compile"] ]) in + Manip.Ev.onclick btn_compile (fun _ -> + recovering () ; + compile (); + let _ = grade () in (); true) ; + let btn_no = Tyxml_js.Html5.(button + [ pcdata [%i"Grade without compiling Test"] ]) in + Manip.Ev.onclick btn_no (fun _ -> let _ = grade () in () ; true); + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata [%i"The Grade feature relies on the contents of Test.ml. \ + Do you want to compile the high-level tests \ + and overwrite Test.ml?\n"] ; + btn_compile ; + pcdata " " ; + btn_no ; + pcdata " " ; + btn_cancel ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:"learnocaml-exo-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + Lwt.return () + end + else + grade () end ; - + grade_black:= (fun ()-> + Manip.removeClass (find_component "grade_id") "special_grade"); + grade_red:= (fun ()-> + Manip.addClass (find_component "grade_id") "special_grade" ); + if arg "tab" = "testhaut" then + !grade_red (); + (* ---- return -------------------------------------------------------- *) - toplevel_launch >>= fun _ -> - typecheck false >>= fun () -> + (* toplevel_launch >>= fun _ -> FIXME? SHOULD BE UNNECESSARY *) + (* typecheck false >>= fun () -> ? *) hide_loading ~id:"learnocaml-exo-loading" () ; - - Lwt.return () ;; + let () = Lwt.async @@ fun () -> + let _ = Dom_html.window##setInterval + (Js.wrap_callback (fun () -> onload ())) 200. in + Lwt.return () in + Lwt.return ();; + +(* Automatic save *) +let () = Lwt.async @@ fun ()-> + let _ = + let auto_save_interval = 120. (* in seconds *) in + Dom_html.window##setInterval + (Js.wrap_callback (fun () -> !recovering_callback ())) + (auto_save_interval *. 1000.) in + Lwt.return_unit ;; diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml new file mode 100644 index 000000000..b7afef5a3 --- /dev/null +++ b/src/editor/editor_lib.ml @@ -0,0 +1,750 @@ +open Learnocaml_exercise_state +open Learnocaml_common +open Learnocaml_index +open Lwt.Infix +open Js_utils +open Tyxml_js.Html5 +open Dom_html + +module StringMap = Map.Make(String);; + + +(* Internationalization *) + Translate.set_lang () + + +let get_titre id = + Learnocaml_local_storage.(retrieve (editor_state id)).metadata.titre + +let get_description id = + Learnocaml_local_storage.(retrieve (editor_state id)).metadata.description + +let get_diff id = + Learnocaml_local_storage.(retrieve (editor_state id)).metadata.diff +let get_solution id = + Learnocaml_local_storage.(retrieve (editor_state id)).solution +let get_question id = + Learnocaml_local_storage.(retrieve (editor_state id)).question +let get_template id = + Learnocaml_local_storage.(retrieve (editor_state id)).template +let get_testml id = + Learnocaml_local_storage.(retrieve (editor_state id)).test.testml +let get_testhaut id = + Learnocaml_local_storage.(retrieve (editor_state id)).test.testhaut +let get_prelude id = + Learnocaml_local_storage.(retrieve (editor_state id)).prelude +let get_prepare id = + Learnocaml_local_storage.(retrieve (editor_state id)).prepare +let get_imperative id = + Learnocaml_local_storage.(retrieve (editor_state id)).checkbox.imperative +let get_undesirable id = + Learnocaml_local_storage.(retrieve (editor_state id)).checkbox.undesirable + +let get_a_question id idQuestion = let string_map = get_testhaut id in + StringMap.(find idQuestion string_map) + +(* TODO refactor the following getters with get_a_question *) + +let get_ty id idQuestion = let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSol a -> a.ty + | TestAgainstSpec a -> a.ty + | TestSuite a -> a.ty + +let get_name_question id idQuestion= let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSol a -> a.name + | TestAgainstSpec a -> a.name + | TestSuite a -> a.name + +let get_type_question id idQuestion = + let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSol _ -> Solution + | TestAgainstSpec _ -> Spec + | TestSuite _ -> Suite + +let get_extra_alea id idQuestion = let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSol a -> a.gen + | TestAgainstSpec a -> a.gen + | _ -> failwith "?" + +let get_input id idQuestion = + let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSol a -> a.suite + | TestAgainstSpec a -> a.suite + | TestSuite a -> a.suite + +let get_spec id idQuestion = let test_list = get_testhaut id in + match StringMap.(find idQuestion test_list) with + | TestAgainstSpec a -> a.spec + | _ -> failwith "" + +let get_buffer id = + Learnocaml_local_storage.(retrieve (editor_state id)).incipit + +let compute_question_id test_haut = + let key_list = List.map (fun (a,b) -> int_of_string a) + (StringMap.bindings test_haut) in + let mi neighbor_color = + let rec aux c n=match c with + | [] -> n + | x :: l -> if x <> n then aux l n else aux neighbor_color (n + 1) + in aux neighbor_color 1 + in string_of_int (mi key_list) + +let save_testhaut testhaut id = + match Learnocaml_local_storage.(retrieve (editor_state id)) with + {metadata;incipit;prepare;solution;question; + template;test;prelude;checkbox;mtime} -> + let mtime = gettimeofday () in + let test = {testml = test.testml; testhaut} in + let new_exo = {metadata;incipit;prepare;solution;question; + template;test;prelude;checkbox;mtime} in + Learnocaml_local_storage.(store (editor_state id)) new_exo + + +let fetch_test_index id = + let index = get_testhaut id in + let json = + Json_repr_browser.Json_encoding.construct + testhaut_enc index in + try Lwt.return (Json_repr_browser.Json_encoding.destruct testhaut_enc json) + with exn -> + Lwt.fail (failwith "") + +let testhaut_iframe = Dom_html.createIframe Dom_html.document +let iframe_tyxml = Tyxml_js.Of_dom.of_iFrame testhaut_iframe + +let find_div id = + match Manip.by_id id with + | Some div -> div + | None -> let window=Dom_html.window in + let window=window##.parent in + let document=window##.document in + Tyxml_js.Of_dom.of_element (Js.Opt.case + (document##getElementById (Js.string id)) + (fun () -> raise Not_found) + (fun node -> node)) + + +let remove_exo exercise_id = + let exos = + Learnocaml_local_storage.(retrieve (index_state "index")).exos in + let exos = StringMap.remove exercise_id exos in + let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in + Learnocaml_local_storage.(store (index_state "index")) index; + Learnocaml_local_storage.(delete (editor_state exercise_id)) + +let titleUnique titre = + let exos= + match Learnocaml_local_storage.(retrieve (index_state "index")) with + | {Learnocaml_exercise_state.exos; mtime} -> exos in + match StringMap.find_first_opt + (fun key -> (StringMap.find key exos).exercise_title = titre) + exos with + | None -> true + | _ -> false + +let idUnique id = + match Learnocaml_local_storage.(retrieve (editor_state id)) with + | exception Not_found -> true + | _ -> false + +let store_in_index metadata = + let exercise_title = metadata.titre in + let exercise_stars = metadata.diff in + let exercise_kind = Learnocaml_exercise in + let exercise_short_description = Some metadata.description in + let exo = {exercise_kind; exercise_stars; exercise_title; + exercise_short_description} in + match Learnocaml_local_storage.(retrieve (index_state "index")) with + | {Learnocaml_exercise_state.exos; mtime} -> + let former_exos = exos in + let exos = StringMap.add metadata.id exo former_exos in + let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in + Learnocaml_local_storage.(store (index_state "index")) index + + +let setInnerHtml elt s = + elt##.innerHTML := Js.string s + +let hide_load id = + let elt_lml=match find_div id with + | exception Not_found -> + let div = Tyxml_js.Html.(div ~a:[ a_id id ]) [] in + let window=Dom_html.window in + let window=window##.parent in + let document=window##.document in + Manip.(appendChild (Tyxml_js.Of_dom.of_body document##.body) ) div; + div + | div -> div + in + Manip.(removeClass elt_lml "initial") ; + Manip.(removeClass elt_lml "loading") ; + Manip.(addClass elt_lml "loaded") + +let show_load id contents = + let elt = match find_div id with + | exception Not_found -> + let div = Tyxml_js.Html.(div ~a:[ a_id id ]) [] in + let window=Dom_html.window in + let window=window##.parent in + let document=window##.document in + Manip.(appendChild (Tyxml_js.Of_dom.of_body document##.body) ) div; + div + | div -> div in + Manip.(addClass elt "loading-layer") ; + Manip.(removeClass elt "loaded") ; + Manip.(addClass elt "loading") ; + let chamo_src = + "icons/tryocaml_loading_" ^ string_of_int (Random.int 8 + 1) ^ ".gif" in + Manip.replaceChildren elt + Tyxml_js.Html.[ + div ~a: [ a_id "chamo" ] [ img ~alt: "loading" ~src: chamo_src () ] ; + div ~a: [ a_class [ "messages" ] ] contents + ] + +let _ = testhaut_iframe##.width := Js.string "100%" +let _ = testhaut_iframe##.height := Js.string "100%" +let _ = Manip.SetCss.opacity iframe_tyxml (Some "1") +let recovering_callback = ref (fun () -> ()) + + +let checkbox_creator string cas id = + let chk = input ~a:[ a_id string; a_input_type `Checkbox] () in + let checked = + match cas with + | 0 -> (get_imperative id) + | _ -> (get_undesirable id) in + let dom_chk = Tyxml_js.To_dom.of_input chk in + dom_chk##.checked := Js.bool checked; + dom_chk##.onclick := handler (fun _ -> + let a = Learnocaml_local_storage.(retrieve (editor_state id)) in + let checkbox = + if cas = 0 then + {imperative = Js.to_bool dom_chk##.checked; + undesirable = a.checkbox.undesirable} + else + {imperative = a.checkbox.imperative; + undesirable = Js.to_bool dom_chk##.checked} in + let new_e = {metadata = a.metadata; incipit = a.incipit; + prepare = a.prepare; prelude = a.prelude; + checkbox;test = a.test; template = a.template; + solution = a.solution; mtime = a.mtime; + question = a.question} in + Learnocaml_local_storage.(store (editor_state id) new_e); Js._true); + Tyxml_js.Of_dom.of_input dom_chk + + +let with_test_lib_prepare string = + "module Dummy_Functor (Introspection :\n Introspection_intf.INTROSPECTION) = struct\n module Dummy_Params = struct\n let results = ref None\n let set_progress _ = ()\n let timeout = None\n module Introspection = Introspection \n end\n module Test_lib = Test_lib.Make(Dummy_Params)\n module Report = Learnocaml_report;;\n let code_ast = (failwith \"WIP\" : Parsetree.structure);;\n\n " + ^ string ^ " end";; + +let typecheck_spec_aux set_class ace_t editor_t top string= + Learnocaml_toplevel.check top + (with_test_lib_prepare string) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor_t error warnings >>= fun () -> + Ace.focus ace_t ; + Lwt.return () ;; + +let typecheck_spec set_class ace_t editor_t top = + typecheck_spec_aux set_class ace_t editor_t top (Ace.get_contents ace_t) + +let rec testhaut_init content_div id = + let elt = find_div "learnocaml-loading" in + fetch_test_index id >>= fun index -> + let format_question_list all_question_states = + let format_contents acc contents = + StringMap.fold + (fun question_id quest acc -> + let name,ty=match quest with + | TestAgainstSol a -> a.name,a.ty + | TestAgainstSpec a -> a.name,a.ty + | TestSuite a -> a.name,a.ty in + div ~a:[a_id "toolbar"; a_class ["button"]] [ + (div ~a:[a_id "button_delete"] [ + let button = button ~a:[a_id question_id] + [img ~src:"icons/icon_cleanup_dark.svg" + ~alt:"" () ; pcdata ""] in + Manip.Ev.onclick button + (fun _ -> + begin + let messages = Tyxml_js.Html5.ul [] in + let aborted, abort_message = + let t, u = Lwt.task () in + let btn_no = + Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in + Manip.Ev.onclick btn_no ( fun _ -> + hide_load "learnocaml-main-loading" ; + true) ; + let btn_yes = + Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in + Manip.Ev.onclick btn_yes (fun _ -> + let rmv = get_testhaut id in + let testhaut = + StringMap.remove question_id rmv in + save_testhaut testhaut id ; + hide_load "learnocaml-main-loading"; + Manip.removeChildren content_div; + let _ = testhaut_init content_div id in + () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata [%i"Are you sure you want to delete \ + this question?\n"] ; + btn_yes ; + pcdata " " ; + btn_no ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_load "learnocaml-main-loading" [ abort_message ] ; + Manip.SetCss.opacity abort_message (Some "1") ; + end ; + true) ; button + ] ); + (div ~a:[a_id "up"] [ + let buttonUp = button ~a:[] + [img ~src:"icons/icon_down_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick buttonUp + (fun _ -> + begin + let qid = question_id in + let testhaut = get_testhaut id in + let question = StringMap.find qid testhaut in + let suivant = string_of_int + ((int_of_string qid) + 1) in + let testhaut = + match StringMap.find suivant testhaut with + | exception Not_found -> testhaut + | qsuivante -> + let map = + StringMap.add qid qsuivante testhaut in + StringMap.add suivant question map in + save_testhaut testhaut id; + Manip.removeChildren content_div; + let _ = testhaut_init content_div id in () + end; + true) ; + buttonUp; + ]); + (div ~a:[a_id "down"] [ + let buttonDown = button ~a:[] + [img ~src:"icons/icon_up_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick buttonDown + (fun _ -> + begin + let qid = question_id in + let testhaut = get_testhaut id in + let question = StringMap.find qid testhaut in + let intp = (int_of_string qid) -1 in + let prec = string_of_int + (if intp = 0 then 1 else intp ) in + let testhaut = + match StringMap.find prec testhaut with + | exception Not_found -> testhaut + | qprec -> + let map = StringMap.add qid qprec testhaut in + StringMap.add prec question map in + save_testhaut testhaut id; + Manip.removeChildren content_div; + let _ = testhaut_init content_div id in () + end; + true) ; + buttonDown; + ]); + (div ~a:[a_id "duplicate"] [ + let buttonDuplicate = button ~a:[] + [img ~src:"icons/icon_list_dark.svg" + ~alt:"" (); pcdata "" ] in + Manip.Ev.onclick buttonDuplicate + (fun _ -> + begin + let testhaut = get_testhaut id in + let question = + StringMap.find question_id testhaut in + let qid = compute_question_id testhaut in + let testhaut = + StringMap.add qid question testhaut in + save_testhaut testhaut id; + Manip.removeChildren content_div; + let _ = testhaut_init content_div id in () + end; true); + buttonDuplicate; + ]) ] + :: a ~a:[ a_onclick (fun _ -> + Manip.(addClass elt "loading-layer") ; + Manip.(removeClass elt "loaded") ; + Manip.(addClass elt "loading") ; + Manip.replaceChildren elt [iframe_tyxml] ; + testhaut_iframe##.src := + Js.string ("test.html#id=" ^ id ^ "&questionid=" ^ + question_id ^ "&action=open") ; + true) ; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata name ] ; + p [ pcdata ty ] ; + ] + ] :: + acc) + contents acc in + List.rev (format_contents ([a ~a:[ a_class ["patterns"]] [ + h1 [ pcdata [%i"Code quality and forbidden patterns"] ]; + div ~a:[ a_class [ "quality" ] ] [ + p [ pcdata [%i"Forbid undesirable code patterns"] ]; + checkbox_creator "quality_box" 1 id ;]; + div ~a:[a_class [ "imperative" ] ] [ + p [ pcdata [%i"Forbid imperative features"] ]; + checkbox_creator "imperative_box" 0 id + ];]] @ + [a ~a:[ a_onclick + (fun _ -> + Manip.(addClass elt "loading-layer") ; + Manip.(removeClass elt "loaded") ; + Manip.(addClass elt "loading") ; + Manip.replaceChildren elt [iframe_tyxml] ; + testhaut_iframe##.src:=Js.string ("test.html#id="^id^"&action=open"); + true); + Tyxml_js.Html5.a_class [ "exercise" ] ] [ + Tyxml_js.Html5.div ~a:[ Tyxml_js.Html5.a_class [ "descr" ] ] [ + Tyxml_js.Html.h1 [ Tyxml_js.Html5.pcdata [%i"New question"] ]; + Tyxml_js.Html5.p [Tyxml_js.Html5.pcdata + [%i"Create a new question"]]; + ]; + ]]) index) in + let list_div = + Tyxml_js.Html5.(div ~a: + [Tyxml_js.Html5.a_id "learnocaml-main-exercise-list" ]) + (format_question_list index) in + Dom.appendChild (Tyxml_js.To_dom.of_div content_div) + (Tyxml_js.To_dom.of_div list_div ) ; + + Lwt.return_unit;; + + +(* ---------- Functions for generate test -> Compile ---------- *) + +let rec redondanceAux liste elem= match liste with + | [] -> [] + | e :: s -> if e = elem then (redondanceAux s elem) + else (e :: (redondanceAux s elem)) + + +let rec redondance liste = match liste with + | [] -> [] + | e :: s -> e :: (redondance (redondanceAux s e)) + +let init = "let () = + set_result @@ + ast_sanity_check code_ast @@ fun () ->\n" + +let section name report = "Section + ([ Text \"Function:\" ; Code \""^name^"\" ], " ^ report ^ " );\n" + + +(*_____________________Functions for the Generate button_____________________*) + +(* we get "val f : int -> int -> int = " *) + +let string_of_char ch = String.make 1 ch + +let rec concatenation listech = match listech with + | [] -> "" + | c :: l -> (string_of_char c) ^ (concatenation l) + + +let rec get_equal listeChar = match listeChar with + | [] -> [] + | '=' :: l -> [] + | ch :: tail -> ch :: (get_equal tail) + +let rec get_val listeChar = match listeChar with + | [] -> [] + | 'v' :: 'a' :: 'l' :: tail -> get_equal tail + | ch :: suite -> get_val suite + +let rec get_next_val listeChar = match listeChar with + | [] -> [] + | 'v' :: 'a' :: 'l' :: tail -> tail + | ch :: suite -> get_next_val suite + +let rec get_all_val listeChar listeRes = match listeChar with + | [] -> listeRes + | _ -> if (get_val listeChar) <> [] + then (get_all_val (get_next_val listeChar) + ((get_val listeChar) :: listeRes)) + else listeRes + +let rec get_only_fct listeChar listeFinale = match listeChar with + | [] -> listeFinale + | 'v'::'a'::'l'::suite -> listeFinale @ (isFct suite ['v';'a';'l']) + | ch::suite -> get_only_fct suite listeFinale +and isFct listeChar listeAux = match listeChar with + | [] -> [] + | 'v'::'a'::'l'::suite -> isFct suite ['v';'a';'l'] + | '<'::'f'::'u'::'n'::'>'::suite -> + get_only_fct suite (listeAux @ ['<';'f';'u';'n';'>']) + | ch::suite -> isFct suite (listeAux @ [ch]) + +let rec get_type_of_fct listeChar b = match listeChar with + | [] -> [] + | ':'::tail -> get_type_of_fct tail true + | ch::tail -> if b then (ch::(get_type_of_fct tail b)) + else (get_type_of_fct tail b) + + +let rec get_nom listeChar nom = match listeChar with + | [] -> nom + | ' '::suite -> get_nom suite nom + | ch::' '::suite -> if ch <> ' ' then nom @ [ch] else get_nom suite nom + | ch::suite -> get_nom suite (nom@[ch]) + +let rec get_questions listeChar name_and_type = match listeChar with + | [] -> name_and_type + | liste::suite -> get_questions suite name_and_type @ + [(concatenation (get_nom liste []), + concatenation (get_type_of_fct liste false))] + + +let first (a,b,c) = a +let second (a,b,c) = b +let third (a,b,c) = c + +let maj_mono val_next_mono = match val_next_mono with + | 'i'::'n'::'t'::[]->'c'::'h'::'a'::'r'::[] + | 'c'::'h'::'a'::'r'::[]->'b'::'o'::'o'::'l'::[] + | 'b'::'o'::'o'::'l'::[] -> 's'::'t'::'r'::'i'::'n'::'g'::[] + | 's'::'t'::'r'::'i'::'n'::'g'::[] -> 'i'::'n'::'t'::[] + | _ -> failwith "error monomorphic type" + +(** Update the list of couples and then return this list + * and the monomorphic type that must be used *) +let rec get_association listeCouple elt listeCouple2 val_next_mono = + match listeCouple with + | [] -> ((elt,maj_mono val_next_mono) :: + listeCouple2,maj_mono val_next_mono, true) + | (poly, mono) :: tail -> + if poly = elt then (listeCouple2,mono,false) + else (get_association tail elt listeCouple2 val_next_mono) + +let getC listeChar = + let rec before listeChar = match listeChar with + | [] -> [] + | ' '::suite -> [] + | ch::suite -> ch:: (before suite) + and after listeChar = match listeChar with + | [] -> [] + | ' '::suite -> suite + | ch::suite -> after suite in + (before listeChar, after listeChar) +(** Replace the 'a, 'b, ... by int || char || ... *) +let rec polymorph_detector_aux listeType listeCouple val_next_mono = + match listeType with + | [] -> [] + | '\''::suite -> let ch,tail = getC suite in + let v = (get_association + listeCouple ch listeCouple val_next_mono) in + if third v + then (second v) @ (polymorph_detector_aux tail + (first v) (second v)) + else (second v) @ (polymorph_detector_aux tail + (first v) (val_next_mono)) + | ch::tail -> ch::(polymorph_detector_aux tail listeCouple val_next_mono) + +let rec decompositionSol str n = + if str = "" then [] + else if n + 1 = String.length str then [(str.[n])] + else (str.[n])::(decompositionSol str (n+1)) + + +let rec decomposition str n = + if str = "" then [] + else if n + 1 = String.length str then [(str.[n])] + else (str.[n])::(decompositionSol str (n+1)) + +(** @param listeChar a list of couples of char lists *) +let rec polymorph_detector listeChar = match listeChar with + | []-> [] + | (listeNom,listeType)::tail -> (listeNom,concatenation + (polymorph_detector_aux (decompositionSol listeType 0) + [] ('c'::'h'::'a'::'r'::[])))::(listeNom,concatenation + (polymorph_detector_aux (decompositionSol listeType 0) + [] ('i'::'n'::'t'::[])))::(polymorph_detector tail) + + +(* ____Functions for generate template______________________________________ *) + +let failchar = + [' ';'f';'a';'i';'l';'w';'i';'t';'h';' ';'"';'T';'O';'D';'O';'"';'\n'] + +let tail l = match l with + | [] -> [] + | e :: l -> l + +let rec commentaire listech cpt = match listech with + | [] -> [] + | '*'::')'::l -> if cpt = 0 then l else commentaire l (cpt - 1) + | '('::'*'::l -> commentaire l (cpt + 1) + | c::l -> commentaire l cpt + +let rec premierLet listech = match listech with + | [] -> [] + | '('::'*'::l -> premierLet (commentaire l 0) + | c::'l'::'e'::'t'::' '::l -> + if c = '\n' || c = ' ' then ('l'::'e'::'t'::' '::l) else premierLet l + | 'l'::'e'::'t'::' '::l -> 'l'::'e'::'t'::' '::l + | ' '::l -> premierLet l + | '\n'::l -> premierLet l + | _ -> [] + +let rec validationLet listech = match listech with + | [] -> false + | ' '::l -> validationLet l + | '\n'::l -> validationLet l + | '('::l -> validationLet l + | 'l'::'e'::'t'::l -> false + | _ -> true + +let rec rechercheEgal listech = match listech with + | [] -> 0 + | '='::l -> 1 + | ' '::'l'::'e'::'t'::' '::l -> 2 + | '\n'::'l'::'e'::'t'::' '::l -> 2 + | c::l -> rechercheEgal l + +let rec rechercheLet listech b = match listech with + | [] -> [] + | '('::'*'::l -> rechercheLet (commentaire l 0) b + | ';'::';'::l -> rechercheLet l true + | '='::l -> rechercheLet l (validationLet l) + | _::'t'::'h'::'e'::'n'::_::l -> rechercheLet l (validationLet l) + | _::'e'::'l'::'s'::'e'::_::l -> rechercheLet l (validationLet l) + | _::'i'::'n'::_::l -> rechercheLet l (validationLet l) + | '-'::'>'::l -> rechercheLet l (validationLet l) + | 'l'::'e'::'t'::' '::l -> + if b && (rechercheEgal l) = 1 then 'l'::'e'::'t'::' '::l + else if (rechercheEgal l) = 0 then rechercheLet l false + else rechercheLet l true + | c::suite -> rechercheLet suite b + +let rec decomposition2 listech = match listech with + | [] -> [] + | '='::l -> ['='] + | c::l -> c :: (decomposition2 l) + +let decompoFirst listech = match listech with + | []-> [] + | _ -> (decomposition2 listech) @ failchar + +let rec genLet listech = + let liste = rechercheLet listech true in + match liste with + | [] -> [] + | _ -> (decomposition2 liste) @ failchar @ (genLet (tail liste)) + +let rec genTemplate chaine = + if chaine = "" then "" + else concatenation (genLet (decompositionSol chaine 0)) + + +(*_________ Check _________________________________________*) + +let typecheck set_class ace editor top = + Learnocaml_toplevel.check top (Ace.get_contents ace) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor error warnings >>= fun () -> + Ace.focus ace ; + Lwt.return () + +(* ---- create an exo ------------------------------------------------------- *) + +let exo_creator proper_id = + let titre = get_titre proper_id in + let question = get_question proper_id in + let question = Omd.to_html (Omd.of_string question) in + let open Learnocaml_exercise in + let exo1 = set id proper_id empty in + let exo2 = set title titre exo1 in + let exo3 = set max_score 80 exo2 in + let exo4 = set prepare (get_prepare proper_id) exo3 in + let exo5 = set prelude (get_prelude proper_id) exo4 in + let exo6 = set solution (get_solution proper_id) exo5 in + let exo7 = set test (get_testml proper_id) exo6 in + let exo8 = set template (get_template proper_id) exo7 in + set descr question exo8 + +let get_answer top = + Learnocaml_toplevel.execute_test top + +let typecheck_dialog_box div_id res = + let result = + let open Toploop_results in + match res with + | Ok _ -> [%i"Your question does typecheck. "] + | Error ((*err*)_,_) -> + [%i"Your question does not typecheck. "] + (* err.msg should be considered*) in + begin + let messages = Tyxml_js.Html5.ul [] in + let checked, check_message = + let t, u = Lwt.task () in + let btn_ok = Tyxml_js.Html5.(button [ pcdata [%i"OK"] ]) in + Manip.Ev.onclick btn_ok ( fun _ -> + hide_loading ~id:div_id () ; true) ; + let div = + Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] + [ pcdata result ; + btn_ok ; + ]) in + Manip.SetCss.opacity div (Some "0") ; + t, div in + Manip.replaceChildren messages + Tyxml_js.Html5.[ li [ pcdata "" ] ] ; + show_loading ~id:div_id [ check_message ] ; + Manip.SetCss.opacity check_message (Some "1") + end; + Lwt.return () +;; + +(* keep sync with test-spec *) +let test_prel = "open Test_lib\nopen Learnocaml_report\n\n\n(* sampler: (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) *)\n(*keep in sync with learnocaml_exercise_state.ml *)\ntype test_qst_untyped =\n | TestAgainstSol of\n { name: string\n ; ty: string\n ; gen: int\n ; suite: string\n ; tester: string\n ; sampler: string}\n | TestAgainstSpec of\n { name: string\n ; ty: string\n ; gen: int\n ; suite: string\n ; spec : string\n ; tester: string\n ; sampler: string}\n | TestSuite of\n { name: string;\n ty: string;\n suite: string;\n tester : string}\n;;\n\ntype outcome =\n | Correct of string option\n | Wrong of string option\n\n(* TODO val get_test_qst : test_qst_untyped -> test_qst_typed *)\n\ntype test_qst_typed =\n | TestAgainstSol :\n { name: string\n ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot\n ; tester: 'ret tester option\n ; sampler:(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) option\n ; gen: int\n ; suite: ('ar -> 'row, 'ar -> 'urow, 'ret) args list } -> test_qst_typed\n | TestAgainstSpec :\n { name: string\n ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot\n ; tester: 'ret tester option (* 'a tester option (base) mais probleme de type : 'a tester incompatible avec 'ret tester*)\n ; sampler: (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) option\n ; gen: int\n ; suite: ('ar -> 'row, 'ar -> 'urow, 'ret) args list\n ; spec : ('ar -> 'row) -> ('ar -> 'row, 'ar -> 'urow, 'ret) args -> 'ret -> outcome } -> test_qst_typed\n | TestSuite :\n { name: string\n ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot\n ; tester: 'ret tester option\n ; suite: (('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list } -> test_qst_typed\n\n(** Notation for TestAgainstSpec *)\nlet (~~) b = if b then Correct None else Wrong None\n(** Notations for TestSuite *)\nlet (==>) a b = (a, fun () -> b)\n(* let (=>) a b = (a, fun () -> Lazy.force b) (* needs module Lazy *) *)\n(** Notations for heterogeneous lists *)\nlet (@:) a l = arg a @@ l\nlet (!!) b = last b\nlet (@:!!) a b = a @: !! b\n\nlet local_dummy : 'a sampler = fun () -> failwith \"dummy sampler\"\n(* à n'utiliser que si on passe l'argument ~gen:0 (pas d'alea) *)\n \nlet test_question (t : test_qst_typed) =\n match t with\n | TestAgainstSol t ->\n let tester = match t.tester with\n | None -> test\n | Some s -> s in\n if t.gen=0 then \n (test_function_against\n ~gen:t.gen ~sampler:local_dummy\n ~test:tester (* could take into account exceptions/sorted lists/etc. *)\n t.prot\n (lookup_student (ty_of_prot t.prot) t.name)\n (lookup_solution (ty_of_prot t.prot) t.name)\n t.suite)\n else\n (match t.sampler with\n | None -> (test_function_against\n ~gen:t.gen\n ~test:tester (* could take into account exceptions/sorted lists/etc. *)\n t.prot\n (lookup_student (ty_of_prot t.prot) t.name)\n (lookup_solution (ty_of_prot t.prot) t.name)\n t.suite)\n | Some s -> (test_function_against\n ~gen:t.gen ~sampler:s\n ~test:tester (* could take into account exceptions/sorted lists/etc. *)\n t.prot\n (lookup_student (ty_of_prot t.prot) t.name)\n (lookup_solution (ty_of_prot t.prot) t.name)\n t.suite))\n | TestAgainstSpec t ->\n let to_string ty v = Format.asprintf \"%a\" (typed_printer ty) v in\n let stud = lookup_student (ty_of_prot t.prot) t.name in\n test_value stud @@ fun uf ->\n (* no sampler for the moment *)\n let open Learnocaml_report in\n List.flatten @@ List.map (fun args ->\n let code = Format.asprintf \"@[%s,%a@]\" t.name (print t.prot) args in\n let ret_ty = get_ret_ty (ty_of_prot t.prot) args in\n Message ([ Text \"Checking spec for\" ; Code code ], Informative) ::\n let ret = apply uf args in\n let value = to_string ret_ty ret in\n let (text, note) = match t.spec uf args ret with\n | Correct None -> (\"Correct spec\", Success 1)\n | Correct (Some message) -> (message, Success 1)\n | Wrong None -> (\"Wrong spec\", Failure)\n | Wrong (Some message) -> (message, Failure) in\n [Message ([Text \"Got value\"; Code value; Text (\": \" ^ text)], note)])\n t.suite\n | TestSuite t ->\n let test = match t.tester with\n | None -> test\n | Some s -> s in\n test_function\n ~test:test (* could take into account exceptions/sorted lists/etc. *)\n t.prot\n (lookup_student (ty_of_prot t.prot) t.name)\n t.suite\n" diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli new file mode 100644 index 000000000..95b77a941 --- /dev/null +++ b/src/editor/editor_lib.mli @@ -0,0 +1,109 @@ +(** Getters of an editor exercise + * @param the id *) +val get_titre : string -> string +val get_description : string -> string +val get_diff : string -> float +val get_solution : string -> string +val get_question : string -> string +val get_template : string -> string +val get_testml : string -> string +val get_testhaut : string -> Learnocaml_exercise_state.test_qst_untyped Map.Make(String).t +val get_prelude : string -> string +val get_prepare : string -> string +val get_imperative : string -> bool +val get_undesirable : string -> bool +val get_buffer : string -> string +(** Getters of a question of an editor exercise + * @param exercise_id question_id *) +val get_a_question : string -> Map.Make(String).key ->Learnocaml_exercise_state.test_qst_untyped +val get_ty : string -> Map.Make(String).key -> string +val get_name_question : string -> Map.Make(String).key -> string +val get_type_question : string -> Map.Make(String).key -> Learnocaml_exercise_state.type_question +val get_extra_alea : string -> Map.Make(String).key -> int +val get_input : string -> Map.Make(String).key -> string +val get_spec : string -> Map.Make(String).key -> string + +(** Question ids are integers stored in strings *) + +(** Compute the smallest integer not used yet *) +val compute_question_id : 'a Map.Make(String).t -> string + +(** Setter of testhaut + * @param new_StringMap exercise_id *) +val save_testhaut : Learnocaml_exercise_state.test_qst_untyped Map.Make(String).t -> string -> unit + +val with_test_lib_prepare :string->string + +(** Remove an exercise from the local storage *) +val remove_exo : Map.Make(String).key -> unit + +(** @return a bool depending on whether the id is already used or not *) +val idUnique : string -> bool +(** @return a bool depending on whether the title is already used or not *) +val titleUnique : string -> bool + +(** Store an exercise in the dynamic index of editor exercises *) +val store_in_index : Learnocaml_exercise_state.metadata -> unit + +(** arguments Dom element , string *) +val setInnerHtml : < innerHTML : < set : Js.js_string Js.t -> unit; .. > + Js_of_ocaml.Js.gen_prop; .. > Js_of_ocaml.Js.t -> string -> unit + +(** Trick to call the recovering function outside of it definition enveroniment *) +val recovering_callback : (unit -> unit) ref + +(** Create the testhaut pane blindfolds *) +val testhaut_init : [< Html_types.div ] Tyxml_js.Html5.elt -> string -> unit Lwt.t + +(** Remove extra_copies of a value in the list (each value of the list is unique now) *) +val redondance : 'a list -> 'a list + +(** Fragment of a test.ml code + * @see definition *) +val init : string + +(** Create the code of a section + * @param name_of_the_function associated_report *) +val section : string -> string -> string + +val string_of_char : char -> string + +(** @param content_of_the_toplevel [[]] + * @return a list + * The first value is the type of the first val, etc. *) +val get_all_val : char list -> char list list -> char list list + +(** Remove atomic values from a list of types + * @return a list of type of function (var function_name : type = ) + * @param content_of_the_toplevel [[]] result_list (second parameter must be []) *) +val get_only_fct : char list -> char list -> char list + +(** Associate each function with its type + * @ return a list of couple (function_name, function_type) + * @ param content_of_the_toplevel result_list (second param must be []) *) +val get_questions : char list list -> (string * string) list -> (string * string) list + +(** Create the corresponding char list of a string (second parameter must be 0) *) +val decompositionSol : string -> int -> char list + +(** Create a list of couple : type parameter associate with a base type + * for example : 'a,int ; 'b,float ... *) +val polymorph_detector : ('a * string) list -> ('a * string) list + +(** Create the template of the solution *) +val genTemplate : string -> string + +(** Refacoring of typecheck functions *) +val typecheck : bool -> 'a Ace.editor -> Ocaml_mode.editor -> Learnocaml_toplevel.t -> unit Lwt.t +val typecheck_spec : bool -> 'a Ace.editor -> Ocaml_mode.editor -> Learnocaml_toplevel.t -> unit Lwt.t + + +(** Create an exercise with the data of the local storage + * @param editor_exercise_id *) +val exo_creator : string -> Learnocaml_exercise.t + +(** @return the output of toplevel buffer *) +val get_answer : Learnocaml_toplevel.t -> string +val typecheck_dialog_box : string-> 'a Toploop_results.toplevel_result -> unit Lwt.t +val test_prel :string + diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index bc4e2941c..6ff33abc5 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -1,178 +1,143 @@ -open Js_of_ocaml open Str open Js_of_ocaml open Dom_html +open Js_utils open Learnocaml_common +open Learnocaml_exercise_state +open Learnocaml_index +open Editor_lib module StringMap = Map.Make (String) -let setInnerHtml elt s = - elt##.innerHTML:= Js.string s -let transResultOption = function - |None -> false - |Some s-> true;; -let idOk s = transResultOption (Regexp.string_match (Regexp.regexp "^[a-z0-9_-]+$") s 0);; -let titreOk s = (transResultOption (Regexp.string_match (Regexp.regexp "^[^ \t]") s 0)) && - (transResultOption (Regexp.string_match (Regexp.regexp ".*[^ \t]$") s 0));; +(* Internationalization *) +let () = Translate.set_lang () +let () = + let translations = [ + "txt_new_exo", [%i"New exercise"]; + "txt_id", [%i"Unique identifier:
"]; + "txt_title", [%i"Title (unique too):
"]; + "txt_descr", [%i"Description of the exercise:
"]; + "txt_diff", [%i"Difficulty level:
"]; + "cancel", [%i"Cancel"]; + "save", [%i"Save"]; + ] in + Translate.set_string_translations translations + -let toString = function - |None -> failwith "incorrect_input" - |Some input -> Js.to_string input##.value -let toStringOpt = function + +let getString = function + | None -> failwith "incorrect_input" + | Some input -> Js.to_string input##.value +let getStringOpt = function | None -> None | Some input -> Some (Js.to_string input##.value) -let toFloatOpt = function +let getFloatOpt = function | None -> None | Some input -> float_of_string_opt (Js.to_string input##.value) -let previousId = match (arg "id") with - |exception Not_found -> "" - |s -> s + + +let previous_id = match (arg "id") with + | exception Not_found -> "" + | s -> s let save = getElementById "save" let identifier = getElementById_coerce "identifier" CoerceTo.input let title = getElementById_coerce "title" CoerceTo.input -let descr = getElementById_coerce "description" CoerceTo.textarea +let description = getElementById_coerce "description" CoerceTo.textarea let difficulty = getElementById_coerce "difficulty" CoerceTo.select -let solution, question, template, test, previousTitre, previousDiff, prelude, prepare = - match Learnocaml_local_storage.(retrieve (editor_state previousId)) with - | exception Not_found -> "", "", "", "", "",None,"","" - | {Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ; - mtime;prelude;prepare } -> solution, question, template, test, titre, diff, prelude, prepare - +let incipit = "" +let checkbox = {undesirable = false; imperative = false} +let solution, question, template, test, + previous_title, previous_diff, prelude, prepare = + match Learnocaml_local_storage.(retrieve (editor_state previous_id)) with + | exception Not_found -> + "", "", "", {testml = ""; testhaut = StringMap.empty}, "", 0., "", "" + | {Learnocaml_exercise_state.metadata; + solution; question; template; test; mtime; prelude; prepare} -> + solution, question, template, test, + metadata.titre, metadata.diff, prelude, prepare + + +let () = match identifier with + | None -> () + | Some input -> input##.value := Js.string previous_id +let () = match title with + | None -> () + | Some input -> input##.value := Js.string previous_title +let previous_descr = + let exos = Learnocaml_local_storage.(retrieve (index_state "index")).exos in + let exo = + match (StringMap.find_opt previous_id exos) with + | None -> {exercise_kind = Learnocaml_exercise; exercise_title = ""; + exercise_short_description = None; exercise_stars = 0.} + | Some s -> s + in exo.exercise_short_description +let () = match previous_descr with + | Some d -> setInnerHtml (getElementById "description") d + | None -> () +let () = match difficulty with + | None -> () + | Some select -> select##.value := Js.string (string_of_float previous_diff) + + +let resultOptionToBool = function + | None -> false + | Some _ -> true +let isIdCorrect s = + resultOptionToBool (Regexp.string_match (Regexp.regexp "^[a-z0-9_-]+$") s 0) +let isTitleCorrect s = + (resultOptionToBool (Regexp.string_match (Regexp.regexp "^[^ \t]") s 0)) && + (resultOptionToBool (Regexp.string_match (Regexp.regexp ".*[^ \t]$") s 0)) + + +let store id titre description diff = + let metadata = {id; titre; description; diff} in + if previous_id <> "" then + Learnocaml_local_storage.(delete (editor_state previous_id)); + Learnocaml_local_storage.(store (editor_state id)) + {Learnocaml_exercise_state.metadata; solution; incipit; question; template; + test; prelude; prepare; checkbox; mtime = gettimeofday ()}; + store_in_index metadata;; + + let id_error = getElementById "id_error" let title_error = getElementById "title_error" -let previousDescr= - let open Learnocaml_exercise_state in - let exos=Learnocaml_local_storage.(retrieve (index_state "index")).exos in - let open Learnocaml_index in - let exo = - match (StringMap.find_opt previousId exos) with - |None -> {exercise_kind=Learnocaml_exercise;exercise_title="";exercise_short_description=None;exercise_stars=1.5} - |Some s->s - in exo.exercise_short_description -let _ = match previousDescr with - | Some d -> setInnerHtml (getElementById "description") d - | None -> setInnerHtml (getElementById "description") "" - -let _= match identifier with - None ->() - | Some input->input##.value:=Js.string previousId - -let _= match title with - None ->() - | Some input->input##.value:=Js.string previousTitre - -let d=match previousDiff with - None-> 0.0 - |Some f->f - -let _ =match difficulty with - |None-> () - |Some select->select##.value:=Js.string (string_of_float d) - -let _ = save##.onclick:= handler (fun _ -> - let id = toString identifier in - let titre = toString title in - let description = toStringOpt descr in - let diff = toFloatOpt difficulty in - let store () =if (previousId!="") then Learnocaml_local_storage.(delete (editor_state previousId)); - Learnocaml_local_storage.(store (editor_state id)) - { Learnocaml_exercise_state.id ; solution ; titre ; question ; template ; diff ; test ; prelude;prepare; - mtime = gettimeofday () } in - let idUnique () =if id = previousId then true else - match Learnocaml_local_storage.(retrieve (editor_state id)) with - | exception Not_found -> true - | _ -> false in - - let titleUnique () = - let exos= - match Learnocaml_local_storage.(retrieve (index_state "index")) with - |{Learnocaml_exercise_state.exos ;mtime}-> exos - in - let open Learnocaml_index in - if previousTitre=titre then true else - match StringMap.find_first_opt (fun key->(StringMap.find key exos).exercise_title=titre) exos with - None->true - | _ -> false - in - let store2 () = - let exercise_title = titre in - let stars = match diff with None -> failwith "" | Some f -> f in - let exercise_stars = stars in - let open Learnocaml_index in - let exercise_kind = Learnocaml_exercise in - let exercise_short_description = description in - let exo = {exercise_kind; exercise_stars; exercise_title; exercise_short_description} in - match Learnocaml_local_storage.(retrieve (index_state "index")) with - | {Learnocaml_exercise_state.exos; mtime} -> - let anciensexos = if (previousId!="") then StringMap.remove previousId exos else exos in - let exos = StringMap.add id exo anciensexos in - let index = {Learnocaml_exercise_state.exos; mtime = gettimeofday ()} in - Learnocaml_local_storage.(store (index_state "index")) index; - in - let id_correct = idOk id in - let id_unique = idUnique () in - let title_correct = titreOk titre in - let title_unique = titleUnique () in - if not id_correct && not title_correct then - begin - setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ - and only lower case letters, numerals, dashes \ - and underscores are allowed"; - setInnerHtml title_error "Incorrect title: a title can't be empty, \ - or begin or end with a space or a tab" - end - else if not id_correct && title_correct && not title_unique then - begin - setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ - and only lower case letters, numerals, dashes \ - and underscores are allowed"; - setInnerHtml title_error "This title is already used, please choose another one" - end - else if not id_correct && title_correct && title_unique then - begin - setInnerHtml id_error "Incorrect identifier: an identifier can't be empty, \ - and only lower case letters, numerals, dashes \ - and underscores are allowed"; - setInnerHtml title_error "" - end - else if id_correct && not id_unique && not title_correct then - begin - setInnerHtml id_error "This identifier is already used, please choose another one"; - setInnerHtml title_error "Incorrect title: a title can't be empty, \ - or begin or end with a space or a tab" - end - else if id_correct && not id_unique && title_correct && not title_unique then - begin - setInnerHtml id_error "This identifier is already used, please choose another one"; - setInnerHtml title_error "This title is already used, please choose another one" - end - else if id_correct && not id_unique && title_correct && title_unique then - begin - setInnerHtml id_error "This identifier is already used, please choose another one"; - setInnerHtml title_error "" - end - else if id_correct && id_unique && not title_correct then - begin - setInnerHtml id_error ""; - setInnerHtml title_error "Incorrect title: a title can't be empty, \ - or begin or end with a space or a tab" - end - else if id_correct && id_unique && title_correct && not title_unique then - begin - setInnerHtml id_error ""; - setInnerHtml title_error "This title is already used, please choose another one" - end +let () = save##.onclick := handler (fun _ -> + let id = getString identifier + and titre = getString title + and description = getString description + and diff = match getFloatOpt difficulty with + | None -> 0. + | Some x -> x in + let id_correct = isIdCorrect id + and id_unique = idUnique id + and title_correct = isTitleCorrect titre + and title_unique = titleUnique titre in + (if not id_correct then + setInnerHtml id_error [%i"Incorrect identifier: an identifier \ + can't be empty, \ + and only lower case letters, numerals, dashes \ + and underscores are allowed"] + else if not id_unique then + setInnerHtml id_error [%i"This identifier is already used, \ + please choose another one"] + else + setInnerHtml id_error ""); + (if not title_correct then + setInnerHtml title_error [%i"Incorrect title: a title can't be empty, \ + or begin or end with a space or a tab"] + else if not title_unique then + setInnerHtml title_error + [%i"This title is already used, please choose another one"] else + setInnerHtml title_error ""); + if id_correct && title_correct && id_unique && title_unique then begin - setInnerHtml id_error ""; - setInnerHtml title_error ""; - store (); - store2 (); + store id titre description diff; Dom_html.window##.location##assign (Js.string ("editor.html#id=" ^ id ^ "&action=open")); - end - ; Js._true + end; + Js._true ) diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml new file mode 100644 index 000000000..9b41c13da --- /dev/null +++ b/src/editor/test_spec.ml @@ -0,0 +1,269 @@ +(* Internationalization *) +let () = Translate.set_lang () + +module type TYPING = sig + (** Should return a representation of a type from its string serialisation *) + val ty_of : string -> 'a Ty.ty +end + +module Make(Test_lib : Test_lib.S) (Typing : TYPING) = struct + +open Test_lib +open Learnocaml_report + + +(* sampler: (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) *) +(* keep in sync with learnocaml_exercise_state.ml *) +type test_qst_untyped = + | TestAgainstSol of + { name: string + ; ty: string + ; gen: int + ; suite: string + ; tester: string + ; sampler: string} + | TestAgainstSpec of + { name: string + ; ty: string + ; gen: int + ; suite: string + ; spec : string + ; tester: string + ; sampler: string} + | TestSuite of + { name: string; + ty: string; + suite: string; + tester : string} + +type outcome = + | Correct of string option + | Wrong of string option + +(* TODO val get_test_qst : test_qst_untyped -> test_qst_typed *) + +type test_qst_typed = + | TestAgainstSol : + { name: string + ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot + ; tester: 'ret tester option + ; sampler:(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) option + ; gen: int + ; suite: ('ar -> 'row, 'ar -> 'urow, 'ret) args list } -> test_qst_typed + | TestAgainstSpec : + { name: string + ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot + ; tester: 'ret tester option + ; sampler: (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) option + ; gen: int + ; suite: ('ar -> 'row, 'ar -> 'urow, 'ret) args list + ; spec : ('ar -> 'row) -> ('ar -> 'row, 'ar -> 'urow, 'ret) args -> + 'ret -> outcome } -> test_qst_typed + | TestSuite : + { name: string + ; prot: (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot + ; tester: 'ret tester option + ; suite: (('ar -> 'row, 'ar -> 'urow, 'ret) args * + (unit -> 'ret)) list } -> test_qst_typed + +(** Notation for TestAgainstSpec *) +let (~~) b = if b then Correct None else Wrong None +(** Notations for TestSuite *) +let (==>) a b = (a, fun () -> b) +(* let (=>) a b = (a, fun () -> Lazy.force b) (* needs module Lazy *) *) +(** Notations for heterogeneous lists *) +let (@:) a l = arg a @@ l +let (!!) b = last b +let (@:!!) a b = a @: !! b +(* Homogeneous case, for testing purposes +let (@:) a l = a :: l +let (!!) b = b :: [] +let (@:!!) a b = a @: !! b +*) + +(* TODO missing: nth_arg *) + +(* +let example_constr_sol = + TestAgainstSol + { name = "opp"; + prot = (last_ty [%ty: int] [%ty: int] ); + gen = 0; + suite = [!! 0; !! 1; !! 2; !! ~-1] + } +*) + +(* +let example_constr_spec = + TestAgainstSpec + { name = "idempotent"; + prot = (last_ty [%ty: (int)] [%ty: int]); + gen = 0; + suite = [!! 0; !! 1; !! 2]; + spec = fun f args ret -> (* ret = apply f args *) + (* Function f should be idempotent *) + ~~ (ret = apply f (!! ret)) + } + +let example_constr_suite = + TestSuite + { + name = "xor"; + prot = (arg_ty [%ty: bool] (last_ty [%ty: bool] [%ty: bool])); + suite = [false @:!! false ==> false; + false @:!! true ==> true; + true @:!! false ==> true; + true @:!! true ==> false] + } +*) + + +let local_dummy : 'a sampler = fun () -> failwith "dummy sampler" +(* à n'utiliser que si on passe l'argument ~gen:0 (pas d'alea) *) + +let test_question (t : test_qst_typed) = + match t with + | TestAgainstSol t -> + let tester = match t.tester with + | None -> test + | Some s -> s in + if t.gen = 0 then + begin + test_function_against + ~gen:t.gen ~sampler:local_dummy + ~test:tester (* could take into account exceptions/sorted lists/etc. *) + t.prot + (lookup_student (ty_of_prot t.prot) t.name) + (lookup_solution (ty_of_prot t.prot) t.name) + t.suite + end + else + begin + match t.sampler with + | None -> (test_function_against + ~gen:t.gen + ~test:tester + (* could take into account exceptions/sorted lists/etc. *) + t.prot + (lookup_student (ty_of_prot t.prot) t.name) + (lookup_solution (ty_of_prot t.prot) t.name) + t.suite) + | Some s -> (test_function_against + ~gen:t.gen ~sampler:s + ~test:tester + (* could take into account exceptions/sorted lists/etc. *) + t.prot + (lookup_student (ty_of_prot t.prot) t.name) + (lookup_solution (ty_of_prot t.prot) t.name) + t.suite) + end + | TestAgainstSpec t -> + let to_string ty v = Format.asprintf "%a" (typed_printer ty) v in + let stud = lookup_student (ty_of_prot t.prot) t.name in + test_value stud @@ fun uf -> + (* no sampler for the moment *) + let open Learnocaml_report in + List.flatten @@ List.map (fun args -> + let code = + Format.asprintf "@[%s,%a@]" t.name (print t.prot) args in + let ret_ty = get_ret_ty (ty_of_prot t.prot) args in + Message ([ Text "Checking spec for" ; Code code ], Informative) :: + let ret = apply uf args in + let value = to_string ret_ty ret in + let (text, note) = match t.spec uf args ret with + | Correct None -> ("Correct spec", Success 1) + | Correct (Some message) -> (message, Success 1) + | Wrong None -> ("Wrong spec", Failure) + | Wrong (Some message) -> (message, Failure) in + [Message ([Text "Got value"; Code value; Text (": " ^ text)], note)]) + t.suite + | TestSuite t -> + let test = match t.tester with + | None -> test + | Some s -> s in + test_function + ~test:test (* could take into account exceptions/sorted lists/etc. *) + t.prot + (lookup_student (ty_of_prot t.prot) t.name) + t.suite +end + +open Editor_lib + +let rec to_string_aux char_list =match char_list with + | []-> "" + | c::l -> (string_of_char c) ^ ( to_string_aux l) + +let to_ty str = "(to_ty \""^str^"\" )" + +let parse_type string = + let char_list_ref = ref (List.rev (decompositionSol string 0)) in + let para_cpt =ref 0 in + let esp_cpt= ref 0 in + (* reverse char_list before using it *) + let rec last_arg char_list acc = + match char_list with + []->char_list_ref:=[];acc + |elt :: l -> + if elt = ')' then + incr para_cpt; + if elt ='(' then + decr para_cpt; + if elt='>' && !para_cpt=0 then + match l with + '-'::l2 -> char_list_ref:=l2;acc + |_ -> failwith "toto" + else + begin + if !esp_cpt=0 && elt=' ' then + begin + esp_cpt:=1; + last_arg l ( elt::acc ) + end + else + begin + if elt<>' ' then + begin + esp_cpt:=0; + last_arg l (elt::acc) + end + else + last_arg l acc + end + end in + let init_acc () = + let arg1=last_arg (!char_list_ref ) [] in + let arg2=last_arg (!char_list_ref) [] in + let ty1=to_ty (to_string_aux arg1) in + let ty2=to_ty (to_string_aux arg2) in + "last_ty "^ty2^" "^ty1 in + let acc =ref (init_acc ()) in + while !char_list_ref <>[] do + let arg=last_arg (!char_list_ref) [] in + let ty= to_ty (to_string_aux arg) in + acc:="arg_ty "^ty^" ("^(!acc)^")" ; + done; + !acc;; + +let question_typed question id_question = + let open Learnocaml_exercise_state in + let name,ty,input,extra_alea,output,type_question,tester,sampler = + match question with + | TestAgainstSol a -> a.name, a.ty, a.suite, a.gen, "", + Solution, a.tester, a.sampler + | TestAgainstSpec a -> a.name, a.ty, a.suite, a.gen, a.spec, + Spec, a.tester, a.sampler + | TestSuite a -> a.name, a.ty, a.suite, 0, "", Suite, a.tester, "" in + let tester = match tester with + | "" -> "None" + | s -> "Some ("^s^")" in + let sampler = match sampler with + | "" -> "None" + | s -> "Some (fun () -> last ("^s^"()))" in + let acc=(match type_question with + | Suite -> "\nlet question"^id_question^" = TestSuite {name=\""^name^"\"; prot="^(parse_type ty)^"; tester="^tester^"; suite="^input^"}" + | Solution -> "\nlet question"^id_question^" = TestAgainstSol {name=\""^name^"\"; prot="^(parse_type ty)^"; tester="^tester^"; sampler="^sampler^"; gen="^(string_of_int extra_alea)^"; suite="^input^"}" + | Spec -> "\nlet question"^id_question^" = TestAgainstSpec {name=\""^name^"\"; prot="^(parse_type ty)^"; tester="^tester^"; sampler="^sampler^"; gen="^(string_of_int extra_alea)^"; suite="^input^"; spec="^output^"}") in + acc +;; + diff --git a/src/editor/test_spec.mli b/src/editor/test_spec.mli new file mode 100644 index 000000000..01925982b --- /dev/null +++ b/src/editor/test_spec.mli @@ -0,0 +1,4 @@ + +(** Allows typing a question passing by a string + * @param question_untyped id_question *) +val question_typed : Learnocaml_exercise_state.test_qst_untyped -> string -> string diff --git a/src/editor/testhaut.ml b/src/editor/testhaut.ml new file mode 100644 index 000000000..70c9f4410 --- /dev/null +++ b/src/editor/testhaut.ml @@ -0,0 +1,445 @@ +(** This ocaml file is associated with test.html. + * This one is called on an iframe. + * This is why there are functions like close_frame *) + +open Js_of_ocaml +open Js_utils +open Lwt.Infix +open Dom_html +open Learnocaml_common +open Editor_lib +open Learnocaml_exercise_state +open Tyxml_js.Html5 + +module StringMap = Map.Make (String);; + +show_loading ~id:"check-answer" + Tyxml_js.Html5.[ ul [ li [ pcdata [%i"Loading"] ] ] ] ; + +(* Internationalization *) + Translate.set_lang () +let () = + let translations = [ + "check", [%i"Check"]; + "cancel", [%i"Cancel"]; + "save", [%i"Save"]; + "txt_name", [%i"Function name: "]; + "txt_ty", [%i"Type: "]; + "txt_sol", [%i"Solution"]; + "txt_spec", [%i"Specification"]; + "txt_suite", [%i"Tests suite"]; + "txt_input_sol", [%i"Arguments:
\ + "]; + "txt_gen_sol", [%i"Number of generated tests:
"]; + "txt_datalist_sol", [%i"Tester:
"]; + "txt_sampler_sol", [%i"Sampler:
"]; + "txt_input_spec", [%i"Arguments:
\ + "]; + "txt_gen_spec", [%i"Number of generated tests:
"]; + "txt_datalist_spec", [%i"Tester:
"]; + "txt_sampler_spec", [%i"Sampler:
"]; + "txt_spec_specification", [%i"Specification:
\ + "]; + "txt_suite_input", [%i"Arguments and results:
\ + "]; + "txt_datalist_suite", [%i"Tester:
"]; + ] in + Translate.set_string_translations translations + +let txt_popup_arg = "[!! 1; !! 2]" ^ + [%i" for two tests for a function with int -> 'a profile"] ^ + "
[true @: 4 @:!! \"titi\"]" ^ + [%i" for one test for a function
\ + with bool -> int -> string -> 'a profile"] +let txt_popup_suite = "[false @:!! false ==> false;
+ false @:!! true ==> true;
+ true @:!! false ==> true;
+ true @:!! true ==> false]
" ^ + [%i"This is the syntax for the exclusive or.
\ + It is the same syntax as the arguments',
\ + but you also have to provide the return value \ + after ==>."] +let txt_popup_spec = "fun f args ret -> let x0 = \ + apply (fun n u -> n) args in ~~ (x0 < ret)
" ^ + [%i"- f is the function
"] ^ + [%i"- args are its arguments
"] ^ + [%i"- ret is the return value of the function \ + when applied with args
"] ^ + [%i"In this example, the return value should be \ + greater than the first argument."] + +let init_tabs, select_tab = + let names = [ "solution"; "spec"; "suite" ] in + let current = ref "suite" in + let select_tab name = + set_arg "tab" name ; + Manip.removeClass + (find_component ("learnocaml-tab-" ^ !current)) + "front-tab" ; + Manip.addClass + (find_component ("learnocaml-tab-" ^ name)) + "front-tab" ; + current := name in + let init_tabs () = + current := begin try + let requested = arg "tab" in + if List.mem requested names then requested else "suite" + with Not_found -> "suite" + end ; + List.iter + (fun name -> + Manip.removeClass + (find_component ("learnocaml-tab-" ^ name)) + "front-tab" ) + names ; + select_tab !current in + init_tabs, select_tab + +let id = arg "id" + +let name = match getElementById_coerce "name" CoerceTo.input with + | None -> failwith "unknown element name" + | Some s -> s +let ty = match getElementById_coerce "ty" CoerceTo.input with + | None -> failwith "unknown element ty" + | Some s -> s + +(* radio button *) +let solution = match getElementById_coerce "solution" CoerceTo.input with + | None -> failwith "" + | Some s -> s +let spec = match getElementById_coerce "spec" CoerceTo.input with + | None -> failwith "" + |Some s -> s +let suite = match getElementById_coerce "suite" CoerceTo.input with + | None -> failwith "" + | Some s -> s + + +let samplerSol = match getElementById_coerce "sol-sampler" CoerceTo.input with + | None -> failwith "unknown element sampler sol" + | Some s -> s +let samplerSpec = match getElementById_coerce "spec-sampler" CoerceTo.input with + | None -> failwith "unknown element sampler spec" + | Some s -> s + +let extraAleaSol =match getElementById_coerce "sol-gen" CoerceTo.input with + | None -> failwith "unknown element extraAleaSol" + | Some s -> s +let extraAleaSpec = match getElementById_coerce "spec-gen" CoerceTo.input with + | None -> failwith "unknown element extraAleaSpec" + | Some s -> s + +let datalistSol = match getElementById_coerce "sol-datalist" CoerceTo.input with + | None -> failwith "unknown element datalistSol" + | Some s -> s +let datalistSpec = + match getElementById_coerce "spec-datalist" CoerceTo.input with + | None -> failwith "unknown element datalistSpec" + | Some s -> s +let datalistSuite = + match getElementById_coerce "suite-datalist" CoerceTo.input with + | None -> failwith "unknown element datalistSuite" + | Some s -> s;; + +let txtPopupSol = getElementById "txt_input_sol";; +let txtPopupSpecArg = getElementById "txt_input_spec";; +let txtPopupSuite = getElementById "txt_suite_input";; +let txtPopupSpec = getElementById "txt_spec_specification";; + +let save = getElementById "save";; + +let setInnerHtml elt s = + elt##.innerHTML := Js.string s + + +let input_solution_editor = find_component "learnocaml-tab-solution-input";; +let editor_input_solution = Ocaml_mode.create_ocaml_editor + (Tyxml_js.To_dom.of_div input_solution_editor);; +let ace_input_sol = Ocaml_mode.get_editor editor_input_solution;; +let _ = Ace.set_contents ace_input_sol "[]"; + Ace.set_font_size ace_input_sol 18;; + +let input_spec_editor = find_component "learnocaml-tab-spec-input" +let editor_input_spec = + Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div input_spec_editor) +let ace_input_spec = Ocaml_mode.get_editor editor_input_spec +let _ = Ace.set_contents ace_input_spec "[]"; + Ace.set_font_size ace_input_spec 18;; + +let spec_spec_editor = find_component "learnocaml-tab-spec-spec" +let editor_spec_spec = + Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div spec_spec_editor) +let ace_spec_spec = Ocaml_mode.get_editor editor_spec_spec +let _ = Ace.set_contents ace_spec_spec "fun f args ret ->\n..."; + Ace.set_font_size ace_spec_spec 18;; + +let input_suite_editor = find_component "learnocaml-tab-suite-input" +let editor_input_suite = + Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div input_suite_editor) +let ace_input_suite = Ocaml_mode.get_editor editor_input_suite +let _ = Ace.set_contents ace_input_suite "[]"; + Ace.set_font_size ace_input_suite 18;; + +(* -------------------------------------------------------------------- *) + +let save_suite () = + let name = Js.to_string name##.value in + let ty = Js.to_string ty##.value in + let input = Ace.get_contents ace_input_suite in + let datalist = Js.to_string datalistSuite##.value in + TestSuite {name; ty; suite=input; tester=datalist} + + +let save_solution () = + let name = Js.to_string name##.value in + let ty = Js.to_string ty##.value in + let input = Ace.get_contents ace_input_sol in + let extra_alea = int_of_string (Js.to_string extraAleaSol##.value) in + let datalist = Js.to_string datalistSol##.value in + let sampler= Js.to_string samplerSol##.value in + TestAgainstSol {name; ty; suite = input; gen = extra_alea; + tester = datalist; sampler} + +let save_spec () = + let name = Js.to_string name##.value in + let ty = Js.to_string ty##.value in + let input = Ace.get_contents ace_input_spec in + let output = Ace.get_contents ace_spec_spec in + let extra_alea = int_of_string (Js.to_string extraAleaSpec##.value) in + let datalist = Js.to_string datalistSpec##.value in + let sampler = Js.to_string samplerSpec##.value in + TestAgainstSpec {name; ty; suite = input; spec = output; + gen = extra_alea; tester = datalist; sampler} + +(* ---- restore fields if they are not empty ------------------------------- *) + +let testhaut=get_testhaut id + +let _ = match arg "questionid" with + | exception Not_found -> select_tab "suite"; suite##.checked := Js.bool true + | qid -> + let name_elt = name in + let ty_elt = ty in + let suite_elt = suite in + let spec_elt = spec in + match StringMap.find qid testhaut with + | TestSuite {name;ty;suite;tester} -> + begin + Ace.set_contents ace_input_suite suite; + name_elt##.value:=Js.string name; + suite_elt##.checked := Js.bool true; + ty_elt##.value:=Js.string ty; + datalistSuite##.value:= Js.string tester; + select_tab "suite" + end; + | TestAgainstSpec {name;ty;gen;tester;sampler;suite;spec} -> + begin + Ace.set_contents ace_input_spec suite; + Ace.set_contents ace_spec_spec spec; + name_elt##.value:=Js.string name; + spec_elt##.checked := Js.bool true; + ty_elt##.value:=Js.string ty; + extraAleaSpec##.value:= Js.string (string_of_int gen); + datalistSpec##.value:= Js.string tester; + samplerSpec##.value:= Js.string sampler; + select_tab "spec" + end; + | TestAgainstSol {name;ty;gen;tester;sampler;suite} -> + begin + Ace.set_contents ace_input_sol suite; + name_elt##.value:=Js.string name; + solution##.checked := Js.bool true; + ty_elt##.value:=Js.string ty; + extraAleaSol##.value:= Js.string (string_of_int gen); + datalistSol##.value:=Js.string tester; + samplerSol##.value:=Js.string sampler; + select_tab "solution" + end;; + +let () = solution##.onclick := + handler (fun _ -> select_tab "solution"; Js._true);; +let () = spec##.onclick := handler + (fun _ -> select_tab "spec"; + if Ace.get_contents ace_spec_spec = "" then + Ace.set_contents ace_spec_spec "fun f args ret ->\n..."; + Js._true);; +let () = suite##.onclick := handler (fun _ -> select_tab "suite"; Js._true);; + +let show_sol = ref false;; +let () = let popup = find_component "popup-sol" in + Manip.setInnerHtml popup txt_popup_arg; + txtPopupSol##.onclick := handler + (fun _ -> let popup = find_component "popup-sol" in + let test = find_component "learnocaml-test" in + if !show_sol then + begin + Manip.removeClass popup "show"; + Manip.SetCss.opacity test (Some "1"); + show_sol := false; + end + else + begin + Manip.addClass popup "show"; + Manip.SetCss.opacity test (Some "0"); + show_sol := true; + end; + Js._true);; + +let show_spec_arg = ref false;; +let () = let popup = find_component "popup-spec-arg" in + Manip.setInnerHtml popup txt_popup_arg; + txtPopupSpecArg##.onclick := handler + (fun _ -> let popup = find_component "popup-spec-arg" in + let test = find_component "learnocaml-test" in + if !show_spec_arg then + begin + Manip.removeClass popup "show"; + Manip.SetCss.opacity test (Some "1"); + show_spec_arg := false; + end + else + begin + Manip.addClass popup "show"; + Manip.SetCss.opacity test (Some "0"); + show_spec_arg := true; + end; + Js._true);; + +let show_spec = ref false;; +let () = let popup = find_component "popup-spec" in + Manip.setInnerHtml popup txt_popup_spec; + txtPopupSpec##.onclick := handler + (fun _ -> let popup = find_component "popup-spec" in + if !show_spec then + begin + Manip.removeClass popup "show"; + show_spec := false; + end + else + begin + Manip.addClass popup "show"; + show_spec := true; + end; + Js._true);; + +let show_suite = ref false;; +let () = let popup = find_component "popup-suite" in + Manip.setInnerHtml popup txt_popup_suite; + txtPopupSuite##.onclick := handler + (fun _ -> let popup = find_component "popup-suite" in + let test = find_component "learnocaml-test" in + if !show_suite then + begin + Manip.removeClass popup "show"; + Manip.SetCss.opacity test (Some "1"); + show_suite := false; + end + else + begin + Manip.addClass popup "show"; + Manip.SetCss.opacity test (Some "0"); + show_suite := true; + end; + Js._true);; + +let transResultOption = function + | None -> false + | Some s -> true +let name_correct s = s <> "" +let type_correct s = s <> "" + +let close_frame () = + (* trick to get access to the container + of the frame (learnocaml-loading) *) + let window = Dom_html.window in + let window = window##.parent in + let document = window##.document in + let div = Js.Opt.case + (document##getElementById (Js.string "learnocaml-loading")) + (fun () -> failwith "titi") + (fun node -> node) in + let exo_list = + Js.Opt.case + (document##getElementById (Js.string "learnocaml-exo-testhaut-pane")) + (fun () -> failwith "toto") + (fun pnode -> pnode) in + let exo_list=Tyxml_js.Of_dom.of_element exo_list in + Manip.removeChildren exo_list; + + let _ = testhaut_init exo_list id in (); + div##setAttribute (Js.string "class") (Js.string "loading-layer loaded") + +let toString = function + | None -> failwith "incorrect_input" + | Some input -> Js.to_string input##.value + +let name_error = getElementById "name_error" +let type_error = getElementById "type_error" + +(* ---- save button -------------------------------------------------------- *) +let question_id = match arg "questionid" with + | exception Not_found -> compute_question_id testhaut + | qid -> qid ;; + +let save_handler close = (fun _ -> + let name = Js.to_string name##.value in + let ty = Js.to_string ty##.value in + let name_correct = name_correct name in + let type_correct = type_correct ty in + (if not name_correct then + setInnerHtml name_error [%i"Incorrect name: a name can't be empty"] + else + setInnerHtml name_error ""); + (if not type_correct then + setInnerHtml type_error [%i"Incorrect type: a type can't be empty"] + else + setInnerHtml type_error ""); + if name_correct && type_correct then ( + let question = + match arg "tab" with + | "suite" -> save_suite () + | "solution" -> save_solution () + | "spec" -> save_spec () + | _ -> failwith "" in + let testhaut = get_testhaut id in + let testhaut = StringMap.add question_id question testhaut in + save_testhaut testhaut id ; + close (); + ); + Js._true + ) +let _ = save##.onclick := handler (save_handler close_frame) + +(* ---- Cancel button ------------------------------------------------------- *) +let cancel = getElementById "cancel" +let () = cancel##.onclick := handler (fun _ -> + let _ = close_frame () in (); Js._true) + +(* ----Check button ------------------------------------------------------------- *) +let check = getElementById "check" ;; +let container_div = find_component "check-answer";; + + +let after_init top = + begin + Lwt.return true + end >>= fun r1 -> + if not r1 then failwith [%i"unexpected error"]; + Learnocaml_toplevel_worker_caller.set_checking_environment top >>= fun _ -> + Lwt.return () in + Learnocaml_toplevel_worker_caller.create ~after_init () + >>= ( fun top-> + hide_loading ~id:"check-answer" (); + check##.onclick := handler (fun _ -> + let _ = save_handler ( fun ()->() ) () in (); + show_loading ~id:"check-answer" + Tyxml_js.Html5.[ ul [ li [ pcdata [%i"Checking the question"] ] ] ] ; + let str=with_test_lib_prepare + (test_prel^"\n"^ + ( Test_spec.question_typed + ( get_a_question id question_id ) question_id )) in + Learnocaml_toplevel_worker_caller.check top str >>= (fun res -> + typecheck_dialog_box "check-answer" res); Js._true); + Lwt.return () ) + diff --git a/src/grader/grader_cli.ml b/src/grader/grader_cli.ml index 7ebc2dd39..99775933b 100644 --- a/src/grader/grader_cli.ml +++ b/src/grader/grader_cli.ml @@ -99,7 +99,8 @@ let grade exercise_dir output_json = | Some path -> read_student_file exercise_dir path | None -> Lwt.return (Learnocaml_exercise.(get solution) exo) in let callback = - if !display_callback then Some (Printf.printf "[ %s ]\n%!") else None in + if !display_callback then Some (Printf.printf "[ %s ]\n%!") + else None in let timeout = !individual_timeout in code_to_grade >>= fun code -> Grading_cli.get_grade ?callback ?timeout exo code @@ -132,10 +133,12 @@ let grade exercise_dir output_json = | None -> () | Some prefix -> let oc = open_out (prefix ^ ".report.txt") in - Learnocaml_report.print_report (Format.formatter_of_out_channel oc) report ; + Learnocaml_report.print_report + (Format.formatter_of_out_channel oc) report ; close_out oc ; let oc = open_out (prefix ^ ".report.html") in - Learnocaml_report.output_html_of_report (Format.formatter_of_out_channel oc) report ; + Learnocaml_report.output_html_of_report + (Format.formatter_of_out_channel oc) report ; close_out oc end ; if stderr_contents <> "" then begin @@ -176,15 +179,18 @@ let grade exercise_dir output_json = Lwt.return 2 end else begin - if !display_callback then Printf.printf "Success: %d points.\n%!" max ; + if !display_callback then + Printf.printf "Success: %d points.\n%!" max ; match output_json with | None -> Lwt.return 0 | Some json_file -> let exo = Learnocaml_exercise.(set max_score) max exo in Learnocaml_exercise.write_lwt - ~write_field: (fun f v acc -> Lwt.return ((f, `String v) :: acc)) - exo ~cipher:true [ "learnocaml_version", `String "1" ] >>= fun fields -> + ~write_field: (fun f v acc -> + Lwt.return ((f, `String v) :: acc)) + exo ~cipher:true [ "learnocaml_version", `String "1" ] + >>= fun fields -> Lwt_io.with_file ~mode: Lwt_io.Output json_file @@ fun chan -> Lwt_io.write chan (Ezjsonm.to_string (`O fields)) >>= fun () -> Lwt.return 0 diff --git a/src/grader/grader_jsoo_worker.ml b/src/grader/grader_jsoo_worker.ml index b1bd09c22..d5397e507 100644 --- a/src/grader/grader_jsoo_worker.ml +++ b/src/grader/grader_jsoo_worker.ml @@ -38,7 +38,9 @@ let get_grade ?callback exo solution = open Grader_jsoo_messages let () = - (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); + (match Js_utils.get_lang() with + | Some l -> Ocplib_i18n.set_lang l + | None -> ()); Worker.set_onmessage @@ fun (json : Json_repr_browser.Repr.value) -> let { exercise ; solution } = Json_repr_browser.Json_encoding.destruct to_worker_enc json in diff --git a/src/grader/grading.ml b/src/grader/grading.ml index 7a231ff78..509d037bc 100644 --- a/src/grader/grading.ml +++ b/src/grader/grading.ml @@ -30,7 +30,8 @@ let () = msg ; if_highlight = msg } | User_code_error error -> let msg = - Printf.sprintf [%if"Error in user code:\n\n%s\n%!"] error.Toploop_ext.msg in + Printf.sprintf [%if"Error in user code:\n\n%s\n%!"] + error.Toploop_ext.msg in Some {Location.loc = Location.none ; sub = [] ; msg ; if_highlight = msg } | _ -> None) @@ -110,7 +111,8 @@ let get_grade ?callback ?timeout ~divert exo code = set_progress [%i"Loading your code."] ; handle_error user_code_error @@ - Toploop_ext.use_mod_string ~print_outcome ~ppf_answer ~modname:"Code" code ; + Toploop_ext.use_mod_string ~print_outcome + ~ppf_answer ~modname:"Code" code ; set_progress [%i"Loading the solution."] ; handle_error (internal_error [%i"while loading the solution"]) @@ @@ -146,7 +148,8 @@ let get_grade ?callback ?timeout ~divert exo code = (* Memory cleanup... *) Toploop.initialize_toplevel_env () ; - (* TODO: Also clear the object table, once the OCaml's Toploop allows to. *) + (* TODO: Also clear the object table, + once the OCaml's Toploop allows to. *) !flush_stderr () ; !flush_stdout () ; match get_result () with diff --git a/src/grader/grading_jsoo.ml b/src/grader/grading_jsoo.ml index 13eb850ca..6dd41f6ce 100644 --- a/src/grader/grading_jsoo.ml +++ b/src/grader/grading_jsoo.ml @@ -28,7 +28,8 @@ let get_grade Lwt.on_cancel t (fun () -> worker##terminate) ; let onmessage (ev : Json_repr_browser.Repr.value Worker.messageEvent Js.t) = let json = ev##.data in - begin match Json_repr_browser.Json_encoding.destruct from_worker_enc json with + begin + match Json_repr_browser.Json_encoding.destruct from_worker_enc json with | Callback text -> callback text | Answer (report, stdout, stderr, outcomes) -> worker##terminate ; diff --git a/src/grader/introspection.ml b/src/grader/introspection.ml index dc1f8db75..34f34ba63 100644 --- a/src/grader/introspection.ml +++ b/src/grader/introspection.ml @@ -97,9 +97,12 @@ let insert_mod_ast_in_env ~var_name impl_code = Pmod_structure s } }}] | Ptop_def [ { pstr_desc = Pstr_module { pmb_expr = { pmod_desc = - Pmod_constraint ({ pmod_desc = - Pmod_structure s }, _) } }}] -> - let ty = Ty.repr (Ast_helper.(Typ.constr (Location.mknoloc (parse_lid "Parsetree.structure")) [])) in + Pmod_constraint ({ pmod_desc = + Pmod_structure s }, _) } }}] -> + let ty = + Ty.repr (Ast_helper.(Typ.constr + (Location.mknoloc + (parse_lid "Parsetree.structure")) [])) in insert_in_env var_name (ty : Parsetree.structure Ty.ty) s | _ (* should not happen *) -> assert false) @@ -115,9 +118,10 @@ let treat_lookup_errors fn = match fn () with (Typetexp.report_error !Toploop.toplevel_env) (Typetexp.Type_mismatch args)) | exception exn -> - match Location.error_of_exn exn with - | None -> Incompatible (Format.asprintf "%a@." Toploop.print_untyped_exception (Obj.repr exn)) - | Some { Location.msg } -> Incompatible msg + (match Location.error_of_exn exn with + | None -> Incompatible (Format.asprintf "%a@." + Toploop.print_untyped_exception (Obj.repr exn)) + | Some { Location.msg } -> Incompatible msg) let compatible_type nexp ngot = treat_lookup_errors @@ fun () -> @@ -125,8 +129,12 @@ let compatible_type nexp ngot = let decl_exp = Env.find_type path_exp !Toploop.toplevel_env in let path_got = Env.lookup_type ngot !Toploop.toplevel_env in let decl_got = Env.find_type path_got !Toploop.toplevel_env in - let texp = Ctype.newconstr path_exp (List.map (fun _ -> Ctype.newvar ()) decl_exp.Types.type_params) in - let tgot = Ctype.newconstr path_got (List.map (fun _ -> Ctype.newvar ()) decl_got.Types.type_params) in + let texp = + Ctype.newconstr path_exp + (List.map (fun _ -> Ctype.newvar ()) decl_exp.Types.type_params) in + let tgot = + Ctype.newconstr path_got + (List.map (fun _ -> Ctype.newvar ()) decl_got.Types.type_params) in Ctype.unify !Toploop.toplevel_env tgot texp ; Present () @@ -137,7 +145,8 @@ let get_value lid ty = begin match Env.lookup_module ~load:false lid !Toploop.toplevel_env with | exception Not_found -> Absent | path -> - let { Types.md_type ; md_loc } = Env.find_module path !Toploop.toplevel_env in + let { Types.md_type ; md_loc } = + Env.find_module path !Toploop.toplevel_env in let phrase = let open Ast_helper in with_default_loc md_loc @@ fun () -> @@ -147,12 +156,15 @@ let get_value lid ty = (Typ.package n rews) in Parsetree.Ptop_def [Str.value Asttypes.Nonrecursive - [Vb.mk (Pat.var (Location.mkloc "%fake%" md_loc)) pack_expr ]] in + [Vb.mk (Pat.var + (Location.mkloc "%fake%" md_loc)) pack_expr ]] in let buf = Buffer.create 300 in let ppf = Format.formatter_of_buffer buf in if Toploop.execute_phrase false ppf phrase then - let fake_path, _ = Env.lookup_value (Longident.Lident "%fake%") !Toploop.toplevel_env in - Present (Obj.obj @@ Toploop.eval_path !Toploop.toplevel_env fake_path) + let fake_path, _ = Env.lookup_value (Longident.Lident "%fake%") + !Toploop.toplevel_env in + Present (Obj.obj @@ + Toploop.eval_path !Toploop.toplevel_env fake_path) else let msg = Format.fprintf ppf "@." ; Buffer.contents buf in failwith msg @@ -195,7 +207,8 @@ let print_value ppf v ty = Toploop.print_value !Toploop.toplevel_env (Obj.repr v) tmp_ppf ty ; Format.pp_print_flush tmp_ppf () with Exit -> () end ; - match !state with `Start | `Decided false | `Undecided -> false | `Decided true -> true in + match !state with | `Start | `Decided false + | `Undecided -> false | `Decided true -> true in if needs_parentheses then begin Format.fprintf ppf "@[(" ; Toploop.print_value !Toploop.toplevel_env (Obj.repr v) ppf ty ; @@ -216,11 +229,14 @@ let sample_value ty = let open Ast_helper in let rec phrase ty = match ty.desc with | Tconstr (path, [], _) -> - let lid = (Location.mknoloc (Longident.Lident ("sample_" ^ Path.name path))) in + let lid = (Location.mknoloc + (Longident.Lident ("sample_" ^ Path.name path))) in Exp.ident lid | Tconstr (path, tl, _) -> - let lid = (Location.mknoloc (Longident.Lident ("sample_" ^ Path.name path))) in - Exp.apply (Exp.ident lid) (List.map (fun arg -> Asttypes.Nolabel, phrase arg) tl) + let lid = (Location.mknoloc + (Longident.Lident ("sample_" ^ Path.name path))) in + Exp.apply (Exp.ident lid) + (List.map (fun arg -> Asttypes.Nolabel, phrase arg) tl) | _ -> failwith "unsamplable type" in let lid = Location.mknoloc lid in @@ -233,7 +249,8 @@ let sample_value ty = if Toploop.execute_phrase false ppf phrase then let path, { Types.val_type } = Env.lookup_value (Longident.Lident lid) !Toploop.toplevel_env in - let gty = Types.{ty with desc = Tarrow (Asttypes.Nolabel, Predef.type_unit, ty, Cok) } in + let gty = Types.{ty with desc = + Tarrow (Asttypes.Nolabel, Predef.type_unit, ty, Cok) } in if Ctype.moregeneral !Toploop.toplevel_env true val_type gty then (Obj.obj @@ Toploop.eval_path !Toploop.toplevel_env path) else (failwith "sampler has the wrong type !") diff --git a/src/grader/test_lib.ml b/src/grader/test_lib.ml index e3db48f66..718bfda50 100644 --- a/src/grader/test_lib.ml +++ b/src/grader/test_lib.ml @@ -20,13 +20,16 @@ module type S = sig type 'a ast_checker = ?on_expression: (Parsetree.expression -> Learnocaml_report.report) -> ?on_pattern: (Parsetree.pattern -> Learnocaml_report.report) -> - ?on_structure_item: (Parsetree.structure_item -> Learnocaml_report.report) -> + ?on_structure_item: + (Parsetree.structure_item -> Learnocaml_report.report) -> ?on_external: (Parsetree.value_description -> Learnocaml_report.report) -> ?on_include: (Parsetree.include_declaration -> Learnocaml_report.report) -> ?on_open: (Parsetree.open_description -> Learnocaml_report.report) -> ?on_module_occurence: (string -> Learnocaml_report.report) -> ?on_variable_occurence: (string -> Learnocaml_report.report) -> - ?on_function_call: ((Parsetree.expression * (string * Parsetree.expression) list) -> Learnocaml_report.report) -> + ?on_function_call: + ((Parsetree.expression * (string * Parsetree.expression) list) -> + Learnocaml_report.report) -> 'a -> Learnocaml_report.report val ast_check_expr : Parsetree.expression ast_checker @@ -34,21 +37,33 @@ module type S = sig val ast_location_stripper : Ast_mapper.mapper - val forbid : string -> ('a -> string) -> 'a list -> ('a -> Learnocaml_report.report) - val restrict : string -> ('a -> string) -> 'a list -> ('a -> Learnocaml_report.report) - val require : string -> ('a -> string) -> 'a -> ('a -> Learnocaml_report.report) - val forbid_expr : string -> Parsetree.expression list -> (Parsetree.expression -> Learnocaml_report.report) - val restrict_expr : string -> Parsetree.expression list -> (Parsetree.expression -> Learnocaml_report.report) - val require_expr : string -> Parsetree.expression -> (Parsetree.expression -> Learnocaml_report.report) + val forbid : string -> ('a -> string) -> 'a list -> + ('a -> Learnocaml_report.report) + val restrict : string -> ('a -> string) -> 'a list -> + ('a -> Learnocaml_report.report) + val require : string -> ('a -> string) -> 'a -> + ('a -> Learnocaml_report.report) + val forbid_expr : string -> Parsetree.expression list -> + (Parsetree.expression -> Learnocaml_report.report) + val restrict_expr : string -> Parsetree.expression list -> + (Parsetree.expression -> Learnocaml_report.report) + val require_expr : string -> Parsetree.expression -> + (Parsetree.expression -> Learnocaml_report.report) val forbid_syntax : string -> (_ -> Learnocaml_report.report) val require_syntax : string -> (_ -> Learnocaml_report.report) - val (@@@) : ('a -> Learnocaml_report.report) -> ('a -> Learnocaml_report.report) -> ('a -> Learnocaml_report.report) + val (@@@) : ('a -> Learnocaml_report.report) -> + ('a -> Learnocaml_report.report) -> + ('a -> Learnocaml_report.report) - val ast_sanity_check : ?modules: string list -> Parsetree.structure -> (unit -> Learnocaml_report.report) -> Learnocaml_report.report + val ast_sanity_check : ?modules: string list -> Parsetree.structure -> + (unit -> Learnocaml_report.report) -> + Learnocaml_report.report - val find_binding : Parsetree.structure -> string -> (Parsetree.expression -> Learnocaml_report.report) -> Learnocaml_report.report + val find_binding : Parsetree.structure -> string -> + (Parsetree.expression -> Learnocaml_report.report) -> + Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val test_ref : 'a Ty.ty -> 'a ref -> 'a -> Learnocaml_report.report @@ -57,30 +72,36 @@ module type S = sig 'a Ty.ty -> string -> 'a -> Learnocaml_report.report val test_variable_property : - 'a Ty.ty -> string -> ('a -> Learnocaml_report.report) -> Learnocaml_report.report + 'a Ty.ty -> string -> ('a -> Learnocaml_report.report) -> + Learnocaml_report.report val test_variable_against_solution : 'a Ty.ty -> string -> Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val compatible_type : expected:string -> string -> Learnocaml_report.report val existing_type : ?score:int -> string -> bool * Learnocaml_report.report - val abstract_type : ?allow_private:bool -> ?score:int -> string -> bool * Learnocaml_report.report + val abstract_type : ?allow_private:bool -> ?score:int -> + string -> bool * Learnocaml_report.report - val test_student_code : 'a Ty.ty -> ('a -> Learnocaml_report.report) -> Learnocaml_report.report + val test_student_code : 'a Ty.ty -> ('a -> Learnocaml_report.report) -> + Learnocaml_report.report val test_module_property : - 'a Ty.ty -> string -> ('a -> Learnocaml_report.report) -> Learnocaml_report.report + 'a Ty.ty -> string -> ('a -> Learnocaml_report.report) -> + Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) type 'a result = | Ok of 'a | Error of exn + val typed_printer : 'a Ty.ty -> Format.formatter -> 'a -> unit + val exec : (unit -> 'a) -> ('a * string * string) result val result : (unit -> 'a) -> 'a result @@ -116,7 +137,8 @@ module type S = sig test : 'ret. ?test_result: 'ret tester -> 'ret tester } val arg_mutation_test_callbacks: - ?test: 'a tester -> dup: ('a -> 'a) -> blit:('a -> 'a -> unit) -> 'a Ty.ty -> + ?test: 'a tester -> dup: ('a -> 'a) -> + blit:('a -> 'a -> unit) -> 'a Ty.ty -> 'a arg_mutation_test_callbacks val array_arg_mutation_test_callbacks: @@ -128,15 +150,18 @@ module type S = sig 'a ref arg_mutation_test_callbacks - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val test_function_1 : ?test: 'b tester -> ?test_stdout: io_tester -> ?test_stderr: io_tester -> ?before : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.report) -> - ('a -> 'b) Ty.ty -> string -> ('a * 'b * string * string) list -> Learnocaml_report.report + ?after : ('a -> ('b * string * string) -> + ('b * string * string) -> Learnocaml_report.report) -> + ('a -> 'b) Ty.ty -> string -> + ('a * 'b * string * string) list -> + Learnocaml_report.report val test_function_1_against : ?gen: int -> @@ -145,9 +170,12 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> unit) -> ?before_user : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> ('b * string * string) -> + ('b * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a) -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) -> 'a list -> Learnocaml_report.report + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) -> + 'a list -> Learnocaml_report.report val test_function_1_against_solution : ?gen: int -> @@ -156,19 +184,25 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> unit) -> ?before_user : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> ('b * string * string) -> + ('b * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a) -> ('a -> 'b) Ty.ty -> string -> 'a list -> Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val test_function_2 : ?test: 'c tester -> ?test_stdout: io_tester -> ?test_stderr: io_tester -> ?before : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.report) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b * 'c * string * string) list -> Learnocaml_report.report + ?after : ('a -> 'b -> ('c * string * string) -> + ('c * string * string) -> + Learnocaml_report.report) -> + ('a -> 'b -> 'c) Ty.ty -> string -> + ('a * 'b * 'c * string * string) list -> + Learnocaml_report.report val test_function_2_against : ?gen: int -> @@ -177,9 +211,12 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> unit) -> ?before_user : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> ('c * string * string) -> + ('c * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) -> ('a * 'b) list -> Learnocaml_report.report + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) -> + ('a * 'b) list -> Learnocaml_report.report val test_function_2_against_solution : ?gen: int -> @@ -188,19 +225,25 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> unit) -> ?before_user : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> ('c * string * string) -> + ('c * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b) list -> Learnocaml_report.report + ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b) list -> + Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val test_function_3 : ?test: 'd tester -> ?test_stdout: io_tester -> ?test_stderr: io_tester -> ?before : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.report) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c * 'd * string * string) list -> Learnocaml_report.report + ?after : ('a -> 'b -> 'c -> ('d * string * string) -> + ('d * string * string) -> Learnocaml_report.report) -> + ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> + ('a * 'b * 'c * 'd * string * string) list -> + Learnocaml_report.report val test_function_3_against : ?gen: int -> @@ -209,9 +252,13 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> 'c -> unit) -> ?before_user : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> 'c -> ('d * string * string) -> + ('d * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b * 'c) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) list -> Learnocaml_report.report + ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> + ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) list -> + Learnocaml_report.report val test_function_3_against_solution : ?gen: int -> @@ -220,19 +267,25 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> 'c -> unit) -> ?before_user : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> 'c -> ('d * string * string) -> + ('d * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b * 'c) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> Learnocaml_report.report + ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> + Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val test_function_4 : ?test: 'e tester -> ?test_stdout: io_tester -> ?test_stderr: io_tester -> ?before : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.report) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a * 'b * 'c * 'd * 'e * string * string) list -> Learnocaml_report.report + ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> + ('e * string * string) -> Learnocaml_report.report) -> + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> + ('a * 'b * 'c * 'd * 'e * string * string) list -> + Learnocaml_report.report val test_function_4_against : ?gen: int -> @@ -241,7 +294,9 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> 'c -> 'd -> unit) -> ?before_user : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> + ('e * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b * 'c * 'd) -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) -> ('a * 'b * 'c * 'd) list -> Learnocaml_report.report @@ -253,11 +308,14 @@ module type S = sig ?test_stderr: io_tester -> ?before_reference : ('a -> 'b -> 'c -> 'd -> unit) -> ?before_user : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.report) -> + ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> + ('e * string * string) -> + Learnocaml_report.report) -> ?sampler : (unit -> 'a * 'b * 'c * 'd) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a * 'b * 'c * 'd) list -> Learnocaml_report.report + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> + ('a * 'b * 'c * 'd) list -> Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) (* Usage: (arg 3 @@ arg "word" @@ last false *) type ('arrow, 'uarrow, 'ret) args @@ -282,7 +340,17 @@ module type S = sig (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot -> (('a -> 'ar -> 'row) Ty.ty, ('a -> 'ar -> 'urow), 'ret) prot - type 'a lookup = unit -> [ `Found of string * Learnocaml_report.report * 'a | `Unbound of string * Learnocaml_report.report ] + val ty_of_prot : + (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot -> ('p -> 'a) Ty.ty + val to_ty : string ->'a Ty.ty + val get_ret_ty : + ('p -> 'a) Ty.ty -> ('p -> 'a, 'p -> 'c, 'r) args -> 'r Ty.ty + val print : + (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot -> + Format.formatter -> ('p -> 'a, 'p -> 'c, 'r) args -> unit + + type 'a lookup = unit -> [ `Found of string * Learnocaml_report.report * 'a + | `Unbound of string * Learnocaml_report.report ] val lookup : 'a Ty.ty -> ?display_name: string -> string -> 'a lookup val lookup_student : 'a Ty.ty -> string -> 'a lookup @@ -290,7 +358,8 @@ module type S = sig val found : string -> 'a -> 'a lookup val name : 'a lookup -> string - val test_value : 'a lookup -> ('a -> Learnocaml_report.report) -> Learnocaml_report.report + val test_value : 'a lookup -> ('a -> Learnocaml_report.report) -> + Learnocaml_report.report val test_function : ?test: 'ret tester -> @@ -330,17 +399,19 @@ module type S = sig ('ar -> 'row, 'ar -> 'urow, 'ret) args list -> Learnocaml_report.report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) val set_result : Learnocaml_report.report -> unit - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) type 'a sampler = unit -> 'a val sample_int : int sampler val sample_float : float sampler - val sample_list : ?min_size: int -> ?max_size: int -> ?dups: bool -> ?sorted: bool -> 'a sampler -> 'a list sampler - val sample_array : ?min_size: int -> ?max_size: int -> ?dups: bool -> ?sorted: bool -> 'a sampler -> 'a array sampler + val sample_list : ?min_size: int -> ?max_size: int -> ?dups: bool -> + ?sorted: bool -> 'a sampler -> 'a list sampler + val sample_array : ?min_size: int -> ?max_size: int -> ?dups: bool -> + ?sorted: bool -> 'a sampler -> 'a array sampler val sample_option : 'a sampler -> 'a option sampler val sample_string : string sampler val sample_char : char sampler @@ -363,13 +434,16 @@ module Make type 'a ast_checker = ?on_expression: (Parsetree.expression -> Learnocaml_report.report) -> ?on_pattern: (Parsetree.pattern -> Learnocaml_report.report) -> - ?on_structure_item: (Parsetree.structure_item -> Learnocaml_report.report) -> + ?on_structure_item: (Parsetree.structure_item -> + Learnocaml_report.report) -> ?on_external: (Parsetree.value_description -> Learnocaml_report.report) -> ?on_include: (Parsetree.include_declaration -> Learnocaml_report.report) -> ?on_open: (Parsetree.open_description -> Learnocaml_report.report) -> ?on_module_occurence: (string -> Learnocaml_report.report) -> ?on_variable_occurence: (string -> Learnocaml_report.report) -> - ?on_function_call: ((Parsetree.expression * (string * Parsetree.expression) list) -> Learnocaml_report.report) -> + ?on_function_call: ((Parsetree.expression * + (string * Parsetree.expression) list) -> + Learnocaml_report.report) -> 'a -> Learnocaml_report.report let ast_check f @@ -428,7 +502,8 @@ module Make ignore (mapper.expr mapper iexpr) ; modules := before ; expr - | { pexp_desc = Pexp_letmodule ({ Location.txt = name }, mexpr, iexpr) } -> + | { pexp_desc = Pexp_letmodule + ({ Location.txt = name }, mexpr, iexpr) } -> let before = !modules in let variables_before = !variables in ignore (mapper.module_expr mapper mexpr) ; @@ -528,7 +603,8 @@ module Make structure_item | { pstr_desc = Pstr_recmodule mbs } -> let variables_before = !variables in - List.iter (fun { pmb_name } -> modules := pmb_name.Location.txt :: !modules) mbs ; + List.iter (fun { pmb_name } -> + modules := pmb_name.Location.txt :: !modules) mbs ; let before = !modules in List.iter (fun { pmb_expr } -> ignore (mapper.module_expr mapper pmb_expr) ; @@ -594,14 +670,17 @@ module Make let before = !variables in let modules_before = !modules in ignore (mapper.pat mapper pc_lhs) ; - (match pc_guard with Some pc_guard -> ignore (mapper.expr mapper pc_guard) | None -> ()) ; + (match pc_guard with + | Some pc_guard -> ignore (mapper.expr mapper pc_guard) + | None -> ()) ; ignore (mapper.expr mapper pc_rhs) ; variables := before ; modules := modules_before ; case in let mapper = { default_mapper with case ; expr ; structure_item ; pat ; typ ; module_expr } in - f (mapper.expr mapper, mapper.structure mapper) arg ; List.flatten (List.rev !res) + f (mapper.expr mapper, mapper.structure mapper) arg ; + List.flatten (List.rev !res) let ast_location_stripper = let open Ast_mapper in @@ -609,13 +688,15 @@ module Make let ast_check_expr : Parsetree.expression ast_checker = ast_check @@ fun (check_expr, _) expr -> - let expr = ast_location_stripper.Ast_mapper.expr ast_location_stripper expr in - check_expr expr + let expr = ast_location_stripper.Ast_mapper.expr + ast_location_stripper expr in + check_expr expr let ast_check_structure = ast_check @@ fun (_, check_structure) structure -> - let structure = ast_location_stripper.Ast_mapper.structure ast_location_stripper structure in - check_structure structure + let structure = ast_location_stripper.Ast_mapper.structure + ast_location_stripper structure in + check_structure structure let forbid_syntax n = let already = ref false in fun _ -> if !already then [] else begin @@ -628,7 +709,8 @@ module Make if !already then [] else begin already := true ; Learnocaml_report.[ Message ([ Text "The " ; Code n ; - Text " syntax has been found, as expected" ], Success 5) ] + Text " syntax has been found, as expected" ], + Success 5) ] end let forbid k pr ls = @@ -638,7 +720,8 @@ module Make match Hashtbl.find t n with | false -> Hashtbl.add t n true ; - Learnocaml_report.[ Message ([ Text "The " ; Code (pr n) ; Text " " ; Text k ; + Learnocaml_report.[ Message ([ Text "The " ; Code (pr n) ; + Text " " ; Text k ; Text " is forbidden" ], Failure) ] | true -> [] | exception Not_found -> [] @@ -649,7 +732,8 @@ module Make fun n -> try Hashtbl.find t n ; [] with Not_found -> Hashtbl.add t n () ; - Learnocaml_report.[ Message ([ Text "The " ; Code (pr n) ; Text " " ; Text k ; + Learnocaml_report.[ Message ([ Text "The " ; Code (pr n) ; + Text " " ; Text k ; Text " is not allowed" ], Failure) ] let require k pr l = @@ -657,20 +741,24 @@ module Make fun n -> if !already then [] else begin already := true ; - Learnocaml_report.[ Message ([ Text "Found " ; Text k ; Text " " ; Code (pr n) ], Success 5) ] + Learnocaml_report.[ Message ([ Text "Found " ; Text k ; + Text " " ; Code (pr n) ], Success 5) ] end let restrict_expr name exprs = let pr expr = Format.asprintf "%a" Pprintast.expression expr in - restrict name pr (List.map (ast_location_stripper.Ast_mapper.expr ast_location_stripper) exprs) + restrict name pr (List.map (ast_location_stripper.Ast_mapper.expr + ast_location_stripper) exprs) let forbid_expr name exprs = let pr expr = Format.asprintf "%a" Pprintast.expression expr in - forbid name pr (List.map (ast_location_stripper.Ast_mapper.expr ast_location_stripper) exprs) + forbid name pr (List.map (ast_location_stripper.Ast_mapper.expr + ast_location_stripper) exprs) let require_expr name expr = let pr expr = Format.asprintf "%a" Pprintast.expression expr in - require name pr (ast_location_stripper.Ast_mapper.expr ast_location_stripper expr) + require name pr (ast_location_stripper.Ast_mapper.expr + ast_location_stripper expr) let (@@@) f g = fun x -> f x @ g x @@ -696,20 +784,23 @@ module Make let rec findlet = function | [] -> [ Message ([ Text "I could not find " ; Code name ; Text "." ; Break ; - Text "Check that it is defined as a simple " ; Code "let" ; + Text "Check that it is defined as a simple " ; + Code "let" ; Text " at top level." ], Failure) ] | { pstr_desc = Pstr_value (_, bds) } :: rest -> let rec findvar = function | [] -> findlet rest - | { pvb_pat = { ppat_desc = Ppat_var { Location.txt } } ; pvb_expr } :: _ when txt = name -> - Message ([ Text "Found a toplevel definition for " ; Code name ; Text "."], Informative) + | { pvb_pat = { ppat_desc = Ppat_var { Location.txt } } ; pvb_expr } + :: _ when txt = name -> + Message ([ Text "Found a toplevel definition for " ; Code name ; + Text "."], Informative) :: cb pvb_expr | _ :: rest -> findvar rest in findvar bds | _ :: rest -> findlet rest in findlet (List.rev code_ast) - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) open Params @@ -727,22 +818,34 @@ module Make let existing_type ?(score = 1) name = let open Learnocaml_report in - try let path = Env.lookup_type Longident.(parse ("Code." ^ name)) !Toploop.toplevel_env in + try let path = Env.lookup_type Longident.(parse ("Code." ^ name)) + !Toploop.toplevel_env in let _ = Env.find_type path !Toploop.toplevel_env in - true, [ Message ( [ Text "Type" ; Code name ; Text "found" ], Success score ) ] - with Not_found -> false, [ Message ( [ Text "type" ; Code name ; Text "not found" ], Failure ) ] + true, [ Message ( [ Text "Type" ; Code name ; Text "found" ], + Success score ) ] + with Not_found -> false, [ Message ( [ Text "type" ; Code name ; + Text "not found" ], Failure ) ] let abstract_type ?(allow_private = true) ?(score = 5) name = let open Learnocaml_report in - try let path = Env.lookup_type Longident.(parse ("Code." ^ name)) !Toploop.toplevel_env in + try let path = Env.lookup_type Longident.(parse ("Code." ^ name)) + !Toploop.toplevel_env in match Env.find_type path !Toploop.toplevel_env with - | { Types. type_kind = Types.Type_abstract ; Types. type_manifest = None } -> - true, [ Message ([Text "Type" ; Code name ; Text "is abstract as expected." ], Success score) ] - | { Types. type_kind = _ ; type_private = Asttypes.Private } when allow_private -> - true, [ Message ([Text "Type" ; Code name ; Text "is private, I'll accept that :-)." ], Success score) ] + | { Types. type_kind = Types.Type_abstract ; + Types. type_manifest = None } -> + true, [ Message ([Text "Type" ; Code name ; + Text "is abstract as expected." ], Success score) ] + | { Types. type_kind = _ ; type_private = Asttypes.Private } + when allow_private -> + true, [ Message ([Text "Type" ; Code name ; + Text "is private, I'll accept that :-)." ], + Success score) ] | { Types. type_kind = _ } -> - false, [ Message ([Text "Type" ; Code name ; Text "should be abstract!" ], Failure) ] - with Not_found -> false, [ Message ( [Text "Type" ; Code name ; Text "not found." ], Failure) ] + false, [ Message ([Text "Type" ; Code name ; + Text "should be abstract!" ], Failure) ] + with Not_found -> false, [ Message ( [Text "Type" ; + Code name ; Text "not found." ], + Failure) ] let test_student_code ty cb = let open Learnocaml_report in @@ -750,7 +853,8 @@ module Make | Introspection.Present v -> cb v | Introspection.Absent -> assert false | Introspection.Incompatible msg -> - [ Message ([ Text "Your code doesn't match the expected signature." ; Break ; + [ Message ([ Text "Your code doesn't match the expected signature." ; + Break ; Code msg (* TODO: hide or fix locations *) ], Failure) ] let test_module_property ty name cb = @@ -760,13 +864,15 @@ module Make | Introspection.Absent -> [ Message ([ Text "Module" ; Code name ; Text "not found." ], Failure) ] | Introspection.Incompatible msg -> - [ Message ([ Text "Module" ; Code name ; Text "doesn't match the expected signature." ; - Break ; Code msg (* TODO: hide or fix locations *) ], Failure) ] + [ Message ([ Text "Module" ; Code name ; + Text "doesn't match the expected signature." ; + Break ; Code msg (* TODO: hide or fix locations *) ], + Failure) ] let typed_printer ty ppf v = Introspection.print_value ppf v ty - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) type 'a result = | Ok of 'a @@ -782,21 +888,33 @@ module Make if eq (canon va) (canon vb) then begin match va with | Ok v -> - Learnocaml_report.[ Message ([ Text "Correct value" ; Code (to_string v) ], Success 1) ] + Learnocaml_report.[ Message ([ Text "Correct value" ; + Code (to_string v) ], Success 1) ] | Error exn -> - Learnocaml_report.[ Message ([ Text "Correct exception" ; Code (Printexc.to_string exn) ], Success 1) ] end + Learnocaml_report.[ Message ([ Text "Correct exception" ; + Code (Printexc.to_string exn) ], + Success 1) ] end else begin match va with | Ok v -> - Learnocaml_report.[ Message ([ Text "Wrong value" ; Code (to_string v) ], Failure) ] + Learnocaml_report.[ Message ([ Text "Wrong value" ; + Code (to_string v) ], Failure) ] | Error (Failure s) when s = "EXCESS"-> - Learnocaml_report.[ Message ([ Text "Your code exceeded the output buffer size limit." ], Failure) ] + Learnocaml_report.[ Message ([ Text "Your code exceeded the output \ + buffer size limit." ], + Failure) ] | Error Stack_overflow -> - Learnocaml_report.[ Message ([ Text "Your code did too many recursions." ], Failure) ] + Learnocaml_report.[ Message ([ Text "Your code did \ + too many recursions." ], + Failure) ] | Error Timeout -> - Learnocaml_report.[ Message ([ Text "Your code exceeded the time limit. Too many recursions?" ], Failure) ] + Learnocaml_report.[ Message ([ Text "Your code exceeded the time \ + limit. Too many recursions?" ], + Failure) ] | Error exn -> - Learnocaml_report.[ Message ([ Text "Wrong exception" ; Code (Printexc.to_string exn) ], Failure) ] end + Learnocaml_report.[ Message ([ Text "Wrong exception" ; + Code (Printexc.to_string exn) ], + Failure) ] end let test_ignore ty va vb = let to_string v = Format.asprintf "%a" (typed_printer ty) v in @@ -807,12 +925,16 @@ module Make Code (to_string v) ; Text "instead of exception" ], Failure) ] | Error (Failure s), _ when s = "EXCESS" -> - Learnocaml_report.[ Message ([ Text "Your code exceeded the output buffer size limit." ], Failure) ] + Learnocaml_report.[ Message ([ Text "Your code exceeded the output \ + buffer size limit." ], Failure) ] | Error Stack_overflow, _ -> - Learnocaml_report.[ Message ([ Text "Your code did too many recursions." ], Failure) ] + Learnocaml_report.[ Message ([ Text "Your code did \ + too many recursions." ], Failure) ] | Error _, Error _ -> [] | Error exn, Ok _ -> - Learnocaml_report.[ Message ([ Text "Unexpected exception" ; Code (Printexc.to_string exn) ], Failure) ] + Learnocaml_report.[ Message ([ Text "Unexpected exception" ; + Code (Printexc.to_string exn) ], + Failure) ] let test ty va vb = test_generic (=) (fun x -> x) ty va vb @@ -840,7 +962,7 @@ module Make let conv = function Error exn -> Error exn | Ok v -> Ok (conv v) in test wit (conv got) (conv exp) - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let sigalrm_handler = Sys.Signal_handle (fun _ -> raise Timeout) let run_timeout ~time v = @@ -962,7 +1084,8 @@ let run_timeout ~time v = let got = List.map tr (split sgot) in let expected = List.map tr (split sexpected) in let got = if skip_empty then List.filter ((<>) "") got else got in - let expected = if skip_empty then List.filter ((<>) "") expected else expected in + let expected = if skip_empty then List.filter ((<>) "") expected + else expected in let rec test_items = function | [], [] -> [ Message ([ Text "Expected output" ; Output sgot ], Success 5) ] @@ -977,14 +1100,17 @@ let run_timeout ~time v = let io_test_lines ?(trim = []) ?(drop = []) - ?(skip_empty = false) ?(test_line = io_test_equals ~trim:[] ~drop:[]) got expected = - io_test_items ~split: [ '\n' ] ~trim ~drop ~skip_empty ~test_item: test_line got expected + ?(skip_empty = false) ?(test_line = io_test_equals ~trim:[] ~drop:[]) + got expected = + io_test_items ~split: [ '\n' ] ~trim ~drop ~skip_empty ~test_item: test_line + got expected - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let expect - ?(test = test) ?(test_stdout = io_test_ignore) ?(test_stderr = io_test_ignore) + ?(test = test) ?(test_stdout = io_test_ignore) + ?(test_stderr = io_test_ignore) ?(pre = (fun _ -> ())) ?(post = (fun _ _ -> [])) ty va vb = let vb = exec vb in let va = pre () ; exec va in @@ -1002,12 +1128,14 @@ let run_timeout ~time v = | Error exna, Error exnb -> test ty (Error exna) (Error exnb) - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) - type 'a lookup = unit -> [ `Found of string * Learnocaml_report.report * 'a | `Unbound of string * Learnocaml_report.report ] + type 'a lookup = unit -> [ `Found of string * Learnocaml_report.report * 'a + | `Unbound of string * Learnocaml_report.report ] let lookup ty ?display_name name = - let display_name = match display_name with None -> name | Some name -> name in + let display_name = + match display_name with None -> name | Some name -> name in let open Learnocaml_report in let res = match Introspection.get_value name ty with | Introspection.Present v -> @@ -1017,7 +1145,8 @@ let run_timeout ~time v = `Found (display_name, msg, v) | Introspection.Absent -> `Unbound - (name, [ Message ([ Text "Cannot find " ; Code display_name ], Failure) ]) + (name, [ Message ([ Text "Cannot find " ; Code display_name ], + Failure) ]) | Introspection.Incompatible msg -> `Unbound (name, [ Message ([ Text "Found" ; Code display_name ; @@ -1050,12 +1179,15 @@ let run_timeout ~time v = `Found (name, [], v) | Introspection.Absent -> `Unbound - (name, [ Message ([ Text "Looking for " ; Code name ], Informative) ; + (name, [ Message ([ Text "Looking for " ; Code name ], + Informative) ; Message ([ Text "Solution not found!" ], Failure) ]) | Introspection.Incompatible msg -> `Unbound - (name, [ Message ([ Text "Looking for " ; Code name ], Informative) ; - Message ([ Text "Solution is wrong!" ; Break ; Code msg ], Failure) ]) in + (name, [ Message ([ Text "Looking for " ; Code name ], + Informative) ; + Message ([ Text "Solution is wrong!" ; Break ; Code msg ], + Failure) ]) in fun () -> res let name f = match f () with `Unbound (n, _) | `Found (n, _, _) -> n @@ -1086,7 +1218,7 @@ let run_timeout ~time v = test_value (lookup_solution ty name) @@ fun sol -> test_variable ty name sol - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) type (_, _, _) args = | Last : 'a -> ('a -> 'r, 'a -> unit, 'r) args @@ -1097,24 +1229,30 @@ let run_timeout ~time v = type (_, _, _) prot = | Last_ty : 'a Ty.ty * 'r Ty.ty -> (('a -> 'r) Ty.ty, 'a -> unit, 'r) prot - | Arg_ty : 'a Ty.ty * (('b -> 'c) Ty.ty, 'b -> 'd, 'r) prot -> (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) prot + | Arg_ty : 'a Ty.ty * (('b -> 'c) Ty.ty, 'b -> 'd, 'r) prot -> + (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) prot let last_ty x r = Last_ty (x, r) let arg_ty x r = Arg_ty (x, r) - let rec ty_of_prot : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> (p -> a) Ty.ty = function + let rec ty_of_prot : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> + (p -> a) Ty.ty = function | Last_ty (a, b) -> Ty.curry a b | Arg_ty (x, Last_ty (l, r)) -> Ty.curry x (Ty.curry l r) | Arg_ty (x, Arg_ty (y, r)) -> Ty.curry x (ty_of_prot (Arg_ty (y, r))) - let rec apply : type p a c r. (p -> a) -> (p -> a, p -> c, r) args -> r = fun f x -> + let to_ty str= (Ty.repr (Parse.core_type (Lexing.from_string str)));; + + let rec apply : type p a c r. (p -> a) -> + (p -> a, p -> c, r) args -> r = fun f x -> match x with | Last x -> f x | Arg (x, Last r) -> (f x) r | Arg (x, Arg (y, r)) -> apply (f x) (Arg (y, r)) let rec print - : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> Format.formatter -> (p -> a, p -> c, r) args -> unit = + : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> Format.formatter -> + (p -> a, p -> c, r) args -> unit = fun t ppf x -> match t, x with | Last_ty (arg_ty, _), Last x -> @@ -1145,7 +1283,8 @@ let run_timeout ~time v = get_ret_ty ret_ty (Arg (y, r)) let rec get_sampler - : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> unit -> (p -> a, p -> c, r) args = + : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> + unit -> (p -> a, p -> c, r) args = fun wit -> match wit with | Last_ty (x, _) -> @@ -1160,7 +1299,7 @@ let run_timeout ~time v = let ret_sampler = get_sampler (Arg_ty (y, r)) in (fun () -> let arg = arg_sampler () in Arg (arg, ret_sampler ())) - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let test_function_generic ?test ?test_stdout ?test_stderr @@ -1172,12 +1311,14 @@ let run_timeout ~time v = let ty = ty_of_prot prot in List.flatten @@ List.map (fun case -> let args, ret = case () in - let code = Format.asprintf "@[%s%a@]" (name uf) (print prot) args in + let code = + Format.asprintf "@[%s%a@]" (name uf) (print prot) args in let ret_ty = get_ret_ty ty args in Message ([ Text "Computing" ; Code code ], Informative) :: expect ?test ?test_stdout ?test_stderr - ~pre: (before args) ~post: (after args) ret_ty (fun () -> apply ruf args) ret) + ~pre: (before args) ~post: (after args) ret_ty + (fun () -> apply ruf args) ret) tests let test_function @@ -1192,7 +1333,8 @@ let run_timeout ~time v = let test_function_against_generic ?gen ?test ?test_stdout ?test_stderr - ?(before_reference = fun _ -> ()) ?before_user ?after ?sampler ?ty prot uf rf tests = + ?(before_reference = fun _ -> ()) ?before_user ?after + ?sampler ?ty prot uf rf tests = test_value rf @@ fun rf -> let sampler = match sampler with @@ -1204,7 +1346,9 @@ let run_timeout ~time v = let rec make i = if i <= 0 then [] else sampler :: make (i - 1) in let tests = List.map (fun x () -> x) tests @ make gen in - let tests = List.map (fun a () -> let a = a () in (a, (fun () -> before_reference a ; apply rf a))) tests in + let tests = List.map (fun a () -> let a = a () in + (a, (fun () -> before_reference a ; + apply rf a))) tests in test_function_generic ?test ?test_stdout ?test_stderr ?before:before_user ?after prot uf tests @@ -1236,14 +1380,22 @@ let run_timeout ~time v = let result_report = test_result ret_ty va vb in let report = match va, vb with | Ok _, Ok _ -> - let got = match !got with Some g -> g | None -> invalid_arg "arg_mutation_test_callbacks" in - let exp = match !exp with Some e -> e | None -> invalid_arg "arg_mutation_test_callbacks" in + let got = match !got with + | Some g -> g + | None -> invalid_arg "arg_mutation_test_callbacks" in + let exp = match !exp with + | Some e -> e + | None -> invalid_arg "arg_mutation_test_callbacks" in test ty (Ok got) (Ok exp) | Error ea, Ok _ -> - let exp = match !exp with Some e -> e | None -> invalid_arg "arg_mutation_test_callbacks" in + let exp = match !exp with + | Some e -> e + | None -> invalid_arg "arg_mutation_test_callbacks" in test ty (Error ea) (Ok exp) | Ok _, Error eb -> - let got = match !got with Some g -> g | None -> invalid_arg "arg_mutation_test_callbacks" in + let got = match !got with + | Some g -> g + | None -> invalid_arg "arg_mutation_test_callbacks" in test ty (Ok got) (Error eb) | Error ea, Error eb -> test ty (Error ea) (Error eb) in @@ -1260,7 +1412,7 @@ let run_timeout ~time v = let dup r = ref !r in arg_mutation_test_callbacks ~test ~blit ~dup ty - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let function_1_adapter after sampler ty = let after = match after with @@ -1280,7 +1432,8 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ?before ?after ty name tests = let tests = List.map (fun (x, r, out, err) -> - (last x, (fun () -> output_string stdout out ; output_string stderr err ; r))) + (last x, (fun () -> output_string stdout out ; + output_string stderr err ; r))) tests in let after, pre, _, prot = function_1_adapter after None ty in test_function @@ -1308,9 +1461,10 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ~before_reference:(pre before_reference) ~before_user:(pre before_user) - ~after ?sampler prot (lookup_student ty name) (lookup_solution ty name) tests + ~after ?sampler prot (lookup_student ty name) + (lookup_solution ty name) tests - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let function_2_adapter after sampler ty = let after = match after with @@ -1334,7 +1488,8 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ?before ?after ty name tests = let tests = List.map (fun (x, y, r, out, err) -> - (arg x @@ last y, (fun () -> output_string stdout out ; output_string stderr err ; r))) + (arg x @@ last y, (fun () -> output_string stdout out ; + output_string stderr err ; r))) tests in let after, pre, _, prot = function_2_adapter after None ty in test_function @@ -1362,9 +1517,10 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ~before_reference:(pre before_reference) ~before_user:(pre before_user) - ~after ?sampler prot (lookup_student ty name) (lookup_solution ty name) tests + ~after ?sampler prot (lookup_student ty name) + (lookup_solution ty name) tests - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let function_3_adapter after sampler ty = let after = match after with @@ -1390,7 +1546,9 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ?before ?after ty name tests = let tests = List.map (fun (w, x, y, r, out, err) -> - (arg w @@ arg x @@ last y, (fun () -> output_string stdout out ; output_string stderr err ; r))) + (arg w @@ arg x @@ last y, + (fun () -> output_string stdout out ; + output_string stderr err ; r))) tests in let after, pre, _, prot = function_3_adapter after None ty in test_function @@ -1418,9 +1576,10 @@ let run_timeout ~time v = ?test ?test_stdout ?test_stderr ~before_reference:(pre before_reference) ~before_user:(pre before_user) - ~after ?sampler prot (lookup_student ty name) (lookup_solution ty name) tests + ~after ?sampler prot (lookup_student ty name) + (lookup_solution ty name) tests - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let function_4_adapter after sampler ty = let after = match after with @@ -1443,7 +1602,8 @@ let run_timeout ~time v = let arg3_ty, ret_ty = Ty.domains ret_ty in let arg4_ty, ret_ty = Ty.domains ret_ty in let prot = - arg_ty arg1_ty @@ arg_ty arg2_ty @@ arg_ty arg3_ty @@ last_ty arg4_ty @@ ret_ty in + arg_ty arg1_ty @@ arg_ty arg2_ty @@ arg_ty arg3_ty @@ + last_ty arg4_ty @@ ret_ty in after, pre, sampler, prot let test_function_4 @@ -1462,7 +1622,8 @@ let run_timeout ~time v = let test_function_4_against ?gen ?test ?test_stdout ?test_stderr ?before_reference ?before_user ?after ?sampler ty name rf tests = - let tests = List.map (fun (w, x, y, z) -> arg w @@ arg x @@ arg y @@ last z) tests in + let tests = List.map (fun (w, x, y, z) -> arg w @@ arg x @@ + arg y @@ last z) tests in let after, pre, sampler, prot = function_4_adapter after sampler ty in test_function_against ?gen ?test ?test_stdout ?test_stderr @@ -1473,20 +1634,22 @@ let run_timeout ~time v = let test_function_4_against_solution ?gen ?test ?test_stdout ?test_stderr ?before_reference ?before_user ?after ?sampler ty name tests = - let tests = List.map (fun (w, x, y, z) -> arg w @@ arg x @@ arg y @@ last z) tests in + let tests = List.map (fun (w, x, y, z) -> arg w @@ arg x @@ + arg y @@ last z) tests in let after, pre, sampler, prot = function_4_adapter after sampler ty in test_function_against ?gen ?test ?test_stdout ?test_stderr ~before_reference:(pre before_reference) ~before_user:(pre before_user) - ~after ?sampler prot (lookup_student ty name) (lookup_solution ty name) tests + ~after ?sampler prot (lookup_student ty name) + (lookup_solution ty name) tests - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) let set_result report = results := Some report - (*----------------------------------------------------------------------------*) +(*----------------------------------------------------------------------------*) type 'a sampler = unit -> 'a let sample_bool () = Random.bool () @@ -1525,7 +1688,8 @@ let run_timeout ~time v = let some () = Some (sample ()) in sample_alternatively [ none ; some ; some ; some ] - let sample_array ?(min_size = 0) ?(max_size = 10) ?(dups = true) ?(sorted = false) sample () = + let sample_array ?(min_size = 0) ?(max_size = 10) + ?(dups = true) ?(sorted = false) sample () = let sample = if dups then sample else let prev = Hashtbl.create max_size in @@ -1561,7 +1725,8 @@ let run_timeout ~time v = let () = let path = Path.Pident (Ident.create "fun_printer") in - let ty = Typetexp.transl_type_scheme !Toploop.toplevel_env (Ty.obj [%ty: _ -> _ ]) in + let ty = Typetexp.transl_type_scheme !Toploop.toplevel_env + (Ty.obj [%ty: _ -> _ ]) in Toploop.install_printer path ty.Typedtree.ctyp_type fun_printer end diff --git a/src/grader/test_lib.mli b/src/grader/test_lib.mli index ee420b1d6..6929530f6 100644 --- a/src/grader/test_lib.mli +++ b/src/grader/test_lib.mli @@ -81,6 +81,8 @@ module type S = sig | Ok of 'a | Error of exn + val typed_printer : 'a Ty.ty -> Format.formatter -> 'a -> unit + val exec : (unit -> 'a) -> ('a * string * string) result val result : (unit -> 'a) -> 'a result @@ -282,6 +284,15 @@ module type S = sig (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot -> (('a -> 'ar -> 'row) Ty.ty, ('a -> 'ar -> 'urow), 'ret) prot + val ty_of_prot : + (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot -> ('p -> 'a) Ty.ty + val to_ty : string -> 'a Ty.ty + val get_ret_ty : + ('p -> 'a) Ty.ty -> ('p -> 'a, 'p -> 'c, 'r) args -> 'r Ty.ty + val print : + (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot -> + Format.formatter -> ('p -> 'a, 'p -> 'c, 'r) args -> unit + type 'a lookup = unit -> [ `Found of string * Learnocaml_report.report * 'a | `Unbound of string * Learnocaml_report.report ] val lookup : 'a Ty.ty -> ?display_name: string -> string -> 'a lookup diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 46b9a831d..7891c6719 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -58,7 +58,8 @@ module Args = struct let info = info ~docs:"GRADER OPTIONS" let exercises = - value & opt_all (list dir) [["."]] & info ["exercises";"e"] ~docv:"DIRS" ~doc: + value & opt_all (list dir) [["."]] & info ["exercises";"e"] + ~docv:"DIRS" ~doc: "Directories where to find the exercises to be graded \ (comma-separated). Can be repeated." @@ -83,11 +84,13 @@ module Args = struct "display the toplevel's standard outputs" let dump_outputs = - value & opt (some string) None & info ["dump-outputs"] ~docv:"PREFIX" ~doc: + value & opt (some string) None & info ["dump-outputs"] + ~docv:"PREFIX" ~doc: "save the outputs in files with the given prefix" let dump_reports = - value & opt (some string) None & info ["dump-reports"] ~docv:"PREFIX" ~doc: + value & opt (some string) None & info ["dump-reports"] + ~docv:"PREFIX" ~doc: "save the reports in files with the given prefix" let timeout = @@ -128,7 +131,7 @@ module Args = struct let contents_dir = let default = - readlink (Filename.dirname (Filename.dirname (Sys.executable_name)) + readlink (Filename.dirname (Filename.dirname Sys.executable_name) /"share"/"learn-ocaml"/"www") in value & opt dir default & info ["contents-dir"] ~docv:"DIR" ~doc: @@ -142,7 +145,7 @@ module Args = struct let apply app_dir repo_dir contents_dir = Learnocaml_process_exercise_repository.exercises_dir := repo_dir/"exercises"; - Learnocaml_process_tutorial_repository.tutorials_dir := + Learnocaml_process_tutorial_repository.tutorials_dir := repo_dir/"tutorials"; { contents_dir } in @@ -216,43 +219,49 @@ open Args let main o = let grade () = if List.mem Grade o.commands then - (if List.mem Build o.commands || List.mem Serve o.commands then - failwith "The 'grade' command is incompatible with 'build' and \ - 'serve'"; - Lwt_list.fold_left_s (fun i ex -> - Grader_cli.grade ex o.grader.Grader.output_json >|= max i) - 0 o.grader.Grader.exercises - >|= fun i -> Some i) + begin + if List.mem Build o.commands || List.mem Serve o.commands then + failwith "The 'grade' command is incompatible with 'build' and \ + 'serve'"; + Lwt_list.fold_left_s (fun i ex -> + Grader_cli.grade ex o.grader.Grader.output_json >|= max i) + 0 o.grader.Grader.exercises + >|= fun i -> Some i + end else Lwt.return None in let generate () = if List.mem Build o.commands then - (Printf.printf "Updating app at %s\n%!" o.app_dir; - Lwt.catch - (fun () -> copy_tree o.builder.Builder.contents_dir o.app_dir) - (function + begin + Printf.printf "Updating app at %s\n%!" o.app_dir; + Lwt.catch + (fun () -> copy_tree o.builder.Builder.contents_dir o.app_dir) + (function | Failure _ -> - Lwt.fail_with @@ Printf.sprintf - "Failed to copy base app contents from %s" - (readlink o.builder.Builder.contents_dir) + Lwt.fail_with @@ Printf.sprintf + "Failed to copy base app contents from %s" + (readlink o.builder.Builder.contents_dir) | e -> Lwt.fail e) - >>= fun () -> - Lwt.catch - (fun () -> copy_tree (o.repo_dir/"lessons") o.app_dir) - (function Failure _ -> Lwt.return_unit - | e -> Lwt.fail e) - >>= fun () -> - Learnocaml_process_tutorial_repository.main o.app_dir >>= fun e_ret -> - Learnocaml_process_exercise_repository.main o.app_dir >>= fun t_ret -> - Lwt.return (e_ret && t_ret)) + >>= fun () -> + Lwt.catch + (fun () -> copy_tree (o.repo_dir/"lessons") o.app_dir) + (function Failure _ -> Lwt.return_unit + | e -> Lwt.fail e) + >>= fun () -> + Learnocaml_process_tutorial_repository.main o.app_dir >>= fun e_ret -> + Learnocaml_process_exercise_repository.main o.app_dir >>= fun t_ret -> + Lwt.return (e_ret && t_ret) + end else Lwt.return true in let run_server () = if List.mem Serve o.commands then - (Printf.printf "Starting server on port %d\n%!" - !Learnocaml_simple_server.port; - Learnocaml_simple_server.launch ()) + begin + Printf.printf "Starting server on port %d\n%!" + !Learnocaml_simple_server.port; + Learnocaml_simple_server.launch () + end else Lwt.return true in diff --git a/src/ppx-metaquot/genlifter.ml b/src/ppx-metaquot/genlifter.ml index 4c380aa97..f4cb494d5 100644 --- a/src/ppx-metaquot/genlifter.ml +++ b/src/ppx-metaquot/genlifter.ml @@ -63,25 +63,30 @@ module Main : sig end = struct | Lapply _ -> assert false in Hashtbl.add printed ty (); - let sparams = List.mapi (fun i _ -> Printf.sprintf "f%i" i) td.type_params in + let sparams = List.mapi (fun i _ -> Printf.sprintf "f%i" i) + td.type_params in let params = List.map mknoloc sparams in let env = List.map2 (fun s t -> t.id, evar s.txt) params td.type_params in - let make_result_t tyargs = Typ.(arrow Asttypes.Nolabel (constr (lid ty) tyargs) (var "res")) in + let make_result_t tyargs = Typ.(arrow Asttypes.Nolabel + (constr (lid ty) tyargs) (var "res")) in let make_t tyargs = List.fold_right (fun arg t -> - Typ.(arrow Asttypes.Nolabel (arrow Asttypes.Nolabel arg (var "res")) t)) + Typ.(arrow Asttypes.Nolabel + (arrow Asttypes.Nolabel arg (var "res")) t)) tyargs (make_result_t tyargs) in let tyargs = List.map (fun t -> Typ.var t.txt) params in let t = Typ.poly params (make_t tyargs) in let concrete e = - let e = List.fold_right (fun x e -> lam x e) (List.map (fun x -> pvar x.txt) params) e in + let e = List.fold_right (fun x e -> lam x e) + (List.map (fun x -> pvar x.txt) params) e in let tyargs = List.map (fun t -> Typ.constr (lid t.txt) []) params in let e = Exp.constraint_ e (make_t tyargs) in let e = List.fold_right (fun x e -> Exp.newtype x e) params e in let body = Exp.poly e (Some t) in - meths := Cf.(method_ (mknoloc (print_fun ty)) Public (concrete Fresh body)) :: !meths + meths := Cf.(method_ (mknoloc (print_fun ty)) Public + (concrete Fresh body)) :: !meths in let field ld = let s = Ident.name ld.ld_id in @@ -102,19 +107,21 @@ module Main : sig end = struct match cd.cd_args with | Cstr_tuple (tys) -> let p, args = gentuple env tys in - pconstr qc p, selfcall "constr" [str ty; tuple[str c; list args]] + pconstr qc p, selfcall "constr" + [str ty; tuple[str c; list args]] | Cstr_record (l) -> let l = List.map field l in pconstr qc [Pat.record (List.map fst l) Closed], selfcall "constr" [str ty; tuple [str c; - selfcall "record" [str (ty ^ "." ^ c); list (List.map snd l)]]] - in + selfcall "record" [str (ty ^ "." ^ c); + list (List.map snd l)]]] in concrete (func (List.map case l)) | Type_abstract, Some t -> concrete (tyexpr_fun env t) | Type_abstract, None -> (* Generate an abstract method to lift abstract types *) - meths := Cf.(method_ (mknoloc (print_fun ty)) Public (virtual_ t)) :: !meths + meths := Cf.(method_ (mknoloc (print_fun ty)) + Public (virtual_ t)) :: !meths | Type_open, _ -> failwith "Open types are not yet supported." @@ -191,7 +198,8 @@ module Main : sig end = struct let args = let open Arg in [ - "-I", String (fun s -> Config.load_path := Misc.expand_directory Config.standard_library s :: !Config.load_path), + "-I", String (fun s -> Config.load_path := Misc.expand_directory + Config.standard_library s :: !Config.load_path), " Add to the list of include directories"; ] @@ -218,7 +226,8 @@ module Main : sig end = struct let params = [Typ.var "res", Invariant] in let cl = Ci.mk ~virt:Virtual ~params (mknoloc "lifter") (Cl.structure cl) in let s = [Str.class_ [cl]] in - Format.printf "%a@." Pprintast.structure (simplify.Ast_mapper.structure simplify s) + Format.printf "%a@." Pprintast.structure + (simplify.Ast_mapper.structure simplify s) let () = try main () diff --git a/src/ppx-metaquot/ppx_metaquot.ml b/src/ppx-metaquot/ppx_metaquot.ml index e09b5ca36..0323fb089 100644 --- a/src/ppx-metaquot/ppx_metaquot.ml +++ b/src/ppx-metaquot/ppx_metaquot.ml @@ -88,7 +88,8 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct class pat_builder = object - method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method record ty x = precord ~closed:Closed + (List.map (fun (l, e) -> prefix ty l, e) x) method constr ty (c, args) = pconstr (prefix ty c) args method list l = plist l method tuple l = ptuple l @@ -220,7 +221,8 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct Exp.constraint_ (Exp.apply (Exp.ident obj_id) - [Nolabel, (exp_lifter !loc this) # lift_Parsetree_core_type ty]) + [Nolabel, (exp_lifter !loc this) # + lift_Parsetree_core_type ty]) (Typ.constr ty_id [ty]) (* ------ ------ *) | _ -> diff --git a/src/ppx-metaquot/ty.ml b/src/ppx-metaquot/ty.ml index 44db4b563..e056e0d0c 100644 --- a/src/ppx-metaquot/ty.ml +++ b/src/ppx-metaquot/ty.ml @@ -20,7 +20,7 @@ type 'a ty = Ty of repr let obj (Ty ty) = ty -let repr ty = Ty (ty) +let repr ty = Ty ty let print (Ty ty) = Format.asprintf "%a%!" Pprintast.core_type ty diff --git a/src/repo/learnocaml_exercise.ml b/src/repo/learnocaml_exercise.ml index 42f29f777..68c6efeff 100644 --- a/src/repo/learnocaml_exercise.ml +++ b/src/repo/learnocaml_exercise.ml @@ -17,7 +17,7 @@ module StringMap = Map.Make (String) type t = string StringMap.t -let (empty :t)=StringMap.empty +let (empty :t)=StringMap.empty type 'a field = { key : string ; ciphered : bool ; @@ -180,7 +180,8 @@ let enc = if List.assoc "learnocaml_version" l <> "1" then raise (Cannot_destruct ([], Failure "unknown version")) with - Not_found -> raise (Cannot_destruct ([], Missing_field "learnocaml_version")) + Not_found -> + raise (Cannot_destruct ([], Missing_field "learnocaml_version")) end ; let id = try List.assoc "id" l with diff --git a/src/repo/learnocaml_index.ml b/src/repo/learnocaml_index.ml index a172ee2f5..8f13759bd 100644 --- a/src/repo/learnocaml_index.ml +++ b/src/repo/learnocaml_index.ml @@ -153,7 +153,8 @@ let text_enc = (fun content -> Emph content) ; case (obj2 (req "code" string) (dft "runnable" bool false)) - (function Code { code ; runnable } -> Some (code, runnable) | _ -> None) + (function Code { code ; runnable } -> Some (code, runnable) + | _ -> None) (fun (code, runnable) -> Code { code ; runnable }) ; case (obj1 (req "math" string)) diff --git a/src/repo/learnocaml_index.mli b/src/repo/learnocaml_index.mli index aeb86d0bc..295db6402 100644 --- a/src/repo/learnocaml_index.mli +++ b/src/repo/learnocaml_index.mli @@ -24,7 +24,7 @@ type exercise = { exercise_kind : exercise_kind ; exercise_title : string ; exercise_short_description : string option ; - exercise_stars : float (* \in [0.,4.] *) } + exercise_stars : float (* in [0.,4.] *) } and group = { group_title : string ; diff --git a/src/repo/learnocaml_process_exercise_repository.ml b/src/repo/learnocaml_process_exercise_repository.ml index 8ccb2bea6..15ebfa648 100644 --- a/src/repo/learnocaml_process_exercise_repository.ml +++ b/src/repo/learnocaml_process_exercise_repository.ml @@ -154,14 +154,17 @@ let main dest_dir = else match Array.to_list (Sys.readdir !exercises_dir) |> - List.filter (fun dir -> Sys.file_exists (!exercises_dir / dir / "meta.json")) + List.filter (fun dir -> + Sys.file_exists (!exercises_dir / dir / "meta.json")) with | [] -> Format.eprintf "No index file, no exercise directory.@." ; - Format.eprintf "This does not look like a LearnOCaml exercise repository.@." ; + Format.eprintf + "This does not look like a LearnOCaml exercise repository.@." ; Lwt.fail (Failure "cannot continue") | dirs -> - Format.eprintf "Missing index file, using all exercise directories.@." ; + Format.eprintf + "Missing index file, using all exercise directories.@." ; Lwt.return (`Exercises dirs)) >>= fun structure -> let all_exercises = ref [] in let rec fill_structure = function @@ -170,28 +173,32 @@ let main dest_dir = (fun acc (id, (group_title, str)) -> fill_structure str >>= fun group_contents -> acc >>= fun acc -> - Lwt.return (StringMap.add id { group_title ; group_contents } acc)) + Lwt.return (StringMap.add id + { group_title ; group_contents } acc)) (Lwt.return StringMap.empty) groups >>= fun groups -> Lwt.return (Groups groups) | `Exercises ids -> List.fold_left (fun acc id -> all_exercises := id :: !all_exercises ; - from_file exercise_meta_enc (!exercises_dir / id / "meta.json") + from_file exercise_meta_enc + (!exercises_dir / id / "meta.json") >>= fun (exercise_kind, exercise_stars) -> let exercise_short_description = None in let exercise = read_exercise (!exercises_dir / id) in let exercise = { exercise_kind ; exercise_stars ; - exercise_title = Learnocaml_exercise.(get title) exercise ; + exercise_title = + Learnocaml_exercise.(get title) exercise ; exercise_short_description} in acc >>= fun acc -> Lwt.return (StringMap.add id exercise acc)) (Lwt.return StringMap.empty) ids >>= fun exercises -> Lwt.return (Learnocaml_exercises exercises) in fill_structure structure >>= fun index -> - to_file exercise_index_enc (dest_dir / exercise_index_path) index >>= fun () -> + to_file exercise_index_enc (dest_dir / exercise_index_path) index + >>= fun () -> let processes_arguments = List.map (fun id -> @@ -201,7 +208,8 @@ let main dest_dir = let { Unix.st_mtime = json_time } = Unix.stat json_path in Sys.readdir exercise_dir |> Array.to_list |> - List.map (fun f -> (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> + List.map (fun f -> + (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> List.exists (fun t -> t >= json_time) with _ -> true in let dump_outputs = @@ -215,14 +223,16 @@ let main dest_dir = id, exercise_dir, json_path, changed, dump_outputs,dump_reports) (List.sort_uniq compare !all_exercises) in begin if !n_processes = 1 then - Lwt_list.map_s (fun (id, exercise_dir, json_path, changed, dump_outputs,dump_reports) -> + Lwt_list.map_s (fun (id, exercise_dir, json_path, + changed, dump_outputs, dump_reports) -> if not changed then begin Format.printf "%-12s (no changes)@." id ; Lwt.return true end else begin Grader_cli.dump_outputs := dump_outputs ; Grader_cli.dump_reports := dump_reports ; - Grader_cli.grade exercise_dir (Some json_path) >>= fun result -> + Grader_cli.grade exercise_dir (Some json_path) + >>= fun result -> match result with | 0 -> Format.printf "%-12s [OK]@." id ; @@ -234,7 +244,8 @@ let main dest_dir = processes_arguments else let pool = Lwt_pool.create !n_processes (fun () -> Lwt.return ()) in - Lwt_list.map_p (fun (id, exercise_dir, json_path, changed, dump_outputs, dump_reports) -> + Lwt_list.map_p (fun (id, exercise_dir, json_path, changed, + dump_outputs, dump_reports) -> Lwt_pool.use pool @@ fun () -> if not changed then begin Format.printf "%-12s (no changes)@." id ; @@ -247,9 +258,18 @@ let main dest_dir = (match dump_reports with | None -> [||] | Some prefix -> [| "-dump-reports" ; prefix |]) ; - (if !Grader_cli.display_outcomes then [| "-display-outcomes" |] else [||]) ; - (if !Grader_cli.display_callback then [| "-display-progression" |] else [||]) ; - (if !Grader_cli.display_std_outputs then [| "-display-stdouts" |] else [||]) ; + (if !Grader_cli.display_outcomes then + [| "-display-outcomes" |] + else + [||]) ; + (if !Grader_cli.display_callback then + [| "-display-progression" |] + else + [||]) ; + (if !Grader_cli.display_std_outputs then + [| "-display-stdouts" |] + else + [||]) ; [| "-output-json" ; json_path |] ; [| exercise_dir |] ]in spawn_grader args >>= function @@ -266,7 +286,8 @@ let main dest_dir = (fun exn -> let print_unknown ppf = function | Failure msg -> Format.fprintf ppf "Cannot process exercises: %s" msg - | exn -> Format.fprintf ppf "Cannot process exercises: %s" (Printexc.to_string exn) in + | exn -> Format.fprintf ppf "Cannot process exercises: %s" + (Printexc.to_string exn) in Json_encoding.print_error ~print_unknown Format.err_formatter exn ; Format.eprintf "@." ; Lwt.return false) diff --git a/src/repo/learnocaml_process_tutorial_repository.ml b/src/repo/learnocaml_process_tutorial_repository.ml index 97aeaa3ab..aec3fd23c 100644 --- a/src/repo/learnocaml_process_tutorial_repository.ml +++ b/src/repo/learnocaml_process_tutorial_repository.ml @@ -77,11 +77,14 @@ let main dest_dir = with | [] -> Format.eprintf "No index file, no .md or .html file.@." ; - Format.eprintf "This does not look like a LearnOCaml tutorial repository.@." ; + Format.eprintf "This does not look \ + like a LearnOCaml tutorial repository.@." ; Lwt.fail_with "cannot continue" | files -> - Format.eprintf "Missing index file, using all .dm and .html files.@." ; - Lwt.return [ "tutorials", ("All tutorials", files) ]) >>= fun series -> + Format.eprintf "Missing index file, \ + using all .dm and .html files.@." ; + Lwt.return [ "tutorials", ("All tutorials", files) ]) + >>= fun series -> let retrieve_tutorial tutorial_name = let base_name = !tutorials_dir / tutorial_name in let md_file = base_name ^ ".md" in @@ -94,21 +97,26 @@ let main dest_dir = Learnocaml_tutorial_parser.parse_html_tutorial ~tutorial_name ~file_name: html_file else - Lwt.fail_with (Format.asprintf "missing file %s.{html|md}" base_name ) in + Lwt.fail_with + (Format.asprintf "missing file %s.{html|md}" base_name ) in List.fold_left (fun acc (name, (series_title, tutorials)) -> Lwt_list.map_p (fun name -> - retrieve_tutorial name >>= fun (server_index_handle, tutorial) -> + retrieve_tutorial name + >>= fun (server_index_handle, tutorial) -> let json_path = dest_dir / tutorial_path name in - to_file Learnocaml_tutorial.tutorial_enc json_path tutorial >>= fun () -> + to_file Learnocaml_tutorial.tutorial_enc json_path tutorial + >>= fun () -> Lwt.return server_index_handle) tutorials >>= fun series_tutorials -> acc >>= fun acc -> - Lwt.return (StringMap.add name { series_title ; series_tutorials } acc)) + Lwt.return (StringMap.add name + { series_title ; series_tutorials } acc)) (Lwt.return StringMap.empty) series >>= fun index -> - to_file tutorial_index_enc (dest_dir / tutorial_index_path) index >>= fun () -> + to_file tutorial_index_enc (dest_dir / tutorial_index_path) index + >>= fun () -> Lwt.return true) (fun exn -> let print_unknown ppf = function diff --git a/src/repo/learnocaml_tutorial_parser.ml b/src/repo/learnocaml_tutorial_parser.ml index e8a17dfbb..d6466925b 100644 --- a/src/repo/learnocaml_tutorial_parser.ml +++ b/src/repo/learnocaml_tutorial_parser.ml @@ -155,19 +155,26 @@ let parse_html_tutorial ~tutorial_name ~file_name = | `Elt ("br", _, _) :: rest -> parse_text acc rest | `Text text :: rest -> - let text = String.trim (Str.(global_replace (regexp "[ \t\n]+")) " " text) in + let text = + String.trim (Str.(global_replace (regexp "[ \t\n]+")) " " text) in parse_text (Text text :: acc) rest | `Elt (("code" | "quote"), [], children) :: rest -> parse_code [] children >>= fun code -> - let code = String.trim (Str.(global_replace (regexp "\\( *\n[ \t]*\\)+")) " " code) in + let code = + String.trim (Str.(global_replace + (regexp "\\( *\n[ \t]*\\)+")) " " code) in parse_text (Code { code ; runnable = false } :: acc) rest | `Elt (("code" | "quote"), [ "data-math", _ ], children) :: rest -> parse_code [] children >>= fun code -> - let code = String.trim (Str.(global_replace (regexp "\\( *\n[ \t]*\\)+")) " " code) in + let code = + String.trim (Str.(global_replace + (regexp "\\( *\n[ \t]*\\)+")) " " code) in parse_text (Math code :: acc) rest | `Elt (("code" | "quote"), [ "data-run", _ ], children) :: rest -> parse_code [] children >>= fun code -> - let code = String.trim (Str.(global_replace (regexp "\\( *\n[ \t]*\\)+")) " " code) in + let code = + String.trim (Str.(global_replace + (regexp "\\( *\n[ \t]*\\)+")) " " code) in parse_text (Code { code ; runnable = true } :: acc) rest | `Elt (("code" | "quote"), _ , children) :: rest -> fail "the markup expects either \ @@ -180,7 +187,8 @@ let parse_html_tutorial ~tutorial_name ~file_name = let rec parse_contents ?(require_p = true) acc = function | `Elt ("p", _, children) :: rest -> parse_text [] children >>= fun contents -> - parse_contents ~require_p (Learnocaml_tutorial.Paragraph contents :: acc) rest + parse_contents ~require_p + (Learnocaml_tutorial.Paragraph contents :: acc) rest | `Elt ("ul" | "ol" as tag, _, children) :: rest -> let rec parse_items tag acc = function | [] -> Lwt.return (List.rev acc) @@ -193,18 +201,21 @@ let parse_html_tutorial ~tutorial_name ~file_name = | `Elt ("pre", [], children) :: rest -> parse_code [] children >>= fun code -> let code = reshape_code_block code in - let code_block = Learnocaml_tutorial.Code_block { code ; runnable = false } in + let code_block = + Learnocaml_tutorial.Code_block { code ; runnable = false } in parse_contents ~require_p (code_block :: acc) rest | `Elt ("pre", [ "data-run", _ ], children) :: rest -> parse_code [] children >>= fun code -> let code = reshape_code_block code in - let code_block = Learnocaml_tutorial.Code_block { code ; runnable = true } in + let code_block = + Learnocaml_tutorial.Code_block { code ; runnable = true } in parse_contents ~require_p (code_block :: acc) rest | `Elt ("pre", [ "data-math", _ ], children) :: rest -> parse_code [] children >>= fun code -> let code = reshape_code_block code in let contents = [ Math code ] in - parse_contents ~require_p (Learnocaml_tutorial.Paragraph contents :: acc) rest + parse_contents ~require_p + (Learnocaml_tutorial.Paragraph contents :: acc) rest | `Elt ("pre", _ , children) :: rest -> fail "the
 markup expects either \
               one data-math, one data-run or zero attribute"
@@ -244,7 +255,7 @@ let parse_html_tutorial ~tutorial_name ~file_name =
         parse_steps (acc, Some (step_title, elt :: sacc), rest) in
   match tree with
   | None -> fail "unparsable HTML file"
-  | Some tree -> match strip tree with
+  | Some tree -> (match strip tree with
     | `Elt ("html", _, [ `Elt ("head", _, _) ; `Elt ("body", _, contents) ])
     | `Elt ("html", _, [ `Elt ("body", _, contents) ]) ->
         begin match contents with
@@ -259,7 +270,7 @@ let parse_html_tutorial ~tutorial_name ~file_name =
                     at the beginning of the "
         end
     | _ -> fail "wrong HTML structure, \
-                 expecting a standard  with a "
+                 expecting a standard  with a ")
 
 let parse_md_tutorial ~tutorial_name ~file_name =
   let fail fmt =
@@ -388,7 +399,8 @@ let print_html_tutorial ~tutorial_name tutorial =
     | _ -> assert false in
   let rec pp_content ppf = function
     | Code_block { code ; runnable } ->
-       Format.fprintf ppf "@[@," (if runnable then " data-run" else "") ;
+       Format.fprintf ppf "@[@,"
+         (if runnable then " data-run" else "") ;
        let code = reshape_code_block code in
        Uutf.String.fold_utf_8 (fun () _ cp ->
            match cp with
@@ -449,12 +461,14 @@ let print_md_tutorial ~tutorial_name tutorial =
         pp_text ppf rest
     |  Code { code ; runnable = true} :: rest ->
         let code = drop_newlines code in
-        let code = Omd_backend.markdown_of_md [ Omd.Code ("", "| " ^ code ^ " |") ] in
+        let code = Omd_backend.markdown_of_md
+                     [ Omd.Code ("", "| " ^ code ^ " |") ] in
         Format.fprintf ppf "%s" code ;
         pp_text ppf rest
     |  Math code :: rest ->
         let code = drop_newlines code in
-        let code = Omd_backend.markdown_of_md [ Omd.Code ("", "$ " ^ code ^ " $") ] in
+        let code = Omd_backend.markdown_of_md
+                     [ Omd.Code ("", "$ " ^ code ^ " $") ] in
         Format.fprintf ppf "%s" code ;
         if rest <> [] then Format.fprintf ppf "@ " ;
         pp_text ppf rest
diff --git a/src/repo/learnocaml_tutorial_reader_main.ml b/src/repo/learnocaml_tutorial_reader_main.ml
index 391545c54..de019b693 100644
--- a/src/repo/learnocaml_tutorial_reader_main.ml
+++ b/src/repo/learnocaml_tutorial_reader_main.ml
@@ -55,22 +55,28 @@ let main () =
                  let tutorial_name =
                    Filename.basename (Filename.chop_extension file_name) in
                  begin if Filename.check_suffix file_name ".html" then
-                     Learnocaml_tutorial_parser.parse_html_tutorial ~tutorial_name ~file_name
+                         Learnocaml_tutorial_parser.parse_html_tutorial
+                           ~tutorial_name ~file_name
                    else if Filename.check_suffix file_name ".md" then
-                     Learnocaml_tutorial_parser.parse_md_tutorial ~tutorial_name ~file_name
+                         Learnocaml_tutorial_parser.parse_md_tutorial
+                           ~tutorial_name ~file_name
                    else if Filename.check_suffix file_name ".json" then
-                     Lwt_io.with_file ~mode: Lwt_io.Input file_name @@ fun chan ->
+                         Lwt_io.with_file ~mode: Lwt_io.Input file_name @@
+                           fun chan ->
                      Lwt_io.read chan >>= fun text ->
                      let json =
                        Ezjsonm.from_string text in
                      let tutorial =
-                       Json_encoding.destruct Learnocaml_tutorial.tutorial_enc json in
+                       Json_encoding.destruct
+                         Learnocaml_tutorial.tutorial_enc json in
                      let tutorial_title =
                        tutorial.Learnocaml_tutorial.tutorial_title in
                      Lwt.return
-                       (Learnocaml_index.{ tutorial_name ; tutorial_title }, tutorial)
+                       (Learnocaml_index.{ tutorial_name ; tutorial_title },
+                        tutorial)
                    else
-                     Lwt.fail_with "unrecognized file extension, expecting .md, .html or .json"
+                     Lwt.fail_with "unrecognized file extension, \
+                                    expecting .md, .html or .json"
                  end >>= fun (_, tutorial) ->
                  Lwt.join
                    [ begin match !output_html with
@@ -79,7 +85,8 @@ let main () =
                            let text =
                              Learnocaml_tutorial_parser.print_html_tutorial
                                ~tutorial_name tutorial in
-                           Lwt_io.with_file ~mode: Lwt_io.Output file_name @@ fun chan ->
+                           Lwt_io.with_file ~mode: Lwt_io.Output file_name @@
+                             fun chan ->
                            Lwt_io.write chan text
                      end ;
                      begin match !output_md with
@@ -88,17 +95,20 @@ let main () =
                            let text =
                              Learnocaml_tutorial_parser.print_md_tutorial
                                ~tutorial_name tutorial in
-                           Lwt_io.with_file ~mode: Lwt_io.Output file_name @@ fun chan ->
+                           Lwt_io.with_file ~mode: Lwt_io.Output file_name @@
+                             fun chan ->
                            Lwt_io.write chan text
                      end ;
                      begin match !output_json with
                        | None -> Lwt.return ()
                        | Some file_name ->
                            let json =
-                             Json_encoding.construct Learnocaml_tutorial.tutorial_enc tutorial in
+                             Json_encoding.construct
+                               Learnocaml_tutorial.tutorial_enc tutorial in
                            match json with
                            | `O _ | `A _ as json ->
-                               Lwt_io.with_file ~mode: Lwt_io.Output file_name @@ fun chan ->
+                              Lwt_io.with_file ~mode: Lwt_io.Output file_name @@
+                                fun chan ->
                                let text = Ezjsonm.to_string json in
                                Lwt_io.write chan text
                            | _ -> assert false
@@ -106,8 +116,10 @@ let main () =
                  Lwt.return 0)
           (fun exn ->
              let print_unknown ppf = function
-               | Failure msg -> Format.fprintf ppf "Cannot process tutorial: %s" msg
-               | exn -> Format.fprintf ppf "Cannot process tutorial: %s"  (Printexc.to_string exn) in
+               | Failure msg ->
+                  Format.fprintf ppf "Cannot process tutorial: %s" msg
+               | exn -> Format.fprintf ppf "Cannot process tutorial: %s"
+                          (Printexc.to_string exn) in
              Json_encoding.print_error ~print_unknown Format.err_formatter exn ;
              Format.eprintf "@." ;
              Lwt.return 1)))
diff --git a/src/simple-server/learnocaml_simple_server.ml b/src/simple-server/learnocaml_simple_server.ml
index 57c9a4647..c273df51a 100644
--- a/src/simple-server/learnocaml_simple_server.ml
+++ b/src/simple-server/learnocaml_simple_server.ml
@@ -114,7 +114,8 @@ let create_token_file token =
     | [] -> assert false
     | [ file ] ->
         let fn = (Filename.concat acc file) in
-        Lwt_io.(with_file ~mode: Output fn (fun chan -> write chan "")) >>= fun () ->
+        Lwt_io.(with_file ~mode: Output fn (fun chan -> write chan ""))
+        >>= fun () ->
         Lwt.return_unit
     | dir :: path ->
         create (Filename.concat acc dir) path
@@ -134,7 +135,8 @@ let gimme () =
     let rand () = String.get alphabet (Random.int (String.length alphabet)) in
     let part () = String.init 3 (fun _ -> rand ()) in
     let token = [ part () ; part () ; part () ; part () ] in
-    if Sys.file_exists (String.concat Filename.dir_sep (!sync_dir :: token)) then
+    if Sys.file_exists
+         (String.concat Filename.dir_sep (!sync_dir :: token)) then
       next ()
     else
       create_token_file token >|= fun () -> String.concat "-" token
@@ -209,7 +211,8 @@ let launch () =
               store token body >>= fun () ->
               Server.respond_string ~status:`OK ~body: "Stored." ()
             else
-              Server.respond_string ~status:`Bad_request ~body: "Invalid save file" ()
+              Server.respond_string ~status:`Bad_request
+                ~body: "Invalid save file" ()
       end
     | `GET, path -> respond_static path
     | _ -> Server.respond_error ~status: `Bad_request ~body: "Bad request" () in
diff --git a/src/state/learnocaml_exercise_state.ml b/src/state/learnocaml_exercise_state.ml
index c8343823d..d59fea3f6 100644
--- a/src/state/learnocaml_exercise_state.ml
+++ b/src/state/learnocaml_exercise_state.ml
@@ -15,14 +15,17 @@
  * You should have received a copy of the GNU Affero General Public License
  * along with this program.  If not, see . *)
 
+
+open Json_encoding;;
+open Learnocaml_index;;
+
+
 type exercise_state =
   { solution : string ;
-    grade : int (* \in [0, 100] *) option ;
+    grade : int option ;
     report : Learnocaml_report.report option ;
     mtime : float }
 
-open Json_encoding
-
 let exercise_state_enc =
   let grade_enc =
     conv
@@ -41,48 +44,234 @@ let exercise_state_enc =
        (opt "grade" grade_enc)
        (req "solution" string)
        (opt "report" Learnocaml_report.report_enc)
-       (dft "mtime" float 0.))
+       (dft "mtime" float 0.));;
+
+
+type index_state =
+  {
+    exos: exercise Map.Make (String).t ;
+        mtime : float
+  }
+let index_state_enc = conv (fun {exos; mtime} -> (exos, mtime))
+  (fun (exos, mtime) -> {exos; mtime})
+  (obj2 (req "exercises" (map_enc exercise_enc)) (dft "mtime" float 0.));;
+type type_question= Suite | Solution | Spec ;;
+
+(* previous version of storing questions may be useful
+
+type type_question= Suite | Solution | Spec ;;
+
+type question_state =
+  {name:string;
+   ty :string;
+   type_question : type_question;
+   input :string;
+   output:string;
+   extra_alea:int;
+   datalist:string;
+  }
+
+let question_state_enc =
+  conv
+    (fun {name; ty; type_question; input; output; extra_alea; datalist}->
+       (name, ty, type_question, input, output, extra_alea, datalist)
+    )
+    (fun (name, ty, type_question, input, output, extra_alea, datalist)->
+       {name; ty; type_question; input; output; extra_alea; datalist}
+    )
+    (obj7
+       (req "name" string)
+       (req "ty" string)
+       (req "type_question"
+         ( string_enum ["suite",Suite;"spec",Spec;"solution",Solution] ) )
+       (req "input" string)
+       (req "output" string)
+       (req "extra_alea" int)
+       (req "datalist" string)
+    );;
+*)
+
+type test_qst_untyped =
+  | TestAgainstSol of
+      { name: string
+      ; ty: string
+      ; gen: int
+      ; suite: string
+      ; tester: string
+      ; sampler : string }
+  | TestAgainstSpec of
+      { name: string
+      ; ty: string
+      ; gen: int
+      ; suite: string
+      ; spec : string
+      ; tester: string
+      ; sampler: string }
+  | TestSuite of
+      { name: string;
+        ty: string;
+        suite: string;
+        tester :string };;
+type a_sol =
+  { name: string
+  ; ty: string
+  ; gen: int
+  ; suite: string
+  ; tester: string
+  ; sampler : string }
+let test_against_sol_enc =
+  conv
+    (fun {name; ty; gen; suite; tester; sampler} ->
+       (name, ty, gen, suite, tester, sampler)
+    )
+    (fun (name, ty, gen, suite, tester, sampler) ->
+       {name; ty; gen; suite; tester; sampler}
+    )
+    (obj6
+       (req "name" string)
+       (req "ty" string)
+       (req "gen" int )
+       (req "suite" string)
+       (req "tester" string)
+       (req "sampler" string)
+    );;
+type a_spec=
+  { name: string
+  ; ty: string
+  ; gen: int
+  ; suite: string
+  ; spec : string
+  ; tester: string
+  ; sampler : string}
+let test_against_spec_enc =
+  conv
+    (fun {name; ty; gen; suite;spec; tester; sampler}->
+       (name, ty, gen, suite,spec, tester, sampler)
+    )
+    (fun (name, ty, gen, suite, spec,tester, sampler)->
+       {name; ty; gen; suite; spec;tester; sampler}
+    )
+    (obj7
+       (req "name" string)
+       (req "ty" string)
+       (req "gen" int )
+       (req "suite" string)
+       (req "spec" string)
+       (req "tester" string)
+       (req "sampler" string)
+    );;
+type suite=
+  { name: string
+  ; ty: string
+  ; suite: string
+  ; tester: string }
+
+let test_suite_enc =
+  conv
+    (fun {name; ty; suite; tester}->
+       (name, ty,  suite, tester)
+    )
+    (fun (name, ty, suite, tester)->
+       {name; ty;  suite; tester}
+    )
+    (obj4
+       (req "name" string)
+       (req "ty" string)
+       (req "suite" string)
+       (req "tester" string)
+    );;
+
+let test_qst_untyped_enc =union [
+    case
+      test_against_sol_enc
+      (function TestAgainstSol {name; ty; gen; suite; tester; sampler} ->
+       Some {name; ty; gen; suite; tester; sampler} | _ -> None)
+      (fun {name; ty; gen; suite; tester; sampler} ->
+       TestAgainstSol {name; ty; gen; suite; tester; sampler});
+    case
+      test_against_spec_enc
+      (function TestAgainstSpec {name; ty; gen; suite;spec; tester; sampler} ->
+       Some {name; ty; gen; suite;spec; tester; sampler} | _ -> None)
+      (fun {name; ty; gen; suite;spec; tester; sampler} ->
+       TestAgainstSpec {name; ty; gen; suite;spec; tester; sampler} );
+    case
+      test_suite_enc
+      (function TestSuite {name; ty; suite; tester} ->
+       Some {name; ty; suite; tester} | _ -> None)
+      (fun {name; ty; suite; tester}  ->TestSuite {name; ty; suite; tester} );
+  ]
 ;;
+type test_state = {testml : string;
+                   testhaut : test_qst_untyped Map.Make (String).t}
 
 
-type editor_state =
-  { id : string ;
+let testhaut_enc = map_enc test_qst_untyped_enc
+
+let test_state_enc =conv
+    (fun {testml; testhaut} -> (testml, testhaut))
+    ( fun (testml, testhaut) -> {testml; testhaut})
+    (obj2
+       (req "testml" string)
+       (req "testhaut" testhaut_enc)
+    );;
+type metadata =
+  { id : string;
     titre : string;
-    prepare :string;
-    diff : float option ;
+    description : string;
+    diff : float;
+  }
+
+let metadata_enc = conv
+    (fun {id;titre;description;diff} -> (id,titre,description,diff))
+    ( fun (id,titre,description,diff) -> {id;titre;description;diff})
+    (obj4
+       (req "id" string)
+       (req "titre" string )
+       (req "description" string)
+       (req "diff" float )
+    )
+type checkbox=
+  { imperative : bool;
+    undesirable : bool}
+
+let checkbox_enc = conv
+    (fun {imperative;undesirable} -> (imperative,undesirable) )
+    (fun (imperative,undesirable) -> {imperative;undesirable} )
+    (obj2
+       (req "imperative" bool )
+       (req "undesirable" bool )
+    )
+
+type editor_state =
+  { metadata : metadata;
+    prepare : string;
     solution : string ;
     question : string ;
     template : string ;
-    test : string ;
-    prelude : string;    
+    test : test_state ;
+    prelude : string;
+    incipit : string ;
+    checkbox : checkbox;
     mtime : float }
 
-open Json_encoding
-
 let editor_state_enc =
-  
   conv
-    (fun {id ; titre ; prepare; diff;solution ; question ;template ; test;prelude ; mtime } ->
-       (id , titre , prepare, diff, solution , question , template , test, prelude , mtime))
-    (fun (id , titre , prepare, diff, solution , question , template , test, prelude , mtime) ->
-       {id ; titre ; prepare; diff;solution ; question ;template ; test; prelude ; mtime })
+    (fun {metadata; prepare; solution; question; template;
+          test; prelude; incipit; checkbox; mtime } ->
+      (metadata, prepare, solution, question, template,
+       test, prelude, incipit, checkbox, mtime))
+    (fun (metadata, prepare, solution, question, template,
+          test, prelude, incipit, checkbox, mtime) ->
+      {metadata; prepare; solution; question; template;
+       test; prelude; incipit; checkbox; mtime})
     (obj10
-       (req "id" string)
-       (req "titre" string)
+       (req "metadata" metadata_enc)
        (req "prepare" string)
-       (opt "diff" float )
        (req "solution" string)
        (req "question" string)
        (req "template" string)
-       (req "test" string)
+       (req "test" test_state_enc )
        (req "prelude" string)
+       (req "incipit" string)
+       (req "checkbox" checkbox_enc )
        (dft "mtime" float 0.))
-
-open Learnocaml_index;;
-type index_state=
-  {
-    exos: exercise Map.Make (String).t ;
-        mtime :float
-        
-  }
-let index_state_enc = conv (fun {exos;mtime}->(exos,mtime) ) (fun (exos,mtime)->{exos;mtime}) (obj2 (req "exercises" (map_enc exercise_enc)) (dft "mtime" float 0.))
diff --git a/src/state/learnocaml_exercise_state.mli b/src/state/learnocaml_exercise_state.mli
index d546561cb..d71f80946 100644
--- a/src/state/learnocaml_exercise_state.mli
+++ b/src/state/learnocaml_exercise_state.mli
@@ -17,22 +17,62 @@
 
 type exercise_state =
   { solution : string ;
-    grade : int (* \in [0, 100] *) option ;
+    grade : int (* in [0, 100] *) option ;
     report : Learnocaml_report.report option ;
     mtime : float }
 
 val exercise_state_enc : exercise_state Json_encoding.encoding
 
-type editor_state =
-  { id : string ;
+type type_question = Suite | Solution | Spec ;;
+
+type test_qst_untyped =
+  | TestAgainstSol of
+      { name: string
+      ; ty: string 
+      ; gen: int
+      ; suite: string
+      ; tester: string
+      ; sampler: string }
+  | TestAgainstSpec of
+      { name: string
+      ; ty: string
+      ; gen: int
+      ; suite: string
+      ; spec : string
+      ; tester: string
+      ; sampler: string }
+  | TestSuite of
+      { name: string
+      ; ty: string
+      ; suite: string
+      ; tester: string } ;;
+
+type test_state = {testml : string;
+                   testhaut : test_qst_untyped Map.Make (String).t}
+
+val testhaut_enc : test_qst_untyped Map.Make (String).t Json_encoding.encoding
+    
+type metadata =
+  { id : string;
     titre : string;
-    prepare : string  ;
-    diff : float option;
-    solution : string ;
-    question : string ;
-    template : string ;
-    test : string ;
-    prelude : string ;    
+    description : string;
+    diff : float
+  }
+
+type checkbox =
+  { imperative : bool;
+    undesirable : bool}
+
+type editor_state =
+  { metadata : metadata;    
+    prepare : string;
+    solution : string;
+    question : string;
+    template : string;
+    test : test_state;
+    prelude : string;
+    incipit : string ;
+    checkbox : checkbox;
     mtime : float }
 
 val editor_state_enc : editor_state Json_encoding.encoding
@@ -42,6 +82,5 @@ type index_state =
      exos : Learnocaml_index.exercise Map.Make(String).t;
      mtime : float;
   }
-  
 
 val index_state_enc : index_state Json_encoding.encoding
diff --git a/src/state/learnocaml_report.ml b/src/state/learnocaml_report.ml
index 6b81dfbf7..d66eeac8c 100644
--- a/src/state/learnocaml_report.ml
+++ b/src/state/learnocaml_report.ml
@@ -62,7 +62,8 @@ and output_elt ppf = function
     Format.fprintf ppf "//"
       output_attrs attrs text
   | E ("style", attrs, [ C text ]) ->
-    Format.fprintf ppf "/**/"
+     Format.fprintf ppf
+       "/**/"
       output_attrs attrs text
   | E (name, attrs, html) ->
     Format.fprintf ppf "<%s%a>%a"
@@ -208,9 +209,11 @@ let format_report items =
            [ E ("span", [ "class", "text" ],
                 match score with
                 | None -> format_text text
-                | Some score -> E ("span", [ "class", "score" ], [ T score ]) :: format_text text) ])
+                | Some score -> E ("span", [ "class", "score" ],
+                                   [ T score ]) :: format_text text) ])
     | Section (title, contents) ->
-        let (successes, failures) as result, formatted_report = format_report contents in
+       let (successes, failures) as result, formatted_report =
+         format_report contents in
         let result_class, score, folder = match result with
           | (0, false) ->
               "informative folded", [], unfolder
@@ -525,21 +528,31 @@ let print_report ppf items =
   let rec print_report ppf items =
     Format.pp_print_list format_item ppf items
   and format_item ppf = function
-    | Section (text, contents) -> Format.fprintf ppf "@[@[%a@]@,%a@]" print_text text print_report contents
-    | Message (text, Failure) -> Format.fprintf ppf [%if"@[Failure: %a@]"] print_text text
-    | Message (text, Warning) -> Format.fprintf ppf [%if"@[Warning: %a@]"] print_text text
-    | Message (text, Informative) -> Format.fprintf ppf "@[%a@]" print_text text
-    | Message (text, Important) -> Format.fprintf ppf [%if"@[Important: %a@]"] print_text text
-    | Message (text, Success n) -> Format.fprintf ppf [%if"@[Success %d: %a@]"] n print_text text
+    | Section (text, contents) ->
+       Format.fprintf ppf "@[@[%a@]@,%a@]"
+         print_text text print_report contents
+    | Message (text, Failure) ->
+       Format.fprintf ppf [%if"@[Failure: %a@]"] print_text text
+    | Message (text, Warning) ->
+       Format.fprintf ppf [%if"@[Warning: %a@]"] print_text text
+    | Message (text, Informative) ->
+       Format.fprintf ppf "@[%a@]" print_text text
+    | Message (text, Important) ->
+       Format.fprintf ppf [%if"@[Important: %a@]"] print_text text
+    | Message (text, Success n) ->
+       Format.fprintf ppf [%if"@[Success %d: %a@]"] n print_text text
   and print_text ppf = function
-    | (Code wa | Output wa) :: Text wb :: rest when not (String.contains (String.trim wa) '\n') ->
+    | (Code wa | Output wa) :: Text wb :: rest
+         when not (String.contains (String.trim wa) '\n') ->
         print_text ppf (Text ("[" ^ String.trim wa ^ "] " ^ wb) :: rest)
-    | Text wa :: (Code wb | Output wb) :: rest when not (String.contains (String.trim wb) '\n') ->
+    | Text wa :: (Code wb | Output wb) :: rest
+         when not (String.contains (String.trim wb) '\n') ->
         print_text ppf (Text (wa ^ " [" ^ String.trim wb ^ "]") :: rest)
     | Text wa :: Text wb :: rest ->
         print_text ppf (Text (wa ^ " " ^ wb) :: rest)
     | Text w :: rest ->
-        Format.fprintf ppf "@[%a@]%a" Format.pp_print_text w print_text rest
+       Format.fprintf ppf "@[%a@]%a"
+         Format.pp_print_text w print_text rest
     | Break :: rest ->
         Format.fprintf ppf "%a" print_text rest
     | Code s :: rest ->
diff --git a/src/toplevel/build.ocp b/src/toplevel/build.ocp
index 1596ccba0..c88b6723e 100644
--- a/src/toplevel/build.ocp
+++ b/src/toplevel/build.ocp
@@ -8,6 +8,7 @@ begin program "learnocaml-toplevel-worker"
     "toploop_results"
     "ocplib-ocamlres.runtime"
     "embedded_cmis"
+    "grading"
   ]
   files = [
     "learnocaml_toplevel_worker_messages.mli"
diff --git a/src/toplevel/learnocaml_toplevel.ml b/src/toplevel/learnocaml_toplevel.ml
index 88017f015..cf981bdcd 100644
--- a/src/toplevel/learnocaml_toplevel.ml
+++ b/src/toplevel/learnocaml_toplevel.ml
@@ -41,7 +41,8 @@ type t = {
   worker: Learnocaml_toplevel_worker_caller.t;
   container: [ `Div ] Html5.elt;
   oldify: bool;
-  mutable status: [ `Reset of (unit Lwt.t * unit Lwt.u) | `Execute of unit Lwt.t | `Idle ] ;
+  mutable status: [ `Reset of (unit Lwt.t * unit Lwt.u)
+                  | `Execute of unit Lwt.t | `Idle ] ;
   mutable on_enable_input: t -> unit;
   mutable on_disable_input: t -> unit;
   mutable disabled : int;
@@ -121,7 +122,8 @@ let reset_with_timeout top ?timeout () =
       top.status <- `Reset (t, u) ;
       let timeout () = start_timeout top "reset" timeout in
       disable_input top;
-      Learnocaml_toplevel_worker_caller.reset ~timeout top.worker () >>= fun () ->
+      Learnocaml_toplevel_worker_caller.reset ~timeout top.worker ()
+      >>= fun () ->
       t
   | `Execute task ->
       let t, u = Lwt.wait () in
@@ -131,7 +133,8 @@ let reset_with_timeout top ?timeout () =
       top.status <- `Reset (t, u) ;
       let timeout () = start_timeout top "reset" timeout in
       disable_input top;
-      Learnocaml_toplevel_worker_caller.reset ~timeout top.worker () >>= fun () ->
+      Learnocaml_toplevel_worker_caller.reset ~timeout top.worker ()
+      >>= fun () ->
       t >>= fun () ->
       Lwt.cancel task ;
       Lwt.return ()
@@ -202,9 +205,14 @@ let execute_phrase top ?timeout content =
     warnings ;
   Lwt.return result
 
+
 let execute top =
   Learnocaml_toplevel_input.execute top.input
 
+let execute_test top =
+  Learnocaml_toplevel_output.get_blocks top.output
+
+
 let go_backward top =
   Learnocaml_toplevel_input.go_backward top.input
 
@@ -217,7 +225,8 @@ let check top code =
 
 let set_checking_environment top =
   protect_execution top @@ fun () ->
-  Learnocaml_toplevel_worker_caller.set_checking_environment top.worker >>= fun _ ->
+    Learnocaml_toplevel_worker_caller.set_checking_environment top.worker
+    >>= fun _ ->
   Lwt.return ()
 
 let execute_phrase top ?timeout content =
@@ -362,7 +371,8 @@ let wrap_flusher_to_prevent_flood top name hook real =
     let total = !flooded + String.length s in
     if total >= top.flood_limit then begin
       let buf = Buffer.create top.flood_limit in
-      hook := (fun s -> try flooded := !flooded + String.length s ; Buffer.add_string buf s with _ -> ()) ;
+      hook := (fun s -> try flooded := !flooded + String.length s ;
+                            Buffer.add_string buf s with _ -> ()) ;
       flooded := total ;
       Lwt.async @@ fun () ->
       Lwt.catch
@@ -503,7 +513,8 @@ let create
     | None -> Lwt.return_unit
     | Some f -> f top in
   after_init top >>= fun () ->
-  Learnocaml_toplevel_worker_caller.set_after_init top.worker (fun _ -> after_init top);
+  Learnocaml_toplevel_worker_caller.set_after_init top.worker
+    (fun _ -> after_init top);
   Lwt.return top
 
 let print_string { output } = Learnocaml_toplevel_output.output_stdout output
diff --git a/src/toplevel/learnocaml_toplevel.mli b/src/toplevel/learnocaml_toplevel.mli
index bec61f239..53c60ef59 100644
--- a/src/toplevel/learnocaml_toplevel.mli
+++ b/src/toplevel/learnocaml_toplevel.mli
@@ -168,6 +168,10 @@ val scroll: t -> unit
     This is equivalent to pressing [Enter] when the toplevel is focused. *)
 val execute: t -> unit
 
+open Learnocaml_toplevel_output
+                    
+val execute_test: t -> string
+                    
 (** Go backward in the input's history.
     This is equivalent to pressing [Up] when the toplevel is focused. *)
 val go_backward: t -> unit
diff --git a/src/toplevel/learnocaml_toplevel_input.ml b/src/toplevel/learnocaml_toplevel_input.ml
index 40661988c..c97fe4118 100644
--- a/src/toplevel/learnocaml_toplevel_input.ml
+++ b/src/toplevel/learnocaml_toplevel_input.ml
@@ -51,7 +51,8 @@ let indent_ocaml_textarea textbox =
     else None in
   let f = match pos with
     | None -> (fun _ -> true)
-    | Some ((c1,line1,lo1,up1),(c2,line2,lo2,up2)) -> (fun l -> l>=(line1+1) && l<=(line2+1)) in
+    | Some ((c1,line1,lo1,up1),(c2,line2,lo2,up2)) ->
+       (fun l -> l>=(line1+1) && l<=(line2+1)) in
   let v = indent_caml (Js.to_string v) f in
   textbox##.value:=Js.string v;
   begin match pos with
@@ -110,8 +111,10 @@ let resize { textbox ; sizing ; on_resize } =
           if text##(charAt i) = Js.string "\n" then incr res
         done ;
         !res |> min max_lines |> max min_lines in
-      textbox##.style##.fontSize := (Js.string (string_of_int line_height ^ "px")) ;
-      textbox##.style##.height := Js.string (Printf.sprintf "%dpx" (line_height * lines))
+      textbox##.style##.fontSize :=
+        (Js.string (string_of_int line_height ^ "px")) ;
+      textbox##.style##.height :=
+        Js.string (Printf.sprintf "%dpx" (line_height * lines))
 
 let execute ({ history ; textbox ; execute } as input) =
   let code = Js.to_string textbox##.value in
@@ -176,11 +179,11 @@ let setup
     );
   textbox##.onfocus :=
     Dom_html.handler (fun _ ->
-        if not (input.disabled) then input.focused <- true ;
+        if not input.disabled then input.focused <- true ;
         Js._true);
   textbox##.onblur :=
     Dom_html.handler (fun _ ->
-        if not (input.disabled) then input.focused <- false ;
+        if not input.disabled then input.focused <- false ;
         Js._true);
   textbox##.onkeyup :=
     Dom_html.handler (fun _ -> resize input ; Js._true);
diff --git a/src/toplevel/learnocaml_toplevel_input.mli b/src/toplevel/learnocaml_toplevel_input.mli
index aaf82cf7b..ff8eaa643 100644
--- a/src/toplevel/learnocaml_toplevel_input.mli
+++ b/src/toplevel/learnocaml_toplevel_input.mli
@@ -60,7 +60,7 @@ val set : input -> string -> unit
 val get : input -> string
 
 (** Simulates a hit on the [Enter] key *)
-val execute : input -> unit
+val execute : input -> unit                       
 
 (** Simulates a hit on the [Up] key *)
 val go_backward : input -> unit
diff --git a/src/toplevel/learnocaml_toplevel_output.ml b/src/toplevel/learnocaml_toplevel_output.ml
index fc3a6bf35..c68086339 100644
--- a/src/toplevel/learnocaml_toplevel_output.ml
+++ b/src/toplevel/learnocaml_toplevel_output.ml
@@ -18,8 +18,10 @@
 type block =
   | Html of string * [ `Div ] Tyxml_js.Html5.elt
   | Std of (string * [ `Out | `Err ]) list ref * [ `Pre ] Tyxml_js.Html5.elt
-  | Code of string * pretty list ref * [ `Pre ] Tyxml_js.Html5.elt * Nstream.snapshot option
-  | Answer of string * pretty list ref * [ `Pre ] Tyxml_js.Html5.elt * Nstream.snapshot option
+  | Code of string * pretty list ref * [ `Pre ] Tyxml_js.Html5.elt *
+              Nstream.snapshot option
+  | Answer of string * pretty list ref * [ `Pre ] Tyxml_js.Html5.elt *
+                Nstream.snapshot option
   | Error of Toploop_results.error * [ `Pre ] Tyxml_js.Html5.elt
   | Warning of int * Toploop_results.warning * [ `Pre ] Tyxml_js.Html5.elt
   | Phrase of phrase * block list ref
@@ -112,7 +114,7 @@ let rec last_elt = function
   | Error (_, pre) :: _
   | Warning (_, _, pre) :: _ -> (pre :> [ `Div | `Pre ] Tyxml_js.Html5.elt)
   | Phrase (_, { contents }) :: rest ->
-      try last_elt contents with Not_found -> last_elt rest
+      (try last_elt contents with Not_found -> last_elt rest)
 
 let find_phrase output u =
   List.fold_left
@@ -130,16 +132,16 @@ let insert output ?phrase block elt =
       Js_utils.Manip.appendChild output.container elt ;
       scroll output
   | Some u ->
-      match find_phrase output u with
-      | Some l ->
+      (match find_phrase output u with
+       | Some l ->
           Js_utils.Manip.insertChildAfter output.container (last_elt !l) elt ;
           l := block :: !l ;
           scroll output
-      | None ->
+       | None ->
           output.blocks <- Phrase (u, ref [ block ]) :: output.blocks ;
           Js_utils.Manip.appendChild output.container hr ;
           Js_utils.Manip.appendChild output.container elt ;
-          scroll output
+          scroll output)
 
 let output_std ?phrase output (str, chan) =
   enforce_limit output ;
@@ -153,7 +155,8 @@ let output_std ?phrase output (str, chan) =
               let buf, pre =
                 ref [],
                 Tyxml_js.Html5.(pre ~a: [ a_class [ "toplevel-output" ] ]) [] in
-              Js_utils.Manip.insertChildAfter output.container (last_elt !l) pre ;
+              Js_utils.Manip.insertChildAfter
+                output.container (last_elt !l) pre ;
               l := Std (buf, pre) :: !l ;
               Js_utils.Manip.appendChild output.container pre ;
               buf, pre in
@@ -192,9 +195,9 @@ let output_code ?phrase output code =
     let blocks = match phrase with
       | None -> output.blocks
       | Some u ->
-          match find_phrase output u with
-          | None -> []
-          | Some l -> !l in
+          (match find_phrase output u with
+           | None -> []
+           | Some l -> !l) in
     match blocks with
     | Code (_, _, _, snapshot) :: _ -> snapshot
     | [] | _ -> None in
@@ -210,9 +213,9 @@ let output_answer ?phrase output answer =
     let blocks = match phrase with
       | None -> output.blocks
       | Some u ->
-          match find_phrase output u with
-          | None -> []
-          | Some l -> !l in
+          (match find_phrase output u with
+           | None -> []
+           | Some l -> !l) in
     match blocks with
     | Answer (_, _, _, snapshot) :: _ -> snapshot
     | [] | _ -> None in
@@ -258,7 +261,8 @@ let hilight_pretty cls pretty ?num locs lbl =
               let acc = if p < i then tok p i @ acc else acc in
               loop (not was_inside) was_last i i acc pos
             else
-              loop was_inside (last pos loc) p (i + 1) acc (next pos (String.get s i)) in
+              loop was_inside (last pos loc) p (i + 1) acc
+                (next pos (String.get s i)) in
           let toks, pos = loop false false 0 0 [] pos in
           hilight_one rest pos (toks @ acc) in
     fst (hilight_one pretty (1, 0) []) in
@@ -340,3 +344,15 @@ let oldify output =
 
 let format_ocaml_code code =
   pretty_html (fst (prettify_ocaml code))
+
+let get_blocks output=
+  let type_string = output.blocks in
+  let rec last_block liste = match liste with
+    |[]-> ""
+    (*|(Html (s,_)) :: suite-> s^"html"^(last_block suite)
+    |(Code (s,_,_,_)) :: suite-> s^"code"^(last_block suite)*)
+    |(Answer (s,_,_,_)) :: suite-> s^(last_block suite)
+    (*|(Warning (s,_,_))::suite -> string_of_int s*)
+    |(Phrase (_,s))::suite -> (last_block (!s))^(last_block suite)
+    |b::suite->(last_block suite) in
+  last_block type_string
diff --git a/src/toplevel/learnocaml_toplevel_output.mli b/src/toplevel/learnocaml_toplevel_output.mli
index dc07e2be3..2eb9a0238 100644
--- a/src/toplevel/learnocaml_toplevel_output.mli
+++ b/src/toplevel/learnocaml_toplevel_output.mli
@@ -14,7 +14,7 @@
  *
  * You should have received a copy of the GNU Affero General Public License
  * along with this program.  If not, see . *)
-
+type block
 (** Toplevel output console. *)
 
 (** A toplevel output console handle. *)
@@ -108,3 +108,5 @@ val output_warning : ?phrase: phrase -> output -> Toploop_results.warning -> uni
 
 (** Format OCaml code in the style of {!output_code}. *)
 val format_ocaml_code : string -> [> `Span | `PCDATA ] Tyxml_js.Html5.elt list
+
+val get_blocks : output -> string
diff --git a/src/toplevel/learnocaml_toplevel_worker_caller.ml b/src/toplevel/learnocaml_toplevel_worker_caller.ml
index 5d837c080..33cc74611 100644
--- a/src/toplevel/learnocaml_toplevel_worker_caller.ml
+++ b/src/toplevel/learnocaml_toplevel_worker_caller.ml
@@ -155,7 +155,8 @@ let ty_of_host_msg : type t. t host_msg -> t msg_ty = function
     [onmessage] by calling [Lwt.wakeup]. They should never end with
     an exception, unless canceled. When canceled, the worker is
     killed and a new one is spawned. *)
-let rec post : type a. t -> a host_msg -> a Toploop_results.toplevel_result Lwt.t =
+let rec post : type a. t -> a host_msg ->
+                    a Toploop_results.toplevel_result Lwt.t =
   fun worker msg ->
     let msg_id = worker.counter in
     let msg_ty = ty_of_host_msg msg in
@@ -179,7 +180,7 @@ and do_reset_worker () =
         (* GRGR: Peut-on 'cancel' directement le Lwt.u ? *)
         (fun _ (U (_, _, t)) -> Lwt.cancel t)
         worker.wakeners;
-      worker.worker <- Worker.create (worker.js_file);
+      worker.worker <- Worker.create worker.js_file;
       worker.fds <-
         IntMap.empty |>
         IntMap.add 0 (IntMap.find 0 worker.fds) |>
diff --git a/src/toplevel/learnocaml_toplevel_worker_main.ml b/src/toplevel/learnocaml_toplevel_worker_main.ml
index 138f084de..b5126dfd7 100644
--- a/src/toplevel/learnocaml_toplevel_worker_main.ml
+++ b/src/toplevel/learnocaml_toplevel_worker_main.ml
@@ -171,8 +171,10 @@ let handler : type a. a host_msg -> a return Lwt.t = function
       let ppf_code = map_option wrap_fd fd_code in
       let ppf_answer = make_answer_ppf fd_answer in
       if !debug then Js_utils.debug "Worker: -> Execute (%S)" code;
-      let result = Toploop_ext.execute ?ppf_code ~print_outcome ~ppf_answer code in
-      if !debug then Js_utils.debug "Worker: <- Execute (%B)" (is_success result);
+      let result =
+        Toploop_ext.execute ?ppf_code ~print_outcome ~ppf_answer code in
+      if !debug then
+        Js_utils.debug "Worker: <- Execute (%B)" (is_success result);
       iter_option close_fd fd_code;
       close_fd fd_answer;
       unwrap_result result
@@ -180,7 +182,8 @@ let handler : type a. a host_msg -> a return Lwt.t = function
       let ppf_answer = make_answer_ppf fd_answer in
       if !debug then
         Js_utils.debug "Worker: -> Use_string (%S)" code;
-      let result = Toploop_ext.use_string ?filename ~print_outcome ~ppf_answer code in
+      let result =
+        Toploop_ext.use_string ?filename ~print_outcome ~ppf_answer code in
       if !debug then
         Js_utils.debug "Worker: <- Use_string (%B)" (is_success result);
       close_fd fd_answer;
@@ -206,10 +209,13 @@ let handler : type a. a host_msg -> a return Lwt.t = function
       let ty =
         let ast =
           let arg =
-            Ast_helper.(Typ.constr (Location.mknoloc (Longident.Lident "string")) []) in
+            Ast_helper.(Typ.constr (Location.mknoloc
+                                      (Longident.Lident "string")) []) in
           let ret =
-            Ast_helper.(Typ.constr (Location.mknoloc (Longident.Lident "unit")) []) in
-          { Parsetree.ptyp_desc = Parsetree.Ptyp_arrow (Asttypes.Nolabel, arg, ret) ;
+            Ast_helper.(Typ.constr (Location.mknoloc
+                                      (Longident.Lident "unit")) []) in
+          { Parsetree.ptyp_desc = Parsetree.Ptyp_arrow
+                                    (Asttypes.Nolabel, arg, ret) ;
             ptyp_loc = Location.none ;
             ptyp_attributes = [] } in
         Typetexp.transl_type_scheme !Toploop.toplevel_env ast in
@@ -257,9 +263,13 @@ let () =
         Lwt.return_unit
   in
   let path = "/worker_cmis" in
+  let root =
+    OCamlRes.Res.merge
+      Embedded_cmis.root
+      Embedded_grading_cmis.root in
   Sys_js.mount ~path
     (fun ~prefix ~path ->
-       match OCamlRes.Res.find (OCamlRes.Path.of_string path) Embedded_cmis.root with
+       match OCamlRes.Res.find (OCamlRes.Path.of_string path) root with
        | cmi ->
            Js.Unsafe.set cmi (Js.string "t") 9 ; (* XXX hack *)
            Some cmi
diff --git a/src/toploop/toploop_ext.ml b/src/toploop/toploop_ext.ml
index dff3f690b..39f257a55 100644
--- a/src/toploop/toploop_ext.ml
+++ b/src/toploop/toploop_ext.ml
@@ -69,8 +69,8 @@ end
 let warnings = ref []
 
 let convert_loc loc =
-  let _file1,line1,col1 = Location.get_pos_info (loc.Location.loc_start) in
-  let _file2,line2,col2 = Location.get_pos_info (loc.Location.loc_end) in
+  let _file1,line1,col1 = Location.get_pos_info loc.Location.loc_start in
+  let _file2,line2,col2 = Location.get_pos_info loc.Location.loc_end in
   { loc_start = (line1, col1) ; loc_end = (line2, col2) }
 
 let () =
diff --git a/src/toploop/toploop_unix.ml b/src/toploop/toploop_unix.ml
index 711117a67..5a59a83fe 100644
--- a/src/toploop/toploop_unix.ml
+++ b/src/toploop/toploop_unix.ml
@@ -63,7 +63,8 @@ let flush_redirected_channel { read_fd ; append ; channel } =
     loop () in
   flush channel ; try loop () with _ -> ()
 
-let stop_channel_redirection ({ target_fd ; read_fd ; backup_fd } as redirection) =
+let stop_channel_redirection
+      ({ target_fd ; read_fd ; backup_fd } as redirection) =
   let fail () = invalid_arg "Toploop_unix.stop_channel_redirection" in
   match List.assq target_fd !redirections with
   | exception Not_found -> fail ()
diff --git a/src/utils/build.ocp b/src/utils/build.ocp
index cfb3a4b97..4957c038f 100644
--- a/src/utils/build.ocp
+++ b/src/utils/build.ocp
@@ -42,3 +42,16 @@ begin library "xor"
   ]
 end
 
+
+begin library "translate"
+  files = [
+    "translate.ml" ( comp = ppx_js ppx_ocplib_i18n )
+  ]
+  requires = [
+    "lwt"
+    "js_of_ocaml.ppx"
+    "ocplib_i18n"
+    "jsutils"
+    "learnocaml-app-common"
+  ]
+end
diff --git a/src/utils/js_utils.ml b/src/utils/js_utils.ml
index b5d560a92..218c84717 100644
--- a/src/utils/js_utils.ml
+++ b/src/utils/js_utils.ml
@@ -30,22 +30,26 @@ let js_error obj = Firebug.console##(error obj)
 
 let log fmt =
   Format.kfprintf
-    (fun s -> Firebug.console##(log (Js.string (Format.flush_str_formatter ()))))
+    (fun s -> Firebug.console##(log
+                                  (Js.string (Format.flush_str_formatter ()))))
     Format.str_formatter
     fmt
 let debug fmt =
   Format.kfprintf
-    (fun s -> Firebug.console##(debug (Js.string (Format.flush_str_formatter ()))))
+    (fun s -> Firebug.console##(debug
+                                  (Js.string (Format.flush_str_formatter ()))))
     Format.str_formatter
     fmt
 let warn fmt =
   Format.kfprintf
-    (fun s -> Firebug.console##(warn (Js.string (Format.flush_str_formatter ()))))
+    (fun s -> Firebug.console##(warn
+                                  (Js.string (Format.flush_str_formatter ()))))
     Format.str_formatter
     fmt
 let error fmt =
   Format.kfprintf
-    (fun s -> Firebug.console##(error (Js.string (Format.flush_str_formatter ()))))
+    (fun s -> Firebug.console##(error
+                                  (Js.string (Format.flush_str_formatter ()))))
     Format.str_formatter
     fmt
 
@@ -58,10 +62,10 @@ let get_lang () =
   match Js.Optdef. to_option (Dom_html.window##.navigator##.language) with
   | Some l -> Some (Js.to_string l)
   | None ->
-      match Js.Optdef.to_option (Dom_html.window##.navigator##.userLanguage)
-      with
-      | Some l -> Some (Js.to_string l)
-      | None -> None
+      (match Js.Optdef.to_option (Dom_html.window##.navigator##.userLanguage)
+       with
+       | Some l -> Some (Js.to_string l)
+       | None -> None)
 
 
 module Manip = struct
@@ -117,6 +121,10 @@ module Manip = struct
     let elt = get_elt "setInnerHtml" elt in
     elt##.innerHTML := Js.string s
 
+  let setTitle elt s =
+    let elt = get_elt "setTitle" elt in
+    elt##.title := Js.string s
+
   let addClass elt s =
     let elt = get_elt "addClass" elt in
     elt##.classList##(add (Js.string s))
@@ -137,7 +145,8 @@ module Manip = struct
       List.iter (fun elt2 -> ignore(node##(appendChild (get_node elt2)))) elts
     | Some elt3 ->
       let node3 = get_node elt3 in
-      List.iter (fun elt2 -> ignore(node##(insertBefore (get_node elt2) (Js.some node3)))) elts
+      List.iter (fun elt2 ->
+          ignore(node##(insertBefore (get_node elt2) (Js.some node3)))) elts
 
   let raw_insertChildAfter node1 node2 elt3 =
     Js.Opt.case
@@ -184,11 +193,13 @@ module Manip = struct
     Js.Opt.to_option res
 
   let by_id n =
-    let res = Js.Opt.bind (Dom_html.window##.document##(getElementById (Js.string n))) (fun node ->
-        Js.Opt.map (Dom.CoerceTo.element node) (fun node ->
-            Of_dom.of_element (Dom_html.element node)
-          )
-      ) in
+    let res = Js.Opt.bind
+                (Dom_html.window##.document##(getElementById (Js.string n)))
+                (fun node -> Js.Opt.map (Dom.CoerceTo.element node)
+                               (fun node -> Of_dom.of_element
+                                              (Dom_html.element node)
+                               )
+                ) in
     Js.Opt.to_option res
 
   let childLength elt =
@@ -402,9 +413,9 @@ module Manip = struct
       elt##.onscroll := (bool_cb f)
     let onreturn elt f =
       let f ev =
-	let key = ev##.keyCode in
-	if key = 13 then f ev;
-	true in
+        let key = ev##.keyCode in
+        if key = 13 then f ev;
+        true in
       onkeydown elt f
     let onchange elt f =
       let elt = get_elt_input "Ev.onchange" elt in
@@ -823,7 +834,8 @@ module Manip = struct
     let borderBottomWidth elt v =
       let elt = get_elt "SetCss.borderBottomWidth" elt in
       elt##.style##.borderBottomWidth := Js.bytestring v
-    let borderBottomWidthPx elt v = borderBottomWidth elt (Printf.sprintf "%dpx" v)
+    let borderBottomWidthPx elt v =
+      borderBottomWidth elt (Printf.sprintf "%dpx" v)
     let borderCollapse elt v =
       let elt = get_elt "SetCss.borderCollapse" elt in
       elt##.style##.borderCollapse := Js.bytestring v
@@ -855,7 +867,8 @@ module Manip = struct
     let borderRightWidth elt v =
       let elt = get_elt "SetCss.borderRightWidth" elt in
       elt##.style##.borderRightWidth := Js.bytestring v
-    let borderRightWidthPx elt v = borderRightWidth elt (Printf.sprintf "%dpx" v)
+    let borderRightWidthPx elt v =
+      borderRightWidth elt (Printf.sprintf "%dpx" v)
     let borderSpacing elt v =
       let elt = get_elt "SetCss.borderSpacing" elt in
       elt##.style##.borderSpacing := Js.bytestring v
@@ -1002,7 +1015,9 @@ module Manip = struct
     let minWidthPx elt v = minWidth elt (Printf.sprintf "%dpx" v)
     let opacity elt v =
       let elt = get_elt "SetCss.opacity" elt in
-      elt##.style##.opacity := match v with None -> Js.undefined | Some v -> Js.def (Js.bytestring v)
+      elt##.style##.opacity := match v with
+                               | None -> Js.undefined
+                               | Some v -> Js.def (Js.bytestring v)
     let outline elt v =
       let elt = get_elt "SetCss.outline" elt in
       elt##.style##.outline := Js.bytestring v
diff --git a/src/utils/js_utils.mli b/src/utils/js_utils.mli
index 613069378..914ca9298 100644
--- a/src/utils/js_utils.mli
+++ b/src/utils/js_utils.mli
@@ -43,6 +43,7 @@ module Manip : sig
   val window: 'a elt -> Dom_html.window Js.t
 
   val setInnerHtml: 'a elt -> string -> unit
+  val setTitle: 'a elt -> string -> unit
   val clone: ?deep:bool -> 'a elt -> 'a elt
 
   val appendChild: ?before:'a elt -> 'b elt ->  'c elt -> unit
diff --git a/src/utils/lwt_request.ml b/src/utils/lwt_request.ml
index b86f9b2b9..bca2e5f41 100644
--- a/src/utils/lwt_request.ml
+++ b/src/utils/lwt_request.ml
@@ -30,9 +30,9 @@ let get ?(headers=[]) ~url ~args =
   let url = match args with
     | [] -> url
     | _ -> url ^ "?" ^ (url_encode_list args) in
-  req##(_open (Js.string "GET") (Js.string url) (Js._true));
+  req##(_open (Js.string "GET") (Js.string url) Js._true);
   req##(setRequestHeader (Js.string "Content-type")
-			 (Js.string "application/x-www-form-urlencoded"));
+          (Js.string "application/x-www-form-urlencoded"));
   List.iter (fun (n, v) -> req##(setRequestHeader (Js.string n) (Js.string v)))
     headers;
   let callback () =
@@ -40,13 +40,13 @@ let get ?(headers=[]) ~url ~args =
     | 200 -> Lwt.wakeup w (Js.to_string req##.responseText)
     | 204 -> Lwt.wakeup w ""
     | code (* including 0 *) ->
-        Lwt.wakeup_exn w
-	        (Request_failed (code, Js.to_string req##.responseText)) in
+       Lwt.wakeup_exn w
+         (Request_failed (code, Js.to_string req##.responseText)) in
   req##.onreadystatechange := Js.wrap_callback
-      (fun _ -> (match req##.readyState with
-	     XmlHttpRequest.DONE -> callback ()
-	   | _ -> ()));
-  req##(send (Js.null));
+                                (fun _ -> (match req##.readyState with
+                                           | XmlHttpRequest.DONE -> callback ()
+                                           | _ -> ()));
+  req##(send Js.null);
   Lwt.on_cancel res (fun () -> req##abort);
   res
 
@@ -56,22 +56,22 @@ let post ?(headers=[]) ?(get_args=[]) ~url ~body =
   let url = match get_args with
     | [] -> url
     | _ -> url ^ "?" ^ (url_encode_list get_args) in
-  req##(_open (Js.string "POST") (Js.string url) (Js._true));
+  req##(_open (Js.string "POST") (Js.string url) Js._true);
   req##(setRequestHeader (Js.string "Content-type")
-			 (Js.string "application/x-www-form-urlencoded"));
+          (Js.string "application/x-www-form-urlencoded"));
   List.iter (fun (n, v) -> req##(setRequestHeader (Js.string n) (Js.string v)))
     headers;
   let callback () =
     match req##.status with
     | 200 -> Lwt.wakeup w (Js.to_string req##.responseText)
     | 204 -> Lwt.wakeup w ""
-    | code (* including 0 *) -> Lwt.wakeup_exn w
-	  (Request_failed (code, Js.to_string req##.responseText))
-  in
+    | code (* including 0 *) ->
+       Lwt.wakeup_exn w
+         (Request_failed (code, Js.to_string req##.responseText)) in
   req##.onreadystatechange := Js.wrap_callback
-      (fun _ -> (match req##.readyState with
-	     XmlHttpRequest.DONE -> callback ()
-	   | _ -> ()));
+                                (fun _ -> (match req##.readyState with
+                                           | XmlHttpRequest.DONE -> callback ()
+                                           | _ -> ()));
   let body = Js.Opt.map (Js.Opt.option body) Js.string in
   req##(send body);
   Lwt.on_cancel res (fun () -> req##abort);
diff --git a/src/utils/ppx_ocplib_i18n.ml b/src/utils/ppx_ocplib_i18n.ml
index a7d192c24..ef189f849 100644
--- a/src/utils/ppx_ocplib_i18n.ml
+++ b/src/utils/ppx_ocplib_i18n.ml
@@ -165,7 +165,8 @@ let transl_mapper _argv =
                get_lang_expr ~loc translations_expr
            | _ ->
                raise (Location.Error (
-                   Location.error ~loc "[%i] requires a constant string, e.g. [%i \"text\"]")))
+                   Location.error ~loc "[%i] requires a constant string, \
+                                        e.g. [%i \"text\"]")))
       | x -> default_mapper.expr mapper x;
   }
 
diff --git a/src/utils/translate.ml b/src/utils/translate.ml
new file mode 100644
index 000000000..91cae8a76
--- /dev/null
+++ b/src/utils/translate.ml
@@ -0,0 +1,21 @@
+open Js_utils
+open Learnocaml_common
+
+let set_lang () =
+  match Js.Optdef.to_option (Dom_html.window##.navigator##.language) with
+  | Some l -> Ocplib_i18n.set_lang (Js.to_string l)
+  | None ->
+     (match Js.Optdef.to_option (Dom_html.window##.navigator##.userLanguage) with
+      | Some l -> Ocplib_i18n.set_lang (Js.to_string l)
+      | None -> ())
+
+let set_string_translations translations =
+  List.iter
+    (fun (id, text) ->
+       Manip.setInnerHtml (find_component id) text)
+    translations
+
+let set_title_translations translations =
+  List.iter
+  (fun (id, text) -> Manip.setTitle (find_component id) text)
+  translations
diff --git a/src/utils/translate.mli b/src/utils/translate.mli
new file mode 100644
index 000000000..ef8af90d1
--- /dev/null
+++ b/src/utils/translate.mli
@@ -0,0 +1,13 @@
+(** Functions for the internationalization of the user interface *)
+
+(** Allow the translation of the strings in the ocaml file
+	written down as [%i"something"] *)
+val set_lang : unit -> unit
+
+(** Allow the translation of the strings in the html file
+    @param a list of ("the id of an html tag", [%i"something in this tag"]) *)
+val set_string_translations : (string * string) list -> unit
+
+(** Allow the translation of the strings in the html file
+    @param a list of ("the id of an html tag", [%i"something in this tag title"]) *)
+val set_title_translations : (string * string) list -> unit
diff --git a/src/utils/xor.ml b/src/utils/xor.ml
index 287cf0b42..d9e759895 100644
--- a/src/utils/xor.ml
+++ b/src/utils/xor.ml
@@ -45,7 +45,7 @@ let xor ?prefix str =
   let str' = Bytes.create (String.length str) in
   for i = 0 to String.length str - 1 do
     let c = Char.code xor_key.[i mod (String.length xor_key)] in
-    Bytes.set str' (i) (Char.chr (c lxor (Char.code (String.get str i))))
+    Bytes.set str' i (Char.chr (c lxor (Char.code (String.get str i))))
   done;
   Bytes.to_string str'
 
diff --git a/static/css/learnocaml_common.css b/static/css/learnocaml_common.css
index 8dd0bcf36..e35c0cf68 100644
--- a/static/css/learnocaml_common.css
+++ b/static/css/learnocaml_common.css
@@ -33,6 +33,16 @@ button[disabled] {
   cursor: not-allowed;
 }
 /* -------------------- buttons ----------------------------------- */
+#toolbar{
+	height : 30px;
+}
+#button_delete{
+	position: absolute;
+}
+#button_download{
+	position: absolute;
+	left: 45px;  
+}
 button::before,
 button::after {
   position: absolute;
@@ -69,8 +79,8 @@ button[disabled]::before {
 @font-face {
   /* A font by Jos Buivenga (exljbris) -> www.exljbris.com */
   font-family: "Fontin";
-  src: url("../fonts/Fontin-Regular.woff") format("woff"),
-       url("../fonts/Fontin-Regular.ttf") format("truetype");
+  src: url("../fonts/InconsolataGo-Regular.woff") format("woff"),
+       url("../fonts/InconsolataGo-Regular.ttf") format("truetype");
 }
 @font-face {
   /* A font by Jos Buivenga (exljbris) -> www.exljbris.com */
@@ -83,8 +93,8 @@ button[disabled]::before {
   /* A font by Jos Buivenga (exljbris) -> www.exljbris.com */
   font-family: "Fontin";
   font-weight: bold;
-  src: url("../fonts/Fontin-Bold.woff") format("woff"),
-       url("../fonts/Fontin-Bold.ttf") format("truetype");
+  src: url("../fonts/InconsolataGo-Bold.woff") format("woff"),
+       url("../fonts/InconsolataGo-Bold.ttf") format("truetype");
 }
 @font-face {
   font-family: "Inconsolata";
diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css
new file mode 100644
index 000000000..68ce51d7d
--- /dev/null
+++ b/static/css/learnocaml_editor.css
@@ -0,0 +1,1417 @@
+body {
+  margin: 0;
+  padding: 0;
+  background: #666;
+}
+
+#learnocaml-main-loading {
+    position: absolute;
+    top: 0px;
+    left: 0px;
+    right: 0px;
+    bottom: 0px;
+}
+#learnocaml-main-exercise-list > .patterns{
+	display :flex;
+	flex-direction: row;
+	position: relative;
+	z-index: 999;
+	background: linear-gradient(to top, #aaa 0px, #eee 10px, #ddd 100%);
+	color: black;
+	text-decoration: none;
+	height: 90px;
+}
+#learnocaml-main-exercise-list > .patterns > h1{
+	margin: 0 0 10px 0;
+	padding: 0;
+	font-size: 18px;
+	font-weight: bold;
+	left:10px; top:10px;
+	position:absolute;
+}
+
+#learnocaml-main-exercise-list > .patterns > .quality{
+	left:10px;
+	position: absolute;
+	width : 100%;
+}
+#learnocaml-main-exercise-list > .patterns > .quality > p{
+	left :40px;
+	top: 20px;
+	position: absolute;
+}
+#quality_box{
+	top: 34px;
+	position:absolute;
+}
+#learnocaml-main-exercise-list > .patterns > .imperative{
+	left:10px;
+	position: absolute;
+	width: 100%;
+	top: 20px;
+}
+#learnocaml-main-exercise-list > .patterns > .imperative > p{
+	left :40px;
+	top: 20px;
+	position: absolute;
+}
+#imperative_box{
+	top:34px;
+	position:absolute;
+}
+
+/* -------------------- toolbar ----------------------------------- */
+#learnocaml-exo-toolbar {
+  position: absolute;
+  left: 0; top: 0;
+  color: #fff;
+  z-index: 1004;
+  border-bottom: 1px #eee solid;
+  display: flex;
+  background: #222;
+}
+#learnocaml-exo-toolbar a {
+  text-decoration: none;
+  color: #fff;
+}
+#learnocaml-exo-toolbar > button {
+  border-left: 1px #eee solid !important;
+  padding: 0 10px 0 10px;
+  margin: 0;
+  background: none;
+  border: none;
+  flex: 0;
+  position: relative;
+  display: block;
+}
+#learnocaml-exo-toolbar > button > * {
+  padding: 5px;
+  color: #eee;
+  text-align: center;
+}
+#learnocaml-exo-toolbar > .special_grade{
+  background:#aaa;
+}
+#learnocaml-exo-toolbar::before {
+  z-index: 1004;
+  position: absolute;
+  left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to bottom, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+@media (max-width: 549px) {
+  #learnocaml-exo-toolbar {
+    height: 40px;
+  }
+  #learnocaml-exo-toolbar::before {
+    top: 41px;
+  }
+  #learnocaml-exo-toolbar > button > .label {
+    display: none;
+  }
+}
+@media (min-width: 550px) {
+  #learnocaml-exo-toolbar {
+    height: 60px;
+  }
+  #learnocaml-exo-toolbar::before {
+    top: 61px;
+  }
+}
+/* -------------------- tabs and tab buttons ---------------------- */
+#learnocaml-exo-tab-buttons {
+  position: absolute;
+  z-index: 999;
+  display: flex;
+  height: 40px;
+}
+#learnocaml-exo-tab-buttons > button {
+  flex: 1;
+  padding: 0;
+  border: none;
+  color: #333;
+  background: #eee;
+  position: relative;
+  z-index: 1000;
+}
+#learnocaml-exo-tab-buttons > button:not(:first-child) {
+  border-left: 1px #333 solid;
+}
+#learnocaml-exo-tab-buttons > button {
+  border-bottom: 1px #333 solid;
+}
+#learnocaml-exo-tab-buttons > button[disabled]::before {
+  display: none;
+}
+#learnocaml-exo-tab-buttons > button:not([disabled])::after {
+  position: absolute;
+  left:0; right:0; bottom:0; top:0;
+  content:"";
+  z-index: 1009;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0, transparent 5px);
+}
+#learnocaml-exo-tab-buttons > button[disabled]::after {
+  position: absolute;
+  left:0; right:0; bottom:0; top:0;
+  content:"";
+  z-index: 1009;
+  background: rgba(0,0,0,0.4);
+}
+#learnocaml-exo-tabs > * {
+  position: absolute;
+  z-index: 997;
+  background: #eee;
+  padding: 0;
+  opacity: 0;
+}
+#learnocaml-exo-tabs > *.front-tab {
+  z-index: 998;
+  opacity: 1;
+}
+/* -------------------- two columns mode -------------------------- */
+@media (min-width: 1200px) {
+  #learnocaml-exo-toolbar {
+    width: 800px;
+  }
+  #learnocaml-exo-tab-editor::after {
+    position: absolute;
+    left: 800px; top: -61px; bottom: 0; width: 10px;
+    background: linear-gradient(to right, #fff 0px, #fff 1px, rgba(0,0,0,0.6) 1px, rgba(0,0,0,0) 10px);
+    content:"";
+  }
+  #learnocaml-exo-button-editor {
+    display: none;
+  }
+  #learnocaml-exo-tab-buttons {
+    left: 800px; right: 0px; top: 0px;
+  }
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-toplevel {
+    border-bottom: none;
+    background: #bbb;
+  }
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-toplevel::after {
+    display: none;
+  }
+  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-toplevel {
+    z-index: 998;
+    opacity: 1;
+  }
+
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template {
+    border-bottom: none;
+    background: #bbb;
+  }
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template::after {
+    display: none;
+  }
+  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-template {
+    z-index: 998;
+    opacity: 1;
+  }
+
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test {
+    border-bottom: none;
+    background: #bbb;
+  }
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test::after {
+    display: none;
+  }
+  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-test {
+    z-index: 998;
+    opacity: 1;
+  }
+  
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-testhaut {
+    border-bottom: none;
+    background: #bbb;
+  }
+  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-testhaut::after {
+    display: none;
+  }
+  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-testhaut {
+    z-index: 998;
+    opacity: 1;
+  }
+
+  #learnocaml-exo-tabs > * {
+    left: 800px; top: 40px; right: 0px; bottom: 0px;
+  }
+  #learnocaml-exo-tabs > #learnocaml-exo-tab-editor {
+    width: 800px; left: 0; bottom: 0; top: 61px;
+    z-index: 1000;
+    opacity: 1;
+  }
+}
+/* -------------------- one column mode --------------------------- */
+@media (max-width: 1199px) {
+  #learnocaml-exo-toolbar {
+    right: 0px;
+  }
+  #learnocaml-exo-tab-buttons {
+    left: 0; right: 0px;
+  }
+  #learnocaml-exo-tabs > * {
+    position: absolute;
+    left: 0; right: 0px; bottom: 0px;
+  }
+  #learnocaml-exo-tab-editor > .pane {
+    margin-top: 5px;
+  }
+  #learnocaml-exo-tab-editor::after {
+    position: absolute;
+    z-index: 1005;
+    left: 0; top: 0; height: 10px; width: 100%;
+    content: "";
+    background: linear-gradient(to bottom, #444 0, #444 5px,
+      rgba(0,0,0,0.5) 5px, transparent 10px) ;
+  }
+}
+@media (min-width: 550px) and (max-width: 1199px) {
+  #learnocaml-exo-tab-buttons {
+    top: 60px;
+  }
+  #learnocaml-exo-tabs > * {
+    top: 100px;
+  }
+}
+@media (max-width: 549px) {
+  #learnocaml-exo-tab-buttons {
+    top: 40px;
+  }
+  #learnocaml-exo-tabs > * {
+    top: 80px;
+  }
+}
+/* -------------------- editor tab -------------------------------- */
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-editor {
+  background: #eee;
+  color: black;
+}
+#learnocaml-exo-tab-editor > .pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+#learnocaml-exo-tab-editor > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-editor > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-editor > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-editor > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-editor > .buttons > button > .label {
+    display: none;
+  }
+}
+/*--------------------- template ---------------------------------- */
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-template {
+  background: #eee;
+  color: black;
+}
+#learnocaml-exo-tab-template > .template-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+#learnocaml-exo-tab-template > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-template > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-template > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-template > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-template > .buttons > button > .label {
+    display: none;
+  }
+}
+
+/*--------------------- prepare ---------------------------------- */
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prepare {
+  background: #eee;
+  color: black;
+}
+#learnocaml-exo-tab-prepare > .prepare-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+#learnocaml-exo-tab-prepare > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-prepare > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-prepare > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-prepare > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-prepare > .buttons > button > .label {
+    display: none;
+  }
+}
+
+/*--------------------- prelude ---------------------------------- */
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prelude {
+  background: #eee;
+  color: black;
+}
+#learnocaml-exo-tab-prelude > .prelude-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+#learnocaml-exo-tab-prelude > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-prelude > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-prelude > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-prelude > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-prelude > .buttons > button > .label {
+    display: none;
+  }
+}
+
+
+/* -------------------- toplevel tab ------------------------------ */
+#learnocaml-exo-tab-toplevel > .toplevel-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  z-index: 1002;
+  margin: 5px 0 0 0;
+}
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-toplevel {
+  background: #eee;
+}
+#learnocaml-exo-tab-toplevel {
+  background: #bbb;
+}
+#learnocaml-exo-tab-toplevel > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #fff 0px, #ddd 10px, #aaa 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-toplevel > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #222;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.2);
+  border-top: 1px #666 solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-toplevel > .buttons > button:not(:first-child) {
+  border-left: 1px #666 solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-toplevel > .buttons > button > .label {
+    display: none;
+  }
+}
+#learnocaml-exo-toplevel-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  z-index: 1002;
+  display: flex;
+  flex-direction: column;
+  margin: 5px 0 0 0;
+}
+#learnocaml-exo-tab-toplevel::after {
+  position: absolute;
+  z-index: 1005;
+  left: 0; top: 5px; height: 10px; width: 100%;
+  content: "";
+  background: linear-gradient(to bottom, rgba(0,0,0,0.5) 0, transparent 5px) ;
+}
+
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-test {
+  background: #eee;
+  color: black;
+}
+#learnocaml-exo-tab-test > .test-pane {
+  position: absolute;
+  left: 0; top: 0; bottom: 40px; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+
+
+#learnocaml-exo-tab-test > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-test > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-test > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-test > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-test > .buttons > button > .label {
+    display: none;
+  }
+}
+
+/* testhaut */
+
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-testhaut {
+  background: #eee;
+  color: black;
+}
+
+
+#learnocaml-exo-tab-testhaut > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-testhaut > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-testhaut > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-testhaut > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-testhaut > .buttons > button > .label {
+    display: none;
+  }
+}
+/* end testhaut */
+
+/* question tab */
+
+
+#learnocaml-exo-question-html > iframe {
+  border: none;
+  overflow: auto;
+  flex: 1 3 auto ;
+}
+#learnocaml-exo-tab-question > .questions-mark {
+  position: absolute;
+  left: 0; top: 0; bottom: 50%; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+
+#learnocaml-exo-tab-question > .questions-html {
+  position: absolute;
+  left: 0; top: 50%; bottom: 0px; width: 100%;
+  background: white;
+  color: #fff;
+  z-index: 1002;
+}
+
+#learnocaml-exo-tab-question > .questions-html > * {
+  position: absolute;
+  left: 0; top: 0; bottom: 0px; width: 100%; height: 100%;
+}
+
+
+#learnocaml-exo-tab-question > .buttons {
+  position: absolute;
+  left: 0; bottom: 0px; width: 100%; height: 40px;
+  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
+  color: #fff;
+  line-height: 40px;
+  display: flex;
+  flex-direction: row;
+  z-index: 1003;
+}
+#learnocaml-exo-tab-question > .buttons::after {
+  position: absolute;
+  bottom: 40px; left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+#learnocaml-exo-tab-question > .buttons > button {
+  flex: 1;
+  background: none;
+  border: none;
+  color: #eee;
+  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
+  border-top: 1px #eee solid;
+  position: relative;
+  padding: 0;
+}
+#learnocaml-exo-tab-question > .buttons > button:not(:first-child) {
+  border-left: 1px #eee solid;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-tab-question > .buttons > button > .label {
+    display: none;
+  }
+}
+
+/* -------------------- report tab -------------------------------- */
+#learnocaml-exo-tab-report {
+  border: none;
+  overflow: hidden;
+}
+#learnocaml-exo-button-report > .score {
+  padding: 0 5px;
+  float: right;
+}
+#learnocaml-exo-tab-report > iframe {
+  border: none;
+  overflow: auto;
+  width: 100%;
+  height: 100%;
+}
+@media (max-width: 550px) {
+  #learnocaml-exo-button-report > .score {
+    position: absolute;
+    right: 0; left: 0; top: 0; bottom: 0;
+    display: block;
+    line-height: 40px;
+    background: inherit;
+  }
+}
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-report.success {
+  background: #0a0;
+  color: white;
+}
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-report.failure {
+  background: #b00;
+  color: white;
+}
+#learnocaml-exo-tab-buttons > #learnocaml-exo-button-report.partial {
+  background: #e80;
+  color: white;
+}
+/* -------------------- text tab ---------------------------------- */
+#learnocaml-exo-tab-text {
+  display: flex;
+  flex-direction: column;
+  overflow: hidden;
+}
+#learnocaml-exo-tab-text > h1 {
+  flex: 0 0 auto;
+  background: #222;
+  color: #eee;
+  font-size: 20px;
+  line-height: 22px;
+  margin: 0;
+  padding: 10px;
+  display: block;
+  font-weight: normal;
+  position: relative;
+}
+#learnocaml-exo-tab-text > h1:first-child {
+  margin-top: 5px;
+}
+#learnocaml-exo-tab-text > h1 > button {
+  float: right;
+  border: none;
+  border-left: 1px #eee solid;
+  color: #eee;
+  background: none;
+  margin: -10px;
+  padding: 10px;
+  font-size: 20px;
+  line-height: 22px;
+}
+#learnocaml-exo-tab-text > iframe {
+  border: none;
+  overflow: auto;
+  flex: 1 3 auto ;
+}
+#learnocaml-exo-tab-text > pre.toplevel-code {
+  flex: 0 1 auto;
+  max-height: 45%;
+  background: #666;
+  margin: 0;
+  padding: 5px 10px 5px 5px;
+  overflow: auto;
+}
+#learnocaml-exo-tab-text > h1::after {
+  position: absolute;
+  left: 0px; bottom: -5px; width: 100%;
+  content:"";
+  height:5px; background: pink;
+  background: linear-gradient(to bottom, rgba(0,0,0,0.3) 0, transparent 100%)
+}
+
+/* -------------------- loading splash screen --------------------- */
+#learnocaml-exo-loading {
+  position: absolute;
+  top: 0; left: 0; right: 0; bottom: 0;
+}
+#learnocaml-exo-loading.loading,
+#learnocaml-exo-loading.loaded {
+  background: rgba(200,200,200,0.9);
+}
+#learnocaml-exo-loading > iframe {
+  border: none;
+  overflow: auto;	
+  flex: 1 3 auto;
+}
+
+#learnocaml-loading {
+  position: absolute;
+  top: 0; left: 0; right: 0; bottom: 0;
+}
+#learnocaml-loading.loading,
+#learnocaml-loading.loaded {
+  background: rgba(200,200,200,0.9);
+}
+#learnocaml-loading > iframe {
+  border: none;
+  overflow: auto;	
+  flex: 1 3 auto;
+}
+/* -------------------- ACE overriding ---------------------------- */
+#learnocaml-exo-editor-pane {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-editor-pane .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-editor-pane .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-editor-pane .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-editor-pane .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-editor-pane .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-editor-pane .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-editor-pane .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-editor-pane .ace_constant { color: #acf; }
+#learnocaml-exo-editor-pane .ace_string { color: #acf; }
+#learnocaml-exo-editor-pane .ace_function { color: #fff; }
+#learnocaml-exo-editor-pane .ace_type { color: #fff; }
+#learnocaml-exo-editor-pane .ace_operator { color: #fff; }
+#learnocaml-exo-editor-pane .ace_meta { color: #fff; }
+#learnocaml-exo-editor-pane .ace_variable { color: #fff; }
+#learnocaml-exo-editor-pane .ace_text { color: #fff; }
+#learnocaml-exo-editor-pane .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-editor-pane .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-editor-pane .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-editor-pane .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-editor-pane .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-editor-pane.ocaml-check-success::after,
+#learnocaml-exo-editor-pane.ocaml-check-warn::after,
+#learnocaml-exo-editor-pane.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-editor-pane.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-editor-pane.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-editor-pane.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+
+#learnocaml-exo-test-pane {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-test-pane .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-test-pane .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-test-pane .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-test-pane .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-test-pane .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-test-pane .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-test-pane .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-test-pane .ace_constant { color: #acf; }
+#learnocaml-exo-test-pane .ace_string { color: #acf; }
+#learnocaml-exo-test-pane .ace_function { color: #fff; }
+#learnocaml-exo-test-pane .ace_type { color: #fff; }
+#learnocaml-exo-test-pane .ace_operator { color: #fff; }
+#learnocaml-exo-test-pane .ace_meta { color: #fff; }
+#learnocaml-exo-test-pane .ace_variable { color: #fff; }
+#learnocaml-exo-test-pane .ace_text { color: #fff; }
+#learnocaml-exo-test-pane .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-test-pane .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-test-pane .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-test-pane .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-test-pane .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-test-pane.ocaml-check-success::after,
+#learnocaml-exo-test-pane.ocaml-check-warn::after,
+#learnocaml-exo-test-pane.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-test-pane.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-test-pane.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-test-pane.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+
+/* testhaut */
+
+#learnocaml-exo-testhaut-edit {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#toolbar{
+	height: 30px;
+}
+#button_delete{
+	position: absolute;
+}
+#up{
+	position: absolute;
+	left: 45px;  
+}
+#down{
+	position: absolute;
+	left: 90px;
+}
+#duplicate{
+	position: absolute;
+	left: 135px;
+}
+#learnocaml-exo-tab-testhaut > .testhaut-edit {
+  position: absolute;
+  left: 0; top: 0; bottom: 64%; width: 100%;
+  background: #666;
+  color: #fff;
+  z-index: 1002;
+}
+
+#learnocaml-exo-tab-testhaut > .testhaut-pane {
+  position: absolute;
+  left: 0; top: 33%; bottom: 40px; width: 100%;
+  background: #eee;
+  color: #fff;
+  z-index: 1002;
+	overflow-y: auto
+}
+#learnocaml-exo-testhaut-edit .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-testhaut-edit .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-testhaut-edit .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-testhaut-edit .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-testhaut-edit .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-testhaut-edit .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-testhaut-edit .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-testhaut-edit .ace_constant { color: #acf; }
+#learnocaml-exo-testhaut-edit .ace_string { color: #acf; }
+#learnocaml-exo-testhaut-edit .ace_function { color: #fff; }
+#learnocaml-exo-testhaut-edit .ace_type { color: #fff; }
+#learnocaml-exo-testhaut-edit .ace_operator { color: #fff; }
+#learnocaml-exo-testhaut-edit .ace_meta { color: #fff; }
+#learnocaml-exo-testhaut-edit .ace_variable { color: #fff; }
+#learnocaml-exo-testhaut-edit .ace_text { color: #fff; }
+#learnocaml-exo-testhaut-edit .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-testhaut-edit .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-testhaut-edit .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-testhaut-edit .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-testhaut-edit .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-testhaut-edit.ocaml-check-success::after,
+#learnocaml-exo-testhaut-edit.ocaml-check-warn::after,
+#learnocaml-exo-testhaut-edit.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-testhaut-edit.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-testhaut-edit.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-testhaut-edit.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+/* end testhaut */
+
+
+/* question mark */
+
+#learnocaml-exo-question-mark {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-question-mark .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-question-mark .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-question-mark .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-question-mark .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-question-mark .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-question-mark .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-question-mark .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-question-mark .ace_constant { color: #acf; }
+#learnocaml-exo-question-mark .ace_string { color: #acf; }
+#learnocaml-exo-question-mark .ace_function { color: #fff; }
+#learnocaml-exo-question-mark .ace_type { color: #fff; }
+#learnocaml-exo-question-mark .ace_operator { color: #fff; }
+#learnocaml-exo-question-mark .ace_meta { color: #fff; }
+#learnocaml-exo-question-mark .ace_variable { color: #fff; }
+#learnocaml-exo-question-mark .ace_text { color: #fff; }
+#learnocaml-exo-question-mark .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-question-mark .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-question-mark .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-question-mark .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-question-mark .ace_selected-word { background: #e80; opacity: 0.2; }
+
+/* question html */
+
+#learnocaml-exo-question-html {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-question-html .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-question-html .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-question-html .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-question-html .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-question-html .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-question-html .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-question-html .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-question-html .ace_constant { color: #acf; }
+#learnocaml-exo-question-html .ace_string { color: #acf; }
+#learnocaml-exo-question-html .ace_function { color: #fff; }
+#learnocaml-exo-question-html .ace_type { color: #fff; }
+#learnocaml-exo-question-html .ace_operator { color: #fff; }
+#learnocaml-exo-question-html .ace_meta { color: #fff; }
+#learnocaml-exo-question-html .ace_variable { color: #fff; }
+#learnocaml-exo-question-html .ace_text { color: #fff; }
+#learnocaml-exo-question-html .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-question-html .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-question-html .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-question-html .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-question-html .ace_selected-word { background: #e80; opacity: 0.2; }
+
+
+/* template */
+#learnocaml-exo-template-pane {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-template-pane .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-template-pane .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-template-pane .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-template-pane .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-template-pane .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-template-pane .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-template-pane .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-template-pane .ace_constant { color: #acf; }
+#learnocaml-exo-template-pane .ace_string { color: #acf; }
+#learnocaml-exo-template-pane .ace_function { color: #fff; }
+#learnocaml-exo-template-pane .ace_type { color: #fff; }
+#learnocaml-exo-template-pane .ace_operator { color: #fff; }
+#learnocaml-exo-template-pane .ace_meta { color: #fff; }
+#learnocaml-exo-template-pane .ace_variable { color: #fff; }
+#learnocaml-exo-template-pane .ace_text { color: #fff; }
+#learnocaml-exo-template-pane .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-template-pane .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-template-pane .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-template-pane .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-template-pane .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-template-pane.ocaml-check-success::after,
+#learnocaml-exo-template-pane.ocaml-check-warn::after,
+#learnocaml-exo-template-pane.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-template-pane.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-template-pane.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-template-pane.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+
+/* prepare */
+
+#learnocaml-exo-prepare-pane {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-prepare-pane .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-prepare-pane .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-prepare-pane .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-prepare-pane .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-prepare-pane .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-prepare-pane .ace_constant { color: #acf; }
+#learnocaml-exo-prepare-pane .ace_string { color: #acf; }
+#learnocaml-exo-prepare-pane .ace_function { color: #fff; }
+#learnocaml-exo-prepare-pane .ace_type { color: #fff; }
+#learnocaml-exo-prepare-pane .ace_operator { color: #fff; }
+#learnocaml-exo-prepare-pane .ace_meta { color: #fff; }
+#learnocaml-exo-prepare-pane .ace_variable { color: #fff; }
+#learnocaml-exo-prepare-pane .ace_text { color: #fff; }
+#learnocaml-exo-prepare-pane .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-prepare-pane .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-prepare-pane .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-prepare-pane .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-prepare-pane .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-prepare-pane.ocaml-check-success::after,
+#learnocaml-exo-prepare-pane.ocaml-check-warn::after,
+#learnocaml-exo-prepare-pane.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-prepare-pane.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-prepare-pane.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-prepare-pane.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+
+/* prelude */
+
+#learnocaml-exo-prelude-pane {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-exo-prelude-pane .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-exo-prelude-pane .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-exo-prelude-pane .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-exo-prelude-pane .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-exo-prelude-pane .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-exo-prelude-pane .ace_constant { color: #acf; }
+#learnocaml-exo-prelude-pane .ace_string { color: #acf; }
+#learnocaml-exo-prelude-pane .ace_function { color: #fff; }
+#learnocaml-exo-prelude-pane .ace_type { color: #fff; }
+#learnocaml-exo-prelude-pane .ace_operator { color: #fff; }
+#learnocaml-exo-prelude-pane .ace_meta { color: #fff; }
+#learnocaml-exo-prelude-pane .ace_variable { color: #fff; }
+#learnocaml-exo-prelude-pane .ace_text { color: #fff; }
+#learnocaml-exo-prelude-pane .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-prelude-pane .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-exo-prelude-pane .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-exo-prelude-pane .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-exo-prelude-pane .ace_selected-word { background: #e80; opacity: 0.2; }
+
+#learnocaml-exo-prelude-pane.ocaml-check-success::after,
+#learnocaml-exo-prelude-pane.ocaml-check-warn::after,
+#learnocaml-exo-prelude-pane.ocaml-check-error::after {
+  animation: 1s check_status_animation;
+  animation-fill-mode: forwards;
+  position: absolute;
+  margin: -100px 0 0 0;
+  top: 50%;
+  text-align: center;
+  font-size: 200px;
+  line-height: 200px;
+  width: 100%;
+}
+
+#learnocaml-exo-prelude-pane.ocaml-check-success::after {
+  content: "✌";
+  color: #0a0;
+  text-shadow: 0px 0px 40px #6F6;
+}
+
+#learnocaml-exo-prelude-pane.ocaml-check-warn::after {
+  content: "✋";
+  color: #ec0;
+  text-shadow: 0px 0px 40px #Fe6;
+}
+
+#learnocaml-exo-prelude-pane.ocaml-check-error::after {
+  content: "☠";
+  color: #b00;
+  text-shadow: 0px 0px 40px #F66;
+}
+
+@keyframes check_status_animation {
+  0%   { opacity: 0; z-index: 9999; }
+  49%  { opacity: 1; transform: scale(2); z-index: 9999; }
+  99%  { opacity: 0; transform: scale(2); z-index: 9999; }
+  100% { opacity: 0; z-index: -9999; }
+}
+
+@-webkit-keyframes check_status_animation {
+  0%   { opacity: 0; z-index: 9999; }
+  49%  { opacity: 1; transform: scale(2); z-index: 9999; }
+  99%  { opacity: 0; transform: scale(2); z-index: 9999; }
+  100% { opacity: 0; z-index: -9999; }
+}
diff --git a/static/css/learnocaml_exercise.css b/static/css/learnocaml_exercise.css
index 34a41d80e..80aaaba16 100644
--- a/static/css/learnocaml_exercise.css
+++ b/static/css/learnocaml_exercise.css
@@ -3,6 +3,15 @@ body {
   padding: 0;
   background: #666;
 }
+
+#learnocaml-main-loading {
+    position: absolute;
+    top: 0px;
+    left: 0px;
+    right: 0px;
+    bottom: 0px;
+}
+
 /* -------------------- toolbar ----------------------------------- */
 #learnocaml-exo-toolbar {
   position: absolute;
@@ -77,7 +86,7 @@ body {
 #learnocaml-exo-tab-buttons > button:not(:first-child) {
   border-left: 1px #333 solid;
 }
-#learnocaml-exo-tab-buttons > button:not([disabled]) {
+#learnocaml-exo-tab-buttons > button {
   border-bottom: 1px #333 solid;
 }
 #learnocaml-exo-tab-buttons > button[disabled]::before {
@@ -90,6 +99,13 @@ body {
   z-index: 1009;
   background: linear-gradient(to top, rgba(0,0,0,0.4) 0, transparent 5px);
 }
+#learnocaml-exo-tab-buttons > button[disabled]::after {
+	position: absolute;
+  left:0; right:0; bottom:0; top:0;
+  content:"";
+  z-index: 1009;
+  background: rgba(0,0,0,0.4);
+}
 #learnocaml-exo-tabs > * {
   position: absolute;
   z-index: 997;
@@ -129,37 +145,6 @@ body {
     z-index: 998;
     opacity: 1;
   }
-
-/* petit changement  */
-  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template {
-    border-bottom: none;
-    background: #bbb;
-  }
-  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-template::after {
-    display: none;
-  }
-  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-template {
-    z-index: 998;
-    opacity: 1;
-  }
-
-
-
-  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test {
-    border-bottom: none;
-    background: #bbb;
-  }
-  #learnocaml-exo-button-editor.front-tab ~ #learnocaml-exo-button-test::after {
-    display: none;
-  }
-  #learnocaml-exo-tab-editor.front-tab ~ #learnocaml-exo-tab-test {
-    z-index: 998;
-    opacity: 1;
-  }
-
-/* fin changement  */
-
-
   #learnocaml-exo-tabs > * {
     left: 800px; top: 40px; right: 0px; bottom: 0px;
   }
@@ -211,8 +196,8 @@ body {
 }
 /* -------------------- editor tab -------------------------------- */
 #learnocaml-exo-tab-buttons > #learnocaml-exo-button-editor {
-  background: #444;
-  color: white;
+  background: #eee;
+  color: black;
 }
 #learnocaml-exo-tab-editor > .pane {
   position: absolute;
@@ -255,147 +240,6 @@ body {
     display: none;
   }
 }
-/*--------------------- template ---------------------------------- */
-#learnocaml-exo-tab-buttons > #learnocaml-exo-button-template {
-  background: #444;
-  color: white;
-}
-#learnocaml-exo-tab-template > .template-pane {
-  position: absolute;
-  left: 0; top: 0; bottom: 40px; width: 100%;
-  background: #666;
-  color: #fff;
-  z-index: 1002;
-}
-#learnocaml-exo-tab-template > .buttons {
-  position: absolute;
-  left: 0; bottom: 0px; width: 100%; height: 40px;
-  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
-  color: #fff;
-  line-height: 40px;
-  display: flex;
-  flex-direction: row;
-  z-index: 1003;
-}
-#learnocaml-exo-tab-template > .buttons::after {
-  position: absolute;
-  bottom: 40px; left: 0px; height: 5px; width: 100%;
-  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
-  content:"";
-}
-#learnocaml-exo-tab-template > .buttons > button {
-  flex: 1;
-  background: none;
-  border: none;
-  color: #eee;
-  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
-  border-top: 1px #eee solid;
-  position: relative;
-  padding: 0;
-}
-#learnocaml-exo-tab-template > .buttons > button:not(:first-child) {
-  border-left: 1px #eee solid;
-}
-@media (max-width: 550px) {
-  #learnocaml-exo-tab-template > .buttons > button > .label {
-    display: none;
-  }
-}
-
-/*--------------------- prepare ---------------------------------- */
-#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prepare {
-  background: #444;
-  color: white;
-}
-#learnocaml-exo-tab-prepare > .prepare-pane {
-  position: absolute;
-  left: 0; top: 0; bottom: 40px; width: 100%;
-  background: #666;
-  color: #fff;
-  z-index: 1002;
-}
-#learnocaml-exo-tab-prepare > .buttons {
-  position: absolute;
-  left: 0; bottom: 0px; width: 100%; height: 40px;
-  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
-  color: #fff;
-  line-height: 40px;
-  display: flex;
-  flex-direction: row;
-  z-index: 1003;
-}
-#learnocaml-exo-tab-prepare > .buttons::after {
-  position: absolute;
-  bottom: 40px; left: 0px; height: 5px; width: 100%;
-  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
-  content:"";
-}
-#learnocaml-exo-tab-prepare > .buttons > button {
-  flex: 1;
-  background: none;
-  border: none;
-  color: #eee;
-  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
-  border-top: 1px #eee solid;
-  position: relative;
-  padding: 0;
-}
-#learnocaml-exo-tab-prepare > .buttons > button:not(:first-child) {
-  border-left: 1px #eee solid;
-}
-@media (max-width: 550px) {
-  #learnocaml-exo-tab-prepare > .buttons > button > .label {
-    display: none;
-  }
-}
-
-/*--------------------- prelude ---------------------------------- */
-#learnocaml-exo-tab-buttons > #learnocaml-exo-button-prelude {
-  background: #444;
-  color: white;
-}
-#learnocaml-exo-tab-prelude > .prelude-pane {
-  position: absolute;
-  left: 0; top: 0; bottom: 40px; width: 100%;
-  background: #666;
-  color: #fff;
-  z-index: 1002;
-}
-#learnocaml-exo-tab-prelude > .buttons {
-  position: absolute;
-  left: 0; bottom: 0px; width: 100%; height: 40px;
-  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
-  color: #fff;
-  line-height: 40px;
-  display: flex;
-  flex-direction: row;
-  z-index: 1003;
-}
-#learnocaml-exo-tab-prelude > .buttons::after {
-  position: absolute;
-  bottom: 40px; left: 0px; height: 5px; width: 100%;
-  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
-  content:"";
-}
-#learnocaml-exo-tab-prelude > .buttons > button {
-  flex: 1;
-  background: none;
-  border: none;
-  color: #eee;
-  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
-  border-top: 1px #eee solid;
-  position: relative;
-  padding: 0;
-}
-#learnocaml-exo-tab-prelude > .buttons > button:not(:first-child) {
-  border-left: 1px #eee solid;
-}
-@media (max-width: 550px) {
-  #learnocaml-exo-tab-prelude > .buttons > button > .label {
-    display: none;
-  }
-}
-
 
 /* -------------------- toplevel tab ------------------------------ */
 #learnocaml-exo-tab-toplevel > .toplevel-pane {
@@ -405,7 +249,7 @@ body {
   margin: 5px 0 0 0;
 }
 #learnocaml-exo-tab-buttons > #learnocaml-exo-button-toplevel {
-  background: #bbb;
+  background: #eee;
 }
 #learnocaml-exo-tab-toplevel {
   background: #bbb;
@@ -454,59 +298,6 @@ body {
   background: linear-gradient(to bottom, rgba(0,0,0,0.5) 0, transparent 5px) ;
 }
 
-
-/* attention changement  */
-
-#learnocaml-exo-tab-buttons > #learnocaml-exo-button-test {
-  background: #444;
-  color: white;
-}
-#learnocaml-exo-tab-test > .test-pane {
-  position: absolute;
-  left: 0; top: 0; bottom: 40px; width: 100%;
-  background: #666;
-  color: #fff;
-  z-index: 1002;
-}
-#learnocaml-exo-tab-test > .buttons {
-  position: absolute;
-  left: 0; bottom: 0px; width: 100%; height: 40px;
-  background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px);
-  color: #fff;
-  line-height: 40px;
-  display: flex;
-  flex-direction: row;
-  z-index: 1003;
-}
-#learnocaml-exo-tab-test > .buttons::after {
-  position: absolute;
-  bottom: 40px; left: 0px; height: 5px; width: 100%;
-  background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
-  content:"";
-}
-#learnocaml-exo-tab-test > .buttons > button {
-  flex: 1;
-  background: none;
-  border: none;
-  color: #eee;
-  text-shadow: 2px 2px 5px rgba(0,0,0,0.4);
-  border-top: 1px #eee solid;
-  position: relative;
-  padding: 0;
-}
-#learnocaml-exo-tab-test > .buttons > button:not(:first-child) {
-  border-left: 1px #eee solid;
-}
-@media (max-width: 550px) {
-  #learnocaml-exo-tab-test > .buttons > button > .label {
-    display: none;
-  }
-}
-
-/* fin du changement  */
-
-
-
 /* -------------------- report tab -------------------------------- */
 #learnocaml-exo-tab-report {
   border: none;
@@ -683,322 +474,6 @@ body {
   text-shadow: 0px 0px 40px #F66;
 }
 
-
-/* petit changement  */
-
-#learnocaml-exo-test-pane {
-  font-size: 18px;
-  font-family: 'Inconsolata', monospace;
-}
-#learnocaml-exo-test-pane .ace_gutter {
-  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
-  color: #ccc;
-}
-#learnocaml-exo-test-pane .ace_gutter-active-line {
-  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
-  color: #888;
-}
-#learnocaml-exo-test-pane .ace_gutter-cell {
-  padding: 0 14px 0 0;
-}
-#learnocaml-exo-test-pane .ace_gutter-cell.ace_warning {
-  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
-}
-#learnocaml-exo-test-pane .ace_gutter-cell.ace_error {
-  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
-}
-#learnocaml-exo-test-pane .ace_comment { color: #aaa; font-style: italic; }
-#learnocaml-exo-test-pane .ace_keyword { color: #e80; font-weight:bold; }
-#learnocaml-exo-test-pane .ace_constant { color: #acf; }
-#learnocaml-exo-test-pane .ace_string { color: #acf; }
-#learnocaml-exo-test-pane .ace_function { color: #fff; }
-#learnocaml-exo-test-pane .ace_type { color: #fff; }
-#learnocaml-exo-test-pane .ace_operator { color: #fff; }
-#learnocaml-exo-test-pane .ace_meta { color: #fff; }
-#learnocaml-exo-test-pane .ace_variable { color: #fff; }
-#learnocaml-exo-test-pane .ace_text { color: #fff; }
-#learnocaml-exo-test-pane .error {
-  border-bottom: 2px #b00 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-test-pane .warning {
-  border-bottom: 2px #ca0 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-test-pane .ace_selection { background: #e80; opacity: 0.4; }
-#learnocaml-exo-test-pane .ace_active-line { background: #acf; opacity: 0.2; }
-#learnocaml-exo-test-pane .ace_selected-word { background: #e80; opacity: 0.2; }
-
-#learnocaml-exo-test-pane.ocaml-check-success::after,
-#learnocaml-exo-test-pane.ocaml-check-warn::after,
-#learnocaml-exo-test-pane.ocaml-check-error::after {
-  animation: 1s check_status_animation;
-  animation-fill-mode: forwards;
-  position: absolute;
-  margin: -100px 0 0 0;
-  top: 50%;
-  text-align: center;
-  font-size: 200px;
-  line-height: 200px;
-  width: 100%;
-}
-
-#learnocaml-exo-test-pane.ocaml-check-success::after {
-  content: "✌";
-  color: #0a0;
-  text-shadow: 0px 0px 40px #6F6;
-}
-
-#learnocaml-exo-test-pane.ocaml-check-warn::after {
-  content: "✋";
-  color: #ec0;
-  text-shadow: 0px 0px 40px #Fe6;
-}
-
-#learnocaml-exo-test-pane.ocaml-check-error::after {
-  content: "☠";
-  color: #b00;
-  text-shadow: 0px 0px 40px #F66;
-}
-
-/* pour template */
-#learnocaml-exo-template-pane {
-  font-size: 18px;
-  font-family: 'Inconsolata', monospace;
-}
-#learnocaml-exo-template-pane .ace_gutter {
-  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
-  color: #ccc;
-}
-#learnocaml-exo-template-pane .ace_gutter-active-line {
-  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
-  color: #888;
-}
-#learnocaml-exo-template-pane .ace_gutter-cell {
-  padding: 0 14px 0 0;
-}
-#learnocaml-exo-template-pane .ace_gutter-cell.ace_warning {
-  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
-}
-#learnocaml-exo-template-pane .ace_gutter-cell.ace_error {
-  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
-}
-#learnocaml-exo-template-pane .ace_comment { color: #aaa; font-style: italic; }
-#learnocaml-exo-template-pane .ace_keyword { color: #e80; font-weight:bold; }
-#learnocaml-exo-template-pane .ace_constant { color: #acf; }
-#learnocaml-exo-template-pane .ace_string { color: #acf; }
-#learnocaml-exo-template-pane .ace_function { color: #fff; }
-#learnocaml-exo-template-pane .ace_type { color: #fff; }
-#learnocaml-exo-template-pane .ace_operator { color: #fff; }
-#learnocaml-exo-template-pane .ace_meta { color: #fff; }
-#learnocaml-exo-template-pane .ace_variable { color: #fff; }
-#learnocaml-exo-template-pane .ace_text { color: #fff; }
-#learnocaml-exo-template-pane .error {
-  border-bottom: 2px #b00 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-template-pane .warning {
-  border-bottom: 2px #ca0 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-template-pane .ace_selection { background: #e80; opacity: 0.4; }
-#learnocaml-exo-template-pane .ace_active-line { background: #acf; opacity: 0.2; }
-#learnocaml-exo-template-pane .ace_selected-word { background: #e80; opacity: 0.2; }
-
-#learnocaml-exo-template-pane.ocaml-check-success::after,
-#learnocaml-exo-template-pane.ocaml-check-warn::after,
-#learnocaml-exo-template-pane.ocaml-check-error::after {
-  animation: 1s check_status_animation;
-  animation-fill-mode: forwards;
-  position: absolute;
-  margin: -100px 0 0 0;
-  top: 50%;
-  text-align: center;
-  font-size: 200px;
-  line-height: 200px;
-  width: 100%;
-}
-
-#learnocaml-exo-template-pane.ocaml-check-success::after {
-  content: "✌";
-  color: #0a0;
-  text-shadow: 0px 0px 40px #6F6;
-}
-
-#learnocaml-exo-template-pane.ocaml-check-warn::after {
-  content: "✋";
-  color: #ec0;
-  text-shadow: 0px 0px 40px #Fe6;
-}
-
-#learnocaml-exo-template-pane.ocaml-check-error::after {
-  content: "☠";
-  color: #b00;
-  text-shadow: 0px 0px 40px #F66;
-}
-
-/*prepare*/
-
-#learnocaml-exo-prepare-pane {
-  font-size: 18px;
-  font-family: 'Inconsolata', monospace;
-}
-#learnocaml-exo-prepare-pane .ace_gutter {
-  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
-  color: #ccc;
-}
-#learnocaml-exo-prepare-pane .ace_gutter-active-line {
-  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
-  color: #888;
-}
-#learnocaml-exo-prepare-pane .ace_gutter-cell {
-  padding: 0 14px 0 0;
-}
-#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_warning {
-  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
-}
-#learnocaml-exo-prepare-pane .ace_gutter-cell.ace_error {
-  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
-}
-#learnocaml-exo-prepare-pane .ace_comment { color: #aaa; font-style: italic; }
-#learnocaml-exo-prepare-pane .ace_keyword { color: #e80; font-weight:bold; }
-#learnocaml-exo-prepare-pane .ace_constant { color: #acf; }
-#learnocaml-exo-prepare-pane .ace_string { color: #acf; }
-#learnocaml-exo-prepare-pane .ace_function { color: #fff; }
-#learnocaml-exo-prepare-pane .ace_type { color: #fff; }
-#learnocaml-exo-prepare-pane .ace_operator { color: #fff; }
-#learnocaml-exo-prepare-pane .ace_meta { color: #fff; }
-#learnocaml-exo-prepare-pane .ace_variable { color: #fff; }
-#learnocaml-exo-prepare-pane .ace_text { color: #fff; }
-#learnocaml-exo-prepare-pane .error {
-  border-bottom: 2px #b00 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-prepare-pane .warning {
-  border-bottom: 2px #ca0 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-prepare-pane .ace_selection { background: #e80; opacity: 0.4; }
-#learnocaml-exo-prepare-pane .ace_active-line { background: #acf; opacity: 0.2; }
-#learnocaml-exo-prepare-pane .ace_selected-word { background: #e80; opacity: 0.2; }
-
-#learnocaml-exo-prepare-pane.ocaml-check-success::after,
-#learnocaml-exo-prepare-pane.ocaml-check-warn::after,
-#learnocaml-exo-prepare-pane.ocaml-check-error::after {
-  animation: 1s check_status_animation;
-  animation-fill-mode: forwards;
-  position: absolute;
-  margin: -100px 0 0 0;
-  top: 50%;
-  text-align: center;
-  font-size: 200px;
-  line-height: 200px;
-  width: 100%;
-}
-
-#learnocaml-exo-prepare-pane.ocaml-check-success::after {
-  content: "✌";
-  color: #0a0;
-  text-shadow: 0px 0px 40px #6F6;
-}
-
-#learnocaml-exo-prepare-pane.ocaml-check-warn::after {
-  content: "✋";
-  color: #ec0;
-  text-shadow: 0px 0px 40px #Fe6;
-}
-
-#learnocaml-exo-prepare-pane.ocaml-check-error::after {
-  content: "☠";
-  color: #b00;
-  text-shadow: 0px 0px 40px #F66;
-}
-
-/*prelude*/
-
-#learnocaml-exo-prelude-pane {
-  font-size: 18px;
-  font-family: 'Inconsolata', monospace;
-}
-#learnocaml-exo-prelude-pane .ace_gutter {
-  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
-  color: #ccc;
-}
-#learnocaml-exo-prelude-pane .ace_gutter-active-line {
-  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
-  color: #888;
-}
-#learnocaml-exo-prelude-pane .ace_gutter-cell {
-  padding: 0 14px 0 0;
-}
-#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_warning {
-  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
-}
-#learnocaml-exo-prelude-pane .ace_gutter-cell.ace_error {
-  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
-}
-#learnocaml-exo-prelude-pane .ace_comment { color: #aaa; font-style: italic; }
-#learnocaml-exo-prelude-pane .ace_keyword { color: #e80; font-weight:bold; }
-#learnocaml-exo-prelude-pane .ace_constant { color: #acf; }
-#learnocaml-exo-prelude-pane .ace_string { color: #acf; }
-#learnocaml-exo-prelude-pane .ace_function { color: #fff; }
-#learnocaml-exo-prelude-pane .ace_type { color: #fff; }
-#learnocaml-exo-prelude-pane .ace_operator { color: #fff; }
-#learnocaml-exo-prelude-pane .ace_meta { color: #fff; }
-#learnocaml-exo-prelude-pane .ace_variable { color: #fff; }
-#learnocaml-exo-prelude-pane .ace_text { color: #fff; }
-#learnocaml-exo-prelude-pane .error {
-  border-bottom: 2px #b00 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-prelude-pane .warning {
-  border-bottom: 2px #ca0 solid;
-  position: absolute;
-}
-
-#learnocaml-exo-prelude-pane .ace_selection { background: #e80; opacity: 0.4; }
-#learnocaml-exo-prelude-pane .ace_active-line { background: #acf; opacity: 0.2; }
-#learnocaml-exo-prelude-pane .ace_selected-word { background: #e80; opacity: 0.2; }
-
-#learnocaml-exo-prelude-pane.ocaml-check-success::after,
-#learnocaml-exo-prelude-pane.ocaml-check-warn::after,
-#learnocaml-exo-prelude-pane.ocaml-check-error::after {
-  animation: 1s check_status_animation;
-  animation-fill-mode: forwards;
-  position: absolute;
-  margin: -100px 0 0 0;
-  top: 50%;
-  text-align: center;
-  font-size: 200px;
-  line-height: 200px;
-  width: 100%;
-}
-
-#learnocaml-exo-prelude-pane.ocaml-check-success::after {
-  content: "✌";
-  color: #0a0;
-  text-shadow: 0px 0px 40px #6F6;
-}
-
-#learnocaml-exo-prelude-pane.ocaml-check-warn::after {
-  content: "✋";
-  color: #ec0;
-  text-shadow: 0px 0px 40px #Fe6;
-}
-
-#learnocaml-exo-prelude-pane.ocaml-check-error::after {
-  content: "☠";
-  color: #b00;
-  text-shadow: 0px 0px 40px #F66;
-}
-
 @keyframes check_status_animation {
   0%   { opacity: 0; z-index: 9999; }
   49%  { opacity: 1; transform: scale(2); z-index: 9999; }
@@ -1012,4 +487,3 @@ body {
   99%  { opacity: 0; transform: scale(2); z-index: 9999; }
   100% { opacity: 0; z-index: -9999; }
 }
-/* fin changement  */
diff --git a/static/css/learnocaml_new_exercise.css b/static/css/learnocaml_new_exercise.css
new file mode 100644
index 000000000..771d8d944
--- /dev/null
+++ b/static/css/learnocaml_new_exercise.css
@@ -0,0 +1,87 @@
+body{
+  background: #eee;
+}
+#page_title{
+  text-align: center;
+  font-size: 25px;
+  line-height: 50px; 
+}
+#learnocaml-main-toolbar {
+  position: fixed;
+  left: 0; top: 0;
+  color: #fff;
+  z-index: 1004;
+  border-bottom: 1px #eee solid;
+  display: flex;
+  background: #222;
+}
+#learnocaml-main-toolbar a {
+  text-decoration: none;
+  color: #fff;
+}
+#learnocaml-main-toolbar > button {
+  border-left: 1px #eee solid !important;
+  padding: 0 10px 0 10px;
+  margin: 0;
+  background: none;
+  border: none;
+  flex: 0;
+  position: relative;
+  display: block;
+}
+#learnocaml-main-toolbar > button > * {
+  padding: 5px;
+  color: #eee;
+  text-align: center;
+}
+#learnocaml-main-toolbar::before {
+  z-index: 1004;
+  position: fixed;
+  left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to bottom, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+@media (max-width: 549px) {
+  #learnocaml-main-toolbar {
+    height: 40px;
+    width: 100%
+  }
+  .button {
+    height: 40px;
+    min-width: 40px;
+  }
+  #learnocaml-main-toolbar::before {
+    top: 41px;
+  }
+  #learnocaml-main-toolbar > button > .label {
+    display: none;
+  }
+}
+@media (min-width: 550px) {
+  #learnocaml-main-toolbar {
+    height: 60px;
+    width: 100%;
+  }
+  .button {
+    height: 60px;
+    min-width: 60px;
+  }
+  #learnocaml-main-toolbar::before {
+    top: 61px;
+  }
+}
+
+#learnocaml-tabs > * {
+  position: absolute;
+  z-index: 997;
+  background: #eee;
+  padding: 0;
+  opacity: 0;
+}
+#learnocaml-tabs > *.front-tab {
+  z-index: 998;
+  opacity: 1;
+}
+#learnocaml-tabs > * {
+  left: 0px; top: 15px; right: 0px; bottom: 0px;
+}
diff --git a/static/css/learnocaml_test.css b/static/css/learnocaml_test.css
new file mode 100644
index 000000000..ca95fffbf
--- /dev/null
+++ b/static/css/learnocaml_test.css
@@ -0,0 +1,506 @@
+body{
+  background: #eee;
+}
+
+#txt_txt{
+  text-align: center;
+}
+
+.popup {
+    position: relative;
+    display: inline-block;
+    cursor: pointer;
+    -webkit-user-select: none;
+    -moz-user-select: none;
+    -ms-user-select: none;
+    user-select: none;
+}
+
+/* The actual popup */
+.popup .popuptext {
+    visibility: hidden;
+    background-color: #555;
+    color: #fff;
+    text-align: left;
+    border-radius: 6px;
+    padding: 8px 8px;
+    position: absolute;
+    z-index: 1;
+    bottom: 125%;
+    left: 0px;
+}
+
+/* Popup arrow */
+.popup .popuptext::after {
+    content: "";
+    position: absolute;
+    top: 100%;
+    left: 50%;
+    margin-left: -5px;
+    border-width: 5px;
+    border-style: solid;
+    border-color: #555 transparent transparent transparent;
+}
+
+/* Toggle this class - hide and show the popup */
+.popup .show {
+    visibility: visible;
+    -webkit-animation: fadeIn 1s;
+    animation: fadeIn 1s;
+}
+
+/* Add animation (fade in the popup) */
+@-webkit-keyframes fadeIn {
+    from {opacity: 0;} 
+    to {opacity: 1;}
+}
+
+@keyframes fadeIn {
+    from {opacity: 0;}
+    to {opacity:1 ;}
+}
+
+/* -------------- toolbar ---------------------------------------- */
+#learnocaml-main-toolbar {
+  position: fixed;
+  left: 0; top: 0;
+  color: #fff;
+  z-index: 1004;
+  border-bottom: 1px #eee solid;
+  display: flex;
+  background: #222;
+}
+#learnocaml-main-toolbar a {
+  text-decoration: none;
+  color: #fff;
+}
+#learnocaml-main-toolbar > button {
+  border-left: 1px #eee solid !important;
+  padding: 0 10px 0 10px;
+  margin: 0;
+  background: none;
+  border: none;
+  flex: 0;
+  position: relative;
+  display: block;
+}
+#learnocaml-main-toolbar > button > * {
+  padding: 5px;
+  color: #eee;
+  text-align: center;
+}
+#learnocaml-main-toolbar::before {
+  z-index: 1004;
+  position: fixed;
+  left: 0px; height: 5px; width: 100%;
+  background: linear-gradient(to bottom, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px);
+  content:"";
+}
+@media (max-width: 549px) {
+  #learnocaml-main-toolbar {
+    height: 40px;
+    width: 100%
+  }
+  .button {
+  	height: 40px;
+  	min-width: 40px;
+  }
+  #learnocaml-main-toolbar::before {
+    top: 41px;
+  }
+  #learnocaml-main-toolbar > button > .label {
+    display: none;
+  }
+}
+@media (min-width: 550px) {
+  #learnocaml-main-toolbar {
+    height: 60px;
+    width: 100%;
+  }
+  .button {
+  	height: 60px;
+  	min-width: 60px;
+  }
+  #learnocaml-main-toolbar::before {
+    top: 61px;
+  }
+}
+
+/* --------------- fixed elements -------------------------------- */
+
+#learnocaml-test {
+  position: absolute;
+  z-index: 998;
+  background: #eee;
+  padding: 0;
+  opacity: 1;
+  text-align: center;
+}
+#learnocaml-test {
+  left: 0px; top:110px; right: 50%; bottom: 55%;
+}
+
+#learnocaml-tab-name{
+  padding: 5px;text-align:center;
+}
+
+#learnocaml-tab-type{
+  padding: 5px;text-align:center;
+}
+
+#learnocaml-tab-choix{
+  padding: 5px;text-align:center;
+}
+
+/* ----------- tabs ---------------------------------------------- */
+
+#learnocaml-tabs {
+  position: absolute;
+  z-index: 997;
+  background: #eee;
+  padding: 0;
+  opacity: 1;
+}
+#learnocaml-tabs {
+  left: 0px; top:0px; right: 0px; bottom: 0px;
+}
+
+#learnocaml-tabs > * {
+  position: absolute;
+  z-index: 997;
+  background: #eee;
+  padding: 0;
+  opacity: 0;
+}
+#learnocaml-tabs > *.front-tab {
+  z-index: 998;
+  opacity: 1;
+}
+#learnocaml-tabs > * {
+  left: 0px; top: 15px; right: 0px; bottom: 0px;
+}
+
+/* ---------------- solution tab --------------------------------- */
+
+#learnocaml-tab-solution-input {
+	left: 0px; top: 48%; right: 0px; bottom: 0px;
+	position:absolute;
+	margin: 10px;
+	background : #666;
+	border : 3px solid #fff
+}
+#txt_input_sol {
+	left: 10px;	top:45%; right: 50%;
+	position: absolute;
+}
+
+#learnocaml-tab-solution-extra {
+	left: 50%; top: 15%; right: 0px; bottom: 0px;
+	position: absolute;
+	text-align:center;
+}
+#learnocaml-tab-solution-datalist{
+	position: absolute;
+	left: 50%;
+	text-align: center;
+	right: 0px;
+	top: 25%;
+}
+#sol-datalist{
+	width:80%;
+}
+#learnocaml-tab-solution-sampler{
+	position: absolute;
+	top: 35%;
+	right: 0px;
+	left: 50%;
+	text-align: center;
+}
+#sol-sampler{
+	width:80%;
+}
+
+/* ----------- specification tab --------------------------------- */
+
+#learnocaml-tab-spec-input {
+	left: 0px; top: 48%; right: 50%; bottom: 0px;
+	position: absolute;
+	margin: 10px;
+	background : #666;
+	border : 3px solid #fff
+}
+
+#txt_input_spec {
+	left: 10px; top: 45%;	right:50%;
+	position: absolute;
+	right: 50%;
+}
+
+#learnocaml-tab-spec-extra {
+	left: 50%; top: 15%; right: 0px; bottom: 0px;
+	position: absolute;
+	text-align:center;
+}
+#learnocaml-tab-spec-datalist{
+	position: absolute;
+	left: 50%;
+	text-align: center;
+	right: 0px;
+	top: 25%;
+}
+#spec-datalist{
+	width:80%;
+}
+#learnocaml-tab-spec-sampler{
+	position: absolute;
+	top: 35%;
+	right: 0px;
+	left: 50%;
+	text-align: center;
+}
+#spec-sampler{
+	width:80%;
+}
+#learnocaml-tab-spec-spec {
+	left: 50%; top: 48%; right: 0px; bottom: 0px;
+	position: absolute;
+	margin: 10px;
+	background : #666;
+	border : 3px solid #fff
+}
+
+#txt_spec_specification {
+	position: absolute;
+	left: 52%;
+	top: 45%;
+  right: 10px;
+}
+
+/* ------------------ suite tab ---------------------------------- */
+
+#learnocaml-tab-suite-input{
+  	left: 0%; top: 48%; right: 0px; bottom: 0px;
+	position: absolute;
+	margin: 10px;
+	background : #666;
+	border : 3px solid #fff
+}
+
+#txt_suite_input {
+	left: 10px;	top: 45%; right:50%;
+	position: absolute;
+}
+#learnocaml-tab-suite-datalist{
+	position: absolute;
+	left: 50%;
+	text-align: center;
+	right: 0px;
+	top: 20%;
+}
+#suite-datalist{
+	width:80%;
+}
+
+
+/* ------- aces -------------------------------------------------- */
+	/* ---- solution input -------------------------------- */
+
+#learnocaml-tab-solution-input {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-tab-solution-input .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-tab-solution-input .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-tab-solution-input .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-tab-solution-input .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-tab-solution-input .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-tab-solution-input .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-tab-solution-input .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-tab-solution-input .ace_constant { color: #acf; }
+#learnocaml-tab-solution-input .ace_string { color: #acf; }
+#learnocaml-tab-solution-input .ace_function { color: #fff; }
+#learnocaml-tab-solution-input .ace_type { color: #fff; }
+#learnocaml-tab-solution-input .ace_operator { color: #fff; }
+#learnocaml-tab-solution-input .ace_meta { color: #fff; }
+#learnocaml-tab-solution-input .ace_variable { color: #fff; }
+#learnocaml-tab-solution-input .ace_text { color: #fff; }
+#learnocaml-tab-solution-input .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-solution-input .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-solution-input .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-tab-solution-input .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-tab-solution-input .ace_selected-word { background: #e80; opacity: 0.2; }
+
+
+/* ---- spec input ------------------------------------ */
+
+#learnocaml-tab-spec-input {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-tab-spec-input .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-tab-spec-input .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-tab-spec-input .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-tab-spec-input .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-tab-spec-input .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-tab-spec-input .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-tab-spec-input .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-tab-spec-input .ace_constant { color: #acf; }
+#learnocaml-tab-spec-input .ace_string { color: #acf; }
+#learnocaml-tab-spec-input .ace_function { color: #fff; }
+#learnocaml-tab-spec-input .ace_type { color: #fff; }
+#learnocaml-tab-spec-input .ace_operator { color: #fff; }
+#learnocaml-tab-spec-input .ace_meta { color: #fff; }
+#learnocaml-tab-spec-input .ace_variable { color: #fff; }
+#learnocaml-tab-spec-input .ace_text { color: #fff; }
+#learnocaml-tab-spec-input .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-spec-input .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-spec-input .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-tab-spec-input .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-tab-spec-input .ace_selected-word { background: #e80; opacity: 0.2; }
+
+
+/* ---- spec spec ------------------------------------- */
+
+#learnocaml-tab-spec-spec {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-tab-spec-spec .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-tab-spec-spec .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-tab-spec-spec .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-tab-spec-spec .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-tab-spec-spec .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-tab-spec-spec .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-tab-spec-spec .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-tab-spec-spec .ace_constant { color: #acf; }
+#learnocaml-tab-spec-spec .ace_string { color: #acf; }
+#learnocaml-tab-spec-spec .ace_function { color: #fff; }
+#learnocaml-tab-spec-spec .ace_type { color: #fff; }
+#learnocaml-tab-spec-spec .ace_operator { color: #fff; }
+#learnocaml-tab-spec-spec .ace_meta { color: #fff; }
+#learnocaml-tab-spec-spec .ace_variable { color: #fff; }
+#learnocaml-tab-spec-spec .ace_text { color: #fff; }
+#learnocaml-tab-spec-spec .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-spec-spec .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-spec-spec .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-tab-spec-spec .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-tab-spec-spec .ace_selected-word { background: #e80; opacity: 0.2; }
+
+
+/* ---- suite input ----------------------------------- */
+
+#learnocaml-tab-suite-input {
+  font-size: 18px;
+  font-family: 'Inconsolata', monospace;
+}
+#learnocaml-tab-suite-input .ace_gutter {
+  background: linear-gradient(to left, transparent 0, #444 8px, #ccc 8px, #ccc 9px, #444 9px) ;
+  color: #ccc;
+}
+#learnocaml-tab-suite-input .ace_gutter-active-line {
+  background: linear-gradient(to left, #777 0, #456 8px, #ccc 8px, #ccc 9px, #678 9px) ;
+  color: #888;
+}
+#learnocaml-tab-suite-input .ace_gutter-cell {
+  padding: 0 14px 0 0;
+}
+#learnocaml-tab-suite-input .ace_gutter-cell.ace_warning {
+  background: linear-gradient(to right, #980 0, #980 4px, transparent 80%) ;
+}
+#learnocaml-tab-suite-input .ace_gutter-cell.ace_error {
+  background: linear-gradient(to right, #900 0, #900 4px, transparent 80%) ;
+}
+#learnocaml-tab-suite-input .ace_comment { color: #aaa; font-style: italic; }
+#learnocaml-tab-suite-input .ace_keyword { color: #e80; font-weight:bold; }
+#learnocaml-tab-suite-input .ace_constant { color: #acf; }
+#learnocaml-tab-suite-input .ace_string { color: #acf; }
+#learnocaml-tab-suite-input .ace_function { color: #fff; }
+#learnocaml-tab-suite-input .ace_type { color: #fff; }
+#learnocaml-tab-suite-input .ace_operator { color: #fff; }
+#learnocaml-tab-suite-input .ace_meta { color: #fff; }
+#learnocaml-tab-suite-input .ace_variable { color: #fff; }
+#learnocaml-tab-suite-input .ace_text { color: #fff; }
+#learnocaml-tab-suite-input .error {
+  border-bottom: 2px #b00 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-suite-input .warning {
+  border-bottom: 2px #ca0 solid;
+  position: absolute;
+}
+
+#learnocaml-tab-suite-input .ace_selection { background: #e80; opacity: 0.4; }
+#learnocaml-tab-suite-input .ace_active-line { background: #acf; opacity: 0.2; }
+#learnocaml-tab-suite-input .ace_selected-word { background: #e80; opacity: 0.2; }
+
+
+/* --------------- check-answer -------------------------- */
+#check-anser {
+  position: absolute;
+  top: 0; left: 0; right: 0; bottom: 0;
+}
+#check-answer.loading,
+#check-anser.loaded {
+  background: rgba(200,200,200,0.9);
+}
\ No newline at end of file
diff --git a/static/editor.html b/static/editor.html
index b0f838591..6136a96c6 100644
--- a/static/editor.html
+++ b/static/editor.html
@@ -3,11 +3,15 @@
   
     
     
-    Learn OCaml by OCamlPro - Exercise
+    Learn OCaml by OCamlPro - Editor
+        
+    
     
-    
+    
     
     
+    
+
     
     
     
@@ -33,6 +37,8 @@
       var n = Math.floor (Math.random () * 9) + 1;
       document.getElementById('chamo-img').src = 'icons/tryocaml_loading_' + n + '.gif';
     
+    
+
- + + - - - + + + + + + + - + - - + + + + + + + - +
@@ -75,19 +100,19 @@ - + - + - + - +
@@ -104,15 +129,15 @@ - + - + - + @@ -121,40 +146,48 @@
- - - Click the Grade! button to test your solution + +
+
-
+
+
-
+
+
-
+
+
-
-
+
+
- - + +
+
+
+
+
+
-
Editor
+
- - diff --git a/static/exercise.html b/static/exercise.html index 8e270ee60..49777d4df 100644 --- a/static/exercise.html +++ b/static/exercise.html @@ -4,6 +4,8 @@ Learn OCaml by OCamlPro - Exercise + +  @@ -14,7 +16,7 @@ - +
@@ -30,7 +32,7 @@
  • Preparing the environment
@@ -50,15 +52,16 @@ -->
- + + - +
@@ -126,10 +129,8 @@ style="position: absolute; top: 50%; margin: -12px 0 0 0; line-height: 24px; font-size: 24px; text-shadow: 0 0 5px #888; width: 100%; text-align: center;"> - + -
- diff --git a/static/icons/favicon.ico b/static/icons/favicon.ico new file mode 100644 index 0000000000000000000000000000000000000000..deed0d407fae492750c5c50e9132729ee1e79d60 GIT binary patch literal 1150 zcmbW1O-vI}5P)a5l$KJIlQEu5Ow^MR6Xjw|#Kgpth6C}S@t_e9TFQ?|1>~yC0z`b9@6FqpotgJ$b{9aP zD>oNt-U%fc0NVgyFF`8On0gWbWZSjRBy~?y){*W5j*~-O_QK#mep%pQf%~aXJn^i{ zar$%6Ui9fboEm=9*8ky!aQwMsE4c4*6!cxRAMQMxb?jc5v+(tU?9w^OSsg>WN5>s? z8uta_4BX3TtJ2X@5y8BU2y1^CW7gsb=9DkvR(I6IwTxR_I$F!8C7V}6>lGEjqagAh zNvKgc)P@miRQx!XU`M;dJhN0mr%S~g_aC?v@|l#NUPGuS|H}&cf>Bl-&>0xR$!%gm^g zwN^ztoiVB|Zs@D(BxeZE2T$58Ci zQM?%;$Zrz}-jVIXT|Ob)NubahBchuk^&Ow-vw?3m4_YP;LCg5R)A(ioum8aR$Yyf- E33hF-bN~PV literal 0 HcmV?d00001 diff --git a/static/icons/icon_cleanup_black.svg b/static/icons/icon_cleanup_black.svg deleted file mode 100644 index 171e7551e..000000000 --- a/static/icons/icon_cleanup_black.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_cleanup_dark.svg b/static/icons/icon_cleanup_dark.svg deleted file mode 100644 index da0aac638..000000000 --- a/static/icons/icon_cleanup_dark.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_cleanup_light.svg b/static/icons/icon_cleanup_light.svg deleted file mode 100644 index 193a45550..000000000 --- a/static/icons/icon_cleanup_light.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_cleanup_white.svg b/static/icons/icon_cleanup_white.svg deleted file mode 100644 index 36e2c2043..000000000 --- a/static/icons/icon_cleanup_white.svg +++ /dev/null @@ -1,79 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_down_black.svg b/static/icons/icon_down_black.svg deleted file mode 100644 index 1df28d721..000000000 --- a/static/icons/icon_down_black.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_down_dark.svg b/static/icons/icon_down_dark.svg deleted file mode 100644 index 61932bf68..000000000 --- a/static/icons/icon_down_dark.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_down_light.svg b/static/icons/icon_down_light.svg deleted file mode 100644 index c65bf25bc..000000000 --- a/static/icons/icon_down_light.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_down_white.svg b/static/icons/icon_down_white.svg deleted file mode 100644 index 3506af3bc..000000000 --- a/static/icons/icon_down_white.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_download_black.svg b/static/icons/icon_download_black.svg deleted file mode 100644 index 49801524c..000000000 --- a/static/icons/icon_download_black.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_download_dark.svg b/static/icons/icon_download_dark.svg deleted file mode 100644 index 2465863e9..000000000 --- a/static/icons/icon_download_dark.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_download_light.svg b/static/icons/icon_download_light.svg deleted file mode 100644 index e9ef959a6..000000000 --- a/static/icons/icon_download_light.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_download_white.svg b/static/icons/icon_download_white.svg deleted file mode 100644 index 0c79dd1da..000000000 --- a/static/icons/icon_download_white.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_left_black.svg b/static/icons/icon_left_black.svg deleted file mode 100644 index 1b4394d7d..000000000 --- a/static/icons/icon_left_black.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_left_dark.svg b/static/icons/icon_left_dark.svg deleted file mode 100644 index 119301b32..000000000 --- a/static/icons/icon_left_dark.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_left_light.svg b/static/icons/icon_left_light.svg deleted file mode 100644 index 7c53d429e..000000000 --- a/static/icons/icon_left_light.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_left_white.svg b/static/icons/icon_left_white.svg deleted file mode 100644 index e1464669a..000000000 --- a/static/icons/icon_left_white.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_list_black.svg b/static/icons/icon_list_black.svg deleted file mode 100644 index 5c0e565b8..000000000 --- a/static/icons/icon_list_black.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_list_dark.svg b/static/icons/icon_list_dark.svg deleted file mode 100644 index 9d05e06d0..000000000 --- a/static/icons/icon_list_dark.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_list_light.svg b/static/icons/icon_list_light.svg deleted file mode 100644 index 14a210596..000000000 --- a/static/icons/icon_list_light.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_list_white.svg b/static/icons/icon_list_white.svg deleted file mode 100644 index b30e332fb..000000000 --- a/static/icons/icon_list_white.svg +++ /dev/null @@ -1,90 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_menu_black.svg b/static/icons/icon_menu_black.svg deleted file mode 100644 index d8bd12126..000000000 --- a/static/icons/icon_menu_black.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - diff --git a/static/icons/icon_menu_dark.svg b/static/icons/icon_menu_dark.svg deleted file mode 100644 index ec7bcd09e..000000000 --- a/static/icons/icon_menu_dark.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - diff --git a/static/icons/icon_menu_light.svg b/static/icons/icon_menu_light.svg deleted file mode 100644 index 138f10946..000000000 --- a/static/icons/icon_menu_light.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - diff --git a/static/icons/icon_menu_white.svg b/static/icons/icon_menu_white.svg deleted file mode 100644 index 45b6cb1ef..000000000 --- a/static/icons/icon_menu_white.svg +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - diff --git a/static/icons/icon_reload_black.svg b/static/icons/icon_reload_black.svg deleted file mode 100644 index 90544a6ab..000000000 --- a/static/icons/icon_reload_black.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_reload_dark.svg b/static/icons/icon_reload_dark.svg deleted file mode 100644 index 9d298824c..000000000 --- a/static/icons/icon_reload_dark.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_reload_light.svg b/static/icons/icon_reload_light.svg deleted file mode 100644 index 1c4e3d430..000000000 --- a/static/icons/icon_reload_light.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_reload_white.svg b/static/icons/icon_reload_white.svg deleted file mode 100644 index a935030b5..000000000 --- a/static/icons/icon_reload_white.svg +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - diff --git a/static/icons/icon_right_black.svg b/static/icons/icon_right_black.svg deleted file mode 100644 index f0aba78ab..000000000 --- a/static/icons/icon_right_black.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_right_dark.svg b/static/icons/icon_right_dark.svg deleted file mode 100644 index a657b05dd..000000000 --- a/static/icons/icon_right_dark.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_right_light.svg b/static/icons/icon_right_light.svg deleted file mode 100644 index 056dd0659..000000000 --- a/static/icons/icon_right_light.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_right_white.svg b/static/icons/icon_right_white.svg deleted file mode 100644 index b01367fef..000000000 --- a/static/icons/icon_right_white.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_run_black.svg b/static/icons/icon_run_black.svg deleted file mode 100644 index cf0922e5f..000000000 --- a/static/icons/icon_run_black.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_run_dark.svg b/static/icons/icon_run_dark.svg deleted file mode 100644 index 54f30b62a..000000000 --- a/static/icons/icon_run_dark.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_run_light.svg b/static/icons/icon_run_light.svg deleted file mode 100644 index 860e9dd0d..000000000 --- a/static/icons/icon_run_light.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_run_white.svg b/static/icons/icon_run_white.svg deleted file mode 100644 index 700b093d8..000000000 --- a/static/icons/icon_run_white.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_save_black.svg b/static/icons/icon_save_black.svg deleted file mode 100644 index a1f2c106f..000000000 --- a/static/icons/icon_save_black.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_save_dark.svg b/static/icons/icon_save_dark.svg deleted file mode 100644 index 1dc7acdec..000000000 --- a/static/icons/icon_save_dark.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_save_light.svg b/static/icons/icon_save_light.svg deleted file mode 100644 index 46c10d2e6..000000000 --- a/static/icons/icon_save_light.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_save_white.svg b/static/icons/icon_save_white.svg deleted file mode 100644 index 5a45c191c..000000000 --- a/static/icons/icon_save_white.svg +++ /dev/null @@ -1,70 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_sync_black.svg b/static/icons/icon_sync_black.svg deleted file mode 100644 index 1fa5dc6ee..000000000 --- a/static/icons/icon_sync_black.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - diff --git a/static/icons/icon_sync_dark.svg b/static/icons/icon_sync_dark.svg deleted file mode 100644 index 371dc5dd6..000000000 --- a/static/icons/icon_sync_dark.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - diff --git a/static/icons/icon_sync_light.svg b/static/icons/icon_sync_light.svg deleted file mode 100644 index 9d1fb4121..000000000 --- a/static/icons/icon_sync_light.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - diff --git a/static/icons/icon_sync_white.svg b/static/icons/icon_sync_white.svg deleted file mode 100644 index 26f543247..000000000 --- a/static/icons/icon_sync_white.svg +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - diff --git a/static/icons/icon_typecheck_black.svg b/static/icons/icon_typecheck_black.svg deleted file mode 100644 index 4b55e0dfc..000000000 --- a/static/icons/icon_typecheck_black.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_typecheck_dark.svg b/static/icons/icon_typecheck_dark.svg deleted file mode 100644 index 02a976de9..000000000 --- a/static/icons/icon_typecheck_dark.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_typecheck_light.svg b/static/icons/icon_typecheck_light.svg deleted file mode 100644 index 0c67302c1..000000000 --- a/static/icons/icon_typecheck_light.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_typecheck_white.svg b/static/icons/icon_typecheck_white.svg deleted file mode 100644 index 64095fc9a..000000000 --- a/static/icons/icon_typecheck_white.svg +++ /dev/null @@ -1,81 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - - diff --git a/static/icons/icon_up_black.svg b/static/icons/icon_up_black.svg deleted file mode 100644 index 795f2dfdb..000000000 --- a/static/icons/icon_up_black.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_up_dark.svg b/static/icons/icon_up_dark.svg deleted file mode 100644 index 41b9e8f2d..000000000 --- a/static/icons/icon_up_dark.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_up_light.svg b/static/icons/icon_up_light.svg deleted file mode 100644 index 6192a0d86..000000000 --- a/static/icons/icon_up_light.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_up_white.svg b/static/icons/icon_up_white.svg deleted file mode 100644 index 7f3fca207..000000000 --- a/static/icons/icon_up_white.svg +++ /dev/null @@ -1,72 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_upload_black.svg b/static/icons/icon_upload_black.svg deleted file mode 100644 index 09ff5ecea..000000000 --- a/static/icons/icon_upload_black.svg +++ /dev/null @@ -1,71 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_upload_dark.svg b/static/icons/icon_upload_dark.svg deleted file mode 100644 index 0f18ee57a..000000000 --- a/static/icons/icon_upload_dark.svg +++ /dev/null @@ -1,71 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_upload_light.svg b/static/icons/icon_upload_light.svg deleted file mode 100644 index 20e33d311..000000000 --- a/static/icons/icon_upload_light.svg +++ /dev/null @@ -1,71 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/icons/icon_upload_white.svg b/static/icons/icon_upload_white.svg deleted file mode 100644 index 1d5b0d70d..000000000 --- a/static/icons/icon_upload_white.svg +++ /dev/null @@ -1,71 +0,0 @@ - - - - - - - - - - - - image/svg+xml - - - - - - - - - diff --git a/static/index.html b/static/index.html index db2d7a788..c394ab8f1 100644 --- a/static/index.html +++ b/static/index.html @@ -3,6 +3,8 @@ Learn OCaml by OCamlPro + +  @@ -17,6 +19,7 @@ +
-
-
-
-
-
-
From f417bfc8635d87022a3ec0d50ccbdf6a83418cfc Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 6 Jul 2019 17:26:57 +0200 Subject: [PATCH 06/91] fix: teacher's Check feature in "Test" tab * Adapt learnocaml_toplevel_worker_main.ml to conditionally load Embedded_grading_cmis. --- src/editor/editor_lib.ml | 4 ++-- src/toplevel/learnocaml_toplevel.ml | 7 +++--- src/toplevel/learnocaml_toplevel.mli | 8 +++++-- .../learnocaml_toplevel_worker_caller.ml | 4 ++-- .../learnocaml_toplevel_worker_caller.mli | 10 ++++---- .../learnocaml_toplevel_worker_main.ml | 23 +++++++++++++++---- 6 files changed, 36 insertions(+), 20 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 861769d3e..876a29d8d 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -119,8 +119,8 @@ let typecheck set_class ace_t editor_t top prelprep ?(mock = false) ?onpasterr s let offset_prelprep = num_occs prelprep (-1) '\n' 0 in let code = prelprep ^ if mock then with_test_lib_prepare string else string - and ppx_meta = mock in - Learnocaml_toplevel.check ~ppx_meta top code >>= fun res -> + and grading = mock in + Learnocaml_toplevel.check ~grading top code >>= fun res -> let error, warnings = match res with | Toploop_results.Ok ((), warnings) -> None, warnings diff --git a/src/toplevel/learnocaml_toplevel.ml b/src/toplevel/learnocaml_toplevel.ml index dc9c222d7..94785b8bf 100644 --- a/src/toplevel/learnocaml_toplevel.ml +++ b/src/toplevel/learnocaml_toplevel.ml @@ -200,19 +200,18 @@ let execute_phrase top ?timeout content = let execute top = Learnocaml_toplevel_input.execute top.input - let execute_test top = Learnocaml_toplevel_output.get_blocks top.output - + let go_backward top = Learnocaml_toplevel_input.go_backward top.input let go_forward top = Learnocaml_toplevel_input.go_forward top.input -let check ?ppx_meta top code = +let check ?grading top code = protect_execution top @@ fun () -> - Learnocaml_toplevel_worker_caller.check ?ppx_meta top.worker code + Learnocaml_toplevel_worker_caller.check ?grading top.worker code let set_checking_environment top = protect_execution top @@ fun () -> diff --git a/src/toplevel/learnocaml_toplevel.mli b/src/toplevel/learnocaml_toplevel.mli index 26bfe98de..592dfd0ed 100644 --- a/src/toplevel/learnocaml_toplevel.mli +++ b/src/toplevel/learnocaml_toplevel.mli @@ -125,8 +125,12 @@ val load: ?message: string -> string -> bool Lwt.t -(** Parse and typecheck a given source code. *) - val check: ?ppx_meta:bool -> t -> string -> unit Toploop_results.toplevel_result Lwt.t +(** Parse and typecheck a given source code. + + @param grading + Load [Embedded_grading_cmis] and ppx-metaquot in the checker toploop. *) +val check: ?grading:bool -> t -> string -> unit Toploop_results.toplevel_result Lwt.t + (** Freezes the environment for future calls to {!check}. *) val set_checking_environment: t -> unit Lwt.t diff --git a/src/toplevel/learnocaml_toplevel_worker_caller.ml b/src/toplevel/learnocaml_toplevel_worker_caller.ml index 499427d70..017d5d4b7 100644 --- a/src/toplevel/learnocaml_toplevel_worker_caller.ml +++ b/src/toplevel/learnocaml_toplevel_worker_caller.ml @@ -236,8 +236,8 @@ let reset worker ?(timeout = fun () -> never_ending) () = (* Not canceling the Reset thread, but manually resetting. *) worker.reset_worker worker -let check ?(ppx_meta = false) worker code = - post worker @@ Check (code,ppx_meta) +let check ?(grading = false) worker code = + post worker @@ Check (code, grading) let set_checking_environment worker = post worker @@ Set_checking_environment diff --git a/src/toplevel/learnocaml_toplevel_worker_caller.mli b/src/toplevel/learnocaml_toplevel_worker_caller.mli index 446732ce3..cfe760056 100644 --- a/src/toplevel/learnocaml_toplevel_worker_caller.mli +++ b/src/toplevel/learnocaml_toplevel_worker_caller.mli @@ -41,13 +41,13 @@ val create: unit -> t Lwt.t -(** Parse and typecheck a given source code +(** Parse and typecheck a given source code. + @param grading + Load [Embedded_grading_cmis] and ppx-metaquot in the checker toploop. @return [Success ()] in case of success and [Error err] - where [err] contains the error message otherwise. - -*) - val check: ?ppx_meta:bool -> t -> string -> unit toplevel_result Lwt.t + where [err] contains the error message otherwise. *) + val check: ?grading:bool -> t -> string -> unit toplevel_result Lwt.t (** Execute a given source code. The evaluation stops after the first toplevel phrase (as terminated by ";;") that fails to compile or diff --git a/src/toplevel/learnocaml_toplevel_worker_main.ml b/src/toplevel/learnocaml_toplevel_worker_main.ml index 2ea085203..1b4765e08 100644 --- a/src/toplevel/learnocaml_toplevel_worker_main.ml +++ b/src/toplevel/learnocaml_toplevel_worker_main.ml @@ -9,6 +9,7 @@ open Learnocaml_toplevel_worker_messages let debug = ref false +let grading = ref false let (>>=) = Lwt.bind @@ -138,7 +139,7 @@ let iter_option f o = match o with | None -> () | Some o -> f o let checking_environment = ref !Toploop.toplevel_env let setup_ppx = lazy (Ast_mapper.register "ppx_metaquot" Ppx_metaquot.expander) - + let handler : type a. a host_msg -> a return Lwt.t = function | Set_checking_environment -> checking_environment := !Toploop.toplevel_env ; @@ -208,10 +209,10 @@ let handler : type a. a host_msg -> a return Lwt.t = function !Toploop.toplevel_env ; Toploop.setvalue name (Obj.repr callback) ; return_unit_success - | Check (code, ppx_meta) -> + | Check (code, grading_cmi_and_ppx_meta) -> let saved = !Toploop.toplevel_env in Toploop.toplevel_env := !checking_environment ; - if ppx_meta then Lazy.force setup_ppx ; + if grading_cmi_and_ppx_meta then (grading := true; Lazy.force setup_ppx) ; let result = Toploop_ext.check code in Toploop.toplevel_env := saved ; unwrap_result result @@ -242,13 +243,25 @@ let () = Lwt.return_unit in let path = "/worker_cmis" in + (* we don't use + [OCamlRes.Res.merge Embedded_cmis.root Embedded_grading_cmis.root] + because we don't want to unconditionally load [Embedded_grading_cmis] *) + let root1 = Embedded_cmis.root in + let root2 = Embedded_grading_cmis.root in Sys_js.mount ~path (fun ~prefix:_ ~path -> - match OCamlRes.Res.find (OCamlRes.Path.of_string path) Embedded_cmis.root with + match OCamlRes.Res.find (OCamlRes.Path.of_string path) root1 with | cmi -> Js.Unsafe.set cmi (Js.string "t") 9 ; (* XXX hack *) Some cmi - | exception Not_found -> None) ; + | exception Not_found -> + if !grading then + match OCamlRes.Res.find (OCamlRes.Path.of_string path) root2 with + | cmi -> + Js.Unsafe.set cmi (Js.string "t") 9 ; (* XXX hack *) + Some cmi + | exception Not_found -> None + else None) ; Config.load_path := [ path ] ; Toploop_jsoo.initialize (); Hashtbl.add Toploop.directive_table From 59f02075b076dc529b5d7c81747810f13138c3e5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 6 Jul 2019 17:26:57 +0200 Subject: [PATCH 07/91] fix: teacher's Check feature in "Test" tab * If error is at line No. < 0, switch first from "Test" to "Prepare". --- src/editor/editor.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 509727f5f..56a31863b 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -403,7 +403,7 @@ let () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in Editor_lib.typecheck true ace_t editor_t top prelprep ~mock:true - ~onpasterr:(fun () -> select_tab "prelude"; typecheck_prepare ()) + ~onpasterr:(fun () -> select_tab "prepare"; typecheck_prepare ()) (Ace.get_contents ace_t) in begin test_button ~group: toplevel_buttons_group From a61bc994971032207d9960803ef2cb2cdc6e3797 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 12 Jul 2019 16:35:35 +0200 Subject: [PATCH 08/91] fix : fix metadata fields --- static/new_exercise.html | 203 +++++++++++++++++++-------------------- 1 file changed, 99 insertions(+), 104 deletions(-) diff --git a/static/new_exercise.html b/static/new_exercise.html index d71bb1f3c..afb42b97d 100644 --- a/static/new_exercise.html +++ b/static/new_exercise.html @@ -1,124 +1,119 @@ - + + Learn OCaml by OCamlPro - Editor - -  + + - - + + +
- - - - - + + + + +
- -
- - - - -
+ +
+ + + + +
-
-

New Exercise

-
- -
-

- - - -

-

- - - -

-

- - -

-
-
- - -
-
-
- -
- -
- +
+

New Exercise

-

- - -

-

- - -

-
-
- - -
-
-
- - -
-
- -
+ +
+

+ + + +

+

+ + + +

+

+ + +

+
+
+ + +
+
+
+ +
+ +
+ +
+

+ + +

+

+ + +

+
+
+ + +
+
+
+ + +
+
+ +
+ + - - + \ No newline at end of file From 1d2052dffd03acaea8f2c7f333b99ee9664bf8cc Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 15 Jul 2019 13:58:13 +0200 Subject: [PATCH 09/91] refactor : some refactor of editor.ml --- src/app/dune | 1 + src/app/learnocaml_common.ml | 40 ++++++++++++ src/app/learnocaml_common.mli | 11 ++++ src/app/learnocaml_exercise_main.ml | 38 +---------- src/app/learnocaml_exercise_main.mli | 1 - src/editor/editor.ml | 97 +++------------------------- 6 files changed, 62 insertions(+), 126 deletions(-) delete mode 100644 src/app/learnocaml_exercise_main.mli diff --git a/src/app/dune b/src/app/dune index 6faf6b30d..3411f8210 100644 --- a/src/app/dune +++ b/src/app/dune @@ -21,6 +21,7 @@ learnocaml_repository learnocaml_data learnocaml_api + grading_jsoo ocplib_i18n) ) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index c9abe277e..cc8980a1f 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -930,3 +930,43 @@ let setup_prelude_pane ace prelude = (fun _ -> state := not !state ; update () ; true) ; Manip.appendChildren prelude_pane [ prelude_title ; prelude_container ] + +module Grade_exercise = struct + +let get_grade = + let get_worker = get_worker_code "learnocaml-grader-worker.js" in + fun ?callback ?timeout exercise -> + get_worker () >>= fun worker_js_file -> + Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise + +let display_report exo report = + let score, _failed = Report.result report in + let report_button = find_component "learnocaml-exo-button-report" in + Manip.removeClass report_button "success" ; + Manip.removeClass report_button "failure" ; + Manip.removeClass report_button "partial" ; + let grade = + let max = Learnocaml_exercise.(access File.max_score exo) in + if max = 0 then 999 else score * 100 / max + in + if grade >= 100 then begin + Manip.addClass report_button "success" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ] + end else if grade = 0 then begin + Manip.addClass report_button "failure" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ] + end else begin + Manip.addClass report_button "partial" ; + let pct = Format.asprintf "%2d%%" grade in + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ; + span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] + end ; + let report_container = find_component "learnocaml-exo-tab-report" in + Manip.setInnerHtml report_container + (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; + grade + +end diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 15ef38da0..0195d4a82 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -215,3 +215,14 @@ val typecheck : val set_nickname_div : unit -> unit val setup_prelude_pane : 'a Ace.editor -> string -> unit + +module Grade_exercise : sig + val get_grade : + ?callback:(string -> unit) -> + ?timeout:float -> + Learnocaml_exercise.t -> + (string -> (Learnocaml_report.t * string * string * string) Lwt.t) Lwt.t + val display_report : + Learnocaml_exercise.t -> Learnocaml_data.Report.t -> int +end + diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index 30ff69878..1c460f436 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -10,7 +10,7 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Learnocaml_data - +open Grade_exercise module H = Tyxml_js.Html let init_tabs, select_tab = @@ -29,42 +29,6 @@ let check_if_need_refresh () = let contents = [ H.p [H.pcdata (String.trim message) ] ] in confirm ~title ~ok_label ~cancel_label contents refresh -let get_grade = - let get_worker = get_worker_code "learnocaml-grader-worker.js" in - fun ?callback ?timeout exercise -> - get_worker () >>= fun worker_js_file -> - Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise - -let display_report exo report = - let score, _failed = Report.result report in - let report_button = find_component "learnocaml-exo-button-report" in - Manip.removeClass report_button "success" ; - Manip.removeClass report_button "failure" ; - Manip.removeClass report_button "partial" ; - let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in - if max = 0 then 999 else score * 100 / max - in - if grade >= 100 then begin - Manip.addClass report_button "success" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else if grade = 0 then begin - Manip.addClass report_button "failure" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else begin - Manip.addClass report_button "partial" ; - let pct = Format.asprintf "%2d%%" grade in - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ; - span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] - end ; - let report_container = find_component "learnocaml-exo-tab-report" in - Manip.setInnerHtml report_container - (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; - grade - let display_descr ex_meta = let open Tyxml_js.Html5 in let open Learnocaml_data.Exercise in diff --git a/src/app/learnocaml_exercise_main.mli b/src/app/learnocaml_exercise_main.mli deleted file mode 100644 index 8b6de312b..000000000 --- a/src/app/learnocaml_exercise_main.mli +++ /dev/null @@ -1 +0,0 @@ -val display_report : Learnocaml_exercise.t -> Learnocaml_data.Report.t -> int diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 56a31863b..4a39efb5b 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -18,95 +18,19 @@ open Js_utils open Lwt.Infix open Learnocaml_common +open Grade_exercise open Learnocaml_data open Js_of_ocaml open Editor_lib open Dom_html open Test_spec - -let display_report exo report = - let score, _failed = Report.result report in - let report_button = find_component "learnocaml-exo-button-report" in - Manip.removeClass report_button "success" ; - Manip.removeClass report_button "failure" ; - Manip.removeClass report_button "partial" ; - let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in - if max = 0 then 999 else score * 100 / max - in - if grade >= 100 then begin - Manip.addClass report_button "success" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else if grade = 0 then begin - Manip.addClass report_button "failure" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else begin - Manip.addClass report_button "partial" ; - let pct = Format.asprintf "%2d%%" grade in - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ; - span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] - end ; - let report_container = find_component "learnocaml-exo-tab-report" in - Manip.setInnerHtml report_container - (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; - grade - - -let get_grade = - let get_worker = get_worker_code "learnocaml-grader-worker.js" in - fun ?callback ?timeout exercise -> - get_worker () >>= fun worker_js_file -> - Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise - (*----------------------------------------------------------------------*) let init_tabs, select_tab = - let names = [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; - "question" ; "prelude" ; "prepare" ] in - let current = ref "question" in - let select_tab name = - set_arg "tab" name ; - Manip.removeClass - (find_component ("learnocaml-exo-button-" ^ !current)) - "front-tab" ; - Manip.removeClass - (find_component ("learnocaml-exo-tab-" ^ !current)) - "front-tab" ; - Manip.enable - (find_component ("learnocaml-exo-button-" ^ !current)) ; - Manip.addClass - (find_component ("learnocaml-exo-button-" ^ name)) - "front-tab" ; - Manip.addClass - (find_component ("learnocaml-exo-tab-" ^ name)) - "front-tab" ; - Manip.disable - (find_component ("learnocaml-exo-button-" ^ name)) ; - current := name in - let init_tabs () = - current := begin try - let requested = arg "tab" in - if List.mem requested names then requested else "question" - with Not_found -> "question" - end ; - List.iter - (fun name -> - Manip.removeClass - (find_component ("learnocaml-exo-button-" ^ name)) - "front-tab" ; - Manip.removeClass - (find_component ("learnocaml-exo-tab-" ^ name)) - "front-tab" ; - Manip.Ev.onclick - (find_component ("learnocaml-exo-button-" ^ name)) - (fun _ -> select_tab name ; true)) - names ; - select_tab !current in - init_tabs, select_tab - + mk_tab_handlers "question" [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; + "prelude" ; "prepare" ] + + let set_string_translations () = let translations = [ "txt_preparing", [%i"Preparing the environment"]; @@ -142,13 +66,7 @@ let set_string_translations () = translations let () = - Lwt.async_exception_hook := begin function - | Failure message -> fatal message - | Server_caller.Cannot_fetch message -> fatal message - | exn -> fatal (Printexc.to_string exn) - end ; - (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); - Lwt.async @@ fun () -> + run_async_with_log @@ fun () -> (*set_string_translations ();*) Learnocaml_local_storage.init () ; @@ -600,6 +518,9 @@ let () = Lwt.return_unit end; *) + + (* TODO : factorize somehow this with + src/app/learnocaml_exercise_main grade to learnocaml_common *) let messages = Tyxml_js.Html5.ul [] in let callback text = Manip.appendChild messages Tyxml_js.Html5.(li [ pcdata text ]) in From 1430be12d7143af630f2d25adde840df1c901b44 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 15 Jul 2019 15:42:29 +0200 Subject: [PATCH 10/91] feat : add experiment feature also update exo_creator --- src/app/dune | 3 +- src/app/learnocaml_exercise_main.ml | 37 ++++++++++++++++++++++-- src/editor/editor.ml | 44 ++++++----------------------- src/editor/editor_lib.ml | 2 +- 4 files changed, 46 insertions(+), 40 deletions(-) diff --git a/src/app/dune b/src/app/dune index 3411f8210..de70c6ca5 100644 --- a/src/app/dune +++ b/src/app/dune @@ -58,7 +58,8 @@ learnocaml_app_common learnocaml_toplevel js_of_ocaml.ppx - ocplib_i18n) + editor_lib + ocplib_i18n) (modules Learnocaml_exercise_main) (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) (js_of_ocaml diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index 1c460f436..6f44c8f66 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -286,6 +286,14 @@ let make_readonly () = [%i"The deadline for this exercise has expired. Any changes you make \ from now on will remain local only."] +(* experiment button of editor.html redirects to the html associated to this ml + to know if we are in this page because of that we decide + to put a '.' before the id + therefore idEditor looks for a '.' before the id *) + +let idEditor s = not ((Regexp.string_match (Regexp.regexp "^[.]+") s 0) = None) + + let () = run_async_with_log @@ fun () -> set_string_translations_exercises (); @@ -323,10 +331,20 @@ let () = in Dom_html.document##.title := Js.string (id ^ " - " ^ "Learn OCaml" ^" v."^ Learnocaml_api.version); - let exercise_fetch = - token >>= fun token -> - retrieve (Learnocaml_api.Exercise (token, id)) + + (* if we came from a true exercise we search in the server. + In the other case we get the exercise information from the Local storage *) + let exercise_fetch = match idEditor id with + | false -> token >>= fun token -> + retrieve (Learnocaml_api.Exercise (token, id)) + + | true -> let proper_id = String.sub id 1 ((String.length id)-1) in + Lwt.return ((Editor_lib.get_editor_state proper_id).Editor.metadata, + (Editor_lib.exo_creator proper_id ), + None) in + + let after_init top = exercise_fetch >>= fun (_meta, exo, _deadline) -> begin match Learnocaml_exercise.(decipher File.prelude exo) with @@ -404,6 +422,18 @@ let () = (* ---- main toolbar -------------------------------------------------- *) let exo_toolbar = find_component "learnocaml-exo-toolbar" in let toolbar_button = button ~container: exo_toolbar ~theme: "light" in + let () = + if idEditor id then + begin + let id = String.sub id 1 ((String.length id)-1) in + begin toolbar_button + ~icon: "upload" [%i"Edit"] @@ fun ()-> + Dom_html.window##.location##assign + (Js.string ("editor.html#id=" ^ id ^ "&action=open")); + Lwt.return_unit + end; + end + in begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> Dom_html.window##.location##assign @@ -416,6 +446,7 @@ let () = let worker = ref (get_grade ~callback exo) in + begin toolbar_button ~icon: "typecheck" [%i"Compile"] @@ fun () -> typecheck true diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 4a39efb5b..386934b9e 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -481,43 +481,16 @@ let () = Manip.SetCss.opacity abort_message (Some "1") ; Lwt.return () end ; -(* + begin toolbar_button - ~icon: "upload" [%i"Experiment"] @@ fun ()-> - (* recovering ();*) - - let aborted, abort_message = - let t, u = Lwt.task () in - let btn = Tyxml_js.Html5.(button [ pcdata [%i"abort"] ]) in - Manip.Ev.onclick btn (fun _ -> Lwt.wakeup u () ; true) ; - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata [%i"Grading is taking a lot of time, "] ; - btn ; - pcdata "?" ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - let worker = ref (Grading_jsoo.get_grade (exo_creator id)) in - let correction = - Learnocaml_exercise.get Learnocaml_exercise.solution (exo_creator id) in - let grading = - !worker correction >>= fun (report, _, _, _) -> - Lwt.return report in - let abortion = - Lwt_js.sleep 5. >>= fun () -> - Manip.SetCss.opacity abort_message (Some "1") ; - aborted >>= fun () -> - Lwt.return Learnocaml_report.[ Message - ([ Text [%i"Grading aborted by user."] ], Failure) ] in - Lwt.pick [ grading ; abortion ] >>= fun report_correction -> - let score_maxi, failed2 = - Learnocaml_report.result report_correction in - Dom_html.window##.location##assign - (Js.string ("exercise.html#id=." ^ id ^ "&score=" ^ - (string_of_int score_maxi) ^ "&action=open")); - Lwt.return_unit + ~icon: "upload" [%i"Experiment"] @@ + fun ()-> + recovering (); + Dom_html.window##.location##assign + (Js.string ("exercise.html#id=." ^ id)); + Lwt.return_unit end; - *) + (* TODO : factorize somehow this with src/app/learnocaml_exercise_main grade to learnocaml_common *) @@ -583,6 +556,7 @@ let () = recovering (); grade () end ; + Window.onunload (fun _ev -> recovering (); true); (* ---- return -------------------------------------------------------- *) (* toplevel_launch >>= fun _ -> should be unnecessary? *) (* typecheck false >>= fun () -> *) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 876a29d8d..b1d467d14 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -341,7 +341,7 @@ let exo_creator proper_id = | "id"-> Some exercise.id | "prelude.ml" -> Some exercise.prelude | "template.ml" -> Some exercise.template - | "descr.html" -> Some exercise.descr + | "descr.md" -> Some exercise.descr | "prepare.ml" -> Some exercise.prepare | "test.ml" -> Some exercise.test | "solution.ml" -> Some exercise.solution From 9a1140fe7eca2b870c8a39537e687c0dc1b98c1b Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 16 Jul 2019 14:09:56 +0200 Subject: [PATCH 11/91] feat : zip export of 1 exercise --- learn-ocaml.opam | 2 +- src/app/#learnocaml_common.ml# | 972 ++++++++++++++++++++ src/app/.#learnocaml_common.ml | 1 + src/editor/dune | 16 +- src/editor/editor.ml | 38 +- src/editor/jszip.mli | 7 + static/Makefile | 1 + static/editor.html | 244 ++--- static/js/jszip/jszip.min.js | 13 + static/js/jszip/learnocaml_jszip_wrapper.js | 19 + static/js/jszip/node_modules/.lsp/debug.log | 118 +++ 11 files changed, 1296 insertions(+), 135 deletions(-) create mode 100644 src/app/#learnocaml_common.ml# create mode 120000 src/app/.#learnocaml_common.ml create mode 100644 src/editor/jszip.mli create mode 100644 static/js/jszip/jszip.min.js create mode 100644 static/js/jszip/learnocaml_jszip_wrapper.js create mode 100644 static/js/jszip/node_modules/.lsp/debug.log diff --git a/learn-ocaml.opam b/learn-ocaml.opam index bcecc4a49..92eb641a5 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -48,7 +48,7 @@ depends: [ "ppx_cstruct" "ppx_tools" "uutf" {>= "1.0" } - "yojson" {>= "1.4.0" } + "yojson" {>= "1.4.0" } ] build: [ [make "static"] diff --git a/src/app/#learnocaml_common.ml# b/src/app/#learnocaml_common.ml# new file mode 100644 index 000000000..737257985 --- /dev/null +++ b/src/app/#learnocaml_common.ml# @@ -0,0 +1,972 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Js_utils +open Lwt.Infix +open Learnocaml_data + +module H = Tyxml_js.Html + +let find_div_or_append_to_body id = + match Manip.by_id id with + | Some div -> div + | None -> + let div = H.(div ~a:[ a_id id ]) [] in + Manip.(appendChild Elt.body) div; + div + +let find_component id = + match Js_utils.Manip.by_id id with + | Some div -> div + | None -> failwith ("Cannot find id " ^ id) + +let fake_download ~name ~contents = + (* TODO: add some primitives to jsoo and clean this up *) + let blob : (Js.js_string Js.t Js.js_array Js.t -> File.blob Js.t) Js.constr = + Js.Unsafe.global ##. _Blob in + let blob = new%js blob (Js.array [| contents |]) in + let url = + Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject blob |] in File + let link = Dom_html.createA Dom_html.document in + link##.href := url ; + Js.Unsafe.set link (Js.string "download") (Js.string name) ; + ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; + ignore (Js.Unsafe.meth_call link "click" [||]) ; + ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t)))) + +let fake_upload () = + let input_files_load = + Dom_html.createInput ~_type: (Js.string "file") Dom_html.document in + let result_t, result_wakener = Lwt.wait () in + let fail () = + Lwt.wakeup_exn result_wakener + (Failure "file loading not implemented for this browser") ; + Js._true in + input_files_load##.onchange := Dom.handler (fun ev -> + Js.Opt.case (ev##.target) fail @@ fun target -> + Js.Opt.case (Dom_html.CoerceTo.input target) fail @@ fun input -> + Js.Optdef.case (input##.files) fail @@ fun files -> + Js.Opt.case (files##(item (0))) fail @@ fun file -> + let name = Js.to_string file##.name in + let fileReader = new%js File.fileReader in + fileReader##.onload := Dom.handler (fun ev -> + Js.Opt.case (ev##.target) fail @@ fun target -> + Js.Opt.case (File.CoerceTo.string (target##.result)) fail @@ fun result -> + Lwt.wakeup result_wakener (name, result) ; + Js._true) ; + fileReader##(readAsText file) ; + Js._true) ; + ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; + result_t + +let fatal ?(title=[%i"INTERNAL ERROR"]) message = + let titletext = title in + let id = "ocp-fatal-layer" in + let div = match Manip.by_id id with + | Some div -> div + | None -> + let div = + H.div ~a:[ H.a_id id ; + H.a_class ["learnocaml-dialog-overlay"] + ] + [] + in + Manip.(appendChild Elt.body) div; + div in + Manip.replaceChildren div [ + H.div [ + H.h3 [ H.pcdata titletext ]; + H.div [ H.p [ H.pcdata (String.trim message) ] ]; + ] + ] + +let dialog_layer_id = "ocp-dialog-layer" + +let box_button txt f = + H.button ~a: [ + H.a_onclick (fun _ -> + f (); + match Manip.by_id dialog_layer_id with + | Some div -> Manip.removeChild Manip.Elt.body div; false + | None -> (); false) + ] [ H.pcdata txt ] + +let close_button txt = + box_button txt @@ fun () -> () + +let ext_alert ~title ?(buttons = [close_button [%i"OK"]]) message = + let div = match Manip.by_id dialog_layer_id with + | Some div -> div + | None -> + let div = + H.div ~a:[ H.a_id dialog_layer_id ; + H.a_class ["learnocaml-dialog-overlay"] ] + [] + in + Manip.(appendChild Elt.body) div; + div in + Manip.replaceChildren div [ + H.div [ + H.h3 [ H.pcdata title ]; + H.div message; + H.div ~a:[ H.a_class ["buttons"] ] buttons; + ] + ] + +let lwt_alert ~title ~buttons message = + let waiter, wakener = Lwt.task () in + let buttons = + List.map (fun (txt, f) -> + box_button txt (fun () -> + Lwt.async @@ fun () -> + f () >|= Lwt.wakeup_later wakener)) + buttons + in + ext_alert ~title message ~buttons; + waiter + +let alert ?(title=[%i"ERROR"]) ?buttons message = + ext_alert ~title ?buttons [ H.p [H.pcdata (String.trim message)] ] + +let confirm ~title ?(ok_label=[%i"OK"]) ?(cancel_label=[%i"Cancel"]) contents f = + ext_alert ~title contents ~buttons:[ + box_button ok_label f; + close_button cancel_label; + ] + +let ask_string ~title ?(ok_label=[%i"OK"]) contents = + let input_field = + H.input ~a:[ + H.a_input_type `Text; + ] () + in + let result_t, up = Lwt.wait () in + ext_alert ~title (contents @ [input_field]) ~buttons:[ + box_button ok_label (fun () -> Lwt.wakeup up @@ Manip.value input_field) + ]; + result_t + +let default_exn_printer = function + | Failure msg -> msg + | e -> Printexc.to_string e + +let catch_with_alert ?(printer=default_exn_printer) f = + Lwt.catch f @@ fun exn -> alert (printer exn); Lwt.return_unit + +let hide_loading ?(id = "ocp-loading-layer") () = + let elt = find_div_or_append_to_body id in + Manip.(removeClass elt "initial") ; + Manip.(removeClass elt "loading") ; + Manip.(addClass elt "loaded") + +let show_loading ?(id = "ocp-loading-layer") contents f = + let show () = + let elt = find_div_or_append_to_body id in + Manip.(addClass elt "loading-layer") ; + Manip.(removeClass elt "loaded") ; + Manip.(addClass elt "loading") ; + let chamo_src = + "/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 () ] ; + div ~a: [ a_class [ "messages" ] ] contents + ] + in + let hide () = + let elt = find_div_or_append_to_body id in + Manip.(removeClass elt "initial") ; + Manip.(removeClass elt "loading") ; + Manip.(addClass elt "loaded") + in + Lwt.finalize + (fun () -> show (); f ()) + (fun () -> hide (); Lwt.return_unit) + +let set_assoc name value = + let rec set acc = function + | [] -> List.rev ((name, value) :: acc) + | (n, _) :: args when n = name -> + List.rev_append ((name, value) :: acc) args + | arg :: args -> set (arg :: acc) args in + set [] + +let delete_assoc name = + List.filter (fun (n, _) -> n <> name) + +let arg, set_arg, delete_arg = + let args = ref (Js_utils.parse_fragment ()) in + let delete_arg name = + args := delete_assoc name !args ; + Js_utils.set_fragment !args in + let set_arg name value = + args := set_assoc name value !args ; + Js_utils.set_fragment !args in + let arg name = + List.assoc name !args in + arg, set_arg, delete_arg + +type button_group = + (< disabled : bool Js.t Js.prop > Js.t * bool ref) list ref + * Lwt_mutex.t + * int ref + +let button_group () : button_group = + (ref [], Lwt_mutex.create (), ref 0) + +type button_state = + bool ref + * (button_group * < disabled : bool Js.t Js.prop > Js.t) option ref + +let button_state () : button_state = + (ref false, ref None) + +let disable_button_group (buttons, _, cpt) = + incr cpt ; + if !cpt = 1 then + List.iter + (fun (button, _) -> + button##.disabled := Js.bool true) + !buttons + +let enable_button_group (buttons, _, cpt) = + decr cpt ; + if !cpt = 0 then + List.iter + (fun (button, state) -> + if not !state then + button##.disabled := Js.bool false) + !buttons + +let disable_button (disabled, self) = + match !self with + | None -> + disabled := true + | Some (_, button) -> + disabled := true ; + button##.disabled := Js.bool true + +let enable_button (disabled, self) = + match !self with + | None -> + disabled := false + | Some ((_, _, cpt), button) -> + disabled := false ; + if !cpt = 0 then + button##.disabled := Js.bool false + +let button_group_disabled (_, _, cpt) = + !cpt > 0 + +let disabling_button_group group cb = + disable_button_group group ; + Lwt_js.yield () >>= fun () -> + Lwt.catch cb + (function + | Lwt.Canceled -> Lwt.return () + | exn -> Lwt.fail exn) >>= fun res -> + enable_button_group group ; + Lwt_js.yield () >>= fun () -> + Lwt.return res + +let disable_with_button_group component (buttons, _, _) = + buttons := + ((component :> < disabled : bool Js.t Js.prop > Js.t), ref false) + :: !buttons + +let button ~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 [ + img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + pcdata " " ; + span ~a:[ a_class [ "label" ] ] [ pcdata lbl ] + ]) in + Manip.Ev.onclick button + (fun _ -> + begin Lwt.async @@ fun () -> + Lwt_mutex.with_lock mutex @@ fun () -> + disabling_button_group group cb + end ; + true) ; + let dom_button = + (Tyxml_js.To_dom.of_button button + :> < disabled : bool Js.t Js.prop > Js.t) in + let self_disabled = + match state with + | None -> ref false + | Some (disabled, self) -> + self := Some (group, dom_button) ; + disabled in + others := (dom_button, self_disabled) :: !others ; + if !self_disabled || !cnt > 0 then + dom_button##.disabled := Js.bool true ; + Manip.appendChild container button + +let dropdown ~id ~title items = + let toggle _ = + let menu = find_component id in + let disp = + match Manip.Css.display menu with + | "block" -> "none" + | _ -> + Lwt_js_events.async (fun () -> + Lwt_js_events.click window >|= fun _ -> + Manip.SetCss.display menu "none" + ); + "block" + in + Manip.SetCss.display menu disp; + false + in + H.div ~a: [H.a_class ["dropdown_btn"]] [ + H.button ~a: [H.a_onclick toggle] + (title @ [H.pcdata " \xe2\x96\xb4" (* U+25B4 *)]); + H.div ~a: [H.a_id id; H.a_class ["dropdown_content"]] items + ] + +let gettimeofday () = + (new%js Js.date_now)##getTime /. 1000. + +let render_rich_text ?on_runnable_clicked text = + let open Learnocaml_data.Tutorial in + let rec render acc text = + match text with + | [] -> List.rev acc + | Text text :: rest -> + render + (H.pcdata text :: acc) + rest + | Code { code ; runnable } :: rest -> + let elt = H.code [ H.pcdata code ] in + (match runnable, on_runnable_clicked with + | true, Some cb -> + Manip.addClass elt "runnable" ; + Manip.Ev.onclick elt (fun _ -> cb code ; true) + | _ -> ()) ; + render (elt :: acc) rest ; + | Emph text :: rest -> + render + (H.em (render [] text) :: acc) + rest + | Image _ :: _ -> assert false + | Math code :: rest -> + render + (H.pcdata ("`" ^ code ^ "`") :: acc) + rest in + (render [] text + :> [< Html_types.phrasing > `Code `Em `PCDATA ] H.elt list) + +let extract_text_from_rich_text text = + let open Learnocaml_data.Tutorial in + let rec render acc text = + match text with + | [] -> String.concat " " (List.rev acc) + | Text text :: rest -> + render (text :: acc) rest + | Code { code ; _ } :: rest -> + render (("[" ^ code ^ "]") :: acc) rest + | Emph text :: rest -> + render (("*" ^ render [] text ^ "*") :: acc) rest + | Image { alt ; _ } :: rest -> + render (("(" ^ alt ^ ")") :: acc) rest + | Math code :: rest -> + render (("$" ^ code ^ "$") :: acc) rest in + render [] 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; + store nickname save.nickname; + store all_exercise_states + (SMap.merge (fun _ ans edi -> + match ans, edi with + | Some ans, Some (mtime, solution) -> + Some {ans with Answer.solution; mtime} + | None, Some (mtime, solution) -> + Some Answer.{grade = None; report = None; solution; mtime} + | ans, _ -> ans) + save.all_exercise_states save.all_exercise_editors); + store all_toplevel_histories save.all_toplevel_histories; + store all_exercise_toplevel_histories save.all_exercise_toplevel_histories + +let rec retrieve ?ignore req = + Server_caller.request req >>= function + | Ok x -> Lwt.return x + | Error e -> + lwt_alert ~title:[%i"REQUEST ERROR"] [ + H.p [H.pcdata [%i"Could not retrieve data from server"]]; + H.code [H.pcdata (Server_caller.string_of_error e)]; + ] ~buttons:( + ([%i"Retry"], (fun () -> retrieve req)) :: + (match ignore with + | None -> [] + | Some v -> [[%i"Ignore"], fun () -> Lwt.return v]) @ + [[%i"Cancel"], (fun () -> Lwt.fail Lwt.Canceled)] + ) + +let get_state_as_save_file ?(include_reports = false) () = + let open Learnocaml_data.Save in + let open Learnocaml_local_storage in + let answers = retrieve all_exercise_states in + { + nickname = retrieve nickname; + all_exercise_editors = + if include_reports then SMap.empty + else SMap.map (fun a -> a.Answer.mtime, a.Answer.solution) answers; + all_exercise_states = + if include_reports then answers + else SMap.empty; + all_toplevel_histories = retrieve all_toplevel_histories; + all_exercise_toplevel_histories = retrieve all_exercise_toplevel_histories; + } + +let rec sync_save token save_file = + Server_caller.request (Learnocaml_api.Update_save (token, save_file)) + >>= function + | Ok save -> set_state_from_save_file ~token save; Lwt.return save + | Error (`Not_found _) -> + Server_caller.request_exn + (Learnocaml_api.Create_token ("", Some token, None)) >>= fun _token -> + assert (_token = token); + Server_caller.request_exn + (Learnocaml_api.Update_save (token, save_file)) >>= fun save -> + set_state_from_save_file ~token save; + Lwt.return save + | Error e -> + lwt_alert ~title:[%i"SYNC FAILED"] [ + H.p [H.pcdata [%i"Could not synchronise save with the server"]]; + H.code [H.pcdata (Server_caller.string_of_error e)]; + ] ~buttons:[ + [%i"Retry"], (fun () -> sync_save token save_file); + [%i"Ignore"], (fun () -> Lwt.return save_file); + ] + +let sync token = sync_save token (get_state_as_save_file ()) + +let sync_exercise token ?answer ?editor id = + let nickname = Learnocaml_local_storage.(retrieve nickname) in + let toplevel_history = + SMap.find_opt id Learnocaml_local_storage.(retrieve all_toplevel_histories) + in + let txt = match editor with None -> None | Some e -> Some (max_float, e) in + let opt_to_map = function + | Some i -> SMap.singleton id i + | None -> SMap.empty + in + let save_file = Save.{ + nickname; + all_exercise_editors = opt_to_map txt; + all_exercise_states = opt_to_map answer; + 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) + + +let string_of_seconds seconds = + let days = seconds / 24 / 60 / 60 in + let hours = seconds / 60 / 60 mod 24 in + let minutes = seconds / 60 mod 60 in + let seconds = seconds mod 60 in + if days >= 1 then Printf.sprintf [%if"%dd %02dh"] days hours else + if hours >= 1 then Printf.sprintf [%if"%02d:%02d"] hours minutes else + Printf.sprintf [%if"0:%02d:%02d"] minutes seconds + +let countdown ?(ontimeout = fun () -> ()) container t = + let deadline = gettimeofday () +. t in + let update_interval seconds = + if seconds >= 24 * 60 * 60 then 1000. *. 60. *. 60. + else if seconds >= 60 * 60 then 1000. *. 60. + else 1000. + in + let update remaining = + Manip.setInnerText container (string_of_seconds remaining) + in + let rec callback () = + let remaining = int_of_float (deadline -. gettimeofday ()) in + if remaining <= 0 then + (update 0; + ontimeout ()) + else + (update remaining; + ignore (window##setTimeout + (Js.wrap_callback callback) + (update_interval remaining))) + in + callback () + +let flog fmt = Printf.ksprintf (fun s -> Firebug.console##log(Js.string s)) fmt + +let stars_div stars = + H.div ~a:[ H.a_class [ "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 + H.img ~alt ~src () + ] + +let exercise_text ex_meta exo = + let mathjax_url = + "/js/mathjax/MathJax.js?delayStartupUntil=configured" + in + let mathjax_config = + "MathJax.Hub.Config({\n\ + \ jax: [\"input/AsciiMath\", \"output/HTML-CSS\"],\n\ + \ extensions: [],\n\ + \ showMathMenu: false,\n\ + \ showMathMenuMSIE: false,\n\ + \ \"HTML-CSS\": {\n\ + \ imageFont: null\n\ + \ } + });" + (* the following would allow comma instead of dot for the decimal separator, + but should depend on the language the exercise is in, not the language of the + app + "AsciiMath: {\n\ + \ decimal: \"" ^[%i"."]^ "\"\n\ + },\n" + *) + in + (* Looking for the description in the correct language. *) + let descr = + let lang = "" in + try + List.assoc lang (Learnocaml_exercise.(access File.descr exo)) + with + Not_found -> + try List.assoc "" (Learnocaml_exercise.(access File.descr exo)) + with Not_found -> [%i "No description available for this exercise." ] + in + Format.asprintf + "\ + \ + %s - exercise text\ + \ + \ + + \ + \ + \ + %s\ + \ + \ + " + ex_meta.Exercise.Meta.title + mathjax_config + mathjax_url + descr + +let string_of_exercise_kind = function + | Exercise.Meta.Project -> [%i"project"] + | Exercise.Meta.Problem -> [%i"problem"] + | Exercise.Meta.Exercise -> [%i"exercise"] + +let grade_color = function + | None -> "#808080" + | Some score -> + Printf.sprintf "hsl(%d, 100%%, 67%%)" + (int_of_float (float_of_int score /. 100. *. 138.)) + +let get_assignments tokens exos_status = + let module ES = Exercise.Status in + let module ATM = Map.Make(struct + type t = (float * float) * Token.Set.t * bool + let compare (d1, ts1, dft1) (d2, ts2, dft2) = + match compare d1 d2 with + | 0 -> (match Token.Set.compare ts1 ts2 with + | 0 -> compare dft1 dft2 + | n -> n) + | n -> n + end) + in + let atm_add atm key id = + match ATM.find_opt key atm with + | None -> ATM.add key (SSet.singleton id) atm + | Some set -> ATM.add key (SSet.add id set) atm + in + let atm = + SMap.fold (fun id st atm -> + let assg = st.ES.assignments in + let default = ES.default_assignment assg in + let stl = ES.by_status tokens assg in + let atm = match default with + | ES.Assigned {start; stop} -> + let explicit_tokens = + Token.Map.fold (fun tok _ -> Token.Set.add tok) + assg.ES.token_map Token.Set.empty + in + let implicit_tokens = + Token.Set.diff tokens explicit_tokens + in + atm_add atm ((start, stop), implicit_tokens, true) id + | _ -> atm + in + List.fold_left (fun atm (status, tokens) -> + match status with + | ES.Open | ES.Closed -> atm + | ES.Assigned {start; stop} -> + let key = (start, stop), tokens, (status = default) in + match ATM.find_opt key atm with + | None -> + ATM.add key (SSet.singleton id) atm + | Some ids -> + ATM.add key (SSet.add id ids) atm) + atm + stl) + exos_status + ATM.empty + in + ATM.fold (fun (assg, tokens, dft) exos l -> + (assg, tokens, dft, exos) :: l) + atm [] + |> List.rev + +let string_of_date ?(time=false) t = + let date = new%js Js.date_fromTimeValue (t *. 1000.) in + if time then + Printf.sprintf "%04d-%02d-%02d %02d:%02d" + date##getFullYear (date##getMonth + 1) date##getDate + date##getHours date##getMinutes + else + Printf.sprintf "%04d-%02d-%02d" + date##getFullYear (date##getMonth + 1) date##getDate + +let date ?(time=false) t = + let date = new%js Js.date_fromTimeValue (t *. 1000.) in + H.time ~a:[ H.a_datetime (Js.to_string date##toISOString) ] [ + H.pcdata + (Js.to_string (if time then date##toLocaleString + else date##toLocaleDateString)) + ] + +let tag_span tag = + let color = + Printf.sprintf "#%06x" ((Hashtbl.hash tag lor 0x808080) land 0xffffff) + in + H.span ~a:[H.a_class ["tag"]; + H.a_style ("background-color: "^color)] + [H.pcdata tag] + +let get_worker_code name = + let worker_url = ref None in + fun () -> match !worker_url with + | None -> + retrieve (Learnocaml_api.Static ["js"; name]) >|= fun js -> + let url = js_code_url js in worker_url := Some url; url + | Some url -> Lwt.return url + +let toplevel_launch ?display_welcome ?after_init ?(on_disable=fun () -> ()) ?(on_enable=fun () -> ()) + container history on_show toplevel_buttons_group id = + let timeout_prompt = + Learnocaml_toplevel.make_timeout_popup ~on_show () in + let flood_prompt = + Learnocaml_toplevel.make_flood_popup ~on_show () in + let history = + let storage_key = history id in + let on_update self = + Learnocaml_local_storage.store storage_key + (Learnocaml_toplevel_history.snapshot self) in + let snapshot = + Learnocaml_local_storage.retrieve storage_key in + Learnocaml_toplevel_history.create + ~gettimeofday + ~on_update + ~max_size: 99 + ~snapshot () in + get_worker_code "learnocaml-toplevel-worker.js" () >>= fun worker_js_file -> + Learnocaml_toplevel.create ~worker_js_file + ?display_welcome ?after_init ~timeout_prompt ~flood_prompt + ~on_disable_input: (fun _ -> on_disable (); disable_button_group toplevel_buttons_group) + ~on_enable_input: (fun _ -> on_enable (); enable_button_group toplevel_buttons_group) + ~container + ~history () + +let init_toplevel_pane toplevel_launch top toplevel_buttons_group toplevel_button = + begin toplevel_button + ~icon: "cleanup" [%i"Clear"] @@ fun () -> + Learnocaml_toplevel.clear top ; + Lwt.return () + end ; + begin toplevel_button + ~icon: "reload" [%i"Reset"] @@ fun () -> + toplevel_launch >>= fun top -> + disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) + end ; + begin toplevel_button + ~icon: "run" [%i"Eval phrase"] @@ fun () -> + Learnocaml_toplevel.execute top ; + Lwt.return () + end + +let set_string_translations_exercises () = + let translations = [ + "txt_preparing", [%i"Preparing the environment"]; + "learnocaml-exo-button-editor", [%i"Editor"]; + "learnocaml-exo-button-toplevel", [%i"Toplevel"]; + "learnocaml-exo-button-report", [%i"Report"]; + "learnocaml-exo-button-text", [%i"Exercise"]; + "learnocaml-exo-button-meta", [%i"Details"]; + "learnocaml-exo-editor-pane", [%i"Editor"]; + "txt_grade_report", [%i"Click the Grade button to get your report"]; + ] in + List.iter + (fun (id, text) -> + match Js_utils.Manip.by_id id with + | None -> () + | Some component -> + Manip.setInnerHtml component text) + translations + +let local_save ace id = + let key = Learnocaml_local_storage.exercise_state id in + let ans = + try Learnocaml_local_storage.retrieve key with Not_found -> + Answer.{solution = ""; mtime = 0.; report = None; grade = None} + in + Learnocaml_local_storage.store key + { ans with Answer.solution = Ace.get_contents ace; + mtime = gettimeofday () } + +let run_async_with_log f = + Lwt.async_exception_hook := begin fun e -> + Firebug.console##log (Js.string + (Printexc.to_string e ^ + if Printexc.backtrace_status () then + Printexc.get_backtrace () + else "")); + match e with + | Failure message -> fatal message + | Server_caller.Cannot_fetch message -> fatal message + | exn -> fatal (Printexc.to_string exn) + end ; + (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); + Lwt.async f + +let mk_tab_handlers default_tab other_tabs = + let names = default_tab::other_tabs in + let current = ref default_tab in + let select_tab name = + set_arg "tab" name ; + Manip.removeClass + (find_component ("learnocaml-exo-button-" ^ !current)) + "front-tab" ; + Manip.removeClass + (find_component ("learnocaml-exo-tab-" ^ !current)) + "front-tab" ; + Manip.enable + (find_component ("learnocaml-exo-button-" ^ !current)) ; + Manip.addClass + (find_component ("learnocaml-exo-button-" ^ name)) + "front-tab" ; + Manip.addClass + (find_component ("learnocaml-exo-tab-" ^ name)) + "front-tab" ; + Manip.disable + (find_component ("learnocaml-exo-button-" ^ name)) ; + current := name in + let init_tabs () = + current := + begin + try + let requested = arg "tab" in + if List.mem requested names then requested else default_tab + with Not_found -> default_tab + end ; + List.iter + (fun name -> + Manip.removeClass + (find_component ("learnocaml-exo-button-" ^ name)) + "front-tab" ; + Manip.removeClass + (find_component ("learnocaml-exo-tab-" ^ name)) + "front-tab" ; + Manip.Ev.onclick + (find_component ("learnocaml-exo-button-" ^ name)) + (fun _ -> select_tab name ; true)) + names ; + select_tab !current in + init_tabs, select_tab + +module type Editor_info = sig + val ace : Ocaml_mode.editor Ace.editor + val buttons_container : 'a Tyxml_js.Html5.elt +end + +module Editor_button (E : Editor_info) = struct + + let editor_button = button ~container:E.buttons_container ~theme:"light" + + let cleanup template = + editor_button + ~icon: "cleanup" [%i"Reset"] @@ fun () -> + confirm ~title:[%i"START FROM SCRATCH"] + [H.pcdata [%i"This will discard all your edits. Are you sure?"]] + (fun () -> + Ace.set_contents E.ace template); + Lwt.return () + + let download id = + editor_button + ~icon: "download" [%i"Download"] @@ fun () -> + let name = id ^ ".ml" in + let contents = Js.string (Ace.get_contents E.ace) in + fake_download ~name ~contents ; + Lwt.return () + + let eval top select_tab = + editor_button + ~icon: "run" [%i"Eval code"] @@ fun () -> + Learnocaml_toplevel.execute_phrase top (Ace.get_contents E.ace) >>= fun _ -> + select_tab "toplevel"; + Lwt.return_unit + + let sync token id = + editor_button + ~icon: "sync" [%i"Sync"] @@ fun () -> + token >>= fun token -> + sync_exercise token id ~editor:(Ace.get_contents E.ace) >|= fun _save -> () +end + +let setup_editor solution = + let editor_pane = find_component "learnocaml-exo-editor-pane" in + let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in + let ace = Ocaml_mode.get_editor editor in + Ace.set_contents ace ~reset_undo:true solution; + Ace.set_font_size ace 18; + editor, ace + +let typecheck top ace editor set_class = + Learnocaml_toplevel.check top (Ace.get_contents ace) >>= fun res -> + let error, warnings = + match res with + | Toploop_results.Ok ((), warnings) -> None, warnings + | Toploop_results.Error (err, warnings) -> Some err, warnings in + let transl_loc { Toploop_results.loc_start ; loc_end } = + { Ocaml_mode.loc_start ; loc_end } in + let error = match error with + | None -> None + | Some { Toploop_results.locs ; msg ; if_highlight } -> + Some { Ocaml_mode.locs = List.map transl_loc locs ; + msg = (if if_highlight <> "" then if_highlight else msg) } in + let warnings = + List.map + (fun { Toploop_results.locs ; msg ; if_highlight } -> + { Ocaml_mode.loc = transl_loc (List.hd locs) ; + msg = (if if_highlight <> "" then if_highlight else msg) }) + warnings in + Ocaml_mode.report_error ~set_class editor error warnings >|= fun () -> + Ace.focus ace + +let set_nickname_div () = + let nickname_div = find_component "learnocaml-nickname" in + match Learnocaml_local_storage.(retrieve nickname) with + | nickname -> Manip.setInnerText nickname_div nickname + | exception Not_found -> () + +let setup_prelude_pane ace prelude = + if prelude = "" then () else + let editor_pane = find_component "learnocaml-exo-editor-pane" in + let prelude_pane = find_component "learnocaml-exo-prelude" in + let open Tyxml_js.Html5 in + let state = + ref (match arg "prelude" with + | exception Not_found -> true + | "shown" -> true + | "hidden" -> false + | _ -> failwith "Bad format for argument prelude.") in + let prelude_btn = button [] in + let prelude_title = h1 [ pcdata [%i"OCaml prelude"] ; + prelude_btn ] in + let prelude_container = + pre ~a: [ a_class [ "toplevel-code" ] ] + (Learnocaml_toplevel_output.format_ocaml_code prelude) in + let update () = + if !state then begin + Manip.replaceChildren prelude_btn [ pcdata ("↳ "^[%i"Hide"]) ] ; + Manip.SetCss.display prelude_container "" ; + Manip.SetCss.top editor_pane "193px" ; (* 150 + 43 *) + Manip.SetCss.bottom editor_pane "40px" ; + Ace.resize ace true; + set_arg "prelude" "shown" + end else begin + Manip.replaceChildren prelude_btn [ pcdata ("↰ "^[%i"Show"]) ] ; + Manip.SetCss.display prelude_container "none" ; + Manip.SetCss.top editor_pane "43px" ; + Manip.SetCss.bottom editor_pane "40px" ; + Ace.resize ace true; + set_arg "prelude" "hidden" + end in + update () ; + Manip.Ev.onclick prelude_btn + (fun _ -> state := not !state ; update () ; true) ; + Manip.appendChildren prelude_pane + [ prelude_title ; prelude_container ] + +module Grade_exercise = struct + +let get_grade = + let get_worker = get_worker_code "learnocaml-grader-worker.js" in + fun ?callback ?timeout exercise -> + get_worker () >>= fun worker_js_file -> + Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise + +let display_report exo report = + let score, _failed = Report.result report in + let report_button = find_component "learnocaml-exo-button-report" in + Manip.removeClass report_button "success" ; + Manip.removeClass report_button "failure" ; + Manip.removeClass report_button "partial" ; + let grade = + let max = Learnocaml_exercise.(access File.max_score exo) in + if max = 0 then 999 else score * 100 / max + in + if grade >= 100 then begin + Manip.addClass report_button "success" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ] + end else if grade = 0 then begin + Manip.addClass report_button "failure" ; + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ] + end else begin + Manip.addClass report_button "partial" ; + let pct = Format.asprintf "%2d%%" grade in + Manip.replaceChildren report_button + Tyxml_js.Html5.[ pcdata [%i"Report"] ; + span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] + end ; + let report_container = find_component "learnocaml-exo-tab-report" in + Manip.setInnerHtml report_container + (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; + grade + +end diff --git a/src/app/.#learnocaml_common.ml b/src/app/.#learnocaml_common.ml new file mode 120000 index 000000000..4ffd372dd --- /dev/null +++ b/src/app/.#learnocaml_common.ml @@ -0,0 +1 @@ +manu@manu-Lenovo-ideapad-330-15ICH.10343:1563255518 \ No newline at end of file diff --git a/src/editor/dune b/src/editor/dune index bc6fff4bd..b27a1f537 100644 --- a/src/editor/dune +++ b/src/editor/dune @@ -1,3 +1,16 @@ +(library + (name jszip) + (wrapped false) + (flags :standard -w -9 -warn-error -27) + (modules_without_implementation Jszip) + (modules Jszip) + (libraries jsutils + js_of_ocaml + js_of_ocaml-lwt + lwt) + (preprocess (pps js_of_ocaml.ppx)) + ) + (library (name editor_lib) (wrapped false) @@ -102,12 +115,13 @@ testing grading editor_lib + jszip test_spec) (modules Editor) (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) (js_of_ocaml (flags :standard --toplevel --nocmis +cstruct/cstruct.js +dynlink.js +toplevel.js) - (javascript_files ../ace-lib/ace_bindings.js)) + (javascript_files ../ace-lib/ace_bindings.js ../../static/js/jszip/learnocaml_jszip_wrapper.js )) ) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 386934b9e..87da622f9 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -402,22 +402,36 @@ let () = recovering (); Lwt.return () end ; - begin editor_button ~icon: "download" [%i"Download"] @@ fun () -> recovering () ; - let name = id ^ ".json" in - let content =get_editor_state id in - let json = - Json_repr_browser.Json_encoding.construct - Editor.editor_state_enc - content in - let contents = - (Js._JSON##stringify json) in - Learnocaml_common.fake_download ~name ~contents ; - Lwt.return () + let name = id ^ ".zip" in + let content =(get_editor_state id) in + let json = + Json_repr_browser.Json_encoding.construct + Editor.editor_state_enc + content in + let contents = + Js._JSON##stringify json in + let editor_download:Js.js_string Js.t -> (File.blob Js.t -> unit Js.meth) Js.meth + = Js.Unsafe.eval_string "editor_download" in + let _ = Js.Unsafe.fun_call editor_download + [|Js.Unsafe.inject contents; + Js.Unsafe.inject (Js.wrap_callback + (fun blob -> + let url = + Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject blob |] in + let link = Dom_html.createA Dom_html.document in + link##.href := url ; + Js.Unsafe.set link (Js.string "download") (Js.string name) ; + ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; + ignore (Js.Unsafe.meth_call link "click" [||]) ; + ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t))))))|]; + in (); + + Lwt.return () end ; - + let typecheck_editor () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in diff --git a/src/editor/jszip.mli b/src/editor/jszip.mli new file mode 100644 index 000000000..4e96f8d50 --- /dev/null +++ b/src/editor/jszip.mli @@ -0,0 +1,7 @@ +open Js_of_ocaml + +val editor_download: Js.js_string Js.t -> (File.blob Js.t -> unit Js.meth) Js.meth + + + + diff --git a/static/Makefile b/static/Makefile index a2782b5f1..d469ddf8e 100644 --- a/static/Makefile +++ b/static/Makefile @@ -5,6 +5,7 @@ all: icons dune FILES = $(wildcard \ js/*.js\ js/ace/*.js\ + js/jszip/*.js\ *.html\ icons/*.svg\ icons/*.gif\ diff --git a/static/editor.html b/static/editor.html index e258dc856..1cbe4c30a 100644 --- a/static/editor.html +++ b/static/editor.html @@ -1,11 +1,12 @@ - + + Learn OCaml by OCamlPro - Editor - -  + + @@ -13,42 +14,50 @@ + + + - - + + +
- - - - - + + + + +
-
-
  • Preparing the environment
+
+
+
    +
  • Preparing the environment
  • +
+
- - - - - - - + - + - - + - + - + - +
- -
-
Editor
-
- +
+
Editor
+
+ - - - - - - - - - - - - - - - - -
-
-
-
- - - - - + + + + + + + + + + + + + + + + +
-
- + + + + +
+
+ - - - - - - - - - - - - + + + + + + + + + + + + +
-
-
- - - + + + - -
- -
-
-
-
- -
-
-
-
- -
-
-
-
- -
-
-
-
- -
-
-
-
- - +
+ +
+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
+
+
+
+ +
- - + + + \ No newline at end of file diff --git a/static/js/jszip/jszip.min.js b/static/js/jszip/jszip.min.js new file mode 100644 index 000000000..520db0742 --- /dev/null +++ b/static/js/jszip/jszip.min.js @@ -0,0 +1,13 @@ +/*! + +JSZip v3.2.1 - A JavaScript class for generating and reading zip files + + +(c) 2009-2016 Stuart Knightley +Dual licenced under the MIT license or GPLv3. See https://raw.github.com/Stuk/jszip/master/LICENSE.markdown. + +JSZip uses the library pako released under the MIT license : +https://github.com/nodeca/pako/blob/master/LICENSE +*/ + +!function(t){if("object"==typeof exports&&"undefined"!=typeof module)module.exports=t();else if("function"==typeof define&&define.amd)define([],t);else{("undefined"!=typeof window?window:"undefined"!=typeof global?global:"undefined"!=typeof self?self:this).JSZip=t()}}(function(){return function s(a,o,h){function u(r,t){if(!o[r]){if(!a[r]){var e="function"==typeof require&&require;if(!t&&e)return e(r,!0);if(l)return l(r,!0);var i=new Error("Cannot find module '"+r+"'");throw i.code="MODULE_NOT_FOUND",i}var n=o[r]={exports:{}};a[r][0].call(n.exports,function(t){var e=a[r][1][t];return u(e||t)},n,n.exports,s,a,o,h)}return o[r].exports}for(var l="function"==typeof require&&require,t=0;t>2,s=(3&e)<<4|r>>4,a=1>6:64,o=2>4,r=(15&n)<<4|(s=p.indexOf(t.charAt(o++)))>>2,i=(3&s)<<6|(a=p.indexOf(t.charAt(o++))),l[h++]=e,64!==s&&(l[h++]=r),64!==a&&(l[h++]=i);return l}},{"./support":30,"./utils":32}],2:[function(t,e,r){"use strict";var i=t("./external"),n=t("./stream/DataWorker"),s=t("./stream/DataLengthProbe"),a=t("./stream/Crc32Probe");s=t("./stream/DataLengthProbe");function o(t,e,r,i,n){this.compressedSize=t,this.uncompressedSize=e,this.crc32=r,this.compression=i,this.compressedContent=n}o.prototype={getContentWorker:function(){var t=new n(i.Promise.resolve(this.compressedContent)).pipe(this.compression.uncompressWorker()).pipe(new s("data_length")),e=this;return t.on("end",function(){if(this.streamInfo.data_length!==e.uncompressedSize)throw new Error("Bug : uncompressed data size mismatch")}),t},getCompressedWorker:function(){return new n(i.Promise.resolve(this.compressedContent)).withStreamInfo("compressedSize",this.compressedSize).withStreamInfo("uncompressedSize",this.uncompressedSize).withStreamInfo("crc32",this.crc32).withStreamInfo("compression",this.compression)}},o.createWorkerFrom=function(t,e,r){return t.pipe(new a).pipe(new s("uncompressedSize")).pipe(e.compressWorker(r)).pipe(new s("compressedSize")).withStreamInfo("compression",e)},e.exports=o},{"./external":6,"./stream/Crc32Probe":25,"./stream/DataLengthProbe":26,"./stream/DataWorker":27}],3:[function(t,e,r){"use strict";var i=t("./stream/GenericWorker");r.STORE={magic:"\0\0",compressWorker:function(t){return new i("STORE compression")},uncompressWorker:function(){return new i("STORE decompression")}},r.DEFLATE=t("./flate")},{"./flate":7,"./stream/GenericWorker":28}],4:[function(t,e,r){"use strict";var i=t("./utils");var o=function(){for(var t,e=[],r=0;r<256;r++){t=r;for(var i=0;i<8;i++)t=1&t?3988292384^t>>>1:t>>>1;e[r]=t}return e}();e.exports=function(t,e){return void 0!==t&&t.length?"string"!==i.getTypeOf(t)?function(t,e,r,i){var n=o,s=i+r;t^=-1;for(var a=i;a>>8^n[255&(t^e[a])];return-1^t}(0|e,t,t.length,0):function(t,e,r,i){var n=o,s=i+r;t^=-1;for(var a=i;a>>8^n[255&(t^e.charCodeAt(a))];return-1^t}(0|e,t,t.length,0):0}},{"./utils":32}],5:[function(t,e,r){"use strict";r.base64=!1,r.binary=!1,r.dir=!1,r.createFolders=!0,r.date=null,r.compression=null,r.compressionOptions=null,r.comment=null,r.unixPermissions=null,r.dosPermissions=null},{}],6:[function(t,e,r){"use strict";var i=null;i="undefined"!=typeof Promise?Promise:t("lie"),e.exports={Promise:i}},{lie:37}],7:[function(t,e,r){"use strict";var i="undefined"!=typeof Uint8Array&&"undefined"!=typeof Uint16Array&&"undefined"!=typeof Uint32Array,n=t("pako"),s=t("./utils"),a=t("./stream/GenericWorker"),o=i?"uint8array":"array";function h(t,e){a.call(this,"FlateWorker/"+t),this._pako=null,this._pakoAction=t,this._pakoOptions=e,this.meta={}}r.magic="\b\0",s.inherits(h,a),h.prototype.processChunk=function(t){this.meta=t.meta,null===this._pako&&this._createPako(),this._pako.push(s.transformTo(o,t.data),!1)},h.prototype.flush=function(){a.prototype.flush.call(this),null===this._pako&&this._createPako(),this._pako.push([],!0)},h.prototype.cleanUp=function(){a.prototype.cleanUp.call(this),this._pako=null},h.prototype._createPako=function(){this._pako=new n[this._pakoAction]({raw:!0,level:this._pakoOptions.level||-1});var e=this;this._pako.onData=function(t){e.push({data:t,meta:e.meta})}},r.compressWorker=function(t){return new h("Deflate",t)},r.uncompressWorker=function(){return new h("Inflate",{})}},{"./stream/GenericWorker":28,"./utils":32,pako:38}],8:[function(t,e,r){"use strict";function A(t,e){var r,i="";for(r=0;r>>=8;return i}function i(t,e,r,i,n,s){var a,o,h=t.file,u=t.compression,l=s!==O.utf8encode,f=I.transformTo("string",s(h.name)),d=I.transformTo("string",O.utf8encode(h.name)),c=h.comment,p=I.transformTo("string",s(c)),m=I.transformTo("string",O.utf8encode(c)),_=d.length!==h.name.length,g=m.length!==c.length,b="",v="",y="",w=h.dir,k=h.date,x={crc32:0,compressedSize:0,uncompressedSize:0};e&&!r||(x.crc32=t.crc32,x.compressedSize=t.compressedSize,x.uncompressedSize=t.uncompressedSize);var S=0;e&&(S|=8),l||!_&&!g||(S|=2048);var z=0,C=0;w&&(z|=16),"UNIX"===n?(C=798,z|=function(t,e){var r=t;return t||(r=e?16893:33204),(65535&r)<<16}(h.unixPermissions,w)):(C=20,z|=function(t){return 63&(t||0)}(h.dosPermissions)),a=k.getUTCHours(),a<<=6,a|=k.getUTCMinutes(),a<<=5,a|=k.getUTCSeconds()/2,o=k.getUTCFullYear()-1980,o<<=4,o|=k.getUTCMonth()+1,o<<=5,o|=k.getUTCDate(),_&&(v=A(1,1)+A(B(f),4)+d,b+="up"+A(v.length,2)+v),g&&(y=A(1,1)+A(B(p),4)+m,b+="uc"+A(y.length,2)+y);var E="";return E+="\n\0",E+=A(S,2),E+=u.magic,E+=A(a,2),E+=A(o,2),E+=A(x.crc32,4),E+=A(x.compressedSize,4),E+=A(x.uncompressedSize,4),E+=A(f.length,2),E+=A(b.length,2),{fileRecord:R.LOCAL_FILE_HEADER+E+f+b,dirRecord:R.CENTRAL_FILE_HEADER+A(C,2)+E+A(p.length,2)+"\0\0\0\0"+A(z,4)+A(i,4)+f+b+p}}var I=t("../utils"),n=t("../stream/GenericWorker"),O=t("../utf8"),B=t("../crc32"),R=t("../signature");function s(t,e,r,i){n.call(this,"ZipFileWorker"),this.bytesWritten=0,this.zipComment=e,this.zipPlatform=r,this.encodeFileName=i,this.streamFiles=t,this.accumulate=!1,this.contentBuffer=[],this.dirRecords=[],this.currentSourceOffset=0,this.entriesCount=0,this.currentFile=null,this._sources=[]}I.inherits(s,n),s.prototype.push=function(t){var e=t.meta.percent||0,r=this.entriesCount,i=this._sources.length;this.accumulate?this.contentBuffer.push(t):(this.bytesWritten+=t.data.length,n.prototype.push.call(this,{data:t.data,meta:{currentFile:this.currentFile,percent:r?(e+100*(r-i-1))/r:100}}))},s.prototype.openedSource=function(t){this.currentSourceOffset=this.bytesWritten,this.currentFile=t.file.name;var e=this.streamFiles&&!t.file.dir;if(e){var r=i(t,e,!1,this.currentSourceOffset,this.zipPlatform,this.encodeFileName);this.push({data:r.fileRecord,meta:{percent:0}})}else this.accumulate=!0},s.prototype.closedSource=function(t){this.accumulate=!1;var e=this.streamFiles&&!t.file.dir,r=i(t,e,!0,this.currentSourceOffset,this.zipPlatform,this.encodeFileName);if(this.dirRecords.push(r.dirRecord),e)this.push({data:function(t){return R.DATA_DESCRIPTOR+A(t.crc32,4)+A(t.compressedSize,4)+A(t.uncompressedSize,4)}(t),meta:{percent:100}});else for(this.push({data:r.fileRecord,meta:{percent:0}});this.contentBuffer.length;)this.push(this.contentBuffer.shift());this.currentFile=null},s.prototype.flush=function(){for(var t=this.bytesWritten,e=0;e=this.index;e--)r=(r<<8)+this.byteAt(e);return this.index+=t,r},readString:function(t){return i.transformTo("string",this.readData(t))},readData:function(t){},lastIndexOfSignature:function(t){},readAndCheckSignature:function(t){},readDate:function(){var t=this.readInt(4);return new Date(Date.UTC(1980+(t>>25&127),(t>>21&15)-1,t>>16&31,t>>11&31,t>>5&63,(31&t)<<1))}},e.exports=n},{"../utils":32}],19:[function(t,e,r){"use strict";var i=t("./Uint8ArrayReader");function n(t){i.call(this,t)}t("../utils").inherits(n,i),n.prototype.readData=function(t){this.checkOffset(t);var e=this.data.slice(this.zero+this.index,this.zero+this.index+t);return this.index+=t,e},e.exports=n},{"../utils":32,"./Uint8ArrayReader":21}],20:[function(t,e,r){"use strict";var i=t("./DataReader");function n(t){i.call(this,t)}t("../utils").inherits(n,i),n.prototype.byteAt=function(t){return this.data.charCodeAt(this.zero+t)},n.prototype.lastIndexOfSignature=function(t){return this.data.lastIndexOf(t)-this.zero},n.prototype.readAndCheckSignature=function(t){return t===this.readData(4)},n.prototype.readData=function(t){this.checkOffset(t);var e=this.data.slice(this.zero+this.index,this.zero+this.index+t);return this.index+=t,e},e.exports=n},{"../utils":32,"./DataReader":18}],21:[function(t,e,r){"use strict";var i=t("./ArrayReader");function n(t){i.call(this,t)}t("../utils").inherits(n,i),n.prototype.readData=function(t){if(this.checkOffset(t),0===t)return new Uint8Array(0);var e=this.data.subarray(this.zero+this.index,this.zero+this.index+t);return this.index+=t,e},e.exports=n},{"../utils":32,"./ArrayReader":17}],22:[function(t,e,r){"use strict";var i=t("../utils"),n=t("../support"),s=t("./ArrayReader"),a=t("./StringReader"),o=t("./NodeBufferReader"),h=t("./Uint8ArrayReader");e.exports=function(t){var e=i.getTypeOf(t);return i.checkSupport(e),"string"!==e||n.uint8array?"nodebuffer"===e?new o(t):n.uint8array?new h(i.transformTo("uint8array",t)):new s(i.transformTo("array",t)):new a(t)}},{"../support":30,"../utils":32,"./ArrayReader":17,"./NodeBufferReader":19,"./StringReader":20,"./Uint8ArrayReader":21}],23:[function(t,e,r){"use strict";r.LOCAL_FILE_HEADER="PK",r.CENTRAL_FILE_HEADER="PK",r.CENTRAL_DIRECTORY_END="PK",r.ZIP64_CENTRAL_DIRECTORY_LOCATOR="PK",r.ZIP64_CENTRAL_DIRECTORY_END="PK",r.DATA_DESCRIPTOR="PK\b"},{}],24:[function(t,e,r){"use strict";var i=t("./GenericWorker"),n=t("../utils");function s(t){i.call(this,"ConvertWorker to "+t),this.destType=t}n.inherits(s,i),s.prototype.processChunk=function(t){this.push({data:n.transformTo(this.destType,t.data),meta:t.meta})},e.exports=s},{"../utils":32,"./GenericWorker":28}],25:[function(t,e,r){"use strict";var i=t("./GenericWorker"),n=t("../crc32");function s(){i.call(this,"Crc32Probe"),this.withStreamInfo("crc32",0)}t("../utils").inherits(s,i),s.prototype.processChunk=function(t){this.streamInfo.crc32=n(t.data,this.streamInfo.crc32||0),this.push(t)},e.exports=s},{"../crc32":4,"../utils":32,"./GenericWorker":28}],26:[function(t,e,r){"use strict";var i=t("../utils"),n=t("./GenericWorker");function s(t){n.call(this,"DataLengthProbe for "+t),this.propName=t,this.withStreamInfo(t,0)}i.inherits(s,n),s.prototype.processChunk=function(t){if(t){var e=this.streamInfo[this.propName]||0;this.streamInfo[this.propName]=e+t.data.length}n.prototype.processChunk.call(this,t)},e.exports=s},{"../utils":32,"./GenericWorker":28}],27:[function(t,e,r){"use strict";var i=t("../utils"),n=t("./GenericWorker");function s(t){n.call(this,"DataWorker");var e=this;this.dataIsReady=!1,this.index=0,this.max=0,this.data=null,this.type="",this._tickScheduled=!1,t.then(function(t){e.dataIsReady=!0,e.data=t,e.max=t&&t.length||0,e.type=i.getTypeOf(t),e.isPaused||e._tickAndRepeat()},function(t){e.error(t)})}i.inherits(s,n),s.prototype.cleanUp=function(){n.prototype.cleanUp.call(this),this.data=null},s.prototype.resume=function(){return!!n.prototype.resume.call(this)&&(!this._tickScheduled&&this.dataIsReady&&(this._tickScheduled=!0,i.delay(this._tickAndRepeat,[],this)),!0)},s.prototype._tickAndRepeat=function(){this._tickScheduled=!1,this.isPaused||this.isFinished||(this._tick(),this.isFinished||(i.delay(this._tickAndRepeat,[],this),this._tickScheduled=!0))},s.prototype._tick=function(){if(this.isPaused||this.isFinished)return!1;var t=null,e=Math.min(this.max,this.index+16384);if(this.index>=this.max)return this.end();switch(this.type){case"string":t=this.data.substring(this.index,e);break;case"uint8array":t=this.data.subarray(this.index,e);break;case"array":case"nodebuffer":t=this.data.slice(this.index,e)}return this.index=e,this.push({data:t,meta:{percent:this.max?this.index/this.max*100:0}})},e.exports=s},{"../utils":32,"./GenericWorker":28}],28:[function(t,e,r){"use strict";function i(t){this.name=t||"default",this.streamInfo={},this.generatedError=null,this.extraStreamInfo={},this.isPaused=!0,this.isFinished=!1,this.isLocked=!1,this._listeners={data:[],end:[],error:[]},this.previous=null}i.prototype={push:function(t){this.emit("data",t)},end:function(){if(this.isFinished)return!1;this.flush();try{this.emit("end"),this.cleanUp(),this.isFinished=!0}catch(t){this.emit("error",t)}return!0},error:function(t){return!this.isFinished&&(this.isPaused?this.generatedError=t:(this.isFinished=!0,this.emit("error",t),this.previous&&this.previous.error(t),this.cleanUp()),!0)},on:function(t,e){return this._listeners[t].push(e),this},cleanUp:function(){this.streamInfo=this.generatedError=this.extraStreamInfo=null,this._listeners=[]},emit:function(t,e){if(this._listeners[t])for(var r=0;r "+t:t}},e.exports=i},{}],29:[function(t,e,r){"use strict";var h=t("../utils"),n=t("./ConvertWorker"),s=t("./GenericWorker"),u=t("../base64"),i=t("../support"),a=t("../external"),o=null;if(i.nodestream)try{o=t("../nodejs/NodejsStreamOutputAdapter")}catch(t){}function l(t,o){return new a.Promise(function(e,r){var i=[],n=t._internalType,s=t._outputType,a=t._mimeType;t.on("data",function(t,e){i.push(t),o&&o(e)}).on("error",function(t){i=[],r(t)}).on("end",function(){try{var t=function(t,e,r){switch(t){case"blob":return h.newBlob(h.transformTo("arraybuffer",e),r);case"base64":return u.encode(e);default:return h.transformTo(t,e)}}(s,function(t,e){var r,i=0,n=null,s=0;for(r=0;r>>6:(r<65536?e[s++]=224|r>>>12:(e[s++]=240|r>>>18,e[s++]=128|r>>>12&63),e[s++]=128|r>>>6&63),e[s++]=128|63&r);return e}(t)},s.utf8decode=function(t){return h.nodebuffer?o.transformTo("nodebuffer",t).toString("utf-8"):function(t){var e,r,i,n,s=t.length,a=new Array(2*s);for(e=r=0;e>10&1023,a[r++]=56320|1023&i)}return a.length!==r&&(a.subarray?a=a.subarray(0,r):a.length=r),o.applyFromCharCode(a)}(t=o.transformTo(h.uint8array?"uint8array":"array",t))},o.inherits(a,i),a.prototype.processChunk=function(t){var e=o.transformTo(h.uint8array?"uint8array":"array",t.data);if(this.leftOver&&this.leftOver.length){if(h.uint8array){var r=e;(e=new Uint8Array(r.length+this.leftOver.length)).set(this.leftOver,0),e.set(r,this.leftOver.length)}else e=this.leftOver.concat(e);this.leftOver=null}var i=function(t,e){var r;for((e=e||t.length)>t.length&&(e=t.length),r=e-1;0<=r&&128==(192&t[r]);)r--;return r<0?e:0===r?e:r+u[t[r]]>e?r:e}(e),n=e;i!==e.length&&(h.uint8array?(n=e.subarray(0,i),this.leftOver=e.subarray(i,e.length)):(n=e.slice(0,i),this.leftOver=e.slice(i,e.length))),this.push({data:s.utf8decode(n),meta:t.meta})},a.prototype.flush=function(){this.leftOver&&this.leftOver.length&&(this.push({data:s.utf8decode(this.leftOver),meta:{}}),this.leftOver=null)},s.Utf8DecodeWorker=a,o.inherits(l,i),l.prototype.processChunk=function(t){this.push({data:s.utf8encode(t.data),meta:t.meta})},s.Utf8EncodeWorker=l},{"./nodejsUtils":14,"./stream/GenericWorker":28,"./support":30,"./utils":32}],32:[function(t,e,a){"use strict";var o=t("./support"),h=t("./base64"),r=t("./nodejsUtils"),i=t("set-immediate-shim"),u=t("./external");function n(t){return t}function l(t,e){for(var r=0;r>8;this.dir=!!(16&this.externalFileAttributes),0==t&&(this.dosPermissions=63&this.externalFileAttributes),3==t&&(this.unixPermissions=this.externalFileAttributes>>16&65535),this.dir||"/"!==this.fileNameStr.slice(-1)||(this.dir=!0)},parseZIP64ExtraField:function(t){if(this.extraFields[1]){var e=i(this.extraFields[1].value);this.uncompressedSize===s.MAX_VALUE_32BITS&&(this.uncompressedSize=e.readInt(8)),this.compressedSize===s.MAX_VALUE_32BITS&&(this.compressedSize=e.readInt(8)),this.localHeaderOffset===s.MAX_VALUE_32BITS&&(this.localHeaderOffset=e.readInt(8)),this.diskNumberStart===s.MAX_VALUE_32BITS&&(this.diskNumberStart=e.readInt(4))}},readExtraFields:function(t){var e,r,i,n=t.index+this.extraFieldsLength;for(this.extraFields||(this.extraFields={});t.index>>6:(r<65536?e[s++]=224|r>>>12:(e[s++]=240|r>>>18,e[s++]=128|r>>>12&63),e[s++]=128|r>>>6&63),e[s++]=128|63&r);return e},r.buf2binstring=function(t){return l(t,t.length)},r.binstring2buf=function(t){for(var e=new h.Buf8(t.length),r=0,i=e.length;r>10&1023,o[i++]=56320|1023&n)}return l(o,i)},r.utf8border=function(t,e){var r;for((e=e||t.length)>t.length&&(e=t.length),r=e-1;0<=r&&128==(192&t[r]);)r--;return r<0?e:0===r?e:r+u[t[r]]>e?r:e}},{"./common":41}],43:[function(t,e,r){"use strict";e.exports=function(t,e,r,i){for(var n=65535&t|0,s=t>>>16&65535|0,a=0;0!==r;){for(r-=a=2e3>>1:t>>>1;e[r]=t}return e}();e.exports=function(t,e,r,i){var n=o,s=i+r;t^=-1;for(var a=i;a>>8^n[255&(t^e[a])];return-1^t}},{}],46:[function(t,e,r){"use strict";var h,d=t("../utils/common"),u=t("./trees"),c=t("./adler32"),p=t("./crc32"),i=t("./messages"),l=0,f=4,m=0,_=-2,g=-1,b=4,n=2,v=8,y=9,s=286,a=30,o=19,w=2*s+1,k=15,x=3,S=258,z=S+x+1,C=42,E=113,A=1,I=2,O=3,B=4;function R(t,e){return t.msg=i[e],e}function T(t){return(t<<1)-(4t.avail_out&&(r=t.avail_out),0!==r&&(d.arraySet(t.output,e.pending_buf,e.pending_out,r,t.next_out),t.next_out+=r,e.pending_out+=r,t.total_out+=r,t.avail_out-=r,e.pending-=r,0===e.pending&&(e.pending_out=0))}function N(t,e){u._tr_flush_block(t,0<=t.block_start?t.block_start:-1,t.strstart-t.block_start,e),t.block_start=t.strstart,F(t.strm)}function U(t,e){t.pending_buf[t.pending++]=e}function P(t,e){t.pending_buf[t.pending++]=e>>>8&255,t.pending_buf[t.pending++]=255&e}function L(t,e){var r,i,n=t.max_chain_length,s=t.strstart,a=t.prev_length,o=t.nice_match,h=t.strstart>t.w_size-z?t.strstart-(t.w_size-z):0,u=t.window,l=t.w_mask,f=t.prev,d=t.strstart+S,c=u[s+a-1],p=u[s+a];t.prev_length>=t.good_match&&(n>>=2),o>t.lookahead&&(o=t.lookahead);do{if(u[(r=e)+a]===p&&u[r+a-1]===c&&u[r]===u[s]&&u[++r]===u[s+1]){s+=2,r++;do{}while(u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&u[++s]===u[++r]&&sh&&0!=--n);return a<=t.lookahead?a:t.lookahead}function j(t){var e,r,i,n,s,a,o,h,u,l,f=t.w_size;do{if(n=t.window_size-t.lookahead-t.strstart,t.strstart>=f+(f-z)){for(d.arraySet(t.window,t.window,f,f,0),t.match_start-=f,t.strstart-=f,t.block_start-=f,e=r=t.hash_size;i=t.head[--e],t.head[e]=f<=i?i-f:0,--r;);for(e=r=f;i=t.prev[--e],t.prev[e]=f<=i?i-f:0,--r;);n+=f}if(0===t.strm.avail_in)break;if(a=t.strm,o=t.window,h=t.strstart+t.lookahead,u=n,l=void 0,l=a.avail_in,u=x)for(s=t.strstart-t.insert,t.ins_h=t.window[s],t.ins_h=(t.ins_h<=x&&(t.ins_h=(t.ins_h<=x)if(i=u._tr_tally(t,t.strstart-t.match_start,t.match_length-x),t.lookahead-=t.match_length,t.match_length<=t.max_lazy_match&&t.lookahead>=x){for(t.match_length--;t.strstart++,t.ins_h=(t.ins_h<=x&&(t.ins_h=(t.ins_h<=x&&t.match_length<=t.prev_length){for(n=t.strstart+t.lookahead-x,i=u._tr_tally(t,t.strstart-1-t.prev_match,t.prev_length-x),t.lookahead-=t.prev_length-1,t.prev_length-=2;++t.strstart<=n&&(t.ins_h=(t.ins_h<t.pending_buf_size-5&&(r=t.pending_buf_size-5);;){if(t.lookahead<=1){if(j(t),0===t.lookahead&&e===l)return A;if(0===t.lookahead)break}t.strstart+=t.lookahead,t.lookahead=0;var i=t.block_start+r;if((0===t.strstart||t.strstart>=i)&&(t.lookahead=t.strstart-i,t.strstart=i,N(t,!1),0===t.strm.avail_out))return A;if(t.strstart-t.block_start>=t.w_size-z&&(N(t,!1),0===t.strm.avail_out))return A}return t.insert=0,e===f?(N(t,!0),0===t.strm.avail_out?O:B):(t.strstart>t.block_start&&(N(t,!1),t.strm.avail_out),A)}),new M(4,4,8,4,Z),new M(4,5,16,8,Z),new M(4,6,32,32,Z),new M(4,4,16,16,W),new M(8,16,32,32,W),new M(8,16,128,128,W),new M(8,32,128,256,W),new M(32,128,258,1024,W),new M(32,258,258,4096,W)],r.deflateInit=function(t,e){return Y(t,e,v,15,8,0)},r.deflateInit2=Y,r.deflateReset=K,r.deflateResetKeep=G,r.deflateSetHeader=function(t,e){return t&&t.state?2!==t.state.wrap?_:(t.state.gzhead=e,m):_},r.deflate=function(t,e){var r,i,n,s;if(!t||!t.state||5>8&255),U(i,i.gzhead.time>>16&255),U(i,i.gzhead.time>>24&255),U(i,9===i.level?2:2<=i.strategy||i.level<2?4:0),U(i,255&i.gzhead.os),i.gzhead.extra&&i.gzhead.extra.length&&(U(i,255&i.gzhead.extra.length),U(i,i.gzhead.extra.length>>8&255)),i.gzhead.hcrc&&(t.adler=p(t.adler,i.pending_buf,i.pending,0)),i.gzindex=0,i.status=69):(U(i,0),U(i,0),U(i,0),U(i,0),U(i,0),U(i,9===i.level?2:2<=i.strategy||i.level<2?4:0),U(i,3),i.status=E);else{var a=v+(i.w_bits-8<<4)<<8;a|=(2<=i.strategy||i.level<2?0:i.level<6?1:6===i.level?2:3)<<6,0!==i.strstart&&(a|=32),a+=31-a%31,i.status=E,P(i,a),0!==i.strstart&&(P(i,t.adler>>>16),P(i,65535&t.adler)),t.adler=1}if(69===i.status)if(i.gzhead.extra){for(n=i.pending;i.gzindex<(65535&i.gzhead.extra.length)&&(i.pending!==i.pending_buf_size||(i.gzhead.hcrc&&i.pending>n&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),F(t),n=i.pending,i.pending!==i.pending_buf_size));)U(i,255&i.gzhead.extra[i.gzindex]),i.gzindex++;i.gzhead.hcrc&&i.pending>n&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),i.gzindex===i.gzhead.extra.length&&(i.gzindex=0,i.status=73)}else i.status=73;if(73===i.status)if(i.gzhead.name){n=i.pending;do{if(i.pending===i.pending_buf_size&&(i.gzhead.hcrc&&i.pending>n&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),F(t),n=i.pending,i.pending===i.pending_buf_size)){s=1;break}s=i.gzindexn&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),0===s&&(i.gzindex=0,i.status=91)}else i.status=91;if(91===i.status)if(i.gzhead.comment){n=i.pending;do{if(i.pending===i.pending_buf_size&&(i.gzhead.hcrc&&i.pending>n&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),F(t),n=i.pending,i.pending===i.pending_buf_size)){s=1;break}s=i.gzindexn&&(t.adler=p(t.adler,i.pending_buf,i.pending-n,n)),0===s&&(i.status=103)}else i.status=103;if(103===i.status&&(i.gzhead.hcrc?(i.pending+2>i.pending_buf_size&&F(t),i.pending+2<=i.pending_buf_size&&(U(i,255&t.adler),U(i,t.adler>>8&255),t.adler=0,i.status=E)):i.status=E),0!==i.pending){if(F(t),0===t.avail_out)return i.last_flush=-1,m}else if(0===t.avail_in&&T(e)<=T(r)&&e!==f)return R(t,-5);if(666===i.status&&0!==t.avail_in)return R(t,-5);if(0!==t.avail_in||0!==i.lookahead||e!==l&&666!==i.status){var o=2===i.strategy?function(t,e){for(var r;;){if(0===t.lookahead&&(j(t),0===t.lookahead)){if(e===l)return A;break}if(t.match_length=0,r=u._tr_tally(t,0,t.window[t.strstart]),t.lookahead--,t.strstart++,r&&(N(t,!1),0===t.strm.avail_out))return A}return t.insert=0,e===f?(N(t,!0),0===t.strm.avail_out?O:B):t.last_lit&&(N(t,!1),0===t.strm.avail_out)?A:I}(i,e):3===i.strategy?function(t,e){for(var r,i,n,s,a=t.window;;){if(t.lookahead<=S){if(j(t),t.lookahead<=S&&e===l)return A;if(0===t.lookahead)break}if(t.match_length=0,t.lookahead>=x&&0t.lookahead&&(t.match_length=t.lookahead)}if(t.match_length>=x?(r=u._tr_tally(t,1,t.match_length-x),t.lookahead-=t.match_length,t.strstart+=t.match_length,t.match_length=0):(r=u._tr_tally(t,0,t.window[t.strstart]),t.lookahead--,t.strstart++),r&&(N(t,!1),0===t.strm.avail_out))return A}return t.insert=0,e===f?(N(t,!0),0===t.strm.avail_out?O:B):t.last_lit&&(N(t,!1),0===t.strm.avail_out)?A:I}(i,e):h[i.level].func(i,e);if(o!==O&&o!==B||(i.status=666),o===A||o===O)return 0===t.avail_out&&(i.last_flush=-1),m;if(o===I&&(1===e?u._tr_align(i):5!==e&&(u._tr_stored_block(i,0,0,!1),3===e&&(D(i.head),0===i.lookahead&&(i.strstart=0,i.block_start=0,i.insert=0))),F(t),0===t.avail_out))return i.last_flush=-1,m}return e!==f?m:i.wrap<=0?1:(2===i.wrap?(U(i,255&t.adler),U(i,t.adler>>8&255),U(i,t.adler>>16&255),U(i,t.adler>>24&255),U(i,255&t.total_in),U(i,t.total_in>>8&255),U(i,t.total_in>>16&255),U(i,t.total_in>>24&255)):(P(i,t.adler>>>16),P(i,65535&t.adler)),F(t),0=r.w_size&&(0===s&&(D(r.head),r.strstart=0,r.block_start=0,r.insert=0),u=new d.Buf8(r.w_size),d.arraySet(u,e,l-r.w_size,r.w_size,0),e=u,l=r.w_size),a=t.avail_in,o=t.next_in,h=t.input,t.avail_in=l,t.next_in=0,t.input=e,j(r);r.lookahead>=x;){for(i=r.strstart,n=r.lookahead-(x-1);r.ins_h=(r.ins_h<>>=y=v>>>24,p-=y,0===(y=v>>>16&255))C[s++]=65535&v;else{if(!(16&y)){if(0==(64&y)){v=m[(65535&v)+(c&(1<>>=y,p-=y),p<15&&(c+=z[i++]<>>=y=v>>>24,p-=y,!(16&(y=v>>>16&255))){if(0==(64&y)){v=_[(65535&v)+(c&(1<>>=y,p-=y,(y=s-a)>3,c&=(1<<(p-=w<<3))-1,t.next_in=i,t.next_out=s,t.avail_in=i>>24&255)+(t>>>8&65280)+((65280&t)<<8)+((255&t)<<24)}function s(){this.mode=0,this.last=!1,this.wrap=0,this.havedict=!1,this.flags=0,this.dmax=0,this.check=0,this.total=0,this.head=null,this.wbits=0,this.wsize=0,this.whave=0,this.wnext=0,this.window=null,this.hold=0,this.bits=0,this.length=0,this.offset=0,this.extra=0,this.lencode=null,this.distcode=null,this.lenbits=0,this.distbits=0,this.ncode=0,this.nlen=0,this.ndist=0,this.have=0,this.next=null,this.lens=new I.Buf16(320),this.work=new I.Buf16(288),this.lendyn=null,this.distdyn=null,this.sane=0,this.back=0,this.was=0}function a(t){var e;return t&&t.state?(e=t.state,t.total_in=t.total_out=e.total=0,t.msg="",e.wrap&&(t.adler=1&e.wrap),e.mode=P,e.last=0,e.havedict=0,e.dmax=32768,e.head=null,e.hold=0,e.bits=0,e.lencode=e.lendyn=new I.Buf32(i),e.distcode=e.distdyn=new I.Buf32(n),e.sane=1,e.back=-1,N):U}function o(t){var e;return t&&t.state?((e=t.state).wsize=0,e.whave=0,e.wnext=0,a(t)):U}function h(t,e){var r,i;return t&&t.state?(i=t.state,e<0?(r=0,e=-e):(r=1+(e>>4),e<48&&(e&=15)),e&&(e<8||15=s.wsize?(I.arraySet(s.window,e,r-s.wsize,s.wsize,0),s.wnext=0,s.whave=s.wsize):(i<(n=s.wsize-s.wnext)&&(n=i),I.arraySet(s.window,e,r-i,n,s.wnext),(i-=n)?(I.arraySet(s.window,e,r-i,i,0),s.wnext=i,s.whave=s.wsize):(s.wnext+=n,s.wnext===s.wsize&&(s.wnext=0),s.whave>>8&255,r.check=B(r.check,E,2,0),l=u=0,r.mode=2;break}if(r.flags=0,r.head&&(r.head.done=!1),!(1&r.wrap)||(((255&u)<<8)+(u>>8))%31){t.msg="incorrect header check",r.mode=30;break}if(8!=(15&u)){t.msg="unknown compression method",r.mode=30;break}if(l-=4,k=8+(15&(u>>>=4)),0===r.wbits)r.wbits=k;else if(k>r.wbits){t.msg="invalid window size",r.mode=30;break}r.dmax=1<>8&1),512&r.flags&&(E[0]=255&u,E[1]=u>>>8&255,r.check=B(r.check,E,2,0)),l=u=0,r.mode=3;case 3:for(;l<32;){if(0===o)break t;o--,u+=i[s++]<>>8&255,E[2]=u>>>16&255,E[3]=u>>>24&255,r.check=B(r.check,E,4,0)),l=u=0,r.mode=4;case 4:for(;l<16;){if(0===o)break t;o--,u+=i[s++]<>8),512&r.flags&&(E[0]=255&u,E[1]=u>>>8&255,r.check=B(r.check,E,2,0)),l=u=0,r.mode=5;case 5:if(1024&r.flags){for(;l<16;){if(0===o)break t;o--,u+=i[s++]<>>8&255,r.check=B(r.check,E,2,0)),l=u=0}else r.head&&(r.head.extra=null);r.mode=6;case 6:if(1024&r.flags&&(o<(c=r.length)&&(c=o),c&&(r.head&&(k=r.head.extra_len-r.length,r.head.extra||(r.head.extra=new Array(r.head.extra_len)),I.arraySet(r.head.extra,i,s,c,k)),512&r.flags&&(r.check=B(r.check,i,c,s)),o-=c,s+=c,r.length-=c),r.length))break t;r.length=0,r.mode=7;case 7:if(2048&r.flags){if(0===o)break t;for(c=0;k=i[s+c++],r.head&&k&&r.length<65536&&(r.head.name+=String.fromCharCode(k)),k&&c>9&1,r.head.done=!0),t.adler=r.check=0,r.mode=12;break;case 10:for(;l<32;){if(0===o)break t;o--,u+=i[s++]<>>=7&l,l-=7&l,r.mode=27;break}for(;l<3;){if(0===o)break t;o--,u+=i[s++]<>>=1)){case 0:r.mode=14;break;case 1:if(j(r),r.mode=20,6!==e)break;u>>>=2,l-=2;break t;case 2:r.mode=17;break;case 3:t.msg="invalid block type",r.mode=30}u>>>=2,l-=2;break;case 14:for(u>>>=7&l,l-=7&l;l<32;){if(0===o)break t;o--,u+=i[s++]<>>16^65535)){t.msg="invalid stored block lengths",r.mode=30;break}if(r.length=65535&u,l=u=0,r.mode=15,6===e)break t;case 15:r.mode=16;case 16:if(c=r.length){if(o>>=5,l-=5,r.ndist=1+(31&u),u>>>=5,l-=5,r.ncode=4+(15&u),u>>>=4,l-=4,286>>=3,l-=3}for(;r.have<19;)r.lens[A[r.have++]]=0;if(r.lencode=r.lendyn,r.lenbits=7,S={bits:r.lenbits},x=T(0,r.lens,0,19,r.lencode,0,r.work,S),r.lenbits=S.bits,x){t.msg="invalid code lengths set",r.mode=30;break}r.have=0,r.mode=19;case 19:for(;r.have>>16&255,b=65535&C,!((_=C>>>24)<=l);){if(0===o)break t;o--,u+=i[s++]<>>=_,l-=_,r.lens[r.have++]=b;else{if(16===b){for(z=_+2;l>>=_,l-=_,0===r.have){t.msg="invalid bit length repeat",r.mode=30;break}k=r.lens[r.have-1],c=3+(3&u),u>>>=2,l-=2}else if(17===b){for(z=_+3;l>>=_)),u>>>=3,l-=3}else{for(z=_+7;l>>=_)),u>>>=7,l-=7}if(r.have+c>r.nlen+r.ndist){t.msg="invalid bit length repeat",r.mode=30;break}for(;c--;)r.lens[r.have++]=k}}if(30===r.mode)break;if(0===r.lens[256]){t.msg="invalid code -- missing end-of-block",r.mode=30;break}if(r.lenbits=9,S={bits:r.lenbits},x=T(D,r.lens,0,r.nlen,r.lencode,0,r.work,S),r.lenbits=S.bits,x){t.msg="invalid literal/lengths set",r.mode=30;break}if(r.distbits=6,r.distcode=r.distdyn,S={bits:r.distbits},x=T(F,r.lens,r.nlen,r.ndist,r.distcode,0,r.work,S),r.distbits=S.bits,x){t.msg="invalid distances set",r.mode=30;break}if(r.mode=20,6===e)break t;case 20:r.mode=21;case 21:if(6<=o&&258<=h){t.next_out=a,t.avail_out=h,t.next_in=s,t.avail_in=o,r.hold=u,r.bits=l,R(t,d),a=t.next_out,n=t.output,h=t.avail_out,s=t.next_in,i=t.input,o=t.avail_in,u=r.hold,l=r.bits,12===r.mode&&(r.back=-1);break}for(r.back=0;g=(C=r.lencode[u&(1<>>16&255,b=65535&C,!((_=C>>>24)<=l);){if(0===o)break t;o--,u+=i[s++]<>v)])>>>16&255,b=65535&C,!(v+(_=C>>>24)<=l);){if(0===o)break t;o--,u+=i[s++]<>>=v,l-=v,r.back+=v}if(u>>>=_,l-=_,r.back+=_,r.length=b,0===g){r.mode=26;break}if(32&g){r.back=-1,r.mode=12;break}if(64&g){t.msg="invalid literal/length code",r.mode=30;break}r.extra=15&g,r.mode=22;case 22:if(r.extra){for(z=r.extra;l>>=r.extra,l-=r.extra,r.back+=r.extra}r.was=r.length,r.mode=23;case 23:for(;g=(C=r.distcode[u&(1<>>16&255,b=65535&C,!((_=C>>>24)<=l);){if(0===o)break t;o--,u+=i[s++]<>v)])>>>16&255,b=65535&C,!(v+(_=C>>>24)<=l);){if(0===o)break t;o--,u+=i[s++]<>>=v,l-=v,r.back+=v}if(u>>>=_,l-=_,r.back+=_,64&g){t.msg="invalid distance code",r.mode=30;break}r.offset=b,r.extra=15&g,r.mode=24;case 24:if(r.extra){for(z=r.extra;l>>=r.extra,l-=r.extra,r.back+=r.extra}if(r.offset>r.dmax){t.msg="invalid distance too far back",r.mode=30;break}r.mode=25;case 25:if(0===h)break t;if(c=d-h,r.offset>c){if((c=r.offset-c)>r.whave&&r.sane){t.msg="invalid distance too far back",r.mode=30;break}p=c>r.wnext?(c-=r.wnext,r.wsize-c):r.wnext-c,c>r.length&&(c=r.length),m=r.window}else m=n,p=a-r.offset,c=r.length;for(hc?(m=R[T+a[v]],A[I+a[v]]):(m=96,0),h=1<>S)+(u-=h)]=p<<24|m<<16|_|0,0!==u;);for(h=1<>=1;if(0!==h?(E&=h-1,E+=h):E=0,v++,0==--O[b]){if(b===w)break;b=e[r+a[v]]}if(k>>7)]}function U(t,e){t.pending_buf[t.pending++]=255&e,t.pending_buf[t.pending++]=e>>>8&255}function P(t,e,r){t.bi_valid>c-r?(t.bi_buf|=e<>c-t.bi_valid,t.bi_valid+=r-c):(t.bi_buf|=e<>>=1,r<<=1,0<--e;);return r>>>1}function Z(t,e,r){var i,n,s=new Array(g+1),a=0;for(i=1;i<=g;i++)s[i]=a=a+r[i-1]<<1;for(n=0;n<=e;n++){var o=t[2*n+1];0!==o&&(t[2*n]=j(s[o]++,o))}}function W(t){var e;for(e=0;e>1;1<=r;r--)G(t,s,r);for(n=h;r=t.heap[1],t.heap[1]=t.heap[t.heap_len--],G(t,s,1),i=t.heap[1],t.heap[--t.heap_max]=r,t.heap[--t.heap_max]=i,s[2*n]=s[2*r]+s[2*i],t.depth[n]=(t.depth[r]>=t.depth[i]?t.depth[r]:t.depth[i])+1,s[2*r+1]=s[2*i+1]=n,t.heap[1]=n++,G(t,s,1),2<=t.heap_len;);t.heap[--t.heap_max]=t.heap[1],function(t,e){var r,i,n,s,a,o,h=e.dyn_tree,u=e.max_code,l=e.stat_desc.static_tree,f=e.stat_desc.has_stree,d=e.stat_desc.extra_bits,c=e.stat_desc.extra_base,p=e.stat_desc.max_length,m=0;for(s=0;s<=g;s++)t.bl_count[s]=0;for(h[2*t.heap[t.heap_max]+1]=0,r=t.heap_max+1;r<_;r++)p<(s=h[2*h[2*(i=t.heap[r])+1]+1]+1)&&(s=p,m++),h[2*i+1]=s,u>=7;i>>=1)if(1&r&&0!==t.dyn_ltree[2*e])return o;if(0!==t.dyn_ltree[18]||0!==t.dyn_ltree[20]||0!==t.dyn_ltree[26])return h;for(e=32;e>>3,(s=t.static_len+3+7>>>3)<=n&&(n=s)):n=s=r+5,r+4<=n&&-1!==e?J(t,e,r,i):4===t.strategy||s===n?(P(t,2+(i?1:0),3),K(t,z,C)):(P(t,4+(i?1:0),3),function(t,e,r,i){var n;for(P(t,e-257,5),P(t,r-1,5),P(t,i-4,4),n=0;n>>8&255,t.pending_buf[t.d_buf+2*t.last_lit+1]=255&e,t.pending_buf[t.l_buf+t.last_lit]=255&r,t.last_lit++,0===e?t.dyn_ltree[2*r]++:(t.matches++,e--,t.dyn_ltree[2*(A[r]+u+1)]++,t.dyn_dtree[2*N(e)]++),t.last_lit===t.lit_bufsize-1},r._tr_align=function(t){P(t,2,3),L(t,m,z),function(t){16===t.bi_valid?(U(t,t.bi_buf),t.bi_buf=0,t.bi_valid=0):8<=t.bi_valid&&(t.pending_buf[t.pending++]=255&t.bi_buf,t.bi_buf>>=8,t.bi_valid-=8)}(t)}},{"../utils/common":41}],53:[function(t,e,r){"use strict";e.exports=function(){this.input=null,this.next_in=0,this.avail_in=0,this.total_in=0,this.output=null,this.next_out=0,this.avail_out=0,this.total_out=0,this.msg="",this.state=null,this.data_type=2,this.adler=0}},{}],54:[function(t,e,r){"use strict";e.exports="function"==typeof setImmediate?setImmediate:function(){var t=[].slice.apply(arguments);t.splice(1,0,0),setTimeout.apply(null,t)}},{}]},{},[10])(10)}); \ No newline at end of file diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js new file mode 100644 index 000000000..42046c77c --- /dev/null +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -0,0 +1,19 @@ +//keep in sync with editor export datatype +function editor_download(brut_data, callback) { + var zip = new JSZip(); + var data = JSON.parse(brut_data); + zip.file("descr.md", data.exercise.descr); + zip.file("meta.json", JSON.stringify(data.metadata, null, 2)); + zip.file("prelude.ml", data.exercise.prelude); + zip.file("prepare.ml", data.exercise.prepare); + zip.file("template.ml", data.exercise.template); + zip.file("test.ml", data.exercise.test); + zip.file("solution.ml", data.exercise.solution); + zip.generateAsync({ + type: "blob", + compression: "DEFLATE", + compressionOptions: { + level: 9 + } + }).then(function(blob) { callback(blob) }); +} \ No newline at end of file diff --git a/static/js/jszip/node_modules/.lsp/debug.log b/static/js/jszip/node_modules/.lsp/debug.log new file mode 100644 index 000000000..bd7622e33 --- /dev/null +++ b/static/js/jszip/node_modules/.lsp/debug.log @@ -0,0 +1,118 @@ +Hello - from /home/manu/.vscode/extensions/jaredly.reason-vscode-1.7.0/bin.native.linux +Previous log location: /tmp/lsp.log +Sending notification {"jsonrpc": "2.0", "method": "client/registerCapability", "params": {"registrations": [{"id": "watching", "method": "workspace/didChangeWatchedFiles", "registerOptions": {"watchers": [{"globPattern": "**/bsconfig.json", "globPattern": "**/.merlin"}]}}]}} +Sending response {"id": 0, "jsonrpc": "2.0", "result": {"capabilities": {"textDocumentSync": 1, "hoverProvider": true, "completionProvider": {"resolveProvider": true, "triggerCharacters": ["."]}, "signatureHelpProvider": {"triggerCharacters": ["("]}, "definitionProvider": true, "typeDefinitionProvider": true, "referencesProvider": true, "documentSymbolProvider": true, "codeActionProvider": true, "executeCommandProvider": {"commands": ["reason-language-server.add_to_interface_inner"]}, "codeLensProvider": {"resolveProvider": true}, "documentHighlightProvider": true, "documentRangeFormattingProvider": true, "documentFormattingProvider": true, "documentFormattingProvider": true, "renameProvider": true}}} +Read message +{"jsonrpc":"2.0","method":"initialized","params":{}} +Read message +{"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"reason_language_server":{"location":"","build_system_override_by_root":{},"refmt":"","lispRefmt":"","format_width":80,"per_value_codelens":false,"dependencies_codelens":true,"opens_codelens":true,"show_module_path_on_hover":true,"reloadOnChange":false,"show_debug_errors":false,"autoRebuild":true,"useOldDuneProcess":true}}}} +Read message +{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml","languageId":"ocaml","version":1,"text":"open Test_lib\nopen Report\n\nlet () =\n set_result @@\n ast_sanity_check code_ast @@ fun () ->\n [ Section\n ([ Text \"Function:\" ; Code \"plus\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"plus\"\n [ (1, 1) ; (2, 2) ; (10, -10) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"minus\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"minus\"\n [ (1, 1) ; (4, -2) ; (0, 10) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"times\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"times\"\n [ (1, 3) ; (2, 4) ; (3, 0) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"divide\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"divide\"\n [ (12, 4) ; (12, 5) ; (3, 0) ]) ]\n"}}} +Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o +]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o +=== Project root: /home/manu/Documentos/irit/learn-ocaml-o +Detected `opam` dependency manager for local use +Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} +Read message +{"jsonrpc":"2.0","id":1,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} +[server] Got a method textDocument/documentSymbol +[server] processing took 0.00596046447754ms +Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o +]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o +=== Project root: /home/manu/Documentos/irit/learn-ocaml-o +Detected `opam` dependency manager for local use +Sending response {"id": 1, "jsonrpc": "2.0", "error": {"code": -32603, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} +Read message +{"jsonrpc":"2.0","id":2,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} +[server] Got a method textDocument/codeAction +[server] processing took 0.00500679016113ms +Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o +]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o +=== Project root: /home/manu/Documentos/irit/learn-ocaml-o +Detected `opam` dependency manager for local use +Sending response {"id": 2, "jsonrpc": "2.0", "error": {"code": -32603, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} +Read message +{"jsonrpc":"2.0","id":3,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} +[server] Got a method textDocument/codeLens +[server] processing took 0.00500679016113ms +Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o +]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o +=== Project root: /home/manu/Documentos/irit/learn-ocaml-o +Detected `opam` dependency manager for local use +Sending response {"id": 3, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin", "command": ""}}]} +Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o +]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o +=== Project root: /home/manu/Documentos/irit/learn-ocaml-o +Detected `opam` dependency manager for local use +Read message +{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} +Read message +{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml","languageId":"ocaml","version":1,"text":"NX2k8sfoMJrFUk1x+YHRRCYPTSBUWEsXJ/NQWFmGrxkucRNwTyqo2Tdcb+mdu+ow5EqANnYdqqDlGs9Mxz4Sf9JiT5MyU1JS73/aqdFGZLQpAtYKp4x4qHxAWN5c9Sb++wq+a2AGULmR2X3BCyAMxaD1mAPPCjeUwA5AjxfOsy5c0yevitVknNEtW7kgescQO9FXURFNSlptEAxaELyxnDrfLX5UMwUQMDy5hMKwwyCLZtBoGHKHgaIMzF0yKgaFQ9JHCTYQ6AGJ9DDsn9dpd7Y1iBrEtpXl3VVQ/pe202MJkZic9pBSb2B93x102BvlxgKGX+tLF+z9TUnJnhelPXxyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9Q1/wUaO8KQPMHPVsrkVdyMO87q+bo2YEllTMpNbvtukHCOfJ7l0gMOAoRN/8DRYznPvHXRWSiPRiQTdbcXf1WVVb3Qwdt79DP9u73To7ni8RbyoolSKf7i1F2vps1efRDQx4LjuohNC1bmsDFMISC+Rty+r4NURgDV9o/XEFN+RIeZULduxkwbpNoDGCODDZhmbPnsfZ678T0LnY5va0rDYxRv7jRslhjC5lbGYxLoetuhhZc+PICGcYM6OACqGJYAsFCeA7EQJq+rJhLPJ+11WaTDH9Nr0qilAeERUHedQ6MmMrTi8kfViGS8YA6zwRwFW9BvghUYppMGFJRGVowRk6BWJPxnDrfHTlOMJhHIp4wf3fhhmiERNEyMpj8gPUXyFayZdTeQ8gcXWJV/p3JaAn7nUV9sjNHyBLBq9bWPFUWjEKRIxQCiwjlyzUWqNAlOcNPMU8fq1yQB19LUL79G5X25fTlPXxyMMD3oXXI8SoAMWemmztyBBhPEQQZ+SoIQWwTcv+00b5U45F5lpQSKayhgKrz1dw5mCs80bvvmRCXVrsqlqAWOGhYJ/XIXhyjO+mIUnHp3BOZTfadHa9kCDmYQwE76EC0jqiQEo0y5HF85mBkD+zm7J/GdUgNb2tOAd3YjvZxOXMpnIW9JwnF2Ut93KXKTD2BUEpZ2VZXL//VUFesgvRna5RmAWDZCnEsfKflwrd5vyq+Ozxqfvba229Rx7rXq9IjA/F7EIYLnKIpwMBaMLxlAME2/PZRbSkaFs6C9SKEQJq+aYoP+0m2K8rxM6sIbqCI6E+BCkDyhElt7YyLtiQlDTDAitVknNEtGjFzftwXKlEIX6FOUEl6O6EVELyxnDrfQTlJYIAPN7DclazbtGPEKZQPJ7vfi3IQ/lLj31LcF8YKC5NDl/aQwDvb7/QdwyFT/U3saBae2RFT/6+4TtlEiwSwlEkQaZoy4sFG0ETfyt4KAh6WPfz9TUnJnhelPXweMJrO5CjYuz63Mz7u5oQTBBU10/wWVmwEQlBTe38AYNtS+QEg7ox52qylf4qbIMoYjmE9OfeyepqX43sqlqAWN5AFMEXDCYCw1bivTnvi3BOVQsbZU0pdVR0YQwE76EC0jqjRGVyk/EsqzpwaHK7/mYQD9nEVv+RNTIyL8qQcJ72PpNP020OtB6s6Kfr3FGNBCAJVMo9Z+RBNFWbgg2YepTpl4lvXG72hePuntv247HiHKiImrqK6Qs/2gibXapg9RoAzSYYW7+YfvhRGJ0h7CgUG8eMXfXJV+26P8p7EQJq+sJZPFaj1ZyfSCj6Iuu8Nn90f26XtfBhJ7YyLtiQlDTDAitVknJB5SSRved1U3VoNGENMXB/nO6EVELyxnF4aAGd0Lg53P8TSaq7uuHKQOrcaD83gd3AYyBGvUJ4KBjgWUWA+6zaGcDG7lAAmxD5+lFXDvHrdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERxELF+z9TUnJvMGp3Hx/Sg78oRXIyShASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRAlS1i1r7txSbLVORro4dA3/sRNULPXdmr44+rAGTn1UfVTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7O1JoUhVvaoNVwPLpqYzUC1ppNeF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWCqG7ttu+fmbZhtoE4BPCAir4G6A2QFvnqv/EIjA/EyXtI6xe5frYRDLL1nB3xD7OAFuXlFRs5H9TbrQJrvqII1Ub7C1Xe2RosIbqCInQ4VSFjwhUM1mJP37i9a2HPA7Yp65PttGjEucgg9J692MkBJSVUpEB/UQOyhoDqBSUJZYJ1MJjz9sejEy7yEOYwVYiLvxvF4jRGvZs0vAXhCEDJA/5XZtS3cblQ6xTJC/QOSglCn0BBO7DiVZc1Dzhjl6A1dqNAlOcNPMU8fuI8lAc/0+rD5CAL2ncWV07gm+ZC0/yr17X504Cqvm9RmR6BAOo9ZGW9QERUQr38ISadZ0Sx8/BE5LPagava8KJcVontiKeuyd/GNS4Yu7ugKW9l4JVyCTt351YHNRCGdJUfXV2roWOEpVWWXDcQ7nBPPnauZZR+dlDQelldoSPupidpDmpsghP1ZQtSOpaQkFz6b6g3BMI+FI/ls+qaKUSkBDBoBCRhQ+WsvFimprgpgxUEaFDCLG8lducGzbg57wD0wAzNacI76Xc9Rx7rXq9IjA/F7GMsKi01ie16TMONjQMUKz3MrbH9GV25VjH0M+wq+a2BPFumQNDqTTmFIwqDhpReR2EHdcAEJ70Doemll0ymQxdVhkqttGjEuvghUYlFNTBEZGR/wEBE2X47d7iOfDiQZ1NUPN7DclazbtGPEYcluKk8vxvF4jRG7Kg3bQ8YCUWIQ65rJvHb2pV5l8TIBjonVhQTa+FU35nPC2sAZngbri6sOfNAwOct845+cr1mBCNUF33D5CAL2nhnPQH5r01m3vmvG/CU00DWBy6R8QUkMER9ZGW9QERUQr38IOewBPVU68RAfPNL5cK7iMYV9oHdzWOv7xVaZE+Iu/egCN5JRY6CGChzx4gKEDXunC8O1Z1GmU0pdVR0YQwE76EC06qjqTor7lEcGjzUoSPup7IRG5QsJv2sNQZ4LcY9lUC1ppNfZ204RIQV6UN+XP99NCB5RWEcWIFRrUEHwxJEewlFoEDT0H8dvfOigxrMcoG0ROWMlvbenGs/YeCqRfppj4VFqDvpL74RawMIAZ0McHNAO63wRfHQQWN5geCLBDM74aZIKU4W3H8qTTmFIbuHEk5PATlnwq/BMiZy0tTk6DTDAitVknLkwW8N/gNkVL5lnH/RJV9tcHzxV44neziucBDk2GctuN7DguLaohnC53gQoLC0vcaI+jUHv1tTiAX2OUS2BlluFqSrl66sOdyFO/UaBtkGdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERrJEU3n9TlSUkx4jJ/AyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5uoxuLKjrtarT1xFnlSl7MK0exQvKVKJhpbpX2VYEMFHKCdn/KvmISTCu1kWaTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7IRG5QtVv11CCMmL8Pp51nUufseF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWD0XiMMfPTwbbEro9zY4oAyv3H9DIxRaC+GslJLKFF7EIZOoeBVod6FMPIpGNxG61p4bWlFXxFC8CLIB1a+qJp2UajU0TqOTjMNqPDOoQuST6X5f9lKiIWO7mkiORuAitVk5Z1tG7Byb2sVJo6NGF/1Vo9S0RFQXOvsnHyaByQ0Sss41i7suPnitWWF1Mka3WavcqMKyBGgAZ3bQ8YCUQgVokyHrmntnUp0xDQ3j6jVqSvdURBF7pPWZhRIhNvJ/R2CqNIbOe1AMQ+kwI8RF1QLR3HcH5XK7tLl2DR7YZW47Tn17ChASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRXjmtz1r7vxELQEe9B/egCN5JRY6CGChyl4bjEAGTn1UfVTdGmU0pdVR0YQwE76EC0jxzVFlKdl8xexoklDub7n1YKjAsAbrFNHcjZje2wLiVo8NfMOhjA3VxsYqaHFy6uTUpRGR9Z+RARFRCgfM5er9EcVWD0XiNhu+ncbbM5oDSU4jNnftHrGgpRxCOLxEtlGXs7EIYL74RaeYQAZPJoTwVPp0NRqDoVFs6C9SKEQJq+a2BPFumQQHfLGmFKcPLk7E0nX/0vhRh47ZWDgTRfW6uAitVk8ZcxMUsyetxUIA9IDkwzXE5gWE5VV0ykh8rfMXpHMghLITixxuXRhnDENN9bNmG7xrRR7VTf3b8fBjVBUTVZl9O8cHas6Fo958QWoTCIcoTn+FVNrRHF2slQixym6B2CqMllVgpB25Gbs10QSOkCU3mvGUnLkwPjYHxvLtC49mvB/VN3MHq8ooQz+lkMER/FGRYQHAtQpwXBEZAN3AF5zB1jOb0Tdefn1Ios/Dw80dC7xSbYQaFrpbpH1poZSBCGChzgPuyHSGSi4oeQFgHMF4/qF6+PCdVvu9C0jqjMTj0g7GREz5slBveplbUVkVcMb3E3QsjTjqQ539sa8wzMMYj43BUNYra0W82BTllMGlQZZAhRVE0jxYoEcARtBS7CXmZSu+ncbed5rmSZYWMJ/frLEgoFxzuEf8kaTpEyQt24pKIf9t2II0EfTsQ1/0NM/8oVWwlW9WHMCbS4wYA2FqyQKRHTTmFI7uH+kpPVWVDtv9Vz71rOcDkf+yGUyYkk82FeU8V85ZhUYlFNTElZQ99tSEFvVPne7mryQUlQOIt5IDidb47kxGXESd/a0zmvgOhNzk8zVMTyDGJDCWISyQzJtVXs6AB9dyES/RSRc5ytQoFT7pGRPhQpixKsuo63cZooOfpSMUX9dMeLFMNCU20iFAL27s0lPnkq3Yn0oiWNbnp0YSruy968G6lJSU/zXSoDU6UNrZ7NYbxb3oxnjnAr3KCnq0jt1xZclAApKfTjhA4ZEbR9o0oC1n6RY6CGChzx4e0URTn7D5uQHIKmTLoMEEfIP2Bpk5HCjxKNTor7lHJl5QkhDIW8l1xSpFMVvbU4Ht7S8PRhUC1ppNeF2ZTRUostN+q/+WNITQV4Mo9ZJVVFFVylrIkwboVlAnW9DTYxhqewbahKoDSU4nI6qsi7FgoSfVTEf6B8QQUiQtM674RaeYQAOulaM2AX93EUejd1WZZYlzuPPcfCuYJ/FumQNDqTDzI1bvnW6CuIWEGycpI3i0T0ryQuJiOP9gUlzwQtU7dBvgg2JUE3A/UZEXUtUUN0Xavw6X4FEi5FLh9L4Suxab7isnCN31QfMTObfa1+w9Py3c8tF8dCBSwVnCGJcHasmUllsnMPpQ+Xc7er3QVZ76+eIxQFkhzhb9dWqNBPRq//4QjrdMyXEqg+QO8xBB8Qndby+XxfGtD37TC1lWVWMWegilAvFp5mQkoJV8sEEQ5fr38IOaYE+VUly6I8Cr8ddvziIN9lkSpiD+PqdRvLUPZ7p4tc2UxUIVrGSsv54fTKKzTn1Ue1C1HyFPFtJkOID1Nj6Fj0xYDQGkegy8RAuzUoSPupm15VoAt2oOE3Hd7MnaQkAS2E6Y+R21vhYUt933uKXTUETQwUWEkMOkVCFV8hqxlebARhGjC4G71ceq8hqa97oEzYVWNnfvK6Xc9Rx7rXq9IjA/F7EIZhiL1dvN2TZKodWwoGp+/LqG5QWh5pkHLLEtapa2BPFumQNDqTTmFIbqCI6E+BIRWwgQMI7ZyLwHIx1mD2cMVknNF5X8UuacsZMmMIHFgLTR/lEFBGRM+u5HegC9IGNI9KMCmhaq8RhnDENJRaYiKle3d5yEyn32LsEXcNHi5YoUPMsmSSlE56qCU1pAuBlmH1PBZ3yQH+X15JnIet9RcGqLBUWa/PMU8fdI7ERxELF+z9TUnJnhelPXxyMMC28TCLz/N3MHq8ooQDISkMU/F1W7JqXkBBf+CRMwBBPVV5jkcm3Omaf4raPtRYiSpi4LysdprzROo7ouhB3UdBIlLDCdCfV3jEAGSeNleBCxm8Ia/tG9SMQxp7amj08uWVAR0HuRhelldoD0+8mYROeEgGbrUKCYyDcYBhIyMppvrLIxz43Fh/Kb8RUCZBHQkFTVoLJlMRXVHqu16gapRmVSS3CmYeb3ygh3F2nBfU4jNnfvK6Xc9Rx7rXq9IjA/F72t2Co+EsvIlJZO6uTtEK8OM8bWp+RIox9SKEQJq+a2BPFumQNDqTTmFIlPCImQ7BQ/OweQA1mJyPxHQtY9bSzgUfzxUtBzFQkwhSZUE4CUFWSlkwDRFr0ZPxnGanBHNVGctnN7qbe4vbhn7aNOAfOn0vxMhljRytZJ4rEH/KGCBZl9eNcDn7n/MpxCQNpQ+OaVHh3QFTzo0UZxkCgs0cxowVagVy+NN4OE7Hjx7EAdkYUKysABmMz1b52Co7TgK0/Tv+6SoeYXyrm/toFVZXOmNVXDlQQEBVfunB2PRRPU6KjkdaP4zte+zt2MQw/DM7I0e2cQ0Z+v2amvQA3Ul2HoDcDsjsZ3iGTnrbDEe1A3rmU36gB9KyBMRtooTS/0OqD/HczXwx6mB7Be+/iMlJmpsLerEDVxH36aRsKG69fseF218T+6/LKfr3FB5dV/1eGTNVLEQRREXdrgoncQdtVXioXiMlfP7cveFq9DSJ4ndmr403ChARjSeDgk6aTAU4EPlOi+k/e1kOMIcoBcs/p0MFbWdB+ZhXijHQC2SU5wEIVaW3ZjbtHHhEufTBnp7BVVLtf/2EyMKOwGdk1ouAitVknw1rMWEuvggqH/wWZ6EmVVpcEB91EKTCnDqwBG9vMwhMJ8TguNj0nSDE211uHCGueO5L5Ge6YcLcCTZBH7ZVbUu+xHbNgAA7wmcOyU0Bq9bWPFVsd9KRIxQmiwzwzQBYqN6POf1K+RmfdrqLAtQLRPm/AQX29wTjPQ1uMIGN9QvZ6GkXKHany/1tBQ5mUEwNEHIfERUQrZrN3OhI16s5lnRmDO8lf4q6RxsfkntvP+ShxkaCE1F9lasCNERTYzjKCc76OueQSSrdYUf1VOrmU0pdJ/O0Fs6sn9CTx4j9C9exlDZ2yAFnHLOaowgE5RAVnrtJCYyJnPYcBntp9YrAJwnYYkVpKfKFPzNBMA=="}}} +Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":4,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} +[server] Got a method textDocument/codeAction +[server] processing took 0.00786781311035ms +Sending response {"id": 4, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":5,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} +[server] Got a method textDocument/documentSymbol +[server] processing took 0.00596046447754ms +Sending response {"id": 5, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":6,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} +[server] Got a method textDocument/codeLens +[server] processing took 0.00691413879395ms +Sending response {"id": 6, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} +Read message +{"jsonrpc":"2.0","id":7,"method":"textDocument/hover","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"},"position":{"line":0,"character":27}}} +[server] Got a method textDocument/hover +[server] processing took 0.00691413879395ms +Sending response {"id": 7, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} +Read message +{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml","languageId":"ocaml","version":1,"text":"NX2k8sfoMJrFUk1x+YHRRCYPTSBUWEsXJ/NQWFmGrxkucRNwTyqo2Tdcb+mdu+ow5EqANnYdqqDlGs9Mxz4Sf9JiT5MyU1JS73/aqdFGZLQpAtYKp4x4qHxAWN5c9Sb++wq+a2AGULmR2X3BCyAMxaD1mAPPCjeUwA5AjxfOsy5c0yevitVknNEtW7kgescQO9FXURFNSlptEAxaELyxnDrfLX5UMwUQMDy5hMKwwyCLZtBoGHKHgaIMzF0yKgaFQ9JHCTYQ6AGJ9DDsn9dpd7Y1iBrEtpXl3VVQ/pe202MJkZic9pBSb2B93x102BvlxgKGX+tLF+z9TUnJnhelPXxyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9Q1/wUaO8KQPMHPVsrkVdyMO87q+bo2YEllTMpNbvtukHCOfJ7l0gMOAoRN/8DRYznPvHXRWSiPRiQTdbcXf1WVVb3Qwdt79DP9u73To7ni8RbyoolSKf7i1F2vps1efRDQx4LjuohNC1bmsDFMISC+Rty+r4NURgDV9o/XEFN+RIeZULduxkwbpNoDGCODDZhmbPnsfZ678T0LnY5va0rDYxRv7jRslhjC5lbGYxLoetuhhZc+PICGcYM6OACqGJYAsFCeA7EQJq+rJhLPJ+11WaTDH9Nr0qilAeERUHedQ6MmMrTi8kfViGS8YA6zwRwFW9BvghUYppMGFJRGVowRk6BWJPxnDrfHTlOMJhHIp4wf3fhhmiERNEyMpj8gPUXyFayZdTeQ8gcXWJV/p3JaAn7nUV9sjNHyBLBq9bWPFUWjEKRIxQCiwjlyzUWqNAlOcNPMU8fq1yQB19LUL79G5X25fTlPXxyMMD3oXXI8SoAMWemmztyBBhPEQQZ+SoIQWwTcv+00b5U45F5lpQSKayhgKrz1dw5mCs80bvvmRCXVrsqlqAWOGhYJ/XIXhyjO+mIUnHp3BOZTfadHa9kCDmYQwE76EC0jqiQEo0y5HF85mBkD+zm7J/GdUgNb2tOAd3YjvZxOXMpnIW9JwnF2Ut93KXKTD2BUEpZ2VZXL//VUFesgvRna5RmAWDZCnEsfKflwrd5vyq+Ozxqfvba229Rx7rXq9IjA/F7EIYLnKIpwMBaMLxlAME2/PZRbSkaFs6C9SKEQJq+aYoP+0m2K8rxM6sIbqCI6E+BCkDyhElt7YyLtiQlDTDAitVknNEtGjFzftwXKlEIX6FOUEl6O6EVELyxnDrfQTlJYIAPN7DclazbtGPEKZQPJ7vfi3IQ/lLj31LcF8YKC5NDl/aQwDvb7/QdwyFT/U3saBae2RFT/6+4TtlEiwSwlEkQaZoy4sFG0ETfyt4KAh6WPfz9TUnJnhelPXweMJrO5CjYuz63Mz7u5oQTBBU10/wWVmwEQlBTe38AYNtS+QEg7ox52qylf4qbIMoYjmE9OfeyepqX43sqlqAWN5AFMEXDCYCw1bivTnvi3BOVQsbZU0pdVR0YQwE76EC0jqjRGVyk/EsqzpwaHK7/mYQD9nEVv+RNTIyL8qQcJ72PpNP020OtB6s6Kfr3FGNBCAJVMo9Z+RBNFWbgg2YepTpl4lvXG72hePuntv247HiHKiImrqK6Qs/2gibXapg9RoAzSYYW7+YfvhRGJ0h7CgUG8eMXfXJV+26P8p7EQJq+sJZPFaj1ZyfSCj6Iuu8Nn90f26XtfBhJ7YyLtiQlDTDAitVknJB5SSRved1U3VoNGENMXB/nO6EVELyxnF4aAGd0Lg53P8TSaq7uuHKQOrcaD83gd3AYyBGvUJ4KBjgWUWA+6zaGcDG7lAAmxD5+lFXDvHrdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERxELF+z9TUnJvMGp3Hx/Sg78oRXIyShASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRAlS1i1r7txSbLVORro4dA3/sRNULPXdmr44+rAGTn1UfVTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7O1JoUhVvaoNVwPLpqYzUC1ppNeF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWCqG7ttu+fmbZhtoE4BPCAir4G6A2QFvnqv/EIjA/EyXtI6xe5frYRDLL1nB3xD7OAFuXlFRs5H9TbrQJrvqII1Ub7C1Xe2RosIbqCInQ4VSFjwhUM1mJP37i9a2HPA7Yp65PttGjEucgg9J692MkBJSVUpEB/UQOyhoDqBSUJZYJ1MJjz9sejEy7yEOYwVYiLvxvF4jRGvZs0vAXhCEDJA/5XZtS3cblQ6xTJC/QOSglCn0BBO7DiVZc1Dzhjl6A1dqNAlOcNPMU8fuI8lAc/0+rD5CAL2ncWV07gm+ZC0/yr17X504Cqvm9RmR6BAOo9ZGW9QERUQr38ISadZ0Sx8/BE5LPagava8KJcVontiKeuyd/GNS4Yu7ugKW9l4JVyCTt351YHNRCGdJUfXV2roWOEpVWWXDcQ7nBPPnauZZR+dlDQelldoSPupidpDmpsghP1ZQtSOpaQkFz6b6g3BMI+FI/ls+qaKUSkBDBoBCRhQ+WsvFimprgpgxUEaFDCLG8lducGzbg57wD0wAzNacI76Xc9Rx7rXq9IjA/F7GMsKi01ie16TMONjQMUKz3MrbH9GV25VjH0M+wq+a2BPFumQNDqTTmFIwqDhpReR2EHdcAEJ70Doemll0ymQxdVhkqttGjEuvghUYlFNTBEZGR/wEBE2X47d7iOfDiQZ1NUPN7DclazbtGPEYcluKk8vxvF4jRG7Kg3bQ8YCUWIQ65rJvHb2pV5l8TIBjonVhQTa+FU35nPC2sAZngbri6sOfNAwOct845+cr1mBCNUF33D5CAL2nhnPQH5r01m3vmvG/CU00DWBy6R8QUkMER9ZGW9QERUQr38IOewBPVU68RAfPNL5cK7iMYV9oHdzWOv7xVaZE+Iu/egCN5JRY6CGChzx4gKEDXunC8O1Z1GmU0pdVR0YQwE76EC06qjqTor7lEcGjzUoSPup7IRG5QsJv2sNQZ4LcY9lUC1ppNfZ204RIQV6UN+XP99NCB5RWEcWIFRrUEHwxJEewlFoEDT0H8dvfOigxrMcoG0ROWMlvbenGs/YeCqRfppj4VFqDvpL74RawMIAZ0McHNAO63wRfHQQWN5geCLBDM74aZIKU4W3H8qTTmFIbuHEk5PATlnwq/BMiZy0tTk6DTDAitVknLkwW8N/gNkVL5lnH/RJV9tcHzxV44neziucBDk2GctuN7DguLaohnC53gQoLC0vcaI+jUHv1tTiAX2OUS2BlluFqSrl66sOdyFO/UaBtkGdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERrJEU3n9TlSUkx4jJ/AyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5uoxuLKjrtarT1xFnlSl7MK0exQvKVKJhpbpX2VYEMFHKCdn/KvmISTCu1kWaTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7IRG5QtVv11CCMmL8Pp51nUufseF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWD0XiMMfPTwbbEro9zY4oAyv3H9DIxRaC+GslJLKFF7EIZOoeBVod6FMPIpGNxG61p4bWlFXxFC8CLIB1a+qJp2UajU0TqOTjMNqPDOoQuST6X5f9lKiIWO7mkiORuAitVk5Z1tG7Byb2sVJo6NGF/1Vo9S0RFQXOvsnHyaByQ0Sss41i7suPnitWWF1Mka3WavcqMKyBGgAZ3bQ8YCUQgVokyHrmntnUp0xDQ3j6jVqSvdURBF7pPWZhRIhNvJ/R2CqNIbOe1AMQ+kwI8RF1QLR3HcH5XK7tLl2DR7YZW47Tn17ChASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRXjmtz1r7vxELQEe9B/egCN5JRY6CGChyl4bjEAGTn1UfVTdGmU0pdVR0YQwE76EC0jxzVFlKdl8xexoklDub7n1YKjAsAbrFNHcjZje2wLiVo8NfMOhjA3VxsYqaHFy6uTUpRGR9Z+RARFRCgfM5er9EcVWD0XiNhu+ncbbM5oDSU4jNnftHrGgpRxCOLxEtlGXs7EIYL74RaeYQAZPJoTwVPp0NRqDoVFs6C9SKEQJq+a2BPFumQQHfLGmFKcPLk7E0nX/0vhRh47ZWDgTRfW6uAitVk8ZcxMUsyetxUIA9IDkwzXE5gWE5VV0ykh8rfMXpHMghLITixxuXRhnDENN9bNmG7xrRR7VTf3b8fBjVBUTVZl9O8cHas6Fo958QWoTCIcoTn+FVNrRHF2slQixym6B2CqMllVgpB25Gbs10QSOkCU3mvGUnLkwPjYHxvLtC49mvB/VN3MHq8ooQz+lkMER/FGRYQHAtQpwXBEZAN3AF5zB1jOb0Tdefn1Ios/Dw80dC7xSbYQaFrpbpH1poZSBCGChzgPuyHSGSi4oeQFgHMF4/qF6+PCdVvu9C0jqjMTj0g7GREz5slBveplbUVkVcMb3E3QsjTjqQ539sa8wzMMYj43BUNYra0W82BTllMGlQZZAhRVE0jxYoEcARtBS7CXmZSu+ncbed5rmSZYWMJ/frLEgoFxzuEf8kaTpEyQt24pKIf9t2II0EfTsQ1/0NM/8oVWwlW9WHMCbS4wYA2FqyQKRHTTmFI7uH+kpPVWVDtv9Vz71rOcDkf+yGUyYkk82FeU8V85ZhUYlFNTElZQ99tSEFvVPne7mryQUlQOIt5IDidb47kxGXESd/a0zmvgOhNzk8zVMTyDGJDCWISyQzJtVXs6AB9dyES/RSRc5ytQoFT7pGRPhQpixKsuo63cZooOfpSMUX9dMeLFMNCU20iFAL27s0lPnkq3Yn0oiWNbnp0YSruy968G6lJSU/zXSoDU6UNrZ7NYbxb3oxnjnAr3KCnq0jt1xZclAApKfTjhA4ZEbR9o0oC1n6RY6CGChzx4e0URTn7D5uQHIKmTLoMEEfIP2Bpk5HCjxKNTor7lHJl5QkhDIW8l1xSpFMVvbU4Ht7S8PRhUC1ppNeF2ZTRUostN+q/+WNITQV4Mo9ZJVVFFVylrIkwboVlAnW9DTYxhqewbahKoDSU4nI6qsi7FgoSfVTEf6B8QQUiQtM674RaeYQAOulaM2AX93EUejd1WZZYlzuPPcfCuYJ/FumQNDqTDzI1bvnW6CuIWEGycpI3i0T0ryQuJiOP9gUlzwQtU7dBvgg2JUE3A/UZEXUtUUN0Xavw6X4FEi5FLh9L4Suxab7isnCN31QfMTObfa1+w9Py3c8tF8dCBSwVnCGJcHasmUllsnMPpQ+Xc7er3QVZ76+eIxQFkhzhb9dWqNBPRq//4QjrdMyXEqg+QO8xBB8Qndby+XxfGtD37TC1lWVWMWegilAvFp5mQkoJV8sEEQ5fr38IOaYE+VUly6I8Cr8ddvziIN9lkSpiD+PqdRvLUPZ7p4tc2UxUIVrGSsv54fTKKzTn1Ue1C1HyFPFtJkOID1Nj6Fj0xYDQGkegy8RAuzUoSPupm15VoAt2oOE3Hd7MnaQkAS2E6Y+R21vhYUt933uKXTUETQwUWEkMOkVCFV8hqxlebARhGjC4G71ceq8hqa97oEzYVWNnfvK6Xc9Rx7rXq9IjA/F7EIZhiL1dvN2TZKodWwoGp+/LqG5QWh5pkHLLEtapa2BPFumQNDqTTmFIbqCI6E+BIRWwgQMI7ZyLwHIx1mD2cMVknNF5X8UuacsZMmMIHFgLTR/lEFBGRM+u5HegC9IGNI9KMCmhaq8RhnDENJRaYiKle3d5yEyn32LsEXcNHi5YoUPMsmSSlE56qCU1pAuBlmH1PBZ3yQH+X15JnIet9RcGqLBUWa/PMU8fdI7ERxELF+z9TUnJnhelPXxyMMC28TCLz/N3MHq8ooQDISkMU/F1W7JqXkBBf+CRMwBBPVV5jkcm3Omaf4raPtRYiSpi4LysdprzROo7ouhB3UdBIlLDCdCfV3jEAGSeNleBCxm8Ia/tG9SMQxp7amj08uWVAR0HuRhelldoD0+8mYROeEgGbrUKCYyDcYBhIyMppvrLIxz43Fh/Kb8RUCZBHQkFTVoLJlMRXVHqu16gapRmVSS3CmYeb3ygh3F2nBfU4jNnfvK6Xc9Rx7rXq9IjA/F72t2Co+EsvIlJZO6uTtEK8OM8bWp+RIox9SKEQJq+a2BPFumQNDqTTmFIlPCImQ7BQ/OweQA1mJyPxHQtY9bSzgUfzxUtBzFQkwhSZUE4CUFWSlkwDRFr0ZPxnGanBHNVGctnN7qbe4vbhn7aNOAfOn0vxMhljRytZJ4rEH/KGCBZl9eNcDn7n/MpxCQNpQ+OaVHh3QFTzo0UZxkCgs0cxowVagVy+NN4OE7Hjx7EAdkYUKysABmMz1b52Co7TgK0/Tv+6SoeYXyrm/toFVZXOmNVXDlQQEBVfunB2PRRPU6KjkdaP4zte+zt2MQw/DM7I0e2cQ0Z+v2amvQA3Ul2HoDcDsjsZ3iGTnrbDEe1A3rmU36gB9KyBMRtooTS/0OqD/HczXwx6mB7Be+/iMlJmpsLerEDVxH36aRsKG69fseF218T+6/LKfr3FB5dV/1eGTNVLEQRREXdrgoncQdtVXioXiMlfP7cveFq9DSJ4ndmr403ChARjSeDgk6aTAU4EPlOi+k/e1kOMIcoBcs/p0MFbWdB+ZhXijHQC2SU5wEIVaW3ZjbtHHhEufTBnp7BVVLtf/2EyMKOwGdk1ouAitVknw1rMWEuvggqH/wWZ6EmVVpcEB91EKTCnDqwBG9vMwhMJ8TguNj0nSDE211uHCGueO5L5Ge6YcLcCTZBH7ZVbUu+xHbNgAA7wmcOyU0Bq9bWPFVsd9KRIxQmiwzwzQBYqN6POf1K+RmfdrqLAtQLRPm/AQX29wTjPQ1uMIGN9QvZ6GkXKHany/1tBQ5mUEwNEHIfERUQrZrN3OhI16s5lnRmDO8lf4q6RxsfkntvP+ShxkaCE1F9lasCNERTYzjKCc76OueQSSrdYUf1VOrmU0pdJ/O0Fs6sn9CTx4j9C9exlDZ2yAFnHLOaowgE5RAVnrtJCYyJnPYcBntp9YrAJwnYYkVpKfKFPzNBMA=="}}} +Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":8,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} +[server] Got a method textDocument/codeAction +[server] processing took 0.00190734863281ms +Sending response {"id": 8, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":9,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} +[server] Got a method textDocument/documentSymbol +[server] processing took 0.00190734863281ms +Sending response {"id": 9, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":10,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} +[server] Got a method textDocument/codeLens +[server] processing took 0.00596046447754ms +Sending response {"id": 10, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} +Read message +{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} +Read message +{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml","languageId":"ocaml","version":1,"text":"open Test_lib\nopen Learnocaml_report;;\n\nlet avoid_thentrue = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not write the following code patterns:\";\n Code \"[if ... then true else ...;\n if ... then false else ...;\n if ... then ... else true;\n if ... then ... else false]\"; Text \"\nPreferably use Boolean operators (&&), (||), not.\"], Success ~-4) ]\n end\n\nlet check_thentrue e =\n Parsetree.(\n match e with\n | {pexp_desc = Pexp_ifthenelse (_, e1, (Some e2))} ->\n begin\n match e1 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e1\n | _ -> []\n end @ begin\n match e2 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e2\n | _ -> []\n end\n | _ -> [])\n\nlet avoid_list1app = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not write:\";\n Code \"[x] @ l\";\n Text \". Preferably write:\";\n Code \"x :: l\";\n Text \".\"], Success ~-4) ]\n end\n\nlet check_list1app e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_apply (app0, [(_, lst1); _]) ->\n (match app0.pexp_desc, lst1.pexp_desc with\n | Pexp_ident {Asttypes.txt = app0'},\n Pexp_construct ({Asttypes.txt = (Longident.Lident \"::\")}, Some lst1')\n when List.mem (Longident.flatten app0') [[\"List\"; \"append\"]; [\"@\"]] ->\n (match lst1'.pexp_desc with\n | Pexp_tuple [_; nil0] ->\n (match nil0.pexp_desc with\n | Pexp_construct ({Asttypes.txt = (Longident.Lident \"[]\")}, None) ->\n avoid_list1app e\n | _ -> [])\n | _ -> [])\n | _ -> [])\n | _ -> [])\n\nlet avoid_eqphy = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not use physical equality\";\n Code \"(==)\";\n Text \". Preferably use structural equality\";\n Code \"(=)\";\n Text \".\"], Success ~-1) ]\n end\n\nlet avoid_neqphy = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not use physical inequality\";\n Code \"(!=)\";\n Text \". Preferably use structural inequality\";\n Code \"(<>)\";\n Text \".\"], Success ~-1) ]\n end\n\nlet check_eqphy e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_ident {Asttypes.txt = Longident.Lident \"==\"} -> avoid_eqphy e\n | _ -> [])\n\nlet check_neqphy e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_ident {Asttypes.txt = Longident.Lident \"!=\"} -> avoid_neqphy e\n | _ -> [])\nlet ast_imperative_check ast =\n let chk_expr e =\n Parsetree.(\n match e with\n | {pexp_desc = Pexp_sequence _} -> forbid_syntax \";\" e\n | {pexp_desc = Pexp_while _} -> forbid_syntax \"while\" e\n | {pexp_desc = Pexp_for _} -> forbid_syntax \"for\" e\n | {pexp_desc = Pexp_array _} -> forbid_syntax \"array\" e\n | _ -> [] ) in\n let imperative_report =\n ast_check_structure\n ~on_expression:chk_expr\n ast |> List.sort_uniq compare in\n if snd (Learnocaml_report.result imperative_report) then\n imperative_report\n else\n []\n\nlet ast_quality ast =\n let imperative_report =\n let tempReport = ast_imperative_check ast in\n if tempReport = [] then []\n else (Message ([ Text \"Imperative features have been detected:\" ],\n Success ~-4)) :: tempReport\n \n and report =\n let tempReport = ast_check_structure\n ~on_expression:(check_thentrue @@@ check_list1app @@@\n check_eqphy @@@ check_neqphy)\n ast |> List.sort_uniq compare in\n if tempReport = [] then []\n else (Message ([Text \"Unwanted code patterns have been detected:\"],\n Failure)) :: tempReport\n \n in if imperative_report = [] && report = []\n then [ Message ([ Text \"OK (no prohibited construction detected)\"], Success 0) ]\n else imperative_report @ report;;\n\nlet question0 =\n let prot = last_ty [%ty:bool] [%ty: bool] in\n test_function_against_solution ~gen:(5) prot\n \"f\"\n [];;\n \nlet question1 =\n let prot = last_ty [%ty:int] [%ty: int] in\n test_function_against_solution ~gen:(5) prot\n \"f\"\n [];;\n \nlet () =\n set_result @@\n ast_sanity_check code_ast @@ fun () ->\n [\n Section ([ Text \"Code quality:\" ], ast_quality code_ast);\n Section ([ Text \"Fonction:\" ; Code \"f\" ], question0 );\n Section ([ Text \"Fonction:\" ; Code \"f\" ], question1 );\n ]"}}} +Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":11,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} +[server] Got a method textDocument/codeAction +[server] processing took 0.00190734863281ms +Sending response {"id": 11, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":12,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"}}} +[server] Got a method textDocument/documentSymbol +[server] processing took 0.00286102294922ms +Sending response {"id": 12, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} +Read message +{"jsonrpc":"2.0","id":13,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"}}} +[server] Got a method textDocument/codeLens +[server] processing took 0.00309944152832ms +Sending response {"id": 13, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} +Read message +{"jsonrpc":"2.0","id":14,"method":"shutdown","params":null} +Sending response {"id": 14, "jsonrpc": "2.0", "result": null} +Read message +{"jsonrpc":"2.0","method":"exit","params":null} +Got exit! Terminating loop +Finished From 680947364c97c8073549dd4efdfa17b4bbd275a9 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Thu, 18 Jul 2019 15:59:46 +0200 Subject: [PATCH 12/91] feat : add zip import for one exercise , also did some refactor --- src/app/#learnocaml_common.ml# | 972 -------------------- src/app/.#learnocaml_common.ml | 1 - src/app/dune | 2 +- src/editor/dune | 2 +- src/editor/editor.ml | 25 +- src/editor/editor_lib.ml | 90 ++ src/editor/editor_lib.mli | 5 + src/editor/jszip.mli | 7 - src/editor/learnocaml_editor_tab.ml | 101 +- src/state/learnocaml_data.ml | 2 +- static/index.html | 2 + static/js/jszip/learnocaml_jszip_wrapper.js | 34 + static/js/jszip/node_modules/.lsp/debug.log | 118 --- 13 files changed, 155 insertions(+), 1206 deletions(-) delete mode 100644 src/app/#learnocaml_common.ml# delete mode 120000 src/app/.#learnocaml_common.ml delete mode 100644 static/js/jszip/node_modules/.lsp/debug.log diff --git a/src/app/#learnocaml_common.ml# b/src/app/#learnocaml_common.ml# deleted file mode 100644 index 737257985..000000000 --- a/src/app/#learnocaml_common.ml# +++ /dev/null @@ -1,972 +0,0 @@ -(* This file is part of Learn-OCaml. - * - * Copyright (C) 2019 OCaml Software Foundation. - * Copyright (C) 2016-2018 OCamlPro. - * - * Learn-OCaml is distributed under the terms of the MIT license. See the - * included LICENSE file for details. *) - -open Js_utils -open Lwt.Infix -open Learnocaml_data - -module H = Tyxml_js.Html - -let find_div_or_append_to_body id = - match Manip.by_id id with - | Some div -> div - | None -> - let div = H.(div ~a:[ a_id id ]) [] in - Manip.(appendChild Elt.body) div; - div - -let find_component id = - match Js_utils.Manip.by_id id with - | Some div -> div - | None -> failwith ("Cannot find id " ^ id) - -let fake_download ~name ~contents = - (* TODO: add some primitives to jsoo and clean this up *) - let blob : (Js.js_string Js.t Js.js_array Js.t -> File.blob Js.t) Js.constr = - Js.Unsafe.global ##. _Blob in - let blob = new%js blob (Js.array [| contents |]) in - let url = - Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject blob |] in File - let link = Dom_html.createA Dom_html.document in - link##.href := url ; - Js.Unsafe.set link (Js.string "download") (Js.string name) ; - ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; - ignore (Js.Unsafe.meth_call link "click" [||]) ; - ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t)))) - -let fake_upload () = - let input_files_load = - Dom_html.createInput ~_type: (Js.string "file") Dom_html.document in - let result_t, result_wakener = Lwt.wait () in - let fail () = - Lwt.wakeup_exn result_wakener - (Failure "file loading not implemented for this browser") ; - Js._true in - input_files_load##.onchange := Dom.handler (fun ev -> - Js.Opt.case (ev##.target) fail @@ fun target -> - Js.Opt.case (Dom_html.CoerceTo.input target) fail @@ fun input -> - Js.Optdef.case (input##.files) fail @@ fun files -> - Js.Opt.case (files##(item (0))) fail @@ fun file -> - let name = Js.to_string file##.name in - let fileReader = new%js File.fileReader in - fileReader##.onload := Dom.handler (fun ev -> - Js.Opt.case (ev##.target) fail @@ fun target -> - Js.Opt.case (File.CoerceTo.string (target##.result)) fail @@ fun result -> - Lwt.wakeup result_wakener (name, result) ; - Js._true) ; - fileReader##(readAsText file) ; - Js._true) ; - ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; - result_t - -let fatal ?(title=[%i"INTERNAL ERROR"]) message = - let titletext = title in - let id = "ocp-fatal-layer" in - let div = match Manip.by_id id with - | Some div -> div - | None -> - let div = - H.div ~a:[ H.a_id id ; - H.a_class ["learnocaml-dialog-overlay"] - ] - [] - in - Manip.(appendChild Elt.body) div; - div in - Manip.replaceChildren div [ - H.div [ - H.h3 [ H.pcdata titletext ]; - H.div [ H.p [ H.pcdata (String.trim message) ] ]; - ] - ] - -let dialog_layer_id = "ocp-dialog-layer" - -let box_button txt f = - H.button ~a: [ - H.a_onclick (fun _ -> - f (); - match Manip.by_id dialog_layer_id with - | Some div -> Manip.removeChild Manip.Elt.body div; false - | None -> (); false) - ] [ H.pcdata txt ] - -let close_button txt = - box_button txt @@ fun () -> () - -let ext_alert ~title ?(buttons = [close_button [%i"OK"]]) message = - let div = match Manip.by_id dialog_layer_id with - | Some div -> div - | None -> - let div = - H.div ~a:[ H.a_id dialog_layer_id ; - H.a_class ["learnocaml-dialog-overlay"] ] - [] - in - Manip.(appendChild Elt.body) div; - div in - Manip.replaceChildren div [ - H.div [ - H.h3 [ H.pcdata title ]; - H.div message; - H.div ~a:[ H.a_class ["buttons"] ] buttons; - ] - ] - -let lwt_alert ~title ~buttons message = - let waiter, wakener = Lwt.task () in - let buttons = - List.map (fun (txt, f) -> - box_button txt (fun () -> - Lwt.async @@ fun () -> - f () >|= Lwt.wakeup_later wakener)) - buttons - in - ext_alert ~title message ~buttons; - waiter - -let alert ?(title=[%i"ERROR"]) ?buttons message = - ext_alert ~title ?buttons [ H.p [H.pcdata (String.trim message)] ] - -let confirm ~title ?(ok_label=[%i"OK"]) ?(cancel_label=[%i"Cancel"]) contents f = - ext_alert ~title contents ~buttons:[ - box_button ok_label f; - close_button cancel_label; - ] - -let ask_string ~title ?(ok_label=[%i"OK"]) contents = - let input_field = - H.input ~a:[ - H.a_input_type `Text; - ] () - in - let result_t, up = Lwt.wait () in - ext_alert ~title (contents @ [input_field]) ~buttons:[ - box_button ok_label (fun () -> Lwt.wakeup up @@ Manip.value input_field) - ]; - result_t - -let default_exn_printer = function - | Failure msg -> msg - | e -> Printexc.to_string e - -let catch_with_alert ?(printer=default_exn_printer) f = - Lwt.catch f @@ fun exn -> alert (printer exn); Lwt.return_unit - -let hide_loading ?(id = "ocp-loading-layer") () = - let elt = find_div_or_append_to_body id in - Manip.(removeClass elt "initial") ; - Manip.(removeClass elt "loading") ; - Manip.(addClass elt "loaded") - -let show_loading ?(id = "ocp-loading-layer") contents f = - let show () = - let elt = find_div_or_append_to_body id in - Manip.(addClass elt "loading-layer") ; - Manip.(removeClass elt "loaded") ; - Manip.(addClass elt "loading") ; - let chamo_src = - "/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 () ] ; - div ~a: [ a_class [ "messages" ] ] contents - ] - in - let hide () = - let elt = find_div_or_append_to_body id in - Manip.(removeClass elt "initial") ; - Manip.(removeClass elt "loading") ; - Manip.(addClass elt "loaded") - in - Lwt.finalize - (fun () -> show (); f ()) - (fun () -> hide (); Lwt.return_unit) - -let set_assoc name value = - let rec set acc = function - | [] -> List.rev ((name, value) :: acc) - | (n, _) :: args when n = name -> - List.rev_append ((name, value) :: acc) args - | arg :: args -> set (arg :: acc) args in - set [] - -let delete_assoc name = - List.filter (fun (n, _) -> n <> name) - -let arg, set_arg, delete_arg = - let args = ref (Js_utils.parse_fragment ()) in - let delete_arg name = - args := delete_assoc name !args ; - Js_utils.set_fragment !args in - let set_arg name value = - args := set_assoc name value !args ; - Js_utils.set_fragment !args in - let arg name = - List.assoc name !args in - arg, set_arg, delete_arg - -type button_group = - (< disabled : bool Js.t Js.prop > Js.t * bool ref) list ref - * Lwt_mutex.t - * int ref - -let button_group () : button_group = - (ref [], Lwt_mutex.create (), ref 0) - -type button_state = - bool ref - * (button_group * < disabled : bool Js.t Js.prop > Js.t) option ref - -let button_state () : button_state = - (ref false, ref None) - -let disable_button_group (buttons, _, cpt) = - incr cpt ; - if !cpt = 1 then - List.iter - (fun (button, _) -> - button##.disabled := Js.bool true) - !buttons - -let enable_button_group (buttons, _, cpt) = - decr cpt ; - if !cpt = 0 then - List.iter - (fun (button, state) -> - if not !state then - button##.disabled := Js.bool false) - !buttons - -let disable_button (disabled, self) = - match !self with - | None -> - disabled := true - | Some (_, button) -> - disabled := true ; - button##.disabled := Js.bool true - -let enable_button (disabled, self) = - match !self with - | None -> - disabled := false - | Some ((_, _, cpt), button) -> - disabled := false ; - if !cpt = 0 then - button##.disabled := Js.bool false - -let button_group_disabled (_, _, cpt) = - !cpt > 0 - -let disabling_button_group group cb = - disable_button_group group ; - Lwt_js.yield () >>= fun () -> - Lwt.catch cb - (function - | Lwt.Canceled -> Lwt.return () - | exn -> Lwt.fail exn) >>= fun res -> - enable_button_group group ; - Lwt_js.yield () >>= fun () -> - Lwt.return res - -let disable_with_button_group component (buttons, _, _) = - buttons := - ((component :> < disabled : bool Js.t Js.prop > Js.t), ref false) - :: !buttons - -let button ~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 [ - img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; - pcdata " " ; - span ~a:[ a_class [ "label" ] ] [ pcdata lbl ] - ]) in - Manip.Ev.onclick button - (fun _ -> - begin Lwt.async @@ fun () -> - Lwt_mutex.with_lock mutex @@ fun () -> - disabling_button_group group cb - end ; - true) ; - let dom_button = - (Tyxml_js.To_dom.of_button button - :> < disabled : bool Js.t Js.prop > Js.t) in - let self_disabled = - match state with - | None -> ref false - | Some (disabled, self) -> - self := Some (group, dom_button) ; - disabled in - others := (dom_button, self_disabled) :: !others ; - if !self_disabled || !cnt > 0 then - dom_button##.disabled := Js.bool true ; - Manip.appendChild container button - -let dropdown ~id ~title items = - let toggle _ = - let menu = find_component id in - let disp = - match Manip.Css.display menu with - | "block" -> "none" - | _ -> - Lwt_js_events.async (fun () -> - Lwt_js_events.click window >|= fun _ -> - Manip.SetCss.display menu "none" - ); - "block" - in - Manip.SetCss.display menu disp; - false - in - H.div ~a: [H.a_class ["dropdown_btn"]] [ - H.button ~a: [H.a_onclick toggle] - (title @ [H.pcdata " \xe2\x96\xb4" (* U+25B4 *)]); - H.div ~a: [H.a_id id; H.a_class ["dropdown_content"]] items - ] - -let gettimeofday () = - (new%js Js.date_now)##getTime /. 1000. - -let render_rich_text ?on_runnable_clicked text = - let open Learnocaml_data.Tutorial in - let rec render acc text = - match text with - | [] -> List.rev acc - | Text text :: rest -> - render - (H.pcdata text :: acc) - rest - | Code { code ; runnable } :: rest -> - let elt = H.code [ H.pcdata code ] in - (match runnable, on_runnable_clicked with - | true, Some cb -> - Manip.addClass elt "runnable" ; - Manip.Ev.onclick elt (fun _ -> cb code ; true) - | _ -> ()) ; - render (elt :: acc) rest ; - | Emph text :: rest -> - render - (H.em (render [] text) :: acc) - rest - | Image _ :: _ -> assert false - | Math code :: rest -> - render - (H.pcdata ("`" ^ code ^ "`") :: acc) - rest in - (render [] text - :> [< Html_types.phrasing > `Code `Em `PCDATA ] H.elt list) - -let extract_text_from_rich_text text = - let open Learnocaml_data.Tutorial in - let rec render acc text = - match text with - | [] -> String.concat " " (List.rev acc) - | Text text :: rest -> - render (text :: acc) rest - | Code { code ; _ } :: rest -> - render (("[" ^ code ^ "]") :: acc) rest - | Emph text :: rest -> - render (("*" ^ render [] text ^ "*") :: acc) rest - | Image { alt ; _ } :: rest -> - render (("(" ^ alt ^ ")") :: acc) rest - | Math code :: rest -> - render (("$" ^ code ^ "$") :: acc) rest in - render [] 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; - store nickname save.nickname; - store all_exercise_states - (SMap.merge (fun _ ans edi -> - match ans, edi with - | Some ans, Some (mtime, solution) -> - Some {ans with Answer.solution; mtime} - | None, Some (mtime, solution) -> - Some Answer.{grade = None; report = None; solution; mtime} - | ans, _ -> ans) - save.all_exercise_states save.all_exercise_editors); - store all_toplevel_histories save.all_toplevel_histories; - store all_exercise_toplevel_histories save.all_exercise_toplevel_histories - -let rec retrieve ?ignore req = - Server_caller.request req >>= function - | Ok x -> Lwt.return x - | Error e -> - lwt_alert ~title:[%i"REQUEST ERROR"] [ - H.p [H.pcdata [%i"Could not retrieve data from server"]]; - H.code [H.pcdata (Server_caller.string_of_error e)]; - ] ~buttons:( - ([%i"Retry"], (fun () -> retrieve req)) :: - (match ignore with - | None -> [] - | Some v -> [[%i"Ignore"], fun () -> Lwt.return v]) @ - [[%i"Cancel"], (fun () -> Lwt.fail Lwt.Canceled)] - ) - -let get_state_as_save_file ?(include_reports = false) () = - let open Learnocaml_data.Save in - let open Learnocaml_local_storage in - let answers = retrieve all_exercise_states in - { - nickname = retrieve nickname; - all_exercise_editors = - if include_reports then SMap.empty - else SMap.map (fun a -> a.Answer.mtime, a.Answer.solution) answers; - all_exercise_states = - if include_reports then answers - else SMap.empty; - all_toplevel_histories = retrieve all_toplevel_histories; - all_exercise_toplevel_histories = retrieve all_exercise_toplevel_histories; - } - -let rec sync_save token save_file = - Server_caller.request (Learnocaml_api.Update_save (token, save_file)) - >>= function - | Ok save -> set_state_from_save_file ~token save; Lwt.return save - | Error (`Not_found _) -> - Server_caller.request_exn - (Learnocaml_api.Create_token ("", Some token, None)) >>= fun _token -> - assert (_token = token); - Server_caller.request_exn - (Learnocaml_api.Update_save (token, save_file)) >>= fun save -> - set_state_from_save_file ~token save; - Lwt.return save - | Error e -> - lwt_alert ~title:[%i"SYNC FAILED"] [ - H.p [H.pcdata [%i"Could not synchronise save with the server"]]; - H.code [H.pcdata (Server_caller.string_of_error e)]; - ] ~buttons:[ - [%i"Retry"], (fun () -> sync_save token save_file); - [%i"Ignore"], (fun () -> Lwt.return save_file); - ] - -let sync token = sync_save token (get_state_as_save_file ()) - -let sync_exercise token ?answer ?editor id = - let nickname = Learnocaml_local_storage.(retrieve nickname) in - let toplevel_history = - SMap.find_opt id Learnocaml_local_storage.(retrieve all_toplevel_histories) - in - let txt = match editor with None -> None | Some e -> Some (max_float, e) in - let opt_to_map = function - | Some i -> SMap.singleton id i - | None -> SMap.empty - in - let save_file = Save.{ - nickname; - all_exercise_editors = opt_to_map txt; - all_exercise_states = opt_to_map answer; - 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) - - -let string_of_seconds seconds = - let days = seconds / 24 / 60 / 60 in - let hours = seconds / 60 / 60 mod 24 in - let minutes = seconds / 60 mod 60 in - let seconds = seconds mod 60 in - if days >= 1 then Printf.sprintf [%if"%dd %02dh"] days hours else - if hours >= 1 then Printf.sprintf [%if"%02d:%02d"] hours minutes else - Printf.sprintf [%if"0:%02d:%02d"] minutes seconds - -let countdown ?(ontimeout = fun () -> ()) container t = - let deadline = gettimeofday () +. t in - let update_interval seconds = - if seconds >= 24 * 60 * 60 then 1000. *. 60. *. 60. - else if seconds >= 60 * 60 then 1000. *. 60. - else 1000. - in - let update remaining = - Manip.setInnerText container (string_of_seconds remaining) - in - let rec callback () = - let remaining = int_of_float (deadline -. gettimeofday ()) in - if remaining <= 0 then - (update 0; - ontimeout ()) - else - (update remaining; - ignore (window##setTimeout - (Js.wrap_callback callback) - (update_interval remaining))) - in - callback () - -let flog fmt = Printf.ksprintf (fun s -> Firebug.console##log(Js.string s)) fmt - -let stars_div stars = - H.div ~a:[ H.a_class [ "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 - H.img ~alt ~src () - ] - -let exercise_text ex_meta exo = - let mathjax_url = - "/js/mathjax/MathJax.js?delayStartupUntil=configured" - in - let mathjax_config = - "MathJax.Hub.Config({\n\ - \ jax: [\"input/AsciiMath\", \"output/HTML-CSS\"],\n\ - \ extensions: [],\n\ - \ showMathMenu: false,\n\ - \ showMathMenuMSIE: false,\n\ - \ \"HTML-CSS\": {\n\ - \ imageFont: null\n\ - \ } - });" - (* the following would allow comma instead of dot for the decimal separator, - but should depend on the language the exercise is in, not the language of the - app - "AsciiMath: {\n\ - \ decimal: \"" ^[%i"."]^ "\"\n\ - },\n" - *) - in - (* Looking for the description in the correct language. *) - let descr = - let lang = "" in - try - List.assoc lang (Learnocaml_exercise.(access File.descr exo)) - with - Not_found -> - try List.assoc "" (Learnocaml_exercise.(access File.descr exo)) - with Not_found -> [%i "No description available for this exercise." ] - in - Format.asprintf - "\ - \ - %s - exercise text\ - \ - \ - - \ - \ - \ - %s\ - \ - \ - " - ex_meta.Exercise.Meta.title - mathjax_config - mathjax_url - descr - -let string_of_exercise_kind = function - | Exercise.Meta.Project -> [%i"project"] - | Exercise.Meta.Problem -> [%i"problem"] - | Exercise.Meta.Exercise -> [%i"exercise"] - -let grade_color = function - | None -> "#808080" - | Some score -> - Printf.sprintf "hsl(%d, 100%%, 67%%)" - (int_of_float (float_of_int score /. 100. *. 138.)) - -let get_assignments tokens exos_status = - let module ES = Exercise.Status in - let module ATM = Map.Make(struct - type t = (float * float) * Token.Set.t * bool - let compare (d1, ts1, dft1) (d2, ts2, dft2) = - match compare d1 d2 with - | 0 -> (match Token.Set.compare ts1 ts2 with - | 0 -> compare dft1 dft2 - | n -> n) - | n -> n - end) - in - let atm_add atm key id = - match ATM.find_opt key atm with - | None -> ATM.add key (SSet.singleton id) atm - | Some set -> ATM.add key (SSet.add id set) atm - in - let atm = - SMap.fold (fun id st atm -> - let assg = st.ES.assignments in - let default = ES.default_assignment assg in - let stl = ES.by_status tokens assg in - let atm = match default with - | ES.Assigned {start; stop} -> - let explicit_tokens = - Token.Map.fold (fun tok _ -> Token.Set.add tok) - assg.ES.token_map Token.Set.empty - in - let implicit_tokens = - Token.Set.diff tokens explicit_tokens - in - atm_add atm ((start, stop), implicit_tokens, true) id - | _ -> atm - in - List.fold_left (fun atm (status, tokens) -> - match status with - | ES.Open | ES.Closed -> atm - | ES.Assigned {start; stop} -> - let key = (start, stop), tokens, (status = default) in - match ATM.find_opt key atm with - | None -> - ATM.add key (SSet.singleton id) atm - | Some ids -> - ATM.add key (SSet.add id ids) atm) - atm - stl) - exos_status - ATM.empty - in - ATM.fold (fun (assg, tokens, dft) exos l -> - (assg, tokens, dft, exos) :: l) - atm [] - |> List.rev - -let string_of_date ?(time=false) t = - let date = new%js Js.date_fromTimeValue (t *. 1000.) in - if time then - Printf.sprintf "%04d-%02d-%02d %02d:%02d" - date##getFullYear (date##getMonth + 1) date##getDate - date##getHours date##getMinutes - else - Printf.sprintf "%04d-%02d-%02d" - date##getFullYear (date##getMonth + 1) date##getDate - -let date ?(time=false) t = - let date = new%js Js.date_fromTimeValue (t *. 1000.) in - H.time ~a:[ H.a_datetime (Js.to_string date##toISOString) ] [ - H.pcdata - (Js.to_string (if time then date##toLocaleString - else date##toLocaleDateString)) - ] - -let tag_span tag = - let color = - Printf.sprintf "#%06x" ((Hashtbl.hash tag lor 0x808080) land 0xffffff) - in - H.span ~a:[H.a_class ["tag"]; - H.a_style ("background-color: "^color)] - [H.pcdata tag] - -let get_worker_code name = - let worker_url = ref None in - fun () -> match !worker_url with - | None -> - retrieve (Learnocaml_api.Static ["js"; name]) >|= fun js -> - let url = js_code_url js in worker_url := Some url; url - | Some url -> Lwt.return url - -let toplevel_launch ?display_welcome ?after_init ?(on_disable=fun () -> ()) ?(on_enable=fun () -> ()) - container history on_show toplevel_buttons_group id = - let timeout_prompt = - Learnocaml_toplevel.make_timeout_popup ~on_show () in - let flood_prompt = - Learnocaml_toplevel.make_flood_popup ~on_show () in - let history = - let storage_key = history id in - let on_update self = - Learnocaml_local_storage.store storage_key - (Learnocaml_toplevel_history.snapshot self) in - let snapshot = - Learnocaml_local_storage.retrieve storage_key in - Learnocaml_toplevel_history.create - ~gettimeofday - ~on_update - ~max_size: 99 - ~snapshot () in - get_worker_code "learnocaml-toplevel-worker.js" () >>= fun worker_js_file -> - Learnocaml_toplevel.create ~worker_js_file - ?display_welcome ?after_init ~timeout_prompt ~flood_prompt - ~on_disable_input: (fun _ -> on_disable (); disable_button_group toplevel_buttons_group) - ~on_enable_input: (fun _ -> on_enable (); enable_button_group toplevel_buttons_group) - ~container - ~history () - -let init_toplevel_pane toplevel_launch top toplevel_buttons_group toplevel_button = - begin toplevel_button - ~icon: "cleanup" [%i"Clear"] @@ fun () -> - Learnocaml_toplevel.clear top ; - Lwt.return () - end ; - begin toplevel_button - ~icon: "reload" [%i"Reset"] @@ fun () -> - toplevel_launch >>= fun top -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) - end ; - begin toplevel_button - ~icon: "run" [%i"Eval phrase"] @@ fun () -> - Learnocaml_toplevel.execute top ; - Lwt.return () - end - -let set_string_translations_exercises () = - let translations = [ - "txt_preparing", [%i"Preparing the environment"]; - "learnocaml-exo-button-editor", [%i"Editor"]; - "learnocaml-exo-button-toplevel", [%i"Toplevel"]; - "learnocaml-exo-button-report", [%i"Report"]; - "learnocaml-exo-button-text", [%i"Exercise"]; - "learnocaml-exo-button-meta", [%i"Details"]; - "learnocaml-exo-editor-pane", [%i"Editor"]; - "txt_grade_report", [%i"Click the Grade button to get your report"]; - ] in - List.iter - (fun (id, text) -> - match Js_utils.Manip.by_id id with - | None -> () - | Some component -> - Manip.setInnerHtml component text) - translations - -let local_save ace id = - let key = Learnocaml_local_storage.exercise_state id in - let ans = - try Learnocaml_local_storage.retrieve key with Not_found -> - Answer.{solution = ""; mtime = 0.; report = None; grade = None} - in - Learnocaml_local_storage.store key - { ans with Answer.solution = Ace.get_contents ace; - mtime = gettimeofday () } - -let run_async_with_log f = - Lwt.async_exception_hook := begin fun e -> - Firebug.console##log (Js.string - (Printexc.to_string e ^ - if Printexc.backtrace_status () then - Printexc.get_backtrace () - else "")); - match e with - | Failure message -> fatal message - | Server_caller.Cannot_fetch message -> fatal message - | exn -> fatal (Printexc.to_string exn) - end ; - (match Js_utils.get_lang() with Some l -> Ocplib_i18n.set_lang l | None -> ()); - Lwt.async f - -let mk_tab_handlers default_tab other_tabs = - let names = default_tab::other_tabs in - let current = ref default_tab in - let select_tab name = - set_arg "tab" name ; - Manip.removeClass - (find_component ("learnocaml-exo-button-" ^ !current)) - "front-tab" ; - Manip.removeClass - (find_component ("learnocaml-exo-tab-" ^ !current)) - "front-tab" ; - Manip.enable - (find_component ("learnocaml-exo-button-" ^ !current)) ; - Manip.addClass - (find_component ("learnocaml-exo-button-" ^ name)) - "front-tab" ; - Manip.addClass - (find_component ("learnocaml-exo-tab-" ^ name)) - "front-tab" ; - Manip.disable - (find_component ("learnocaml-exo-button-" ^ name)) ; - current := name in - let init_tabs () = - current := - begin - try - let requested = arg "tab" in - if List.mem requested names then requested else default_tab - with Not_found -> default_tab - end ; - List.iter - (fun name -> - Manip.removeClass - (find_component ("learnocaml-exo-button-" ^ name)) - "front-tab" ; - Manip.removeClass - (find_component ("learnocaml-exo-tab-" ^ name)) - "front-tab" ; - Manip.Ev.onclick - (find_component ("learnocaml-exo-button-" ^ name)) - (fun _ -> select_tab name ; true)) - names ; - select_tab !current in - init_tabs, select_tab - -module type Editor_info = sig - val ace : Ocaml_mode.editor Ace.editor - val buttons_container : 'a Tyxml_js.Html5.elt -end - -module Editor_button (E : Editor_info) = struct - - let editor_button = button ~container:E.buttons_container ~theme:"light" - - let cleanup template = - editor_button - ~icon: "cleanup" [%i"Reset"] @@ fun () -> - confirm ~title:[%i"START FROM SCRATCH"] - [H.pcdata [%i"This will discard all your edits. Are you sure?"]] - (fun () -> - Ace.set_contents E.ace template); - Lwt.return () - - let download id = - editor_button - ~icon: "download" [%i"Download"] @@ fun () -> - let name = id ^ ".ml" in - let contents = Js.string (Ace.get_contents E.ace) in - fake_download ~name ~contents ; - Lwt.return () - - let eval top select_tab = - editor_button - ~icon: "run" [%i"Eval code"] @@ fun () -> - Learnocaml_toplevel.execute_phrase top (Ace.get_contents E.ace) >>= fun _ -> - select_tab "toplevel"; - Lwt.return_unit - - let sync token id = - editor_button - ~icon: "sync" [%i"Sync"] @@ fun () -> - token >>= fun token -> - sync_exercise token id ~editor:(Ace.get_contents E.ace) >|= fun _save -> () -end - -let setup_editor solution = - let editor_pane = find_component "learnocaml-exo-editor-pane" in - let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in - let ace = Ocaml_mode.get_editor editor in - Ace.set_contents ace ~reset_undo:true solution; - Ace.set_font_size ace 18; - editor, ace - -let typecheck top ace editor set_class = - Learnocaml_toplevel.check top (Ace.get_contents ace) >>= fun res -> - let error, warnings = - match res with - | Toploop_results.Ok ((), warnings) -> None, warnings - | Toploop_results.Error (err, warnings) -> Some err, warnings in - let transl_loc { Toploop_results.loc_start ; loc_end } = - { Ocaml_mode.loc_start ; loc_end } in - let error = match error with - | None -> None - | Some { Toploop_results.locs ; msg ; if_highlight } -> - Some { Ocaml_mode.locs = List.map transl_loc locs ; - msg = (if if_highlight <> "" then if_highlight else msg) } in - let warnings = - List.map - (fun { Toploop_results.locs ; msg ; if_highlight } -> - { Ocaml_mode.loc = transl_loc (List.hd locs) ; - msg = (if if_highlight <> "" then if_highlight else msg) }) - warnings in - Ocaml_mode.report_error ~set_class editor error warnings >|= fun () -> - Ace.focus ace - -let set_nickname_div () = - let nickname_div = find_component "learnocaml-nickname" in - match Learnocaml_local_storage.(retrieve nickname) with - | nickname -> Manip.setInnerText nickname_div nickname - | exception Not_found -> () - -let setup_prelude_pane ace prelude = - if prelude = "" then () else - let editor_pane = find_component "learnocaml-exo-editor-pane" in - let prelude_pane = find_component "learnocaml-exo-prelude" in - let open Tyxml_js.Html5 in - let state = - ref (match arg "prelude" with - | exception Not_found -> true - | "shown" -> true - | "hidden" -> false - | _ -> failwith "Bad format for argument prelude.") in - let prelude_btn = button [] in - let prelude_title = h1 [ pcdata [%i"OCaml prelude"] ; - prelude_btn ] in - let prelude_container = - pre ~a: [ a_class [ "toplevel-code" ] ] - (Learnocaml_toplevel_output.format_ocaml_code prelude) in - let update () = - if !state then begin - Manip.replaceChildren prelude_btn [ pcdata ("↳ "^[%i"Hide"]) ] ; - Manip.SetCss.display prelude_container "" ; - Manip.SetCss.top editor_pane "193px" ; (* 150 + 43 *) - Manip.SetCss.bottom editor_pane "40px" ; - Ace.resize ace true; - set_arg "prelude" "shown" - end else begin - Manip.replaceChildren prelude_btn [ pcdata ("↰ "^[%i"Show"]) ] ; - Manip.SetCss.display prelude_container "none" ; - Manip.SetCss.top editor_pane "43px" ; - Manip.SetCss.bottom editor_pane "40px" ; - Ace.resize ace true; - set_arg "prelude" "hidden" - end in - update () ; - Manip.Ev.onclick prelude_btn - (fun _ -> state := not !state ; update () ; true) ; - Manip.appendChildren prelude_pane - [ prelude_title ; prelude_container ] - -module Grade_exercise = struct - -let get_grade = - let get_worker = get_worker_code "learnocaml-grader-worker.js" in - fun ?callback ?timeout exercise -> - get_worker () >>= fun worker_js_file -> - Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise - -let display_report exo report = - let score, _failed = Report.result report in - let report_button = find_component "learnocaml-exo-button-report" in - Manip.removeClass report_button "success" ; - Manip.removeClass report_button "failure" ; - Manip.removeClass report_button "partial" ; - let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in - if max = 0 then 999 else score * 100 / max - in - if grade >= 100 then begin - Manip.addClass report_button "success" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else if grade = 0 then begin - Manip.addClass report_button "failure" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ] - end else begin - Manip.addClass report_button "partial" ; - let pct = Format.asprintf "%2d%%" grade in - Manip.replaceChildren report_button - Tyxml_js.Html5.[ pcdata [%i"Report"] ; - span ~a: [ a_class [ "score" ] ] [ pcdata pct ]] - end ; - let report_container = find_component "learnocaml-exo-tab-report" in - Manip.setInnerHtml report_container - (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; - grade - -end diff --git a/src/app/.#learnocaml_common.ml b/src/app/.#learnocaml_common.ml deleted file mode 120000 index 4ffd372dd..000000000 --- a/src/app/.#learnocaml_common.ml +++ /dev/null @@ -1 +0,0 @@ -manu@manu-Lenovo-ideapad-330-15ICH.10343:1563255518 \ No newline at end of file diff --git a/src/app/dune b/src/app/dune index de70c6ca5..fbb7c3b95 100644 --- a/src/app/dune +++ b/src/app/dune @@ -43,7 +43,7 @@ (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) (js_of_ocaml (flags :standard +cstruct/cstruct.js) - (javascript_files ../ace-lib/ace_bindings.js)) + (javascript_files ../ace-lib/ace_bindings.js ../../static/js/jszip/learnocaml_jszip_wrapper.js)) ) (executable diff --git a/src/editor/dune b/src/editor/dune index b27a1f537..b8ace9f48 100644 --- a/src/editor/dune +++ b/src/editor/dune @@ -121,7 +121,7 @@ (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) (js_of_ocaml (flags :standard --toplevel --nocmis +cstruct/cstruct.js +dynlink.js +toplevel.js) - (javascript_files ../ace-lib/ace_bindings.js ../../static/js/jszip/learnocaml_jszip_wrapper.js )) + (javascript_files ../ace-lib/ace_bindings.js)) ) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 87da622f9..3230a3e2d 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -405,30 +405,7 @@ let () = begin editor_button ~icon: "download" [%i"Download"] @@ fun () -> recovering () ; - let name = id ^ ".zip" in - let content =(get_editor_state id) in - let json = - Json_repr_browser.Json_encoding.construct - Editor.editor_state_enc - content in - let contents = - Js._JSON##stringify json in - let editor_download:Js.js_string Js.t -> (File.blob Js.t -> unit Js.meth) Js.meth - = Js.Unsafe.eval_string "editor_download" in - let _ = Js.Unsafe.fun_call editor_download - [|Js.Unsafe.inject contents; - Js.Unsafe.inject (Js.wrap_callback - (fun blob -> - let url = - Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject blob |] in - let link = Dom_html.createA Dom_html.document in - link##.href := url ; - Js.Unsafe.set link (Js.string "download") (Js.string name) ; - ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; - ignore (Js.Unsafe.meth_call link "click" [||]) ; - ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t))))))|]; - in (); - + Editor_io.download id; Lwt.return () end ; diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index b1d467d14..09d64b205 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -393,3 +393,93 @@ let typecheck_dialog_box div_id res = Dom_html.window##alert (Js.string result); Lwt.return (); end + + +let put_exercise_id id (old_state:editor_state) = + { + exercise = {old_state.exercise with id} ; + metadata = {old_state.metadata with id =Some id} + } + ;; + +module Editor_io = struct + + let download_file name contents = + let url = + Js.Unsafe.meth_call (Js.Unsafe.global##._URL) "createObjectURL" [| Js.Unsafe.inject contents |] in + let link = Dom_html.createA Dom_html.document in + link##.href := url ; + Js.Unsafe.set link (Js.string "download") (Js.string name) ; + ignore (Dom_html.document##.body##(appendChild ((link :> Dom.node Js.t)))) ; + ignore (Js.Unsafe.meth_call link "click" [||]) ; + ignore (Dom_html.document##.body##(removeChild ((link :> Dom.node Js.t)))) + + let download id = + let name = id ^ ".zip" in + let json = (get_editor_state id) + |> Json_repr_browser.Json_encoding.construct + Editor.editor_state_enc + in + let contents = Js._JSON##(stringify json) in + let editor_download = Js.Unsafe.eval_string "editor_download" in + let callback = download_file name in + let _ = + Js.Unsafe.fun_call editor_download + [|Js.Unsafe.inject contents; + Js.Unsafe.inject (Js.wrap_callback callback) |] in () + + let upload_file () = + let input_files_load = + Dom_html.createInput ~_type: (Js.string "file") Dom_html.document in + let result_t, result_wakener = Lwt.wait () in + let fail () = + Lwt.wakeup_exn result_wakener + (Failure "file loading not implemented for this browser") ; + Js._true + in + input_files_load##.onchange := + Dom.handler + (fun ev -> + Js.Opt.case (ev##.target) fail @@ + fun target -> + Js.Opt.case (Dom_html.CoerceTo.input target) fail @@ + fun input -> + Js.Optdef.case (input##.files) fail @@ + fun files -> + Js.Opt.case (files##(item (0))) fail @@ + fun file -> + Lwt.wakeup result_wakener file; Js._true); + ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; + result_t + + let upload_new_exercise id text = + let save_file = + Json_repr_browser.Json_encoding.destruct + editor_state_enc + (Js._JSON##(parse text)) + |> put_exercise_id id + in + let open Exercise.Meta in + let result= idUnique id && titleUnique save_file.metadata.title in + if result then + update_index save_file; + result + + let upload () = + run_async_with_log + (fun () -> + upload_file () >>= + fun file -> + let id = Filename.chop_extension (Js.to_string file##.name) in + let f = Js.Unsafe.eval_string "editor_import" in + let callback = + (fun text -> + if upload_new_exercise id text then + Dom_html.window##.location##reload + else + Learnocaml_common.alert [%i"Identifier and/or title not unique\n"]); + in + Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; + Js.Unsafe.inject callback|]) + +end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index a215d1430..0c9c52f6e 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -102,3 +102,8 @@ val monomorph_generator : (string * string) list -> Editor.test_qst_untyped list val show_load : Html_types.text Tyxml_js.Html.wrap -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt Tyxml_js.Html.list_wrap -> unit + +module Editor_io : sig + val download : Learnocaml_data.SMap.key -> unit + val upload : unit -> unit +end diff --git a/src/editor/jszip.mli b/src/editor/jszip.mli index 4e96f8d50..e69de29bb 100644 --- a/src/editor/jszip.mli +++ b/src/editor/jszip.mli @@ -1,7 +0,0 @@ -open Js_of_ocaml - -val editor_download: Js.js_string Js.t -> (File.blob Js.t -> unit Js.meth) Js.meth - - - - diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index ceeab0ff8..313757899 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -1,5 +1,5 @@ (* This file is part of Learn-OCaml. - * +* * Copyright (C) 2019 OCaml Software Foundation. * Copyright (C) 2016-2018 OCamlPro. * @@ -35,8 +35,8 @@ let delete_button_handler exercise_id = (fun _ -> begin let messages = Tyxml_js.Html5.ul [] in - let aborted, abort_message = - let t, u = Lwt.task () in + let _aborted, abort_message = + let t, _u = Lwt.task () in let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in Manip.Ev.onclick btn_no ( fun _ -> hide_loading ~id:"learnocaml-main-loading" () ; true) ; @@ -58,9 +58,11 @@ let delete_button_handler exercise_id = show_load "learnocaml-main-loading" [ abort_message ] ; Manip.SetCss.opacity abort_message (Some "1") ; end ; - true) ;; - - + true) ;; + + + + let rec editor_tab token _ _ () = @@ -79,33 +81,16 @@ let rec editor_tab token _ _ () = SMap.fold (fun exercise_id editor_sate acc -> div ~a:[a_id "toolbar"; a_class ["button"]] [ - ( - let button = button ~a:[a_id exercise_id] - [img ~src:"icons/icon_cleanup_dark.svg" - ~alt:"" () ; pcdata "" ] in - Manip.Ev.onclick button - (delete_button_handler exercise_id) ;button - ); - ( - let button = button ~a:[a_id exercise_id] - [img ~src:"icons/icon_download_dark.svg" - ~alt:"" () ; pcdata "" ] in - Manip.Ev.onclick button - (fun _ -> - let name = exercise_id ^ ".json" in - let content = - SMap.find - exercise_id - Learnocaml_local_storage.(retrieve editor_index) - in - let json = - Json_repr_browser.Json_encoding.construct - Editor.editor_state_enc - content in - let contents = - (Js._JSON##stringify json) in - Learnocaml_common.fake_download ~name ~contents; - true) ;button + (let button = button ~a:[a_id exercise_id] + [img ~src:"icons/icon_cleanup_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick button + (delete_button_handler exercise_id); button); + (let download_button = button ~a:[a_id exercise_id] + [img ~src:"icons/icon_download_dark.svg" + ~alt:"" () ; pcdata "" ] in + Manip.Ev.onclick download_button + (fun _ -> Editor_io.download exercise_id; true) ;download_button )] :: a ~a:[ a_href ("editor.html#id="^exercise_id) ; a_class [ "exercise" ] ] @@ -138,54 +123,8 @@ let rec editor_tab token _ _ () = let open Tyxml_js.Html5 in let open Learnocaml_exercise in let open Exercise.Meta in - let restore_bar = a ~a:[ a_onclick (fun _ -> - let _ = begin - Learnocaml_common.fake_upload () >>= fun (_, contents) -> - let save_file = - Json_repr_browser.Json_encoding.destruct - editor_state_enc - (Js._JSON##(parse contents)) in - let messages = Tyxml_js.Html5.ul [] in - - let id = match save_file.metadata.id with - None -> "" - | Some id -> id - in - if idUnique id && - titleUnique save_file.metadata.title then - begin - let old_index= - Learnocaml_local_storage.(retrieve editor_index) in - let new_index=SMap.add id save_file old_index in - Learnocaml_local_storage.(store - (editor_index) new_index); - Dom_html.window##.location##reload; - - end - else - begin - let aborted, abort_message = - let t, u = Lwt.task () in - let btn_ok = Tyxml_js.Html5.(button [ pcdata [%i"OK"] ]) in - Manip.Ev.onclick btn_ok (fun _ -> hide_loading - ~id:"learnocaml-main-loading" () ; - true) ; - - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata [%i"Identifier and/or title \ - not unique\n"] ; - btn_ok - ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "" ] ] ; - show_load "learnocaml-main-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1"); - end; - Lwt.return (); - end in (); + let restore_bar = a ~a:[ a_onclick (fun _ -> + Editor_io.upload (); true); a_class [ "exercise"] ] [ div ~a:[ a_class [ "descr" ] ] [ h1 [ pcdata [%i"Import an exercise"] ]; diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 4f64eea80..884fa78fa 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -1296,7 +1296,7 @@ type exercise = (req "prepare" string) (req "test" string) (req "solution" string) - (req "max-score" int)) + (req "max_score" int)) diff --git a/static/index.html b/static/index.html index 3ef4e881a..3dbe146d8 100644 --- a/static/index.html +++ b/static/index.html @@ -8,6 +8,8 @@ + + diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index 42046c77c..3d18a372f 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -16,4 +16,38 @@ function editor_download(brut_data, callback) { level: 9 } }).then(function(blob) { callback(blob) }); +} + + +//also to keep in sync +function editor_import(brut_data, callback) { + var zip = new JSZip(); + zip.loadAsync(brut_data) + .then(function(loaded_zip) { + var result = { exercise: {}, metadata: {} }; + + var descr = loaded_zip.file("descr.md").async("string"); + var meta = loaded_zip.file("meta.json").async("string"); + var prelude = loaded_zip.file("prelude.ml").async("string"); + var prepare = loaded_zip.file("prepare.ml").async("string"); + var template = loaded_zip.file("template.ml").async("string"); + var test = loaded_zip.file("test.ml").async("string"); + var solution = loaded_zip.file("solution.ml").async("string"); + Promise.all([descr, meta, prelude, prepare, template, test, solution]) + .then(function(values) { + result.exercise.max_score = 0; + result.exercise.id = ""; + result.exercise.descr = values[0]; + var brut_meta = values[1]; + var meta = brut_meta.replace(/\r?\n|\r/g, " "); + result.metadata = JSON.parse(meta); + result.exercise.prelude = values[2]; + result.exercise.prepare = values[3]; + result.exercise.template = values[4]; + result.exercise.test = values[5]; + result.exercise.solution = values[6]; + console.log(brut_data); + callback(JSON.stringify(result)); + }); + }); } \ No newline at end of file diff --git a/static/js/jszip/node_modules/.lsp/debug.log b/static/js/jszip/node_modules/.lsp/debug.log deleted file mode 100644 index bd7622e33..000000000 --- a/static/js/jszip/node_modules/.lsp/debug.log +++ /dev/null @@ -1,118 +0,0 @@ -Hello - from /home/manu/.vscode/extensions/jaredly.reason-vscode-1.7.0/bin.native.linux -Previous log location: /tmp/lsp.log -Sending notification {"jsonrpc": "2.0", "method": "client/registerCapability", "params": {"registrations": [{"id": "watching", "method": "workspace/didChangeWatchedFiles", "registerOptions": {"watchers": [{"globPattern": "**/bsconfig.json", "globPattern": "**/.merlin"}]}}]}} -Sending response {"id": 0, "jsonrpc": "2.0", "result": {"capabilities": {"textDocumentSync": 1, "hoverProvider": true, "completionProvider": {"resolveProvider": true, "triggerCharacters": ["."]}, "signatureHelpProvider": {"triggerCharacters": ["("]}, "definitionProvider": true, "typeDefinitionProvider": true, "referencesProvider": true, "documentSymbolProvider": true, "codeActionProvider": true, "executeCommandProvider": {"commands": ["reason-language-server.add_to_interface_inner"]}, "codeLensProvider": {"resolveProvider": true}, "documentHighlightProvider": true, "documentRangeFormattingProvider": true, "documentFormattingProvider": true, "documentFormattingProvider": true, "renameProvider": true}}} -Read message -{"jsonrpc":"2.0","method":"initialized","params":{}} -Read message -{"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"reason_language_server":{"location":"","build_system_override_by_root":{},"refmt":"","lispRefmt":"","format_width":80,"per_value_codelens":false,"dependencies_codelens":true,"opens_codelens":true,"show_module_path_on_hover":true,"reloadOnChange":false,"show_debug_errors":false,"autoRebuild":true,"useOldDuneProcess":true}}}} -Read message -{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml","languageId":"ocaml","version":1,"text":"open Test_lib\nopen Report\n\nlet () =\n set_result @@\n ast_sanity_check code_ast @@ fun () ->\n [ Section\n ([ Text \"Function:\" ; Code \"plus\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"plus\"\n [ (1, 1) ; (2, 2) ; (10, -10) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"minus\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"minus\"\n [ (1, 1) ; (4, -2) ; (0, 10) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"times\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"times\"\n [ (1, 3) ; (2, 4) ; (3, 0) ]) ;\n Section\n ([ Text \"Function:\" ; Code \"divide\" ],\n test_function_2_against_solution\n [%ty : int -> int -> int ] \"divide\"\n [ (12, 4) ; (12, 5) ; (3, 0) ]) ]\n"}}} -Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o -]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o -=== Project root: /home/manu/Documentos/irit/learn-ocaml-o -Detected `opam` dependency manager for local use -Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} -Read message -{"jsonrpc":"2.0","id":1,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} -[server] Got a method textDocument/documentSymbol -[server] processing took 0.00596046447754ms -Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o -]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o -=== Project root: /home/manu/Documentos/irit/learn-ocaml-o -Detected `opam` dependency manager for local use -Sending response {"id": 1, "jsonrpc": "2.0", "error": {"code": -32603, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} -Read message -{"jsonrpc":"2.0","id":2,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} -[server] Got a method textDocument/codeAction -[server] processing took 0.00500679016113ms -Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o -]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o -=== Project root: /home/manu/Documentos/irit/learn-ocaml-o -Detected `opam` dependency manager for local use -Sending response {"id": 2, "jsonrpc": "2.0", "error": {"code": -32603, "message": "Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin"}} -Read message -{"jsonrpc":"2.0","id":3,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} -[server] Got a method textDocument/codeLens -[server] processing took 0.00500679016113ms -Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o -]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o -=== Project root: /home/manu/Documentos/irit/learn-ocaml-o -Detected `opam` dependency manager for local use -Sending response {"id": 3, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: Unable to read /home/manu/Documentos/irit/learn-ocaml-o/.merlin", "command": ""}}]} -Found a `dune` file at /home/manu/Documentos/irit/learn-ocaml-o -]] Making a new jbuilder package at /home/manu/Documentos/irit/learn-ocaml-o -=== Project root: /home/manu/Documentos/irit/learn-ocaml-o -Detected `opam` dependency manager for local use -Read message -{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/Documentos/irit/learn-ocaml-o/demo-repository/exercises/demo/test.ml"}}} -Read message -{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml","languageId":"ocaml","version":1,"text":"NX2k8sfoMJrFUk1x+YHRRCYPTSBUWEsXJ/NQWFmGrxkucRNwTyqo2Tdcb+mdu+ow5EqANnYdqqDlGs9Mxz4Sf9JiT5MyU1JS73/aqdFGZLQpAtYKp4x4qHxAWN5c9Sb++wq+a2AGULmR2X3BCyAMxaD1mAPPCjeUwA5AjxfOsy5c0yevitVknNEtW7kgescQO9FXURFNSlptEAxaELyxnDrfLX5UMwUQMDy5hMKwwyCLZtBoGHKHgaIMzF0yKgaFQ9JHCTYQ6AGJ9DDsn9dpd7Y1iBrEtpXl3VVQ/pe202MJkZic9pBSb2B93x102BvlxgKGX+tLF+z9TUnJnhelPXxyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9Q1/wUaO8KQPMHPVsrkVdyMO87q+bo2YEllTMpNbvtukHCOfJ7l0gMOAoRN/8DRYznPvHXRWSiPRiQTdbcXf1WVVb3Qwdt79DP9u73To7ni8RbyoolSKf7i1F2vps1efRDQx4LjuohNC1bmsDFMISC+Rty+r4NURgDV9o/XEFN+RIeZULduxkwbpNoDGCODDZhmbPnsfZ678T0LnY5va0rDYxRv7jRslhjC5lbGYxLoetuhhZc+PICGcYM6OACqGJYAsFCeA7EQJq+rJhLPJ+11WaTDH9Nr0qilAeERUHedQ6MmMrTi8kfViGS8YA6zwRwFW9BvghUYppMGFJRGVowRk6BWJPxnDrfHTlOMJhHIp4wf3fhhmiERNEyMpj8gPUXyFayZdTeQ8gcXWJV/p3JaAn7nUV9sjNHyBLBq9bWPFUWjEKRIxQCiwjlyzUWqNAlOcNPMU8fq1yQB19LUL79G5X25fTlPXxyMMD3oXXI8SoAMWemmztyBBhPEQQZ+SoIQWwTcv+00b5U45F5lpQSKayhgKrz1dw5mCs80bvvmRCXVrsqlqAWOGhYJ/XIXhyjO+mIUnHp3BOZTfadHa9kCDmYQwE76EC0jqiQEo0y5HF85mBkD+zm7J/GdUgNb2tOAd3YjvZxOXMpnIW9JwnF2Ut93KXKTD2BUEpZ2VZXL//VUFesgvRna5RmAWDZCnEsfKflwrd5vyq+Ozxqfvba229Rx7rXq9IjA/F7EIYLnKIpwMBaMLxlAME2/PZRbSkaFs6C9SKEQJq+aYoP+0m2K8rxM6sIbqCI6E+BCkDyhElt7YyLtiQlDTDAitVknNEtGjFzftwXKlEIX6FOUEl6O6EVELyxnDrfQTlJYIAPN7DclazbtGPEKZQPJ7vfi3IQ/lLj31LcF8YKC5NDl/aQwDvb7/QdwyFT/U3saBae2RFT/6+4TtlEiwSwlEkQaZoy4sFG0ETfyt4KAh6WPfz9TUnJnhelPXweMJrO5CjYuz63Mz7u5oQTBBU10/wWVmwEQlBTe38AYNtS+QEg7ox52qylf4qbIMoYjmE9OfeyepqX43sqlqAWN5AFMEXDCYCw1bivTnvi3BOVQsbZU0pdVR0YQwE76EC0jqjRGVyk/EsqzpwaHK7/mYQD9nEVv+RNTIyL8qQcJ72PpNP020OtB6s6Kfr3FGNBCAJVMo9Z+RBNFWbgg2YepTpl4lvXG72hePuntv247HiHKiImrqK6Qs/2gibXapg9RoAzSYYW7+YfvhRGJ0h7CgUG8eMXfXJV+26P8p7EQJq+sJZPFaj1ZyfSCj6Iuu8Nn90f26XtfBhJ7YyLtiQlDTDAitVknJB5SSRved1U3VoNGENMXB/nO6EVELyxnF4aAGd0Lg53P8TSaq7uuHKQOrcaD83gd3AYyBGvUJ4KBjgWUWA+6zaGcDG7lAAmxD5+lFXDvHrdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERxELF+z9TUnJvMGp3Hx/Sg78oRXIyShASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRAlS1i1r7txSbLVORro4dA3/sRNULPXdmr44+rAGTn1UfVTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7O1JoUhVvaoNVwPLpqYzUC1ppNeF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWCqG7ttu+fmbZhtoE4BPCAir4G6A2QFvnqv/EIjA/EyXtI6xe5frYRDLL1nB3xD7OAFuXlFRs5H9TbrQJrvqII1Ub7C1Xe2RosIbqCInQ4VSFjwhUM1mJP37i9a2HPA7Yp65PttGjEucgg9J692MkBJSVUpEB/UQOyhoDqBSUJZYJ1MJjz9sejEy7yEOYwVYiLvxvF4jRGvZs0vAXhCEDJA/5XZtS3cblQ6xTJC/QOSglCn0BBO7DiVZc1Dzhjl6A1dqNAlOcNPMU8fuI8lAc/0+rD5CAL2ncWV07gm+ZC0/yr17X504Cqvm9RmR6BAOo9ZGW9QERUQr38ISadZ0Sx8/BE5LPagava8KJcVontiKeuyd/GNS4Yu7ugKW9l4JVyCTt351YHNRCGdJUfXV2roWOEpVWWXDcQ7nBPPnauZZR+dlDQelldoSPupidpDmpsghP1ZQtSOpaQkFz6b6g3BMI+FI/ls+qaKUSkBDBoBCRhQ+WsvFimprgpgxUEaFDCLG8lducGzbg57wD0wAzNacI76Xc9Rx7rXq9IjA/F7GMsKi01ie16TMONjQMUKz3MrbH9GV25VjH0M+wq+a2BPFumQNDqTTmFIwqDhpReR2EHdcAEJ70Doemll0ymQxdVhkqttGjEuvghUYlFNTBEZGR/wEBE2X47d7iOfDiQZ1NUPN7DclazbtGPEYcluKk8vxvF4jRG7Kg3bQ8YCUWIQ65rJvHb2pV5l8TIBjonVhQTa+FU35nPC2sAZngbri6sOfNAwOct845+cr1mBCNUF33D5CAL2nhnPQH5r01m3vmvG/CU00DWBy6R8QUkMER9ZGW9QERUQr38IOewBPVU68RAfPNL5cK7iMYV9oHdzWOv7xVaZE+Iu/egCN5JRY6CGChzx4gKEDXunC8O1Z1GmU0pdVR0YQwE76EC06qjqTor7lEcGjzUoSPup7IRG5QsJv2sNQZ4LcY9lUC1ppNfZ204RIQV6UN+XP99NCB5RWEcWIFRrUEHwxJEewlFoEDT0H8dvfOigxrMcoG0ROWMlvbenGs/YeCqRfppj4VFqDvpL74RawMIAZ0McHNAO63wRfHQQWN5geCLBDM74aZIKU4W3H8qTTmFIbuHEk5PATlnwq/BMiZy0tTk6DTDAitVknLkwW8N/gNkVL5lnH/RJV9tcHzxV44neziucBDk2GctuN7DguLaohnC53gQoLC0vcaI+jUHv1tTiAX2OUS2BlluFqSrl66sOdyFO/UaBtkGdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERrJEU3n9TlSUkx4jJ/AyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5uoxuLKjrtarT1xFnlSl7MK0exQvKVKJhpbpX2VYEMFHKCdn/KvmISTCu1kWaTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7IRG5QtVv11CCMmL8Pp51nUufseF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWD0XiMMfPTwbbEro9zY4oAyv3H9DIxRaC+GslJLKFF7EIZOoeBVod6FMPIpGNxG61p4bWlFXxFC8CLIB1a+qJp2UajU0TqOTjMNqPDOoQuST6X5f9lKiIWO7mkiORuAitVk5Z1tG7Byb2sVJo6NGF/1Vo9S0RFQXOvsnHyaByQ0Sss41i7suPnitWWF1Mka3WavcqMKyBGgAZ3bQ8YCUQgVokyHrmntnUp0xDQ3j6jVqSvdURBF7pPWZhRIhNvJ/R2CqNIbOe1AMQ+kwI8RF1QLR3HcH5XK7tLl2DR7YZW47Tn17ChASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRXjmtz1r7vxELQEe9B/egCN5JRY6CGChyl4bjEAGTn1UfVTdGmU0pdVR0YQwE76EC0jxzVFlKdl8xexoklDub7n1YKjAsAbrFNHcjZje2wLiVo8NfMOhjA3VxsYqaHFy6uTUpRGR9Z+RARFRCgfM5er9EcVWD0XiNhu+ncbbM5oDSU4jNnftHrGgpRxCOLxEtlGXs7EIYL74RaeYQAZPJoTwVPp0NRqDoVFs6C9SKEQJq+a2BPFumQQHfLGmFKcPLk7E0nX/0vhRh47ZWDgTRfW6uAitVk8ZcxMUsyetxUIA9IDkwzXE5gWE5VV0ykh8rfMXpHMghLITixxuXRhnDENN9bNmG7xrRR7VTf3b8fBjVBUTVZl9O8cHas6Fo958QWoTCIcoTn+FVNrRHF2slQixym6B2CqMllVgpB25Gbs10QSOkCU3mvGUnLkwPjYHxvLtC49mvB/VN3MHq8ooQz+lkMER/FGRYQHAtQpwXBEZAN3AF5zB1jOb0Tdefn1Ios/Dw80dC7xSbYQaFrpbpH1poZSBCGChzgPuyHSGSi4oeQFgHMF4/qF6+PCdVvu9C0jqjMTj0g7GREz5slBveplbUVkVcMb3E3QsjTjqQ539sa8wzMMYj43BUNYra0W82BTllMGlQZZAhRVE0jxYoEcARtBS7CXmZSu+ncbed5rmSZYWMJ/frLEgoFxzuEf8kaTpEyQt24pKIf9t2II0EfTsQ1/0NM/8oVWwlW9WHMCbS4wYA2FqyQKRHTTmFI7uH+kpPVWVDtv9Vz71rOcDkf+yGUyYkk82FeU8V85ZhUYlFNTElZQ99tSEFvVPne7mryQUlQOIt5IDidb47kxGXESd/a0zmvgOhNzk8zVMTyDGJDCWISyQzJtVXs6AB9dyES/RSRc5ytQoFT7pGRPhQpixKsuo63cZooOfpSMUX9dMeLFMNCU20iFAL27s0lPnkq3Yn0oiWNbnp0YSruy968G6lJSU/zXSoDU6UNrZ7NYbxb3oxnjnAr3KCnq0jt1xZclAApKfTjhA4ZEbR9o0oC1n6RY6CGChzx4e0URTn7D5uQHIKmTLoMEEfIP2Bpk5HCjxKNTor7lHJl5QkhDIW8l1xSpFMVvbU4Ht7S8PRhUC1ppNeF2ZTRUostN+q/+WNITQV4Mo9ZJVVFFVylrIkwboVlAnW9DTYxhqewbahKoDSU4nI6qsi7FgoSfVTEf6B8QQUiQtM674RaeYQAOulaM2AX93EUejd1WZZYlzuPPcfCuYJ/FumQNDqTDzI1bvnW6CuIWEGycpI3i0T0ryQuJiOP9gUlzwQtU7dBvgg2JUE3A/UZEXUtUUN0Xavw6X4FEi5FLh9L4Suxab7isnCN31QfMTObfa1+w9Py3c8tF8dCBSwVnCGJcHasmUllsnMPpQ+Xc7er3QVZ76+eIxQFkhzhb9dWqNBPRq//4QjrdMyXEqg+QO8xBB8Qndby+XxfGtD37TC1lWVWMWegilAvFp5mQkoJV8sEEQ5fr38IOaYE+VUly6I8Cr8ddvziIN9lkSpiD+PqdRvLUPZ7p4tc2UxUIVrGSsv54fTKKzTn1Ue1C1HyFPFtJkOID1Nj6Fj0xYDQGkegy8RAuzUoSPupm15VoAt2oOE3Hd7MnaQkAS2E6Y+R21vhYUt933uKXTUETQwUWEkMOkVCFV8hqxlebARhGjC4G71ceq8hqa97oEzYVWNnfvK6Xc9Rx7rXq9IjA/F7EIZhiL1dvN2TZKodWwoGp+/LqG5QWh5pkHLLEtapa2BPFumQNDqTTmFIbqCI6E+BIRWwgQMI7ZyLwHIx1mD2cMVknNF5X8UuacsZMmMIHFgLTR/lEFBGRM+u5HegC9IGNI9KMCmhaq8RhnDENJRaYiKle3d5yEyn32LsEXcNHi5YoUPMsmSSlE56qCU1pAuBlmH1PBZ3yQH+X15JnIet9RcGqLBUWa/PMU8fdI7ERxELF+z9TUnJnhelPXxyMMC28TCLz/N3MHq8ooQDISkMU/F1W7JqXkBBf+CRMwBBPVV5jkcm3Omaf4raPtRYiSpi4LysdprzROo7ouhB3UdBIlLDCdCfV3jEAGSeNleBCxm8Ia/tG9SMQxp7amj08uWVAR0HuRhelldoD0+8mYROeEgGbrUKCYyDcYBhIyMppvrLIxz43Fh/Kb8RUCZBHQkFTVoLJlMRXVHqu16gapRmVSS3CmYeb3ygh3F2nBfU4jNnfvK6Xc9Rx7rXq9IjA/F72t2Co+EsvIlJZO6uTtEK8OM8bWp+RIox9SKEQJq+a2BPFumQNDqTTmFIlPCImQ7BQ/OweQA1mJyPxHQtY9bSzgUfzxUtBzFQkwhSZUE4CUFWSlkwDRFr0ZPxnGanBHNVGctnN7qbe4vbhn7aNOAfOn0vxMhljRytZJ4rEH/KGCBZl9eNcDn7n/MpxCQNpQ+OaVHh3QFTzo0UZxkCgs0cxowVagVy+NN4OE7Hjx7EAdkYUKysABmMz1b52Co7TgK0/Tv+6SoeYXyrm/toFVZXOmNVXDlQQEBVfunB2PRRPU6KjkdaP4zte+zt2MQw/DM7I0e2cQ0Z+v2amvQA3Ul2HoDcDsjsZ3iGTnrbDEe1A3rmU36gB9KyBMRtooTS/0OqD/HczXwx6mB7Be+/iMlJmpsLerEDVxH36aRsKG69fseF218T+6/LKfr3FB5dV/1eGTNVLEQRREXdrgoncQdtVXioXiMlfP7cveFq9DSJ4ndmr403ChARjSeDgk6aTAU4EPlOi+k/e1kOMIcoBcs/p0MFbWdB+ZhXijHQC2SU5wEIVaW3ZjbtHHhEufTBnp7BVVLtf/2EyMKOwGdk1ouAitVknw1rMWEuvggqH/wWZ6EmVVpcEB91EKTCnDqwBG9vMwhMJ8TguNj0nSDE211uHCGueO5L5Ge6YcLcCTZBH7ZVbUu+xHbNgAA7wmcOyU0Bq9bWPFVsd9KRIxQmiwzwzQBYqN6POf1K+RmfdrqLAtQLRPm/AQX29wTjPQ1uMIGN9QvZ6GkXKHany/1tBQ5mUEwNEHIfERUQrZrN3OhI16s5lnRmDO8lf4q6RxsfkntvP+ShxkaCE1F9lasCNERTYzjKCc76OueQSSrdYUf1VOrmU0pdJ/O0Fs6sn9CTx4j9C9exlDZ2yAFnHLOaowgE5RAVnrtJCYyJnPYcBntp9YrAJwnYYkVpKfKFPzNBMA=="}}} -Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":4,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} -[server] Got a method textDocument/codeAction -[server] processing took 0.00786781311035ms -Sending response {"id": 4, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":5,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} -[server] Got a method textDocument/documentSymbol -[server] processing took 0.00596046447754ms -Sending response {"id": 5, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":6,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} -[server] Got a method textDocument/codeLens -[server] processing took 0.00691413879395ms -Sending response {"id": 6, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} -Read message -{"jsonrpc":"2.0","id":7,"method":"textDocument/hover","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"},"position":{"line":0,"character":27}}} -[server] Got a method textDocument/hover -[server] processing took 0.00691413879395ms -Sending response {"id": 7, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-OMBpBy/test.ml"}}} -Read message -{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml","languageId":"ocaml","version":1,"text":"NX2k8sfoMJrFUk1x+YHRRCYPTSBUWEsXJ/NQWFmGrxkucRNwTyqo2Tdcb+mdu+ow5EqANnYdqqDlGs9Mxz4Sf9JiT5MyU1JS73/aqdFGZLQpAtYKp4x4qHxAWN5c9Sb++wq+a2AGULmR2X3BCyAMxaD1mAPPCjeUwA5AjxfOsy5c0yevitVknNEtW7kgescQO9FXURFNSlptEAxaELyxnDrfLX5UMwUQMDy5hMKwwyCLZtBoGHKHgaIMzF0yKgaFQ9JHCTYQ6AGJ9DDsn9dpd7Y1iBrEtpXl3VVQ/pe202MJkZic9pBSb2B93x102BvlxgKGX+tLF+z9TUnJnhelPXxyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9Q1/wUaO8KQPMHPVsrkVdyMO87q+bo2YEllTMpNbvtukHCOfJ7l0gMOAoRN/8DRYznPvHXRWSiPRiQTdbcXf1WVVb3Qwdt79DP9u73To7ni8RbyoolSKf7i1F2vps1efRDQx4LjuohNC1bmsDFMISC+Rty+r4NURgDV9o/XEFN+RIeZULduxkwbpNoDGCODDZhmbPnsfZ678T0LnY5va0rDYxRv7jRslhjC5lbGYxLoetuhhZc+PICGcYM6OACqGJYAsFCeA7EQJq+rJhLPJ+11WaTDH9Nr0qilAeERUHedQ6MmMrTi8kfViGS8YA6zwRwFW9BvghUYppMGFJRGVowRk6BWJPxnDrfHTlOMJhHIp4wf3fhhmiERNEyMpj8gPUXyFayZdTeQ8gcXWJV/p3JaAn7nUV9sjNHyBLBq9bWPFUWjEKRIxQCiwjlyzUWqNAlOcNPMU8fq1yQB19LUL79G5X25fTlPXxyMMD3oXXI8SoAMWemmztyBBhPEQQZ+SoIQWwTcv+00b5U45F5lpQSKayhgKrz1dw5mCs80bvvmRCXVrsqlqAWOGhYJ/XIXhyjO+mIUnHp3BOZTfadHa9kCDmYQwE76EC0jqiQEo0y5HF85mBkD+zm7J/GdUgNb2tOAd3YjvZxOXMpnIW9JwnF2Ut93KXKTD2BUEpZ2VZXL//VUFesgvRna5RmAWDZCnEsfKflwrd5vyq+Ozxqfvba229Rx7rXq9IjA/F7EIYLnKIpwMBaMLxlAME2/PZRbSkaFs6C9SKEQJq+aYoP+0m2K8rxM6sIbqCI6E+BCkDyhElt7YyLtiQlDTDAitVknNEtGjFzftwXKlEIX6FOUEl6O6EVELyxnDrfQTlJYIAPN7DclazbtGPEKZQPJ7vfi3IQ/lLj31LcF8YKC5NDl/aQwDvb7/QdwyFT/U3saBae2RFT/6+4TtlEiwSwlEkQaZoy4sFG0ETfyt4KAh6WPfz9TUnJnhelPXweMJrO5CjYuz63Mz7u5oQTBBU10/wWVmwEQlBTe38AYNtS+QEg7ox52qylf4qbIMoYjmE9OfeyepqX43sqlqAWN5AFMEXDCYCw1bivTnvi3BOVQsbZU0pdVR0YQwE76EC0jqjRGVyk/EsqzpwaHK7/mYQD9nEVv+RNTIyL8qQcJ72PpNP020OtB6s6Kfr3FGNBCAJVMo9Z+RBNFWbgg2YepTpl4lvXG72hePuntv247HiHKiImrqK6Qs/2gibXapg9RoAzSYYW7+YfvhRGJ0h7CgUG8eMXfXJV+26P8p7EQJq+sJZPFaj1ZyfSCj6Iuu8Nn90f26XtfBhJ7YyLtiQlDTDAitVknJB5SSRved1U3VoNGENMXB/nO6EVELyxnF4aAGd0Lg53P8TSaq7uuHKQOrcaD83gd3AYyBGvUJ4KBjgWUWA+6zaGcDG7lAAmxD5+lFXDvHrdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERxELF+z9TUnJvMGp3Hx/Sg78oRXIyShASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRAlS1i1r7txSbLVORro4dA3/sRNULPXdmr44+rAGTn1UfVTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7O1JoUhVvaoNVwPLpqYzUC1ppNeF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWCqG7ttu+fmbZhtoE4BPCAir4G6A2QFvnqv/EIjA/EyXtI6xe5frYRDLL1nB3xD7OAFuXlFRs5H9TbrQJrvqII1Ub7C1Xe2RosIbqCInQ4VSFjwhUM1mJP37i9a2HPA7Yp65PttGjEucgg9J692MkBJSVUpEB/UQOyhoDqBSUJZYJ1MJjz9sejEy7yEOYwVYiLvxvF4jRGvZs0vAXhCEDJA/5XZtS3cblQ6xTJC/QOSglCn0BBO7DiVZc1Dzhjl6A1dqNAlOcNPMU8fuI8lAc/0+rD5CAL2ncWV07gm+ZC0/yr17X504Cqvm9RmR6BAOo9ZGW9QERUQr38ISadZ0Sx8/BE5LPagava8KJcVontiKeuyd/GNS4Yu7ugKW9l4JVyCTt351YHNRCGdJUfXV2roWOEpVWWXDcQ7nBPPnauZZR+dlDQelldoSPupidpDmpsghP1ZQtSOpaQkFz6b6g3BMI+FI/ls+qaKUSkBDBoBCRhQ+WsvFimprgpgxUEaFDCLG8lducGzbg57wD0wAzNacI76Xc9Rx7rXq9IjA/F7GMsKi01ie16TMONjQMUKz3MrbH9GV25VjH0M+wq+a2BPFumQNDqTTmFIwqDhpReR2EHdcAEJ70Doemll0ymQxdVhkqttGjEuvghUYlFNTBEZGR/wEBE2X47d7iOfDiQZ1NUPN7DclazbtGPEYcluKk8vxvF4jRG7Kg3bQ8YCUWIQ65rJvHb2pV5l8TIBjonVhQTa+FU35nPC2sAZngbri6sOfNAwOct845+cr1mBCNUF33D5CAL2nhnPQH5r01m3vmvG/CU00DWBy6R8QUkMER9ZGW9QERUQr38IOewBPVU68RAfPNL5cK7iMYV9oHdzWOv7xVaZE+Iu/egCN5JRY6CGChzx4gKEDXunC8O1Z1GmU0pdVR0YQwE76EC06qjqTor7lEcGjzUoSPup7IRG5QsJv2sNQZ4LcY9lUC1ppNfZ204RIQV6UN+XP99NCB5RWEcWIFRrUEHwxJEewlFoEDT0H8dvfOigxrMcoG0ROWMlvbenGs/YeCqRfppj4VFqDvpL74RawMIAZ0McHNAO63wRfHQQWN5geCLBDM74aZIKU4W3H8qTTmFIbuHEk5PATlnwq/BMiZy0tTk6DTDAitVknLkwW8N/gNkVL5lnH/RJV9tcHzxV44neziucBDk2GctuN7DguLaohnC53gQoLC0vcaI+jUHv1tTiAX2OUS2BlluFqSrl66sOdyFO/UaBtkGdPFUWjEKRIxRAzcuclEdWqNAlOcNPMU8fdI7ERrJEU3n9TlSUkx4jJ/AyMMD3oXXIlSp0YSruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5uoxuLKjrtarT1xFnlSl7MK0exQvKVKJhpbpX2VYEMFHKCdn/KvmISTCu1kWaTdGmU0pdVR0YQwE76EC0jqiQTo+dlDQelldoSPup7IRG5QtVv11CCMmL8Pp51nUufseF218RLBs6Kfr3FGNBTUpRGR9Z+RARFRCgfM5er9EcVWD0XiMMfPTwbbEro9zY4oAyv3H9DIxRaC+GslJLKFF7EIZOoeBVod6FMPIpGNxG61p4bWlFXxFC8CLIB1a+qJp2UajU0TqOTjMNqPDOoQuST6X5f9lKiIWO7mkiORuAitVk5Z1tG7Byb2sVJo6NGF/1Vo9S0RFQXOvsnHyaByQ0Sss41i7suPnitWWF1Mka3WavcqMKyBGgAZ3bQ8YCUQgVokyHrmntnUp0xDQ3j6jVqSvdURBF7pPWZhRIhNvJ/R2CqNIbOe1AMQ+kwI8RF1QLR3HcH5XK7tLl2DR7YZW47Tn17ChASnruy6R8QUkMER9ZGW9QERUQr38IOewBPVV5jkcm3Kjtq4q8IMRXjmtz1r7vxELQEe9B/egCN5JRY6CGChyl4bjEAGTn1UfVTdGmU0pdVR0YQwE76EC0jxzVFlKdl8xexoklDub7n1YKjAsAbrFNHcjZje2wLiVo8NfMOhjA3VxsYqaHFy6uTUpRGR9Z+RARFRCgfM5er9EcVWD0XiNhu+ncbbM5oDSU4jNnftHrGgpRxCOLxEtlGXs7EIYL74RaeYQAZPJoTwVPp0NRqDoVFs6C9SKEQJq+a2BPFumQQHfLGmFKcPLk7E0nX/0vhRh47ZWDgTRfW6uAitVk8ZcxMUsyetxUIA9IDkwzXE5gWE5VV0ykh8rfMXpHMghLITixxuXRhnDENN9bNmG7xrRR7VTf3b8fBjVBUTVZl9O8cHas6Fo958QWoTCIcoTn+FVNrRHF2slQixym6B2CqMllVgpB25Gbs10QSOkCU3mvGUnLkwPjYHxvLtC49mvB/VN3MHq8ooQz+lkMER/FGRYQHAtQpwXBEZAN3AF5zB1jOb0Tdefn1Ios/Dw80dC7xSbYQaFrpbpH1poZSBCGChzgPuyHSGSi4oeQFgHMF4/qF6+PCdVvu9C0jqjMTj0g7GREz5slBveplbUVkVcMb3E3QsjTjqQ539sa8wzMMYj43BUNYra0W82BTllMGlQZZAhRVE0jxYoEcARtBS7CXmZSu+ncbed5rmSZYWMJ/frLEgoFxzuEf8kaTpEyQt24pKIf9t2II0EfTsQ1/0NM/8oVWwlW9WHMCbS4wYA2FqyQKRHTTmFI7uH+kpPVWVDtv9Vz71rOcDkf+yGUyYkk82FeU8V85ZhUYlFNTElZQ99tSEFvVPne7mryQUlQOIt5IDidb47kxGXESd/a0zmvgOhNzk8zVMTyDGJDCWISyQzJtVXs6AB9dyES/RSRc5ytQoFT7pGRPhQpixKsuo63cZooOfpSMUX9dMeLFMNCU20iFAL27s0lPnkq3Yn0oiWNbnp0YSruy968G6lJSU/zXSoDU6UNrZ7NYbxb3oxnjnAr3KCnq0jt1xZclAApKfTjhA4ZEbR9o0oC1n6RY6CGChzx4e0URTn7D5uQHIKmTLoMEEfIP2Bpk5HCjxKNTor7lHJl5QkhDIW8l1xSpFMVvbU4Ht7S8PRhUC1ppNeF2ZTRUostN+q/+WNITQV4Mo9ZJVVFFVylrIkwboVlAnW9DTYxhqewbahKoDSU4nI6qsi7FgoSfVTEf6B8QQUiQtM674RaeYQAOulaM2AX93EUejd1WZZYlzuPPcfCuYJ/FumQNDqTDzI1bvnW6CuIWEGycpI3i0T0ryQuJiOP9gUlzwQtU7dBvgg2JUE3A/UZEXUtUUN0Xavw6X4FEi5FLh9L4Suxab7isnCN31QfMTObfa1+w9Py3c8tF8dCBSwVnCGJcHasmUllsnMPpQ+Xc7er3QVZ76+eIxQFkhzhb9dWqNBPRq//4QjrdMyXEqg+QO8xBB8Qndby+XxfGtD37TC1lWVWMWegilAvFp5mQkoJV8sEEQ5fr38IOaYE+VUly6I8Cr8ddvziIN9lkSpiD+PqdRvLUPZ7p4tc2UxUIVrGSsv54fTKKzTn1Ue1C1HyFPFtJkOID1Nj6Fj0xYDQGkegy8RAuzUoSPupm15VoAt2oOE3Hd7MnaQkAS2E6Y+R21vhYUt933uKXTUETQwUWEkMOkVCFV8hqxlebARhGjC4G71ceq8hqa97oEzYVWNnfvK6Xc9Rx7rXq9IjA/F7EIZhiL1dvN2TZKodWwoGp+/LqG5QWh5pkHLLEtapa2BPFumQNDqTTmFIbqCI6E+BIRWwgQMI7ZyLwHIx1mD2cMVknNF5X8UuacsZMmMIHFgLTR/lEFBGRM+u5HegC9IGNI9KMCmhaq8RhnDENJRaYiKle3d5yEyn32LsEXcNHi5YoUPMsmSSlE56qCU1pAuBlmH1PBZ3yQH+X15JnIet9RcGqLBUWa/PMU8fdI7ERxELF+z9TUnJnhelPXxyMMC28TCLz/N3MHq8ooQDISkMU/F1W7JqXkBBf+CRMwBBPVV5jkcm3Omaf4raPtRYiSpi4LysdprzROo7ouhB3UdBIlLDCdCfV3jEAGSeNleBCxm8Ia/tG9SMQxp7amj08uWVAR0HuRhelldoD0+8mYROeEgGbrUKCYyDcYBhIyMppvrLIxz43Fh/Kb8RUCZBHQkFTVoLJlMRXVHqu16gapRmVSS3CmYeb3ygh3F2nBfU4jNnfvK6Xc9Rx7rXq9IjA/F72t2Co+EsvIlJZO6uTtEK8OM8bWp+RIox9SKEQJq+a2BPFumQNDqTTmFIlPCImQ7BQ/OweQA1mJyPxHQtY9bSzgUfzxUtBzFQkwhSZUE4CUFWSlkwDRFr0ZPxnGanBHNVGctnN7qbe4vbhn7aNOAfOn0vxMhljRytZJ4rEH/KGCBZl9eNcDn7n/MpxCQNpQ+OaVHh3QFTzo0UZxkCgs0cxowVagVy+NN4OE7Hjx7EAdkYUKysABmMz1b52Co7TgK0/Tv+6SoeYXyrm/toFVZXOmNVXDlQQEBVfunB2PRRPU6KjkdaP4zte+zt2MQw/DM7I0e2cQ0Z+v2amvQA3Ul2HoDcDsjsZ3iGTnrbDEe1A3rmU36gB9KyBMRtooTS/0OqD/HczXwx6mB7Be+/iMlJmpsLerEDVxH36aRsKG69fseF218T+6/LKfr3FB5dV/1eGTNVLEQRREXdrgoncQdtVXioXiMlfP7cveFq9DSJ4ndmr403ChARjSeDgk6aTAU4EPlOi+k/e1kOMIcoBcs/p0MFbWdB+ZhXijHQC2SU5wEIVaW3ZjbtHHhEufTBnp7BVVLtf/2EyMKOwGdk1ouAitVknw1rMWEuvggqH/wWZ6EmVVpcEB91EKTCnDqwBG9vMwhMJ8TguNj0nSDE211uHCGueO5L5Ge6YcLcCTZBH7ZVbUu+xHbNgAA7wmcOyU0Bq9bWPFVsd9KRIxQmiwzwzQBYqN6POf1K+RmfdrqLAtQLRPm/AQX29wTjPQ1uMIGN9QvZ6GkXKHany/1tBQ5mUEwNEHIfERUQrZrN3OhI16s5lnRmDO8lf4q6RxsfkntvP+ShxkaCE1F9lasCNERTYzjKCc76OueQSSrdYUf1VOrmU0pdJ/O0Fs6sn9CTx4j9C9exlDZ2yAFnHLOaowgE5RAVnrtJCYyJnPYcBntp9YrAJwnYYkVpKfKFPzNBMA=="}}} -Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":8,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} -[server] Got a method textDocument/codeAction -[server] processing took 0.00190734863281ms -Sending response {"id": 8, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":9,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} -[server] Got a method textDocument/documentSymbol -[server] processing took 0.00190734863281ms -Sending response {"id": 9, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":10,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} -[server] Got a method textDocument/codeLens -[server] processing took 0.00596046447754ms -Sending response {"id": 10, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} -Read message -{"jsonrpc":"2.0","method":"textDocument/didClose","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-vgvPtT/test.ml"}}} -Read message -{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml","languageId":"ocaml","version":1,"text":"open Test_lib\nopen Learnocaml_report;;\n\nlet avoid_thentrue = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not write the following code patterns:\";\n Code \"[if ... then true else ...;\n if ... then false else ...;\n if ... then ... else true;\n if ... then ... else false]\"; Text \"\nPreferably use Boolean operators (&&), (||), not.\"], Success ~-4) ]\n end\n\nlet check_thentrue e =\n Parsetree.(\n match e with\n | {pexp_desc = Pexp_ifthenelse (_, e1, (Some e2))} ->\n begin\n match e1 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e1\n | _ -> []\n end @ begin\n match e2 with\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"false\")}, None)}\n | {pexp_desc = Pexp_construct ({Asttypes.txt = (Longident.Lident \"true\")}, None)} ->\n avoid_thentrue e2\n | _ -> []\n end\n | _ -> [])\n\nlet avoid_list1app = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not write:\";\n Code \"[x] @ l\";\n Text \". Preferably write:\";\n Code \"x :: l\";\n Text \".\"], Success ~-4) ]\n end\n\nlet check_list1app e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_apply (app0, [(_, lst1); _]) ->\n (match app0.pexp_desc, lst1.pexp_desc with\n | Pexp_ident {Asttypes.txt = app0'},\n Pexp_construct ({Asttypes.txt = (Longident.Lident \"::\")}, Some lst1')\n when List.mem (Longident.flatten app0') [[\"List\"; \"append\"]; [\"@\"]] ->\n (match lst1'.pexp_desc with\n | Pexp_tuple [_; nil0] ->\n (match nil0.pexp_desc with\n | Pexp_construct ({Asttypes.txt = (Longident.Lident \"[]\")}, None) ->\n avoid_list1app e\n | _ -> [])\n | _ -> [])\n | _ -> [])\n | _ -> [])\n\nlet avoid_eqphy = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not use physical equality\";\n Code \"(==)\";\n Text \". Preferably use structural equality\";\n Code \"(=)\";\n Text \".\"], Success ~-1) ]\n end\n\nlet avoid_neqphy = let already = ref false in fun _ ->\n if !already then [] else begin\n already := true ;\n Learnocaml_report.[ Message ([ Text \"* Do not use physical inequality\";\n Code \"(!=)\";\n Text \". Preferably use structural inequality\";\n Code \"(<>)\";\n Text \".\"], Success ~-1) ]\n end\n\nlet check_eqphy e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_ident {Asttypes.txt = Longident.Lident \"==\"} -> avoid_eqphy e\n | _ -> [])\n\nlet check_neqphy e =\n Parsetree.(\n match e.pexp_desc with\n | Pexp_ident {Asttypes.txt = Longident.Lident \"!=\"} -> avoid_neqphy e\n | _ -> [])\nlet ast_imperative_check ast =\n let chk_expr e =\n Parsetree.(\n match e with\n | {pexp_desc = Pexp_sequence _} -> forbid_syntax \";\" e\n | {pexp_desc = Pexp_while _} -> forbid_syntax \"while\" e\n | {pexp_desc = Pexp_for _} -> forbid_syntax \"for\" e\n | {pexp_desc = Pexp_array _} -> forbid_syntax \"array\" e\n | _ -> [] ) in\n let imperative_report =\n ast_check_structure\n ~on_expression:chk_expr\n ast |> List.sort_uniq compare in\n if snd (Learnocaml_report.result imperative_report) then\n imperative_report\n else\n []\n\nlet ast_quality ast =\n let imperative_report =\n let tempReport = ast_imperative_check ast in\n if tempReport = [] then []\n else (Message ([ Text \"Imperative features have been detected:\" ],\n Success ~-4)) :: tempReport\n \n and report =\n let tempReport = ast_check_structure\n ~on_expression:(check_thentrue @@@ check_list1app @@@\n check_eqphy @@@ check_neqphy)\n ast |> List.sort_uniq compare in\n if tempReport = [] then []\n else (Message ([Text \"Unwanted code patterns have been detected:\"],\n Failure)) :: tempReport\n \n in if imperative_report = [] && report = []\n then [ Message ([ Text \"OK (no prohibited construction detected)\"], Success 0) ]\n else imperative_report @ report;;\n\nlet question0 =\n let prot = last_ty [%ty:bool] [%ty: bool] in\n test_function_against_solution ~gen:(5) prot\n \"f\"\n [];;\n \nlet question1 =\n let prot = last_ty [%ty:int] [%ty: int] in\n test_function_against_solution ~gen:(5) prot\n \"f\"\n [];;\n \nlet () =\n set_result @@\n ast_sanity_check code_ast @@ fun () ->\n [\n Section ([ Text \"Code quality:\" ], ast_quality code_ast);\n Section ([ Text \"Fonction:\" ; Code \"f\" ], question0 );\n Section ([ Text \"Fonction:\" ; Code \"f\" ], question1 );\n ]"}}} -Sending notification {"jsonrpc": "2.0", "method": "window/showMessage", "params": {"type": 1, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":11,"method":"textDocument/codeAction","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"},"range":{"start":{"line":0,"character":0},"end":{"line":0,"character":0}},"context":{"diagnostics":[]}}} -[server] Got a method textDocument/codeAction -[server] processing took 0.00190734863281ms -Sending response {"id": 11, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":12,"method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"}}} -[server] Got a method textDocument/documentSymbol -[server] processing took 0.00286102294922ms -Sending response {"id": 12, "jsonrpc": "2.0", "error": {"code": -32603, "message": "No root directory found"}} -Read message -{"jsonrpc":"2.0","id":13,"method":"textDocument/codeLens","params":{"textDocument":{"uri":"file:///home/manu/.cache/.fr-WfSyJ8/test.ml"}}} -[server] Got a method textDocument/codeLens -[server] processing took 0.00309944152832ms -Sending response {"id": 13, "jsonrpc": "2.0", "result": [{"range": {"start": {"line": 0, "character": 0}, "end": {"line": 0, "character": 0}}, "command": {"title": "Unable to load compilation data: No root directory found", "command": ""}}]} -Read message -{"jsonrpc":"2.0","id":14,"method":"shutdown","params":null} -Sending response {"id": 14, "jsonrpc": "2.0", "result": null} -Read message -{"jsonrpc":"2.0","method":"exit","params":null} -Got exit! Terminating loop -Finished From 413966325d822555a0f6c1159ecb230ae968c5ed Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Thu, 18 Jul 2019 17:28:24 +0200 Subject: [PATCH 13/91] feat : Add export all --- src/editor/editor_lib.ml | 24 +++++++++++ src/editor/editor_lib.mli | 1 + src/editor/learnocaml_editor_tab.ml | 44 +++++++++++---------- static/js/jszip/learnocaml_jszip_wrapper.js | 35 ++++++++++++---- 4 files changed, 77 insertions(+), 27 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 09d64b205..c0c9328ef 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -428,6 +428,30 @@ module Editor_io = struct [|Js.Unsafe.inject contents; Js.Unsafe.inject (Js.wrap_callback callback) |] in () + let download_all () = + let name = "exercises.zip" in + let editor_index= Learnocaml_local_storage.(retrieve editor_index) in + let json = Json_repr_browser.Json_encoding.construct + (SMap.enc editor_state_enc) + editor_index + in + let exercises = Js._JSON##(stringify json) in + let index = SMap.fold + (fun k editor_state acc -> + (k, Some editor_state.metadata ) :: acc) editor_index [] + in + let index = Learnocaml_data.Exercise.Index.Exercises index + |> Json_repr_browser.Json_encoding.construct + Exercise.Index.enc + in + let editor_download = Js.Unsafe.eval_string "editor_download_all" in + let callback = download_file name in + let _ = + Js.Unsafe.fun_call editor_download + [|Js.Unsafe.inject exercises; + Js.Unsafe.inject index; + Js.Unsafe.inject (Js.wrap_callback callback) |] in () + let upload_file () = let input_files_load = Dom_html.createInput ~_type: (Js.string "file") Dom_html.document in diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index 0c9c52f6e..e9b47f07d 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -106,4 +106,5 @@ unit module Editor_io : sig val download : Learnocaml_data.SMap.key -> unit val upload : unit -> unit + val download_all : unit -> unit end diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 313757899..621595bb5 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -12,7 +12,7 @@ open Learnocaml_data open Learnocaml_common open Editor open Editor_lib -module H = Tyxml_js.Html5 +open Tyxml_js.Html5 let fetch_editor_index ()= @@ -60,7 +60,27 @@ let delete_button_handler exercise_id = end ; true) ;; +let import_bar = + a ~a:[ a_onclick (fun _ -> Editor_io.upload ();true); + a_class [ "exercise"] ] + [ div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata [%i"Import"] ]; + p [pcdata [%i"Import from a zip file"]]]] +let export_all_bar = + a ~a:[ a_onclick (fun _ -> Editor_io.download_all ();true); + a_class [ "exercise"] ] + [ div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata [%i"Export all"] ]; + p [pcdata [%i"Export all exercises to a zip file"]]]] + +let new_exercise_bar = + a ~a:[ a_href "new_exercise.html"; + a_class [ "exercise" ] ] [ + div ~a:[ a_class [ "descr" ] ] [ + h1 [ pcdata [%i"New exercise"] ]; + p [pcdata [%i"Create \ + a new exercise"]]]] let rec editor_tab token _ _ () = @@ -120,27 +140,11 @@ let rec editor_tab token _ _ () = ] :: acc) index contents in - let open Tyxml_js.Html5 in - let open Learnocaml_exercise in - let open Exercise.Meta in - let restore_bar = a ~a:[ a_onclick (fun _ -> - Editor_io.upload (); - true); a_class [ "exercise"] ] - [ div ~a:[ a_class [ "descr" ] ] [ - h1 [ pcdata [%i"Import an exercise"] ]; - p [pcdata [%i"Import a new exercise \ - from a json file"]]]] - in let c= List.rev (format_exercise_list - ( [a ~a:[ - a_href (Printf.sprintf "new_exercise.html?token=%s" (Token.to_string token)); - a_class [ "exercise" ] ] [ - div ~a:[ a_class [ "descr" ] ] [ - h1 [ pcdata [%i"New exercise"] ]; - p [pcdata [%i"Create \ - a new exercise"]]]]; - restore_bar]) ) + [ new_exercise_bar; + export_all_bar; + import_bar] ) in let list_div = Tyxml_js.Html5.(div ~a: diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index 3d18a372f..b482c0b3f 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -1,14 +1,18 @@ //keep in sync with editor export datatype +function editor_create_exercise(zip, data, prefix) { + zip.file(prefix + "descr.md", data.exercise.descr); + zip.file(prefix + "meta.json", JSON.stringify(data.metadata, null, 2)); + zip.file(prefix + "prelude.ml", data.exercise.prelude); + zip.file(prefix + "prepare.ml", data.exercise.prepare); + zip.file(prefix + "template.ml", data.exercise.template); + zip.file(prefix + "test.ml", data.exercise.test); + zip.file(prefix + "solution.ml", data.exercise.solution); +} + function editor_download(brut_data, callback) { var zip = new JSZip(); var data = JSON.parse(brut_data); - zip.file("descr.md", data.exercise.descr); - zip.file("meta.json", JSON.stringify(data.metadata, null, 2)); - zip.file("prelude.ml", data.exercise.prelude); - zip.file("prepare.ml", data.exercise.prepare); - zip.file("template.ml", data.exercise.template); - zip.file("test.ml", data.exercise.test); - zip.file("solution.ml", data.exercise.solution); + editor_create_exercise(zip, data, "") zip.generateAsync({ type: "blob", compression: "DEFLATE", @@ -18,6 +22,23 @@ function editor_download(brut_data, callback) { }).then(function(blob) { callback(blob) }); } +function editor_download_all(brut_exercises, brut_index, callback) { + var zip = new JSZip(); + var all_data = JSON.parse(brut_exercises); + Object.keys(all_data).forEach(function(k) { + zip.folder(k); + let prefix = k + "/"; + editor_create_exercise(zip, all_data[k], prefix) + }); + zip.file("index.json", brut_index); + zip.generateAsync({ + type: "blob", + compression: "DEFLATE", + compressionOptions: { + level: 9 + } + }).then(function(blob) { callback(blob) }); +} //also to keep in sync function editor_import(brut_data, callback) { From bac422cd8290baa18a67c65eb49d12ac016594cb Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Thu, 18 Jul 2019 17:46:42 +0200 Subject: [PATCH 14/91] fix : remove the saving of editor exercise to the state of a proper exercise while grading --- src/editor/editor.ml | 5 +---- src/editor/editor_lib.ml | 3 ++- static/js/jszip/learnocaml_jszip_wrapper.js | 5 +++-- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 3230a3e2d..0495e8947 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -528,11 +528,8 @@ let () = Lwt.return Learnocaml_report.[ Message ([ Text [%i"Grading aborted by user."] ], Failure) ] in Lwt.pick [ grading ; abortion ] >>= fun report -> - let grade = display_report (exo_creator id) report in + let _grade = display_report (exo_creator id) report in (worker() ) := Grading_jsoo.get_grade ~callback (exo_creator id) ; - Learnocaml_local_storage.(store (exercise_state id)) - { Answer.grade = Some grade; - solution; report = Some report ; mtime = gettimeofday () } ; select_tab "report" ; Lwt_js.yield () >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index c0c9328ef..3d58b2adb 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -443,7 +443,8 @@ module Editor_io = struct let index = Learnocaml_data.Exercise.Index.Exercises index |> Json_repr_browser.Json_encoding.construct Exercise.Index.enc - in + in + let index = Js._JSON##(stringify index) in let editor_download = Js.Unsafe.eval_string "editor_download_all" in let callback = download_file name in let _ = diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index b482c0b3f..f04759ca3 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -27,10 +27,11 @@ function editor_download_all(brut_exercises, brut_index, callback) { var all_data = JSON.parse(brut_exercises); Object.keys(all_data).forEach(function(k) { zip.folder(k); - let prefix = k + "/"; + var prefix = k + "/"; editor_create_exercise(zip, all_data[k], prefix) }); - zip.file("index.json", brut_index); + var index = JSON.stringify(JSON.parse(brut_index), null, 2); + zip.file("index.json", index); zip.generateAsync({ type: "blob", compression: "DEFLATE", From d23c98741d8ea90a900300a279b4d9014f205c40 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 19 Jul 2019 11:39:06 +0200 Subject: [PATCH 15/91] feat(export) : add a folder in the zip when exporting one exercise --- src/editor/editor_lib.ml | 25 ++++---- static/js/jszip/learnocaml_jszip_wrapper.js | 68 +++++++++++++-------- 2 files changed, 56 insertions(+), 37 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 3d58b2adb..0a8a917e1 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -477,17 +477,13 @@ module Editor_io = struct ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; result_t - let upload_new_exercise id text = - let save_file = - Json_repr_browser.Json_encoding.destruct - editor_state_enc - (Js._JSON##(parse text)) - |> put_exercise_id id + let upload_new_exercise id to_save = + let to_save = put_exercise_id id to_save in let open Exercise.Meta in - let result= idUnique id && titleUnique save_file.metadata.title in + let result= idUnique id && titleUnique to_save.metadata.title in if result then - update_index save_file; + update_index to_save; result let upload () = @@ -495,14 +491,17 @@ module Editor_io = struct (fun () -> upload_file () >>= fun file -> - let id = Filename.chop_extension (Js.to_string file##.name) in let f = Js.Unsafe.eval_string "editor_import" in let callback = (fun text -> - if upload_new_exercise id text then - Dom_html.window##.location##reload - else - Learnocaml_common.alert [%i"Identifier and/or title not unique\n"]); + SMap.iter + (fun id editor_state -> + if not (upload_new_exercise id editor_state) then + Learnocaml_common.alert [%i"Identifier and/or title not unique\n"]) + (Json_repr_browser.Json_encoding.destruct + (SMap.enc editor_state_enc) + (Js._JSON##(parse text))); + Dom_html.window##.location##reload) in Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; Js.Unsafe.inject callback|]) diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index f04759ca3..4e9a743da 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -12,7 +12,9 @@ function editor_create_exercise(zip, data, prefix) { function editor_download(brut_data, callback) { var zip = new JSZip(); var data = JSON.parse(brut_data); - editor_create_exercise(zip, data, "") + var dirname = data.exercise.id + zip.folder(dirname); + editor_create_exercise(zip, data, dirname + "/"); zip.generateAsync({ type: "blob", compression: "DEFLATE", @@ -41,35 +43,53 @@ function editor_download_all(brut_exercises, brut_index, callback) { }).then(function(blob) { callback(blob) }); } +function editor_read_exercise(loaded_zip, path) { + return new Promise(function(resolve, reject) { + var descr = loaded_zip.file(path + "descr.md").async("string"); + var meta = loaded_zip.file(path + "meta.json").async("string"); + var prelude = loaded_zip.file(path + "prelude.ml").async("string"); + var prepare = loaded_zip.file(path + "prepare.ml").async("string"); + var template = loaded_zip.file(path + "template.ml").async("string"); + var test = loaded_zip.file(path + "test.ml").async("string"); + var solution = loaded_zip.file(path + "solution.ml").async("string"); + Promise.all([descr, meta, prelude, prepare, template, test, solution]) + .then(function(values) { + result.exercise.max_score = 0; + result.exercise.id = ""; + result.exercise.descr = values[0]; + var brut_meta = values[1]; + var meta = brut_meta.replace(/\r?\n|\r/g, " "); + result.metadata = JSON.parse(meta); + result.exercise.prelude = values[2]; + result.exercise.prepare = values[3]; + result.exercise.template = values[4]; + result.exercise.test = values[5]; + result.exercise.solution = values[6]; + resolve(result); + }) + }) +} +/* //also to keep in sync function editor_import(brut_data, callback) { var zip = new JSZip(); zip.loadAsync(brut_data) .then(function(loaded_zip) { - var result = { exercise: {}, metadata: {} }; + if (loaded_zip.file("index.json")) { + loaded_zip.forEach(function(relative_path, file) { + if (file.dir) { + new Promise(function(resolve, reject) { + editor_read_exercise(loaded_zip, relative_path) + .then(function(result) { + + }) + }) + } + } + } + var result = { exercise: {}, metadata: {} }; - var descr = loaded_zip.file("descr.md").async("string"); - var meta = loaded_zip.file("meta.json").async("string"); - var prelude = loaded_zip.file("prelude.ml").async("string"); - var prepare = loaded_zip.file("prepare.ml").async("string"); - var template = loaded_zip.file("template.ml").async("string"); - var test = loaded_zip.file("test.ml").async("string"); - var solution = loaded_zip.file("solution.ml").async("string"); - Promise.all([descr, meta, prelude, prepare, template, test, solution]) - .then(function(values) { - result.exercise.max_score = 0; - result.exercise.id = ""; - result.exercise.descr = values[0]; - var brut_meta = values[1]; - var meta = brut_meta.replace(/\r?\n|\r/g, " "); - result.metadata = JSON.parse(meta); - result.exercise.prelude = values[2]; - result.exercise.prepare = values[3]; - result.exercise.template = values[4]; - result.exercise.test = values[5]; - result.exercise.solution = values[6]; - console.log(brut_data); callback(JSON.stringify(result)); }); }); -} \ No newline at end of file +}*/ \ No newline at end of file From d82eb94a8a60b8228c744a71b27304aa9b175aa5 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 19 Jul 2019 14:00:36 +0200 Subject: [PATCH 16/91] feat (import all): finish Editor_io --- src/editor/editor_lib.ml | 10 ++++-- static/js/jszip/learnocaml_jszip_wrapper.js | 38 ++++++++++----------- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 0a8a917e1..7c599b086 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -491,7 +491,8 @@ module Editor_io = struct (fun () -> upload_file () >>= fun file -> - let f = Js.Unsafe.eval_string "editor_import" in + Firebug.console##(log file); + let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in let callback = (fun text -> SMap.iter @@ -503,7 +504,10 @@ module Editor_io = struct (Js._JSON##(parse text))); Dom_html.window##.location##reload) in - Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; - Js.Unsafe.inject callback|]) + let _ = + Js.Unsafe.fun_call f + [| Js.Unsafe.inject file ; + Js.Unsafe.inject callback|] + in Lwt.return_unit) end diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index 4e9a743da..3ccdee131 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -43,7 +43,7 @@ function editor_download_all(brut_exercises, brut_index, callback) { }).then(function(blob) { callback(blob) }); } -function editor_read_exercise(loaded_zip, path) { +function editor_read_exercise(loaded_zip, path, id) { return new Promise(function(resolve, reject) { var descr = loaded_zip.file(path + "descr.md").async("string"); var meta = loaded_zip.file(path + "meta.json").async("string"); @@ -54,8 +54,9 @@ function editor_read_exercise(loaded_zip, path) { var solution = loaded_zip.file(path + "solution.ml").async("string"); Promise.all([descr, meta, prelude, prepare, template, test, solution]) .then(function(values) { + var result = { exercise: {}, metadata: {} }; result.exercise.max_score = 0; - result.exercise.id = ""; + result.exercise.id = id; result.exercise.descr = values[0]; var brut_meta = values[1]; var meta = brut_meta.replace(/\r?\n|\r/g, " "); @@ -69,27 +70,26 @@ function editor_read_exercise(loaded_zip, path) { }) }) } -/* + //also to keep in sync function editor_import(brut_data, callback) { var zip = new JSZip(); zip.loadAsync(brut_data) .then(function(loaded_zip) { - if (loaded_zip.file("index.json")) { - loaded_zip.forEach(function(relative_path, file) { - if (file.dir) { - new Promise(function(resolve, reject) { - editor_read_exercise(loaded_zip, relative_path) - .then(function(result) { - - }) - }) - } - } - } - var result = { exercise: {}, metadata: {} }; + var promises = []; + loaded_zip.forEach(function(relative_path, file) { + if (file.dir) { + var promise = editor_read_exercise(loaded_zip, relative_path, file.name.replace(/\//, "")); + promises.push(promise); + } + }) + Promise.all(promises).then(function(values) { + var result = values.reduce(function(acc, elt) { + acc[elt.exercise.id] = elt; + return acc; + }, {}) + callback(JSON.stringify(result)); + }) - callback(JSON.stringify(result)); - }); }); -}*/ \ No newline at end of file +} \ No newline at end of file From 15780b5b7c91689a26cfeaf33f3ed2cdb3a5e801 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 19 Jul 2019 18:00:24 +0200 Subject: [PATCH 17/91] feat : add beforeunload management --- src/ace-lib/ace.ml | 3 +++ src/ace-lib/ace.mli | 1 + src/ace-lib/ace_types.mli | 3 +++ src/editor/editor.ml | 51 ++++++++++++++++----------------------- src/editor/editor_lib.ml | 5 ++-- 5 files changed, 31 insertions(+), 32 deletions(-) diff --git a/src/ace-lib/ace.ml b/src/ace-lib/ace.ml index 3cc81ea0f..28e93983c 100644 --- a/src/ace-lib/ace.ml +++ b/src/ace-lib/ace.ml @@ -91,6 +91,9 @@ let set_custom_data { editor } data = let set_mode {editor} name = editor##getSession##(setMode (Js.string name)) +let on {editor} event callback = + editor##getSession##(on (Js.string event) (Js.Unsafe.meth_callback callback)) + type mark_type = Error | Warning | Message let string_of_make_type: mark_type -> string = function diff --git a/src/ace-lib/ace.mli b/src/ace-lib/ace.mli index b53513da9..00e75b6f8 100644 --- a/src/ace-lib/ace.mli +++ b/src/ace-lib/ace.mli @@ -18,6 +18,7 @@ type loc = { val create_editor: Dom_html.divElement Js.t -> 'a editor val set_mode: 'a editor -> string -> unit +val on: 'b editor -> string -> (Dom_html.event Js.t -> unit) -> unit val read_range: Ace_types.range Js.t -> (int * int) * (int * int) val create_range: diff --git a/src/ace-lib/ace_types.mli b/src/ace-lib/ace_types.mli index bf165d59d..cdd9caac5 100644 --- a/src/ace-lib/ace_types.mli +++ b/src/ace-lib/ace_types.mli @@ -58,6 +58,9 @@ class type editSession = object method getTokenAt : int -> int -> token Js.t Js.meth method replace : range Js.t -> Js.js_string Js.t -> unit Js.meth method setMode : Js.js_string Js.t -> unit Js.meth + method on : Js.js_string Js.t -> + ((Dom_html.event Js.t , unit) Js.meth_callback)-> + unit Js.meth method setAnnotations : annotation Js.t Js.js_array Js.t -> unit Js.meth method getAnnotations : annotation Js.t Js.js_array Js.t Js.meth method clearAnnotations : unit Js.meth diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 0495e8947..6ce947f76 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -24,6 +24,8 @@ open Js_of_ocaml open Editor_lib open Dom_html open Test_spec + + (*----------------------------------------------------------------------*) let init_tabs, select_tab = @@ -65,6 +67,22 @@ let set_string_translations () = Manip.setInnerHtml (find_component id) text) translations +let activate_before_unload () :unit = + Js.Unsafe.js_expr + "window.onbeforeunload = function() {return 'You have unsaved changes!';}" + +let unable_before_unload () :unit = + Js.Unsafe.js_expr "window.onbeforeunload = null" + +let onchange ace_list = + let add_change_listener ace = + Ace.on + ace + "change" + (fun _ -> activate_before_unload ();) in + List.iter (fun ace -> add_change_listener ace) ace_list + + let () = run_async_with_log @@ fun () -> (*set_string_translations ();*) @@ -157,7 +175,6 @@ let () = (Tyxml_js.To_dom.of_div editor_prelude) in let ace_prel = Ocaml_mode.get_editor editor_prel in let contents= get_prelude id in - Ace.set_contents ace_prel contents ; Ace.set_font_size ace_prel 18; @@ -384,6 +401,7 @@ let () = end; let recovering () = + unable_before_unload (); let solution = Ace.get_contents ace in let descr = Ace.get_contents ace_quest in let template = Ace.get_contents ace_temp in @@ -435,41 +453,14 @@ let () = (*let toolbar_button2 = button2 ~container: exo_toolbar ~theme: "light" in*) begin toolbar_button ~icon: "left" [%i"Metadata"] @@ fun () -> - recovering (); Dom_html.window##.location##assign (Js.string ("new_exercise.html#id=" ^ id ^ "&action=open")); Lwt.return () end; begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> - let _aborted, abort_message = - let t, _u = Lwt.task () in - let btn_cancel = Tyxml_js.Html5.(button [ pcdata [%i"Cancel"] ]) in - Manip.Ev.onclick btn_cancel ( fun _ -> - hide_loading ~id:"learnocaml-exo-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in - Manip.Ev.onclick btn_yes (fun _ -> - recovering (); Dom_html.window##.location##assign - (Js.string "index.html#activity=editor") ; true) ; - let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in - Manip.Ev.onclick btn_no (fun _ -> - Dom_html.window##.location##assign - (Js.string "index.html#activity=editor") ; true); - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata [%i"Do you want to save before closing?\n"] ; - btn_yes ; - pcdata " " ; - btn_no ; - pcdata " " ; - btn_cancel ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "" ] ] ; - show_load "learnocaml-exo-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1") ; + (Js.string "index.html#activity=editor"); Lwt.return () end ; @@ -544,7 +535,7 @@ let () = recovering (); grade () end ; - Window.onunload (fun _ev -> recovering (); true); + onchange [ace_temp; ace_t; ace_prep; ace_prel; ace_quest; ace ]; (* ---- return -------------------------------------------------------- *) (* toplevel_launch >>= fun _ -> should be unnecessary? *) (* typecheck false >>= fun () -> *) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 7c599b086..ca5468060 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -491,14 +491,15 @@ module Editor_io = struct (fun () -> upload_file () >>= fun file -> - Firebug.console##(log file); let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in let callback = (fun text -> + SMap.iter (fun id editor_state -> if not (upload_new_exercise id editor_state) then - Learnocaml_common.alert [%i"Identifier and/or title not unique\n"]) + alert ([%i"Identifier and/or title not unique\n"] ^ + "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title)) (Json_repr_browser.Json_encoding.destruct (SMap.enc editor_state_enc) (Js._JSON##(parse text))); From 7d76ddec1572b6afa4c2d7cbd4e14ab757b4d330 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 10:54:48 +0200 Subject: [PATCH 18/91] refactor: refactor the majority of dialog boxes with learn_ocaml_common functions --- src/app/learnocaml_index_main.ml | 6 ++-- src/editor/editor.ml | 41 +++++++++------------------- src/editor/learnocaml_editor_tab.ml | 39 ++++++++------------------ src/editor/learnocaml_editor_tab.mli | 2 +- 4 files changed, 29 insertions(+), 59 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index e59c55233..0dd3f250e 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -505,9 +505,9 @@ let teacher_tab token a b () = Learnocaml_teacher_tab.teacher_tab token a b () >>= fun div -> Lwt.return div -let editor_tab token a b () = +let editor_tab a b () = show_loading[%i"Loading Editor"] @@ fun () -> - Learnocaml_editor_tab.editor_tab token a b () >>= fun div -> + Learnocaml_editor_tab.editor_tab a b () >>= fun div -> Lwt.return div let get_stored_token () = @@ -699,7 +699,7 @@ let () = then [ "playground", ([%i"Playground"], playground_tab) ] else []) @ (match token with | Some t when Token.is_teacher t -> - [ "teacher", ([%i"Teach"], teacher_tab t);"editor",([%i"Editor"], editor_tab t)] + [ "teacher", ([%i"Teach"], teacher_tab t);"editor",([%i"Editor"], editor_tab )] | _ -> []) in diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 6ce947f76..ee27896af 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -25,6 +25,7 @@ open Editor_lib open Dom_html open Test_spec +module H = Tyxml_js.Html (*----------------------------------------------------------------------*) @@ -355,40 +356,24 @@ let () = Ace.set_contents ace_temp contents ; Ace.set_font_size ace_temp 18; - let messages = Tyxml_js.Html5.ul [] in begin template_button ~icon: "sync" [%i"Gen. template"] @@ fun () -> if (Ace.get_contents ace_temp) = "" then Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ) else begin - let aborted, abort_message = - let t, u = Lwt.task () in - let btn_cancel = Tyxml_js.Html5.(button [ pcdata [%i"Cancel"] ]) in - Manip.Ev.onclick btn_cancel - (fun _ -> hide_loading ~id:"learnocaml-exo-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in - Manip.Ev.onclick btn_yes - (fun _ -> Ace.set_contents ace_temp - (genTemplate (Ace.get_contents ace)); - hide_loading ~id:"learnocaml-exo-loading" (); - true); - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [pcdata [%i"Do you want to crush the template?\n"]; - btn_yes ; - pcdata " " ; - btn_cancel ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "" ] ] ; - show_load "learnocaml-exo-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1") - end; - Lwt.return () - end ; - + Learnocaml_common.confirm + ~title:"Confirmation" + ~ok_label:"Yes" + [ H.p [H.pcdata "Do you want to crush the template?\n"] ] + (fun () -> + Ace.set_contents ace_temp + (genTemplate (Ace.get_contents ace)); + hide_loading ~id:"learnocaml-exo-loading" ()); + end ; + Lwt.return(); + end; + let typecheck_template () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 621595bb5..f1231be29 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -33,32 +33,17 @@ let fetch_editor_index ()= let delete_button_handler exercise_id = (fun _ -> - begin - let messages = Tyxml_js.Html5.ul [] in - let _aborted, abort_message = - let t, _u = Lwt.task () in - let btn_no = Tyxml_js.Html5.(button [ pcdata [%i"No"] ]) in - Manip.Ev.onclick btn_no ( fun _ -> - hide_loading ~id:"learnocaml-main-loading" () ; true) ; - let btn_yes = Tyxml_js.Html5.(button [ pcdata [%i"Yes"] ]) in - Manip.Ev.onclick btn_yes (fun _ -> - remove_exo exercise_id; - Dom_html.window##.location##reload ; true) ; - let div = - Tyxml_js.Html5.(div ~a: [ a_class [ "dialog" ] ] - [ pcdata [%i"Are you sure you want \ - to delete this exercise?\n"] ; - btn_yes ; - pcdata " " ; - btn_no ]) in - Manip.SetCss.opacity div (Some "0") ; - t, div in - Manip.replaceChildren messages - Tyxml_js.Html5.[ li [ pcdata "" ] ] ; - show_load "learnocaml-main-loading" [ abort_message ] ; - Manip.SetCss.opacity abort_message (Some "1") ; - end ; - true) ;; + let message = + pcdata [%i"Are you sure you want to delete this exercise?\n"] + in + Learnocaml_common.confirm + ~title:"Confirmation" + ~ok_label:"Yes" + [message] + (fun () -> + remove_exo exercise_id; + Dom_html.window##.location##reload); + true) ;; let import_bar = a ~a:[ a_onclick (fun _ -> Editor_io.upload ();true); @@ -83,7 +68,7 @@ let new_exercise_bar = a new exercise"]]]] -let rec editor_tab token _ _ () = +let editor_tab _ _ () = Lwt_js.sleep 0.5 >>= fun () -> diff --git a/src/editor/learnocaml_editor_tab.mli b/src/editor/learnocaml_editor_tab.mli index 47e2a0efc..a485c29d3 100644 --- a/src/editor/learnocaml_editor_tab.mli +++ b/src/editor/learnocaml_editor_tab.mli @@ -1 +1 @@ -val editor_tab : Learnocaml_data.Token.t -> 'b -> 'c -> unit -> [> Html_types.div ] Tyxml_js.Html5.elt Lwt.t +val editor_tab : 'b -> 'c -> unit -> [> Html_types.div ] Tyxml_js.Html5.elt Lwt.t From c55c2340f5549ac10d38cb5728453e6a031941dc Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 11:02:54 +0200 Subject: [PATCH 19/91] refacor : update copyright messages --- src/editor/editor.ml | 20 +++++++------------- src/editor/editor_lib.ml | 11 +++++++++++ src/editor/editor_lib.mli | 11 +++++++++++ src/editor/learnocaml_editor_tab.ml | 5 ++++- src/editor/learnocaml_editor_tab.mli | 11 +++++++++++ src/editor/new_exercise.ml | 11 +++++++++++ src/editor/test_spec.ml | 11 +++++++++++ src/editor/test_spec.mli | 10 ++++++++++ 8 files changed, 76 insertions(+), 14 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index ee27896af..374bc6795 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -1,19 +1,13 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2016 OCamlPro. + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. * - * Learn-OCaml is free software: you can redistribute it and/or modify - * it under the terms of the GNU Affero General Public License as - * published by the Free Software Foundation, either version 3 of the - * License, or (at your op1tion) any later version. - * - * Learn-OCaml is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Affero General Public License for more details. - * - * You should have received a copy of the GNU Affero General Public License - * along with this program. If not, see . *) + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) open Js_utils open Lwt.Infix diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index ca5468060..116b15c6c 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -1,3 +1,14 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Learnocaml_data open Learnocaml_common open Learnocaml_index diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index e9b47f07d..a11f2f9db 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -1,3 +1,14 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Learnocaml_data open Editor val update_index : Editor.editor_state -> unit diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index f1231be29..325c34335 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -1,8 +1,11 @@ (* This file is part of Learn-OCaml. -* + * * Copyright (C) 2019 OCaml Software Foundation. * Copyright (C) 2016-2018 OCamlPro. * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) diff --git a/src/editor/learnocaml_editor_tab.mli b/src/editor/learnocaml_editor_tab.mli index a485c29d3..d2fbb8b85 100644 --- a/src/editor/learnocaml_editor_tab.mli +++ b/src/editor/learnocaml_editor_tab.mli @@ -1 +1,12 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + val editor_tab : 'b -> 'c -> unit -> [> Html_types.div ] Tyxml_js.Html5.elt Lwt.t diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index 50dd925a6..5a6b696ee 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -1,3 +1,14 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Js_of_ocaml open Dom_html open Js_utils diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 4bfcf599f..a32162bf5 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -1,3 +1,14 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Editor_lib let rec to_string_aux char_list =match char_list with diff --git a/src/editor/test_spec.mli b/src/editor/test_spec.mli index 6b1fed37f..ff438451a 100644 --- a/src/editor/test_spec.mli +++ b/src/editor/test_spec.mli @@ -1,3 +1,13 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * The main authors of the editor part is the pfitaxel team see + * https://github.com/pfitaxel/learn-ocaml-editor for more information + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) (** Allows typing a question passing by a string * @param question_untyped id_question *) From c082d9db36a5cadd5d493aea891b14c96801e305 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 11:42:39 +0200 Subject: [PATCH 20/91] fix : New exercise display is correct --- static/new_exercise.html | 180 +++++++++++++++++++-------------------- 1 file changed, 90 insertions(+), 90 deletions(-) diff --git a/static/new_exercise.html b/static/new_exercise.html index afb42b97d..ad28a3e8f 100644 --- a/static/new_exercise.html +++ b/static/new_exercise.html @@ -1,7 +1,7 @@ - + Learn OCaml by OCamlPro - Editor @@ -13,107 +13,107 @@ - + - +
- - - - - + + + + +
- +
+
+

New Exercise

+
+ +
+

+ + + +

+

+ + + +

+

+ + +

+
+
+ +
+
- - - - + +
+
-
-
-
-

New Exercise

+ +
+

+ + +

+

+ + +

+
+
+ +
- +
-

- - - -

-

- - - -

-

- - -

-
-
- - -
-
-
- -
- -
- -
-

- - -

-

- - -

-
-
- - -
-
-
- - -
-
- + +
+
+ +
- \ No newline at end of file + From c9840c88754e1f4fba3e11a336caca40d5b6d685 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 13:42:48 +0200 Subject: [PATCH 21/91] fix : fix the problem of getting prompt when trying to exit the editor when loaded --- src/editor/editor.ml | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 374bc6795..57f1fd9da 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -62,12 +62,21 @@ let set_string_translations () = Manip.setInnerHtml (find_component id) text) translations +let changed = ref false + let activate_before_unload () :unit = - Js.Unsafe.js_expr - "window.onbeforeunload = function() {return 'You have unsaved changes!';}" - + if not !changed then + begin + changed := true; + Js.Unsafe.js_expr + "window.onbeforeunload = function() {return 'You have unsaved changes!';}" + end let unable_before_unload () :unit = - Js.Unsafe.js_expr "window.onbeforeunload = null" + if !changed then + begin + changed := false; + Js.Unsafe.js_expr "window.onbeforeunload = null" + end let onchange ace_list = let add_change_listener ace = @@ -400,7 +409,7 @@ let () = Lwt.return () end ; begin editor_button - ~icon: "download" [%i"Download"] @@ fun () -> + ~icon: "download" [%i"Save & Download"] @@ fun () -> recovering () ; Editor_io.download id; Lwt.return () @@ -446,7 +455,6 @@ let () = begin toolbar_button ~icon: "upload" [%i"Experiment"] @@ fun ()-> - recovering (); Dom_html.window##.location##assign (Js.string ("exercise.html#id=." ^ id)); Lwt.return_unit @@ -511,10 +519,10 @@ let () = typecheck_editor () in begin toolbar_button ~icon: "reload" [%i"Grade!"] @@ fun () -> - recovering (); grade () end ; onchange [ace_temp; ace_t; ace_prep; ace_prel; ace_quest; ace ]; + (* ---- return -------------------------------------------------------- *) (* toplevel_launch >>= fun _ -> should be unnecessary? *) (* typecheck false >>= fun () -> *) @@ -525,3 +533,12 @@ let () = Lwt.return () in Lwt.return ();; + +(* Temporary workaround; could be done without the sleep *) +let () = Lwt.async @@ + fun () -> + Lwt_js.sleep 5. >>= + fun () -> + changed:=true; + unable_before_unload (); + Lwt.return (); From 5d58ab50789f257f42b5dce3d5b133ee4384d612 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 15:18:16 +0200 Subject: [PATCH 22/91] refactor : remove useless template generation when generating the test code --- src/editor/editor.ml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 57f1fd9da..e0de4935e 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -318,9 +318,7 @@ let () = begin test_button ~group: toplevel_buttons_group ~icon: "sync" [%i"Generate"] @@ fun () -> - let sol = genTemplate (Ace.get_contents ace) in - if sol<>"" then - begin + disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) >>= fun () -> Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= @@ -334,8 +332,6 @@ let () = Lwt.return_unit end else (select_tab "toplevel" ; Lwt.return ()) - end - else Lwt.return (); end; let typecheck_testml () = @@ -518,8 +514,9 @@ let () = hide_loading ~id:"learnocaml-exo-loading" () ; typecheck_editor () in begin toolbar_button - ~icon: "reload" [%i"Grade!"] @@ fun () -> - grade () + ~icon: "reload" [%i"Save & Grade!"] @@ fun () -> + recovering (); + grade (); end ; onchange [ace_temp; ace_t; ace_prep; ace_prel; ace_quest; ace ]; From 3b115d1a69addb0a6e0842aa2817bf1801f914f8 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 15:53:58 +0200 Subject: [PATCH 23/91] fix : add more expressive message when is an error in the authors field --- src/editor/editor.ml | 2 +- src/editor/new_exercise.ml | 11 ++++++++--- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index e0de4935e..734ba2d92 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -514,7 +514,7 @@ let () = hide_loading ~id:"learnocaml-exo-loading" () ; typecheck_editor () in begin toolbar_button - ~icon: "reload" [%i"Save & Grade!"] @@ fun () -> + ~icon: "reload" [%i"Save&Grade!"] @@ fun () -> recovering (); grade (); end ; diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index 5a6b696ee..d134c6ba9 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -111,8 +111,10 @@ let _ = match previous_state with "" state.metadata.author) in - authors_input##.value := - Js.string (String.sub s 0 (String.length s - 2)); + authors_input##.value := + if s="" then Js.string "" + else + Js.string (String.sub s 0 (String.length s - 2)); required_input##.value := Js.string (string_with_spaces @@ -166,6 +168,9 @@ let _ = and backward = string_parser (Js.to_string backward_input##.value) and forward = string_parser (Js.to_string forward_input##.value) and authors= + if String.trim (Js.to_string authors_input##.value) = "" then + [] + else Regexp.split (Regexp.regexp ";") (Js.to_string authors_input##.value) @@ -177,7 +182,7 @@ let _ = with a::b::[]->(a,b) | _ -> - Dom_html.window##alert (Js.string "Syntax error"); + Dom_html.window##alert (Js.string "Incorrect value for the authors field"); failwith "bad syntax" in From ff7e53cbaba965efc14a4a0f0f02205584014499 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 16:27:28 +0200 Subject: [PATCH 24/91] feat : add id display in exercise list --- src/editor/learnocaml_editor_tab.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 325c34335..8a274b803 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -108,6 +108,8 @@ let editor_tab _ _ () = | None -> pcdata [%i"No description available."] | Some text -> pcdata text ] ; ] ; + div ~a:[ a_class [ "time-left" ] ] [pcdata ("id: " ^ editor_sate.exercise.id ) ]; + div ~a:[a_class["stats"]] [ div ~a:[ a_class [ "stars" ] ] [ let num = 5 * int_of_float (editor_sate.metadata.stars*. 2.) in From 9581acedd4e2819c53d08c6fa60a85de69190fcd Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 22 Jul 2019 16:26:59 +0200 Subject: [PATCH 25/91] refactor: Simplify the code of genTemplate * Rely on Editor_lib.extract_functions --- src/editor/editor.ml | 21 ++++--- src/editor/editor_lib.ml | 122 +++++++------------------------------- src/editor/editor_lib.mli | 19 +++--- src/editor/test_spec.ml | 11 ++++ 4 files changed, 53 insertions(+), 120 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 734ba2d92..6a43be4ae 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -26,8 +26,7 @@ module H = Tyxml_js.Html let init_tabs, select_tab = mk_tab_handlers "question" [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; "prelude" ; "prepare" ] - - + let set_string_translations () = let translations = [ "txt_preparing", [%i"Preparing the environment"]; @@ -318,7 +317,6 @@ let () = begin test_button ~group: toplevel_buttons_group ~icon: "sync" [%i"Generate"] @@ fun () -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) >>= fun () -> Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= @@ -355,24 +353,25 @@ let () = Ace.set_contents ace_temp contents ; Ace.set_font_size ace_temp 18; + let set_temp_tab () = + genTemplate top ~on_err:(fun () -> select_tab "toplevel") + (Ace.get_contents ace) >>= fun template -> + (Ace.set_contents ace_temp template; Lwt.return ()) in begin template_button ~icon: "sync" [%i"Gen. template"] @@ fun () -> if (Ace.get_contents ace_temp) = "" then - Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ) + set_temp_tab () else begin Learnocaml_common.confirm ~title:"Confirmation" ~ok_label:"Yes" [ H.p [H.pcdata "Do you want to crush the template?\n"] ] - (fun () -> - Ace.set_contents ace_temp - (genTemplate (Ace.get_contents ace)); - hide_loading ~id:"learnocaml-exo-loading" ()); - end ; - Lwt.return(); + (fun () -> Lwt.async set_temp_tab); + Lwt.return () + end; end; - + let typecheck_template () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 116b15c6c..51cf1f82f 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -254,95 +254,23 @@ let monomorph_generator l = list_mono) |> List.flatten -(* ____Functions for generate template______________________________________ *) +(* ____Functions for "GenTemplate" feature__________________________________ *) -(* TODO: Refactor and delete concatenation that involves type (char list) *) - -let string_of_char ch = String.make 1 ch - -let rec concatenation listech = match listech with - | [] -> "" - | c :: l -> (string_of_char c) ^ (concatenation l) - -let rec decompositionSol str n = - if str = "" then [] - else if n + 1 = String.length str then [(str.[n])] - else (str.[n])::(decompositionSol str (n+1)) - -let failchar = - decompositionSol {| - "Change this string for you code." - - |} 0 - -let tail l = match l with - | [] -> [] - | e :: l -> l - -let rec commentaire listech cpt = match listech with - | [] -> [] - | '*'::')'::l -> if cpt = 0 then l else commentaire l (cpt - 1) - | '('::'*'::l -> commentaire l (cpt + 1) - | c::l -> commentaire l cpt - -let rec premierLet listech = match listech with - | [] -> [] - | '('::'*'::l -> premierLet (commentaire l 0) - | c::'l'::'e'::'t'::' '::l -> - if c = '\n' || c = ' ' then ('l'::'e'::'t'::' '::l) else premierLet l - | 'l'::'e'::'t'::' '::l -> 'l'::'e'::'t'::' '::l - | ' '::l -> premierLet l - | '\n'::l -> premierLet l - | _ -> [] - -let rec validationLet listech = match listech with - | [] -> false - | ' '::l -> validationLet l - | '\n'::l -> validationLet l - | '('::l -> validationLet l - | 'l'::'e'::'t'::l -> false - | _ -> true - -let rec rechercheEgal listech = match listech with - | [] -> 0 - | '='::l -> 1 - | ' '::'l'::'e'::'t'::' '::l -> 2 - | '\n'::'l'::'e'::'t'::' '::l -> 2 - | c::l -> rechercheEgal l - -let rec rechercheLet listech b = match listech with - | [] -> [] - | '('::'*'::l -> rechercheLet (commentaire l 0) b - | ';'::';'::l -> rechercheLet l true - | '='::l -> rechercheLet l (validationLet l) - | _::'t'::'h'::'e'::'n'::_::l -> rechercheLet l (validationLet l) - | _::'e'::'l'::'s'::'e'::_::l -> rechercheLet l (validationLet l) - | _::'i'::'n'::_::l -> rechercheLet l (validationLet l) - | '-'::'>'::l -> rechercheLet l (validationLet l) - | 'l'::'e'::'t'::' '::l -> - if b && (rechercheEgal l) = 1 then 'l'::'e'::'t'::' '::l - else if (rechercheEgal l) = 0 then rechercheLet l false - else rechercheLet l true - | c::suite -> rechercheLet suite b - -let rec decomposition2 listech = match listech with - | [] -> [] - | '='::l -> ['='] - | c::l -> c :: (decomposition2 l) - -let decompoFirst listech = match listech with - | []-> [] - | _ -> (decomposition2 listech) @ failchar - -let rec genLet listech = - let liste = rechercheLet listech true in - match liste with - | [] -> [] - | _ -> (decomposition2 liste) @ failchar @ (genLet (tail liste)) +let get_answer top = + Learnocaml_toplevel.execute_test top -let genTemplate chaine = - if chaine = "" then "" - else concatenation (genLet (decompositionSol chaine 0)) +let genTemplate top ?(on_err = fun () -> ()) sol = + Learnocaml_toplevel.reset top >>= fun () -> + Learnocaml_toplevel.execute_phrase top sol >>= + fun ok -> + if ok then + let list_f_ty = extract_functions (get_answer top) in + let result = + List.fold_right (fun (f, _ty) r -> + Format.sprintf {|let %s =@. "Replace this string with you code."@.@.|} f ^ r) + list_f_ty "" + in Lwt.return result + else Lwt.return (let () = on_err () in "") (* ---- create an exo ------------------------------------------------------- *) let exo_creator proper_id = @@ -365,9 +293,6 @@ let exo_creator proper_id = ~decipher:false () -let get_answer top = - Learnocaml_toplevel.execute_test top - (* TODO look for the record type of res to make the message more understandable *) let typecheck_dialog_box div_id res = let result,ok = @@ -488,24 +413,24 @@ module Editor_io = struct ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; result_t + (* Return true if the ID and the title is unique *) + (* FIXME: refactor this as the handling of IDs has changed *) let upload_new_exercise id to_save = let to_save = put_exercise_id id to_save in let open Exercise.Meta in - let result= idUnique id && titleUnique to_save.metadata.title in - if result then - update_index to_save; - result - + let result = idUnique id && titleUnique to_save.metadata.title in + if result then update_index to_save; + result + let upload () = run_async_with_log (fun () -> upload_file () >>= fun file -> - let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in + let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in let callback = (fun text -> - SMap.iter (fun id editor_state -> if not (upload_new_exercise id editor_state) then @@ -520,6 +445,5 @@ module Editor_io = struct Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; Js.Unsafe.inject callback|] - in Lwt.return_unit) - + in Lwt.return_unit) end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index a11f2f9db..0a7ec21e4 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -36,7 +36,7 @@ val idUnique : string -> bool (** @return a bool depending on whether the title is already used or not *) val titleUnique : string -> bool -val new_state : Exercise.Meta.t -> editor_state +val new_state : Exercise.Meta.t -> editor_state (** arguments Dom element , string *) val setInnerHtml : < innerHTML : < set : Js.js_string Js.t -> unit; .. > Js_of_ocaml.Js.gen_prop; .. > Js_of_ocaml.Js.t -> string -> unit @@ -49,8 +49,6 @@ val init : string * @param name_of_the_function associated_report *) val section : string -> string -> string -val string_of_char : char -> string - (* TODO: Remove commented code (** @param content_of_the_toplevel [[]] * @return a list @@ -68,9 +66,6 @@ val get_only_fct : char list -> char list -> char list val get_questions : char list list -> (string * string) list -> (string * string) list *) -(** Create the corresponding char list of a string (second parameter must be 0) *) -val decompositionSol : string -> int -> char list - (* (** Create a list of triples (key, alea, "monorphic type"): polymorph_detector [("f", "'a -> 'b"); ("p", "int -> int")] = @@ -78,8 +73,12 @@ val decompositionSol : string -> int -> char list val polymorph_detector : ('a * string) list -> ('a * int * string) list *) -(** Create the template of the solution *) -val genTemplate : string -> string +(** [genTemplate top ?(on_err=fun()->()) sol]: + evaluate the solution [sol] using the toplevel [top], + generate then return a template string. + Run also [on_err] if there is a typecheck error. *) +val genTemplate : + Learnocaml_toplevel.t -> ?on_err:(unit -> unit) -> string -> string Lwt.t (** [typecheck set_class ace editor top prelprep ?(mock=false) ?onpasterr code]: check if [code] (taken from buffer [ace, editor], with [prelprep] @@ -112,10 +111,10 @@ val monomorph_generator : (string * string) list -> Editor.test_qst_untyped list val show_load : Html_types.text Tyxml_js.Html.wrap -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt Tyxml_js.Html.list_wrap -> -unit +unit module Editor_io : sig val download : Learnocaml_data.SMap.key -> unit val upload : unit -> unit val download_all : unit -> unit -end +end diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index a32162bf5..2d1f64cda 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -11,6 +11,8 @@ open Editor_lib +let string_of_char ch = String.make 1 ch + let rec to_string_aux char_list =match char_list with | []-> "" | c::l -> (string_of_char c) ^ ( to_string_aux l) @@ -19,6 +21,15 @@ let rec to_string_aux char_list =match char_list with This should be fix so that the space comes from [to_ty] itself. *) let to_ty str = "[%ty:" ^ str ^ "]" +let rec concatenation listech = match listech with + | [] -> "" + | c :: l -> (string_of_char c) ^ (concatenation l) + +let rec decompositionSol str n = + if str = "" then [] + else if n + 1 = String.length str then [(str.[n])] + else (str.[n])::(decompositionSol str (n+1)) + let parse_type string = let char_list_ref = ref (List.rev (decompositionSol string 0)) in let para_cpt =ref 0 in From 75bf8945d924f4eaf9dc46f354e3d42936062b33 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 18:00:04 +0200 Subject: [PATCH 26/91] refactor : simplify the id handling in Editor_io.upload --- src/editor/editor_lib.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 51cf1f82f..e73bb3edf 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -414,9 +414,9 @@ module Editor_io = struct result_t (* Return true if the ID and the title is unique *) - (* FIXME: refactor this as the handling of IDs has changed *) - let upload_new_exercise id to_save = - let to_save = put_exercise_id id to_save + let upload_new_exercise to_save = + let id = to_save.exercise.id in + let to_save = put_exercise_id id to_save (* to put the id in metadata too *) in let open Exercise.Meta in let result = idUnique id && titleUnique to_save.metadata.title in @@ -433,7 +433,7 @@ module Editor_io = struct (fun text -> SMap.iter (fun id editor_state -> - if not (upload_new_exercise id editor_state) then + if not (upload_new_exercise editor_state) then alert ([%i"Identifier and/or title not unique\n"] ^ "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title)) (Json_repr_browser.Json_encoding.destruct From 09cd3cb3d9cfe0de6d0f1be4cd1f5a46d369e636 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 09:52:23 +0200 Subject: [PATCH 27/91] feat : Add override all option when importing --- src/editor/editor_lib.ml | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index e73bb3edf..ffbac62dd 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -413,15 +413,6 @@ module Editor_io = struct ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; result_t - (* Return true if the ID and the title is unique *) - let upload_new_exercise to_save = - let id = to_save.exercise.id in - let to_save = put_exercise_id id to_save (* to put the id in metadata too *) - in - let open Exercise.Meta in - let result = idUnique id && titleUnique to_save.metadata.title in - if result then update_index to_save; - result let upload () = run_async_with_log @@ -429,13 +420,23 @@ module Editor_io = struct upload_file () >>= fun file -> let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in + let override_all = Js_utils.confirm "Do you want to override all?" in let callback = (fun text -> SMap.iter (fun id editor_state -> - if not (upload_new_exercise editor_state) then - alert ([%i"Identifier and/or title not unique\n"] ^ - "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title)) + let editor_state = put_exercise_id id editor_state in (* update metadata.id *) + if (not (idUnique id && titleUnique id)) && not override_all then + let override = Js_utils.confirm + ([%i"Identifier and/or title not unique\n"] ^ + "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title ^ + "\n Do you want to override?") + in + if override then + update_index editor_state; + else + update_index editor_state + ) (Json_repr_browser.Json_encoding.destruct (SMap.enc editor_state_enc) (Js._JSON##(parse text))); From f59835c64de8c4d9ec188a5472635def3429dcab Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 10:13:29 +0200 Subject: [PATCH 28/91] fix(localStorage.clear) : Temporary workaround : keeping learnocaml index in localStorage when clearing the localStorage This makes the editor-index persist when changing tokens --- src/app/learnocaml_index_main.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 0dd3f250e..978b67e18 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -803,8 +803,10 @@ let () = H.div ~a:[H.a_style "text-align: center;"] [token_disp_div (get_stored_token ())]] (fun () -> - Lwt.async @@ fun () -> + Lwt.async @@ fun () -> + let index = Learnocaml_local_storage.(retrieve editor_index) in Learnocaml_local_storage.clear (); + Learnocaml_local_storage.(store editor_index index); reload (); Lwt.return_unit) in From d81f3d6825d9780d8cc90ecb8b07824d6cf74645 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 12:14:19 +0200 Subject: [PATCH 29/91] feat : Add the possibility to import an exercise even with missing files also make the import more robust, if the exercise folder contains another folders there is no problem --- src/editor/editor_lib.ml | 2 +- static/js/jszip/learnocaml_jszip_wrapper.js | 33 ++++++++++++++------- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index ffbac62dd..6d9f994b2 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -446,5 +446,5 @@ module Editor_io = struct Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; Js.Unsafe.inject callback|] - in Lwt.return_unit) + in Lwt.return_unit) end diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index 3ccdee131..e46296562 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -43,15 +43,22 @@ function editor_download_all(brut_exercises, brut_index, callback) { }).then(function(blob) { callback(blob) }); } +function editor_read_file(loaded_zip, file) { + if (loaded_zip.file(file)) + return loaded_zip.file(file).async("string") + else + return Promise.resolve(""); +} + function editor_read_exercise(loaded_zip, path, id) { return new Promise(function(resolve, reject) { - var descr = loaded_zip.file(path + "descr.md").async("string"); - var meta = loaded_zip.file(path + "meta.json").async("string"); - var prelude = loaded_zip.file(path + "prelude.ml").async("string"); - var prepare = loaded_zip.file(path + "prepare.ml").async("string"); - var template = loaded_zip.file(path + "template.ml").async("string"); - var test = loaded_zip.file(path + "test.ml").async("string"); - var solution = loaded_zip.file(path + "solution.ml").async("string"); + var descr = editor_read_file(loaded_zip, path + "descr.md"); + var meta = editor_read_file(loaded_zip, path + "meta.json"); + var prelude = editor_read_file(loaded_zip, path + "prelude.ml"); + var prepare = editor_read_file(loaded_zip, path + "prepare.ml"); + var template = editor_read_file(loaded_zip, path + "template.ml"); + var test = editor_read_file(loaded_zip, path + "test.ml"); + var solution = editor_read_file(loaded_zip, path + "solution.ml"); Promise.all([descr, meta, prelude, prepare, template, test, solution]) .then(function(values) { var result = { exercise: {}, metadata: {} }; @@ -60,6 +67,7 @@ function editor_read_exercise(loaded_zip, path, id) { result.exercise.descr = values[0]; var brut_meta = values[1]; var meta = brut_meta.replace(/\r?\n|\r/g, " "); + if (meta == "") meta = "{}"; result.metadata = JSON.parse(meta); result.exercise.prelude = values[2]; result.exercise.prepare = values[3]; @@ -79,10 +87,14 @@ function editor_import(brut_data, callback) { var promises = []; loaded_zip.forEach(function(relative_path, file) { if (file.dir) { - var promise = editor_read_exercise(loaded_zip, relative_path, file.name.replace(/\//, "")); - promises.push(promise); + var slash_regex = /\//g; + var depth = file.name.match(slash_regex).length; + if (depth == 1) { + var promise = editor_read_exercise(loaded_zip, relative_path, file.name.replace(/\//, "")); + promises.push(promise); + } } - }) + }); Promise.all(promises).then(function(values) { var result = values.reduce(function(acc, elt) { acc[elt.exercise.id] = elt; @@ -90,6 +102,5 @@ function editor_import(brut_data, callback) { }, {}) callback(JSON.stringify(result)); }) - }); } \ No newline at end of file From 5add660a82acb3b2f5f12dc2e1001592a9df1ba7 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 12:26:57 +0200 Subject: [PATCH 30/91] fix (new_exercise.ml) : restoring the information of fields when they are empty is ok --- src/editor/new_exercise.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index d134c6ba9..f5cab0a86 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -54,7 +54,10 @@ let string_with_spaces list= "" list in - String.sub s 1 (String.length s - 1 ) + if s="" then + "" + else + String.sub s 1 (String.length s - 1 ) let resultOptionToBool = function | None -> false @@ -94,7 +97,7 @@ let difficulty_select = let backward_input =get (getElementById_coerce "backward" CoerceTo.input) let forward_input = get (getElementById_coerce "forward" CoerceTo.input) -let previous_state = +let previous_state = match get_editor_state previous_id with | exception Not_found -> None | state->Some state @@ -115,7 +118,7 @@ let _ = match previous_state with if s="" then Js.string "" else Js.string (String.sub s 0 (String.length s - 2)); - + required_input##.value := Js.string (string_with_spaces state.metadata.requirements); From bebd99cee6cb7c6a50541c0afd7294347efcef4d Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 23 Jul 2019 13:26:45 +0200 Subject: [PATCH 31/91] feat: Improve "Generate" to group questions about the same function * Change the type of monomorph_generator and Test_spec.{question_typed,compile} * Add documentation for gen1, gen2 --- src/editor/editor.ml | 3 +- src/editor/editor_lib.ml | 34 +++++++++++++++------- src/editor/editor_lib.mli | 4 +-- src/editor/test_spec.ml | 60 ++++++++++++++++++++++++++------------- src/editor/test_spec.mli | 10 ++++--- 5 files changed, 73 insertions(+), 38 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 6a43be4ae..ee3954f69 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -324,8 +324,7 @@ let () = if ok then begin let questions = monomorph_generator (extract_functions (get_answer top)) in - let indexed_list= List.mapi (fun i elt -> (i,elt)) questions in - let string = compile indexed_list in + let string = compile questions in Ace.set_contents ace_t string; Lwt.return_unit end diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 6d9f994b2..34d7e7ec4 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -197,7 +197,7 @@ let rec undup_assoc = function even if it is defined before the non-function expression. *) let extract_functions s = (* Remove module/module_types as their signature could contain val items *) - let s = Regexp.(global_replace (regexp "module type\\\s\\w+\\s=\\ssig\\s[^]+?\\send\\s*") s "") in + let s = Regexp.(global_replace (regexp "module type\\s\\w+\\s=\\ssig\\s[^]+?\\send\\s*") s "") in let s = Regexp.(global_replace (regexp "module type\\s\\w+\\s=\\s\\w+\\s*") s "") in let s = Regexp.(global_replace (regexp "module\\s\\w+\\s:\\ssig\\s[^]+?\\send\\s*") s "") in let s = Regexp.(global_replace (regexp "module\\s\\w+\\s:\\s\\w+\\s*") s "") in @@ -226,6 +226,22 @@ let replace_all map s = Regexp.(global_replace (regexp_string e) res by)) s map +(* [gen1] and [gen2] are helper functions devised to generate for each + polymorphic function, two monomorphic testcases. + + Properties: + * forall i, gen1 i \in base + * forall i, gen1 i <> gen2 i + * forall i, j \in [[0, 11]], i <> j -> (gen1 i, gen2 i) <> (gen1 j, gen2 j) + + List.map gen1 [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11] + = ["int"; "bool"; "char"; "string"; "int"; "bool"; "char"; "string"; + "int"; "bool"; "char"; "string"] + + List.map gen2 [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11] + = ["bool"; "int"; "bool"; "bool"; "char"; "char"; "int"; "char"; + "string"; "string"; "string"; "int"] + *) let base = ["int"; "bool"; "char"; "string"] let gen1 i = List.nth base (i mod 4) let gen2 i = @@ -244,15 +260,13 @@ let monomorph_generator l = and t2 = replace_all (List.mapi (fun i e -> (e, gen2 i)) vars) ty in [(5, t1); (5, t2)] in - List.map (fun (func, ty) -> (func, f ty)) l - |> List.map (fun (name, list_mono) -> - List.fold_left (fun acc (gen, ty) -> - TestAgainstSol - {name; ty; suite = "[]"; gen; - tester = ""; sampler = ""}::acc) - [] - list_mono) - |> List.flatten + List.map (fun (name, ty) -> + let list_mono = f ty in + let list_qst = List.map (fun (gen, mono_ty) -> + TestAgainstSol {name; ty = mono_ty; suite = "[]"; gen; + tester = ""; sampler = ""}) + list_mono + in (name, list_qst)) l (* ____Functions for "GenTemplate" feature__________________________________ *) diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index 0a7ec21e4..7f9e4b856 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -106,8 +106,8 @@ val typecheck_dialog_box : string-> 'a Toploop_results.toplevel_result -> unit L val extract_functions : string -> (string * string) list (** Generate monomorphic test specifications - @return a list of ("function_name", [(alea, "monomorphic type")]) *) -val monomorph_generator : (string * string) list -> Editor.test_qst_untyped list + @return a list of ("function_name", list_of_monomorphic_test_cases) *) +val monomorph_generator : (string * string) list -> (string * Editor.test_qst_untyped list) list val show_load : Html_types.text Tyxml_js.Html.wrap -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt Tyxml_js.Html.list_wrap -> diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 2d1f64cda..06a871a6f 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -80,7 +80,7 @@ let parse_type string = !acc;; (* The tester arg could take into account exceptions/sorted lists/etc. *) -let question_typed question id_question = +let question_typed ?num question = let open Learnocaml_data.Editor in let opt_string param = function | "" -> "" @@ -89,6 +89,7 @@ let question_typed question id_question = | "" -> "" | f -> Format.sprintf "fun () -> last ((%s) ())" f in + let suffix = match num with None -> "" | Some n -> "_" ^ string_of_int n in match question with | TestAgainstSpec a -> (* FIXME *) @@ -97,12 +98,13 @@ let question_typed question id_question = | TestSuite a -> let name, prot, tester, suite = a.name, parse_type a.ty, opt_string "test" a.tester, a.suite in - Format.sprintf "let question%d =@. \ + (* Naming convention: [q_name], [q_name1; q_name2] (occurrence 1/3) *) + Format.sprintf "let q_%s%s =@. \ let prot = %s in@. \ test_function%s prot@. \ (lookup_student (ty_of_prot prot) %s)@. \ %s;;@." - id_question prot tester name suite + name suffix prot tester name suite | TestAgainstSol a -> let name = a.name and prot = parse_type a.ty @@ -111,12 +113,13 @@ let question_typed question id_question = and tester = opt_string "test" a.tester and suite = a.suite in - Format.sprintf "let question%d =@. \ + (* Naming convention: [q_name], [q_name1; q_name2] (occurrence 2/3) *) + Format.sprintf "let q_%s%s =@. \ let prot = %s in@. \ test_function_against_solution ~gen:(%d)%s%s prot@. \ \"%s\"@. \ %s;;@." - id_question prot gen sampler tester name suite + name suffix prot gen sampler tester name suite (*****************) (* compile stuff *) @@ -291,18 +294,35 @@ let fonction = "" in fonction - let compile indexed_list = - let tests = test_prel ^ (ast_fonction true true) in - let tests = List.fold_left (fun acc (qid,quest) -> - acc ^ (question_typed quest qid)^" \n") - tests indexed_list in - let tests = tests ^ init ^ "[\n" ^ ast_code true true in - let tests = - List.fold_left (fun acc (qid, quest) -> - let name=match quest with - | TestAgainstSol a->a.name - | TestAgainstSpec a ->a.name - | TestSuite a -> a.name in - acc ^ (section name ("question" ^ string_of_int qid ) )) - tests indexed_list in - tests ^ " ]" +(* Naming convention: [q_name], [q_name1; q_name2] (occurrence 3/3) *) +(* [cat_question "foo" [42] = "q_foo"] + [cat_question "foo" [42; 42; 42] = "q_foo_1 @ q_foo_2 @ q_foo_3"] *) +let cat_question name list_qst = + match list_qst with + | [] -> invalid_arg "cat_question" + | [_] -> "q_" ^ name + | _q :: ((_ :: _) as l) -> + List.fold_left (fun (i, acc) _e -> + (i + 1, acc ^" @ q_"^ name ^ "_" ^ string_of_int i)) + (2, "q_" ^ name ^ "_1") l + |> snd + +let compile indexed_list = + let tests = test_prel ^ (ast_fonction true true) in + let tests = List.fold_left (fun acc (_name, list_qst) -> + acc ^ + if List.length list_qst > 1 then + List.fold_left (fun (i, acc) qst -> + (i + 1, acc ^ question_typed ~num:i qst ^" \n")) + (1, "") list_qst + |> snd + else List.fold_left (fun acc qst -> + acc ^ question_typed qst ^" \n") + "" list_qst) + tests indexed_list in + let tests = tests ^ init ^ "[\n" ^ ast_code true true in + let tests = + List.fold_left (fun acc (name, list_qst) -> + acc ^ section name (cat_question name list_qst)) + tests indexed_list in + tests ^ " ]" diff --git a/src/editor/test_spec.mli b/src/editor/test_spec.mli index ff438451a..b35c1c90a 100644 --- a/src/editor/test_spec.mli +++ b/src/editor/test_spec.mli @@ -9,8 +9,10 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -(** Allows typing a question passing by a string - * @param question_untyped id_question *) -val question_typed : Learnocaml_data.Editor.test_qst_untyped -> int -> string +(** [question_typed] is used by [compile] + @return the compiled string of a single question *) +val question_typed : ?num:int -> Learnocaml_data.Editor.test_qst_untyped -> string -val compile : (int * Learnocaml_data.Editor.test_qst_untyped) list -> string +(** [compile] is used by the "Generate" feature of the test.ml tab + @return the compiled string of all given questions *) +val compile : (string * Learnocaml_data.Editor.test_qst_untyped list) list -> string From df4dd5c057f37f27367aba102838ba6208446f40 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 15:53:58 +0200 Subject: [PATCH 32/91] fix: Add more helpful message when there's an error in field authors --- src/editor/editor.ml | 2 +- src/editor/new_exercise.ml | 11 ++++++++--- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index e0de4935e..734ba2d92 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -514,7 +514,7 @@ let () = hide_loading ~id:"learnocaml-exo-loading" () ; typecheck_editor () in begin toolbar_button - ~icon: "reload" [%i"Save & Grade!"] @@ fun () -> + ~icon: "reload" [%i"Save&Grade!"] @@ fun () -> recovering (); grade (); end ; diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index 5a6b696ee..d134c6ba9 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -111,8 +111,10 @@ let _ = match previous_state with "" state.metadata.author) in - authors_input##.value := - Js.string (String.sub s 0 (String.length s - 2)); + authors_input##.value := + if s="" then Js.string "" + else + Js.string (String.sub s 0 (String.length s - 2)); required_input##.value := Js.string (string_with_spaces @@ -166,6 +168,9 @@ let _ = and backward = string_parser (Js.to_string backward_input##.value) and forward = string_parser (Js.to_string forward_input##.value) and authors= + if String.trim (Js.to_string authors_input##.value) = "" then + [] + else Regexp.split (Regexp.regexp ";") (Js.to_string authors_input##.value) @@ -177,7 +182,7 @@ let _ = with a::b::[]->(a,b) | _ -> - Dom_html.window##alert (Js.string "Syntax error"); + Dom_html.window##alert (Js.string "Incorrect value for the authors field"); failwith "bad syntax" in From 04005b0ba804adbd756988105ef16c9355f0cb0c Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 16:27:28 +0200 Subject: [PATCH 33/91] feat: add id display in exercise list --- src/editor/learnocaml_editor_tab.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 325c34335..8a274b803 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -108,6 +108,8 @@ let editor_tab _ _ () = | None -> pcdata [%i"No description available."] | Some text -> pcdata text ] ; ] ; + div ~a:[ a_class [ "time-left" ] ] [pcdata ("id: " ^ editor_sate.exercise.id ) ]; + div ~a:[a_class["stats"]] [ div ~a:[ a_class [ "stars" ] ] [ let num = 5 * int_of_float (editor_sate.metadata.stars*. 2.) in From cef5c93675eeb1a47183a965f39f17cd67bfc223 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 22 Jul 2019 16:26:59 +0200 Subject: [PATCH 34/91] refactor: Simplify the code of genTemplate * Rely on Editor_lib.extract_functions --- src/editor/editor.ml | 21 ++++--- src/editor/editor_lib.ml | 122 +++++++------------------------------- src/editor/editor_lib.mli | 19 +++--- src/editor/test_spec.ml | 11 ++++ 4 files changed, 53 insertions(+), 120 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 734ba2d92..6a43be4ae 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -26,8 +26,7 @@ module H = Tyxml_js.Html let init_tabs, select_tab = mk_tab_handlers "question" [ "toplevel" ; "report" ; "editor" ; "template" ; "test" ; "prelude" ; "prepare" ] - - + let set_string_translations () = let translations = [ "txt_preparing", [%i"Preparing the environment"]; @@ -318,7 +317,6 @@ let () = begin test_button ~group: toplevel_buttons_group ~icon: "sync" [%i"Generate"] @@ fun () -> - disabling_button_group toplevel_buttons_group (fun () -> Learnocaml_toplevel.reset top) >>= fun () -> Learnocaml_toplevel.execute_phrase top (Ace.get_contents ace) >>= @@ -355,24 +353,25 @@ let () = Ace.set_contents ace_temp contents ; Ace.set_font_size ace_temp 18; + let set_temp_tab () = + genTemplate top ~on_err:(fun () -> select_tab "toplevel") + (Ace.get_contents ace) >>= fun template -> + (Ace.set_contents ace_temp template; Lwt.return ()) in begin template_button ~icon: "sync" [%i"Gen. template"] @@ fun () -> if (Ace.get_contents ace_temp) = "" then - Ace.set_contents ace_temp (genTemplate (Ace.get_contents ace) ) + set_temp_tab () else begin Learnocaml_common.confirm ~title:"Confirmation" ~ok_label:"Yes" [ H.p [H.pcdata "Do you want to crush the template?\n"] ] - (fun () -> - Ace.set_contents ace_temp - (genTemplate (Ace.get_contents ace)); - hide_loading ~id:"learnocaml-exo-loading" ()); - end ; - Lwt.return(); + (fun () -> Lwt.async set_temp_tab); + Lwt.return () + end; end; - + let typecheck_template () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 116b15c6c..51cf1f82f 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -254,95 +254,23 @@ let monomorph_generator l = list_mono) |> List.flatten -(* ____Functions for generate template______________________________________ *) +(* ____Functions for "GenTemplate" feature__________________________________ *) -(* TODO: Refactor and delete concatenation that involves type (char list) *) - -let string_of_char ch = String.make 1 ch - -let rec concatenation listech = match listech with - | [] -> "" - | c :: l -> (string_of_char c) ^ (concatenation l) - -let rec decompositionSol str n = - if str = "" then [] - else if n + 1 = String.length str then [(str.[n])] - else (str.[n])::(decompositionSol str (n+1)) - -let failchar = - decompositionSol {| - "Change this string for you code." - - |} 0 - -let tail l = match l with - | [] -> [] - | e :: l -> l - -let rec commentaire listech cpt = match listech with - | [] -> [] - | '*'::')'::l -> if cpt = 0 then l else commentaire l (cpt - 1) - | '('::'*'::l -> commentaire l (cpt + 1) - | c::l -> commentaire l cpt - -let rec premierLet listech = match listech with - | [] -> [] - | '('::'*'::l -> premierLet (commentaire l 0) - | c::'l'::'e'::'t'::' '::l -> - if c = '\n' || c = ' ' then ('l'::'e'::'t'::' '::l) else premierLet l - | 'l'::'e'::'t'::' '::l -> 'l'::'e'::'t'::' '::l - | ' '::l -> premierLet l - | '\n'::l -> premierLet l - | _ -> [] - -let rec validationLet listech = match listech with - | [] -> false - | ' '::l -> validationLet l - | '\n'::l -> validationLet l - | '('::l -> validationLet l - | 'l'::'e'::'t'::l -> false - | _ -> true - -let rec rechercheEgal listech = match listech with - | [] -> 0 - | '='::l -> 1 - | ' '::'l'::'e'::'t'::' '::l -> 2 - | '\n'::'l'::'e'::'t'::' '::l -> 2 - | c::l -> rechercheEgal l - -let rec rechercheLet listech b = match listech with - | [] -> [] - | '('::'*'::l -> rechercheLet (commentaire l 0) b - | ';'::';'::l -> rechercheLet l true - | '='::l -> rechercheLet l (validationLet l) - | _::'t'::'h'::'e'::'n'::_::l -> rechercheLet l (validationLet l) - | _::'e'::'l'::'s'::'e'::_::l -> rechercheLet l (validationLet l) - | _::'i'::'n'::_::l -> rechercheLet l (validationLet l) - | '-'::'>'::l -> rechercheLet l (validationLet l) - | 'l'::'e'::'t'::' '::l -> - if b && (rechercheEgal l) = 1 then 'l'::'e'::'t'::' '::l - else if (rechercheEgal l) = 0 then rechercheLet l false - else rechercheLet l true - | c::suite -> rechercheLet suite b - -let rec decomposition2 listech = match listech with - | [] -> [] - | '='::l -> ['='] - | c::l -> c :: (decomposition2 l) - -let decompoFirst listech = match listech with - | []-> [] - | _ -> (decomposition2 listech) @ failchar - -let rec genLet listech = - let liste = rechercheLet listech true in - match liste with - | [] -> [] - | _ -> (decomposition2 liste) @ failchar @ (genLet (tail liste)) +let get_answer top = + Learnocaml_toplevel.execute_test top -let genTemplate chaine = - if chaine = "" then "" - else concatenation (genLet (decompositionSol chaine 0)) +let genTemplate top ?(on_err = fun () -> ()) sol = + Learnocaml_toplevel.reset top >>= fun () -> + Learnocaml_toplevel.execute_phrase top sol >>= + fun ok -> + if ok then + let list_f_ty = extract_functions (get_answer top) in + let result = + List.fold_right (fun (f, _ty) r -> + Format.sprintf {|let %s =@. "Replace this string with you code."@.@.|} f ^ r) + list_f_ty "" + in Lwt.return result + else Lwt.return (let () = on_err () in "") (* ---- create an exo ------------------------------------------------------- *) let exo_creator proper_id = @@ -365,9 +293,6 @@ let exo_creator proper_id = ~decipher:false () -let get_answer top = - Learnocaml_toplevel.execute_test top - (* TODO look for the record type of res to make the message more understandable *) let typecheck_dialog_box div_id res = let result,ok = @@ -488,24 +413,24 @@ module Editor_io = struct ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; result_t + (* Return true if the ID and the title is unique *) + (* FIXME: refactor this as the handling of IDs has changed *) let upload_new_exercise id to_save = let to_save = put_exercise_id id to_save in let open Exercise.Meta in - let result= idUnique id && titleUnique to_save.metadata.title in - if result then - update_index to_save; - result - + let result = idUnique id && titleUnique to_save.metadata.title in + if result then update_index to_save; + result + let upload () = run_async_with_log (fun () -> upload_file () >>= fun file -> - let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in + let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in let callback = (fun text -> - SMap.iter (fun id editor_state -> if not (upload_new_exercise id editor_state) then @@ -520,6 +445,5 @@ module Editor_io = struct Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; Js.Unsafe.inject callback|] - in Lwt.return_unit) - + in Lwt.return_unit) end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index a11f2f9db..0a7ec21e4 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -36,7 +36,7 @@ val idUnique : string -> bool (** @return a bool depending on whether the title is already used or not *) val titleUnique : string -> bool -val new_state : Exercise.Meta.t -> editor_state +val new_state : Exercise.Meta.t -> editor_state (** arguments Dom element , string *) val setInnerHtml : < innerHTML : < set : Js.js_string Js.t -> unit; .. > Js_of_ocaml.Js.gen_prop; .. > Js_of_ocaml.Js.t -> string -> unit @@ -49,8 +49,6 @@ val init : string * @param name_of_the_function associated_report *) val section : string -> string -> string -val string_of_char : char -> string - (* TODO: Remove commented code (** @param content_of_the_toplevel [[]] * @return a list @@ -68,9 +66,6 @@ val get_only_fct : char list -> char list -> char list val get_questions : char list list -> (string * string) list -> (string * string) list *) -(** Create the corresponding char list of a string (second parameter must be 0) *) -val decompositionSol : string -> int -> char list - (* (** Create a list of triples (key, alea, "monorphic type"): polymorph_detector [("f", "'a -> 'b"); ("p", "int -> int")] = @@ -78,8 +73,12 @@ val decompositionSol : string -> int -> char list val polymorph_detector : ('a * string) list -> ('a * int * string) list *) -(** Create the template of the solution *) -val genTemplate : string -> string +(** [genTemplate top ?(on_err=fun()->()) sol]: + evaluate the solution [sol] using the toplevel [top], + generate then return a template string. + Run also [on_err] if there is a typecheck error. *) +val genTemplate : + Learnocaml_toplevel.t -> ?on_err:(unit -> unit) -> string -> string Lwt.t (** [typecheck set_class ace editor top prelprep ?(mock=false) ?onpasterr code]: check if [code] (taken from buffer [ace, editor], with [prelprep] @@ -112,10 +111,10 @@ val monomorph_generator : (string * string) list -> Editor.test_qst_untyped list val show_load : Html_types.text Tyxml_js.Html.wrap -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt Tyxml_js.Html.list_wrap -> -unit +unit module Editor_io : sig val download : Learnocaml_data.SMap.key -> unit val upload : unit -> unit val download_all : unit -> unit -end +end diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index a32162bf5..2d1f64cda 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -11,6 +11,8 @@ open Editor_lib +let string_of_char ch = String.make 1 ch + let rec to_string_aux char_list =match char_list with | []-> "" | c::l -> (string_of_char c) ^ ( to_string_aux l) @@ -19,6 +21,15 @@ let rec to_string_aux char_list =match char_list with This should be fix so that the space comes from [to_ty] itself. *) let to_ty str = "[%ty:" ^ str ^ "]" +let rec concatenation listech = match listech with + | [] -> "" + | c :: l -> (string_of_char c) ^ (concatenation l) + +let rec decompositionSol str n = + if str = "" then [] + else if n + 1 = String.length str then [(str.[n])] + else (str.[n])::(decompositionSol str (n+1)) + let parse_type string = let char_list_ref = ref (List.rev (decompositionSol string 0)) in let para_cpt =ref 0 in From caec3fa4d52895b86c66725c37d9176c1f623b4b Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Mon, 22 Jul 2019 18:00:04 +0200 Subject: [PATCH 35/91] refactor: simplify the id handling in Editor_io.upload --- src/editor/editor_lib.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 51cf1f82f..e73bb3edf 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -414,9 +414,9 @@ module Editor_io = struct result_t (* Return true if the ID and the title is unique *) - (* FIXME: refactor this as the handling of IDs has changed *) - let upload_new_exercise id to_save = - let to_save = put_exercise_id id to_save + let upload_new_exercise to_save = + let id = to_save.exercise.id in + let to_save = put_exercise_id id to_save (* to put the id in metadata too *) in let open Exercise.Meta in let result = idUnique id && titleUnique to_save.metadata.title in @@ -433,7 +433,7 @@ module Editor_io = struct (fun text -> SMap.iter (fun id editor_state -> - if not (upload_new_exercise id editor_state) then + if not (upload_new_exercise editor_state) then alert ([%i"Identifier and/or title not unique\n"] ^ "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title)) (Json_repr_browser.Json_encoding.destruct From beefd631528ff6d6295d8c8e755ef9c2b270e537 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 09:52:23 +0200 Subject: [PATCH 36/91] feat: Add override all option when importing --- src/editor/editor_lib.ml | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index e73bb3edf..ffbac62dd 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -413,15 +413,6 @@ module Editor_io = struct ignore (Js.Unsafe.meth_call input_files_load "click" [||]) ; result_t - (* Return true if the ID and the title is unique *) - let upload_new_exercise to_save = - let id = to_save.exercise.id in - let to_save = put_exercise_id id to_save (* to put the id in metadata too *) - in - let open Exercise.Meta in - let result = idUnique id && titleUnique to_save.metadata.title in - if result then update_index to_save; - result let upload () = run_async_with_log @@ -429,13 +420,23 @@ module Editor_io = struct upload_file () >>= fun file -> let (f:Js.js_string Js.t ->(Js.js_string Js.t -> unit)->unit) = Js.Unsafe.eval_string "editor_import" in + let override_all = Js_utils.confirm "Do you want to override all?" in let callback = (fun text -> SMap.iter (fun id editor_state -> - if not (upload_new_exercise editor_state) then - alert ([%i"Identifier and/or title not unique\n"] ^ - "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title)) + let editor_state = put_exercise_id id editor_state in (* update metadata.id *) + if (not (idUnique id && titleUnique id)) && not override_all then + let override = Js_utils.confirm + ([%i"Identifier and/or title not unique\n"] ^ + "id:" ^ id ^ [%i" title:"] ^ editor_state.metadata.title ^ + "\n Do you want to override?") + in + if override then + update_index editor_state; + else + update_index editor_state + ) (Json_repr_browser.Json_encoding.destruct (SMap.enc editor_state_enc) (Js._JSON##(parse text))); From 27d95df6d7158d93565d9569fa82ebf87165087e Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 10:13:29 +0200 Subject: [PATCH 37/91] fix(localStorage.clear): Temporary workaround: keeping learnocaml index in localStorage when clearing the localStorage. This makes the editor-index persist when changing tokens. --- src/app/learnocaml_index_main.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 0dd3f250e..978b67e18 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -803,8 +803,10 @@ let () = H.div ~a:[H.a_style "text-align: center;"] [token_disp_div (get_stored_token ())]] (fun () -> - Lwt.async @@ fun () -> + Lwt.async @@ fun () -> + let index = Learnocaml_local_storage.(retrieve editor_index) in Learnocaml_local_storage.clear (); + Learnocaml_local_storage.(store editor_index index); reload (); Lwt.return_unit) in From d6098c186a1d7d94b46e7606bc828010ac03ae64 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 12:14:19 +0200 Subject: [PATCH 38/91] feat: Add the possibility to import an exercise even with missing files * Also make the import more robust, if the exercise folder contains other folders there is no problem. --- src/editor/editor_lib.ml | 2 +- static/js/jszip/learnocaml_jszip_wrapper.js | 33 ++++++++++++++------- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index ffbac62dd..6d9f994b2 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -446,5 +446,5 @@ module Editor_io = struct Js.Unsafe.fun_call f [| Js.Unsafe.inject file ; Js.Unsafe.inject callback|] - in Lwt.return_unit) + in Lwt.return_unit) end diff --git a/static/js/jszip/learnocaml_jszip_wrapper.js b/static/js/jszip/learnocaml_jszip_wrapper.js index 3ccdee131..e46296562 100644 --- a/static/js/jszip/learnocaml_jszip_wrapper.js +++ b/static/js/jszip/learnocaml_jszip_wrapper.js @@ -43,15 +43,22 @@ function editor_download_all(brut_exercises, brut_index, callback) { }).then(function(blob) { callback(blob) }); } +function editor_read_file(loaded_zip, file) { + if (loaded_zip.file(file)) + return loaded_zip.file(file).async("string") + else + return Promise.resolve(""); +} + function editor_read_exercise(loaded_zip, path, id) { return new Promise(function(resolve, reject) { - var descr = loaded_zip.file(path + "descr.md").async("string"); - var meta = loaded_zip.file(path + "meta.json").async("string"); - var prelude = loaded_zip.file(path + "prelude.ml").async("string"); - var prepare = loaded_zip.file(path + "prepare.ml").async("string"); - var template = loaded_zip.file(path + "template.ml").async("string"); - var test = loaded_zip.file(path + "test.ml").async("string"); - var solution = loaded_zip.file(path + "solution.ml").async("string"); + var descr = editor_read_file(loaded_zip, path + "descr.md"); + var meta = editor_read_file(loaded_zip, path + "meta.json"); + var prelude = editor_read_file(loaded_zip, path + "prelude.ml"); + var prepare = editor_read_file(loaded_zip, path + "prepare.ml"); + var template = editor_read_file(loaded_zip, path + "template.ml"); + var test = editor_read_file(loaded_zip, path + "test.ml"); + var solution = editor_read_file(loaded_zip, path + "solution.ml"); Promise.all([descr, meta, prelude, prepare, template, test, solution]) .then(function(values) { var result = { exercise: {}, metadata: {} }; @@ -60,6 +67,7 @@ function editor_read_exercise(loaded_zip, path, id) { result.exercise.descr = values[0]; var brut_meta = values[1]; var meta = brut_meta.replace(/\r?\n|\r/g, " "); + if (meta == "") meta = "{}"; result.metadata = JSON.parse(meta); result.exercise.prelude = values[2]; result.exercise.prepare = values[3]; @@ -79,10 +87,14 @@ function editor_import(brut_data, callback) { var promises = []; loaded_zip.forEach(function(relative_path, file) { if (file.dir) { - var promise = editor_read_exercise(loaded_zip, relative_path, file.name.replace(/\//, "")); - promises.push(promise); + var slash_regex = /\//g; + var depth = file.name.match(slash_regex).length; + if (depth == 1) { + var promise = editor_read_exercise(loaded_zip, relative_path, file.name.replace(/\//, "")); + promises.push(promise); + } } - }) + }); Promise.all(promises).then(function(values) { var result = values.reduce(function(acc, elt) { acc[elt.exercise.id] = elt; @@ -90,6 +102,5 @@ function editor_import(brut_data, callback) { }, {}) callback(JSON.stringify(result)); }) - }); } \ No newline at end of file From f411cbbb636b3f3b78522c0b2553f8bff9096c29 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 23 Jul 2019 12:26:57 +0200 Subject: [PATCH 39/91] fix(new_exercise.ml): restoring the information of fields when they're empty is ok --- src/editor/new_exercise.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index d134c6ba9..f5cab0a86 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -54,7 +54,10 @@ let string_with_spaces list= "" list in - String.sub s 1 (String.length s - 1 ) + if s="" then + "" + else + String.sub s 1 (String.length s - 1 ) let resultOptionToBool = function | None -> false @@ -94,7 +97,7 @@ let difficulty_select = let backward_input =get (getElementById_coerce "backward" CoerceTo.input) let forward_input = get (getElementById_coerce "forward" CoerceTo.input) -let previous_state = +let previous_state = match get_editor_state previous_id with | exception Not_found -> None | state->Some state @@ -115,7 +118,7 @@ let _ = match previous_state with if s="" then Js.string "" else Js.string (String.sub s 0 (String.length s - 2)); - + required_input##.value := Js.string (string_with_spaces state.metadata.requirements); From 9cde33e0413e08c98ba75ab5b225b892c315b25b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 23 Jul 2019 13:26:45 +0200 Subject: [PATCH 40/91] feat: Improve "Generate" to group questions about the same function * Change the type of monomorph_generator and Test_spec.{question_typed,compile} * Add documentation for gen1, gen2 --- src/editor/editor.ml | 3 +- src/editor/editor_lib.ml | 34 ++++++++++++++------ src/editor/editor_lib.mli | 4 +-- src/editor/test_spec.ml | 67 +++++++++++++++++++++++---------------- src/editor/test_spec.mli | 10 +++--- 5 files changed, 73 insertions(+), 45 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 6a43be4ae..ee3954f69 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -324,8 +324,7 @@ let () = if ok then begin let questions = monomorph_generator (extract_functions (get_answer top)) in - let indexed_list= List.mapi (fun i elt -> (i,elt)) questions in - let string = compile indexed_list in + let string = compile questions in Ace.set_contents ace_t string; Lwt.return_unit end diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 6d9f994b2..34d7e7ec4 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -197,7 +197,7 @@ let rec undup_assoc = function even if it is defined before the non-function expression. *) let extract_functions s = (* Remove module/module_types as their signature could contain val items *) - let s = Regexp.(global_replace (regexp "module type\\\s\\w+\\s=\\ssig\\s[^]+?\\send\\s*") s "") in + let s = Regexp.(global_replace (regexp "module type\\s\\w+\\s=\\ssig\\s[^]+?\\send\\s*") s "") in let s = Regexp.(global_replace (regexp "module type\\s\\w+\\s=\\s\\w+\\s*") s "") in let s = Regexp.(global_replace (regexp "module\\s\\w+\\s:\\ssig\\s[^]+?\\send\\s*") s "") in let s = Regexp.(global_replace (regexp "module\\s\\w+\\s:\\s\\w+\\s*") s "") in @@ -226,6 +226,22 @@ let replace_all map s = Regexp.(global_replace (regexp_string e) res by)) s map +(* [gen1] and [gen2] are helper functions devised to generate for each + polymorphic function, two monomorphic testcases. + + Properties: + * forall i, gen1 i \in base + * forall i, gen1 i <> gen2 i + * forall i, j \in [[0, 11]], i <> j -> (gen1 i, gen2 i) <> (gen1 j, gen2 j) + + List.map gen1 [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11] + = ["int"; "bool"; "char"; "string"; "int"; "bool"; "char"; "string"; + "int"; "bool"; "char"; "string"] + + List.map gen2 [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11] + = ["bool"; "int"; "bool"; "bool"; "char"; "char"; "int"; "char"; + "string"; "string"; "string"; "int"] + *) let base = ["int"; "bool"; "char"; "string"] let gen1 i = List.nth base (i mod 4) let gen2 i = @@ -244,15 +260,13 @@ let monomorph_generator l = and t2 = replace_all (List.mapi (fun i e -> (e, gen2 i)) vars) ty in [(5, t1); (5, t2)] in - List.map (fun (func, ty) -> (func, f ty)) l - |> List.map (fun (name, list_mono) -> - List.fold_left (fun acc (gen, ty) -> - TestAgainstSol - {name; ty; suite = "[]"; gen; - tester = ""; sampler = ""}::acc) - [] - list_mono) - |> List.flatten + List.map (fun (name, ty) -> + let list_mono = f ty in + let list_qst = List.map (fun (gen, mono_ty) -> + TestAgainstSol {name; ty = mono_ty; suite = "[]"; gen; + tester = ""; sampler = ""}) + list_mono + in (name, list_qst)) l (* ____Functions for "GenTemplate" feature__________________________________ *) diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index 0a7ec21e4..7f9e4b856 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -106,8 +106,8 @@ val typecheck_dialog_box : string-> 'a Toploop_results.toplevel_result -> unit L val extract_functions : string -> (string * string) list (** Generate monomorphic test specifications - @return a list of ("function_name", [(alea, "monomorphic type")]) *) -val monomorph_generator : (string * string) list -> Editor.test_qst_untyped list + @return a list of ("function_name", list_of_monomorphic_test_cases) *) +val monomorph_generator : (string * string) list -> (string * Editor.test_qst_untyped list) list val show_load : Html_types.text Tyxml_js.Html.wrap -> [< Html_types.div_content_fun ] Tyxml_js.Html.elt Tyxml_js.Html.list_wrap -> diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 2d1f64cda..5814a9950 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -21,10 +21,6 @@ let rec to_string_aux char_list =match char_list with This should be fix so that the space comes from [to_ty] itself. *) let to_ty str = "[%ty:" ^ str ^ "]" -let rec concatenation listech = match listech with - | [] -> "" - | c :: l -> (string_of_char c) ^ (concatenation l) - let rec decompositionSol str n = if str = "" then [] else if n + 1 = String.length str then [(str.[n])] @@ -80,7 +76,7 @@ let parse_type string = !acc;; (* The tester arg could take into account exceptions/sorted lists/etc. *) -let question_typed question id_question = +let question_typed ?num question = let open Learnocaml_data.Editor in let opt_string param = function | "" -> "" @@ -89,6 +85,7 @@ let question_typed question id_question = | "" -> "" | f -> Format.sprintf "fun () -> last ((%s) ())" f in + let suffix = match num with None -> "" | Some n -> "_" ^ string_of_int n in match question with | TestAgainstSpec a -> (* FIXME *) @@ -97,12 +94,13 @@ let question_typed question id_question = | TestSuite a -> let name, prot, tester, suite = a.name, parse_type a.ty, opt_string "test" a.tester, a.suite in - Format.sprintf "let question%d =@. \ + (* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 1/3) *) + Format.sprintf "let q_%s%s =@. \ let prot = %s in@. \ test_function%s prot@. \ (lookup_student (ty_of_prot prot) %s)@. \ %s;;@." - id_question prot tester name suite + name suffix prot tester name suite | TestAgainstSol a -> let name = a.name and prot = parse_type a.ty @@ -111,22 +109,20 @@ let question_typed question id_question = and tester = opt_string "test" a.tester and suite = a.suite in - Format.sprintf "let question%d =@. \ + (* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 2/3) *) + Format.sprintf "let q_%s%s =@. \ let prot = %s in@. \ test_function_against_solution ~gen:(%d)%s%s prot@. \ \"%s\"@. \ %s;;@." - id_question prot gen sampler tester name suite + name suffix prot gen sampler tester name suite (*****************) (* compile stuff *) (*****************) -open Learnocaml_data.Editor - let test_prel = "open Test_lib\nopen Learnocaml_report;;\n" - let quality_function = {| let avoid_thentrue = let already = ref false in fun _ -> if !already then [] else begin @@ -291,18 +287,35 @@ let fonction = "" in fonction - let compile indexed_list = - let tests = test_prel ^ (ast_fonction true true) in - let tests = List.fold_left (fun acc (qid,quest) -> - acc ^ (question_typed quest qid)^" \n") - tests indexed_list in - let tests = tests ^ init ^ "[\n" ^ ast_code true true in - let tests = - List.fold_left (fun acc (qid, quest) -> - let name=match quest with - | TestAgainstSol a->a.name - | TestAgainstSpec a ->a.name - | TestSuite a -> a.name in - acc ^ (section name ("question" ^ string_of_int qid ) )) - tests indexed_list in - tests ^ " ]" +(* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 3/3) *) +(* [cat_question "foo" [42] = "q_foo"] + [cat_question "foo" [42; 42; 42] = "q_foo_1 @ q_foo_2 @ q_foo_3"] *) +let cat_question name list_qst = + match list_qst with + | [] -> invalid_arg "cat_question" + | [_] -> "q_" ^ name + | _q :: ((_ :: _) as l) -> + List.fold_left (fun (i, acc) _e -> + (i + 1, acc ^" @ q_"^ name ^ "_" ^ string_of_int i)) + (2, "q_" ^ name ^ "_1") l + |> snd + +let compile indexed_list = + let tests = test_prel ^ (ast_fonction true true) in + let tests = List.fold_left (fun acc (_name, list_qst) -> + acc ^ + if List.length list_qst > 1 then + List.fold_left (fun (i, acc) qst -> + (i + 1, acc ^ question_typed ~num:i qst ^" \n")) + (1, "") list_qst + |> snd + else List.fold_left (fun acc qst -> + acc ^ question_typed qst ^" \n") + "" list_qst) + tests indexed_list in + let tests = tests ^ init ^ "[\n" ^ ast_code true true in + let tests = + List.fold_left (fun acc (name, list_qst) -> + acc ^ section name (cat_question name list_qst)) + tests indexed_list in + tests ^ " ]" diff --git a/src/editor/test_spec.mli b/src/editor/test_spec.mli index ff438451a..b35c1c90a 100644 --- a/src/editor/test_spec.mli +++ b/src/editor/test_spec.mli @@ -9,8 +9,10 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -(** Allows typing a question passing by a string - * @param question_untyped id_question *) -val question_typed : Learnocaml_data.Editor.test_qst_untyped -> int -> string +(** [question_typed] is used by [compile] + @return the compiled string of a single question *) +val question_typed : ?num:int -> Learnocaml_data.Editor.test_qst_untyped -> string -val compile : (int * Learnocaml_data.Editor.test_qst_untyped) list -> string +(** [compile] is used by the "Generate" feature of the test.ml tab + @return the compiled string of all given questions *) +val compile : (string * Learnocaml_data.Editor.test_qst_untyped list) list -> string From 840a14d407182b9a8737411cbeeae9bd33e4fc5b Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Wed, 24 Jul 2019 11:01:16 +0200 Subject: [PATCH 41/91] feat : add generate 1 dropup --- src/editor/editor.ml | 31 +++++++++++++ static/css/learnocaml_editor.css | 79 +++++++++++++++++++------------- 2 files changed, 79 insertions(+), 31 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index ee3954f69..7d20e8f67 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -21,6 +21,27 @@ open Test_spec module H = Tyxml_js.Html + +let dropup ~icon ~theme name items = + let dropup_content = + H.(div ~a:[a_class ["dropup-content"]] items) + in + let drop_button = + H.(button ~a:[a_class ["dropbtn"]] [ + img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + pcdata " " ; + span ~a:[ a_class [ "label" ] ] [ pcdata name ] + ]) + in + Manip.Ev.onclick drop_button + (fun _ -> Manip.toggleClass dropup_content "show"); + + (* TODO translate it to js_of_ocaml *) + let _ = + Js.Unsafe.js_expr " //Close the dropdown menu if the user clicks outside of it\nwindow.onclick = function(event) {\n if (!event.target.matches(\'.dropbtn\')) {\n var dropdowns = document.getElementsByClassName(\"dropup-content\");\n var i;\n for (i = 0; i < dropdowns.length; i++) {\n var openDropdown = dropdowns[i];\n if (openDropdown.classList.contains(\'show\')) {\n openDropdown.classList.remove(\'show\');\n }\n }\n }\n} " in (); + H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) + + (*----------------------------------------------------------------------*) let init_tabs, select_tab = @@ -331,6 +352,16 @@ let () = else (select_tab "toplevel" ; Lwt.return ()) end; + let echo_lol = + H.(a ~a: [a_onclick (fun _ -> js_log "lol";true)] [pcdata "log lol"]) + in + + let generate1 = + dropup ~icon:"sync" ~theme:"light" "Generate 1" [echo_lol] + in + Manip.appendChild test_toolbar generate1; + + let typecheck_testml () = let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index 68ce51d7d..9bed2a7db 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -527,6 +527,8 @@ body { background: linear-gradient(to bottom, rgba(0,0,0,0.5) 0, transparent 5px) ; } +/* -------------- test tab -----------------------------*/ + #learnocaml-exo-tab-buttons > #learnocaml-exo-button-test { background: #eee; color: black; @@ -575,49 +577,64 @@ body { } } -/* testhaut */ +/* generate 1 of Test tab */ -#learnocaml-exo-tab-buttons > #learnocaml-exo-button-testhaut { - background: #eee; - color: black; + /* Dropup Button */ + .dropbtn { + background: none; + border: none; + color: inherit; + width: 100%; + height: 100%; } -#learnocaml-exo-tab-testhaut > .buttons { - position: absolute; - left: 0; bottom: 0px; width: 100%; height: 40px; - background: linear-gradient(to bottom, #666 0px, #444 10px, #222 60px); - color: #fff; - line-height: 40px; - display: flex; - flex-direction: row; - z-index: 1003; -} -#learnocaml-exo-tab-testhaut > .buttons::after { +/* Dropup content (Hidden by Default) */ +.dropup-content { + display: none; position: absolute; - bottom: 40px; left: 0px; height: 5px; width: 100%; - background: linear-gradient(to top, rgba(0,0,0,0.4) 0px, rgba(0,0,0,0) 5px); - content:""; + bottom: 41px; + background-color: #333 ; + width: 100%; + box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); + z-index: 1; } -#learnocaml-exo-tab-testhaut > .buttons > button { - flex: 1; - background: none; - border: none; + +/* Links inside the dropup */ +.dropup-content a { color: #eee; + padding: 12px 16px; + text-decoration: none; + display: block; text-shadow: 2px 2px 5px rgba(0,0,0,0.4); - border-top: 1px #eee solid; +} + +/* Change color of dropup links on hover */ +.dropup-content a:hover {background-color: cadetblue ; } + + +.show {display:block;} + +#learnocaml-exo-tab-test > .buttons > div { + flex: 1; + background: none; + border: none; + color: #eee; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + border-top: 1px #eee solid; + position: relative; + padding: 0; +} + +.dropup { position: relative; - padding: 0; + display: inline-block; } -#learnocaml-exo-tab-testhaut > .buttons > button:not(:first-child) { + +#learnocaml-exo-tab-test > .buttons > div:not(:first-child) { border-left: 1px #eee solid; } -@media (max-width: 550px) { - #learnocaml-exo-tab-testhaut > .buttons > button > .label { - display: none; - } -} -/* end testhaut */ +/* end generate 1*/ /* question tab */ From 06810841278555ea5ae7ce60d6d28acaabff0344 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Wed, 24 Jul 2019 11:31:22 +0200 Subject: [PATCH 42/91] feat : add insert and get_cursor_position to ace.ml --- src/ace-lib/ace.ml | 5 +++++ src/ace-lib/ace.mli | 3 +++ src/ace-lib/ace_types.mli | 1 + src/editor/editor.ml | 5 +++-- 4 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/ace-lib/ace.ml b/src/ace-lib/ace.ml index 28e93983c..83383d5bc 100644 --- a/src/ace-lib/ace.ml +++ b/src/ace-lib/ace.ml @@ -42,6 +42,8 @@ let create_range s e = let read_position pos = (pos##.row, pos##.column) +let get_cursor_position {editor} = editor##(getCursorPosition) + let read_range range = ((range##.start##.row, range##.start##.column), (range##.end_##.row, range##.end_##.column)) @@ -94,6 +96,9 @@ let set_mode {editor} name = let on {editor} event callback = editor##getSession##(on (Js.string event) (Js.Unsafe.meth_callback callback)) +let insert {editor} position content = + editor##getSession##(insert position (Js.string content)) + type mark_type = Error | Warning | Message let string_of_make_type: mark_type -> string = function diff --git a/src/ace-lib/ace.mli b/src/ace-lib/ace.mli index 00e75b6f8..7c555ecc4 100644 --- a/src/ace-lib/ace.mli +++ b/src/ace-lib/ace.mli @@ -19,6 +19,8 @@ val create_editor: Dom_html.divElement Js.t -> 'a editor val set_mode: 'a editor -> string -> unit val on: 'b editor -> string -> (Dom_html.event Js.t -> unit) -> unit +val insert: 'a editor -> Ace_types.position Js.t -> string -> unit + val read_range: Ace_types.range Js.t -> (int * int) * (int * int) val create_range: @@ -27,6 +29,7 @@ val create_position: int -> int -> Ace_types.position Js.t val read_position: Ace_types.position Js.t -> int * int val greater_position: Ace_types.position Js.t -> Ace_types.position Js.t -> bool +val get_cursor_position: 'a editor -> Ace_types.position Js.t val get_contents: ?range:Ace_types.range Js.t -> 'a editor -> string val get_line: 'a editor -> int -> string diff --git a/src/ace-lib/ace_types.mli b/src/ace-lib/ace_types.mli index cdd9caac5..f443dcde6 100644 --- a/src/ace-lib/ace_types.mli +++ b/src/ace-lib/ace_types.mli @@ -61,6 +61,7 @@ class type editSession = object method on : Js.js_string Js.t -> ((Dom_html.event Js.t , unit) Js.meth_callback)-> unit Js.meth + method insert : position Js.t -> Js.js_string Js.t -> unit Js.meth method setAnnotations : annotation Js.t Js.js_array Js.t -> unit Js.meth method getAnnotations : annotation Js.t Js.js_array Js.t Js.meth method clearAnnotations : unit Js.meth diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 7d20e8f67..ddce9b257 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -351,7 +351,8 @@ let () = end else (select_tab "toplevel" ; Lwt.return ()) end; - + + (* Generate 1 *) let echo_lol = H.(a ~a: [a_onclick (fun _ -> js_log "lol";true)] [pcdata "log lol"]) in @@ -360,7 +361,7 @@ let () = dropup ~icon:"sync" ~theme:"light" "Generate 1" [echo_lol] in Manip.appendChild test_toolbar generate1; - +(* end generate 1 *) let typecheck_testml () = let prelprep = (Ace.get_contents ace_prel ^ "\n" From 605d2f7b37eb58a53fd080737eb81ec79250c912 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Wed, 24 Jul 2019 12:23:44 +0200 Subject: [PATCH 43/91] feat : add against solution template --- src/editor/editor.ml | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index ddce9b257..afbc3dff9 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -357,8 +357,28 @@ let () = H.(a ~a: [a_onclick (fun _ -> js_log "lol";true)] [pcdata "log lol"]) in + let against_solution_template = + (*let solution = + Editor.TestAgainstSol + {name = "plus"; ty = "int -> int -> int "; + gen=10; suite= "[1 @:!! 4 ; 3 @:!! 3 ]"; + tester = ""; sampler = ""} + in + let string_to_insert = question_typed solution in *) + let string_to_insert = "let q_plus =\n let prot = arg_ty [%ty:int] (last_ty [%ty: int] [%ty: int ]) in (* type: int-> int -> int *)\n test_function_against_solution ~gen:(10) prot (*10 random tests *)\n \"plus\" (* function name = plus *)\n [1 @:!! 4 ; 3 @:!! 3 ];; (* compare (plus 1 4) and \n (plus 3 3) against professor\'s solution *)" + in + H.(a ~a:[ a_onclick (fun _ -> + let position = Ace.get_cursor_position ace_t in + Ace.insert ace_t position string_to_insert;true) ] + [pcdata "Against solution template"]) + in + let generate1 = - dropup ~icon:"sync" ~theme:"light" "Generate 1" [echo_lol] + dropup + ~icon:"sync" + ~theme:"light" + "Generate 1" + [echo_lol;against_solution_template] in Manip.appendChild test_toolbar generate1; (* end generate 1 *) From f184a7db66380714e9f900a6ac625b23df44acd9 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 26 Jul 2019 14:50:38 +0200 Subject: [PATCH 44/91] feat : add templates to the local storage --- src/app/learnocaml_local_storage.ml | 11 ++++++ src/app/learnocaml_local_storage.mli | 1 + src/editor/editor.ml | 40 ++++++++------------ src/editor/editor_lib.ml | 55 ++++++++++++++++++++++++++++ src/editor/editor_lib.mli | 10 +++++ src/editor/test_spec.ml | 43 ++++++++++++++++++++++ src/state/learnocaml_data.ml | 28 ++++++++++++++ src/state/learnocaml_data.mli | 6 +++ 8 files changed, 169 insertions(+), 25 deletions(-) diff --git a/src/app/learnocaml_local_storage.ml b/src/app/learnocaml_local_storage.ml index ad272af0a..6ac4b358f 100644 --- a/src/app/learnocaml_local_storage.ml +++ b/src/app/learnocaml_local_storage.ml @@ -265,3 +265,14 @@ let editor_index= { key = Some key ; dependent_keys = (=) key ; store ; retrieve ; delete ; listeners = [] } +let editor_templates = + let key = mangle [ "editor-templates" ] in + let enc = Json_encoding.list Editor.editor_template_enc in + let store value = store_single key enc value + and retrieve () = + try retrieve_single key enc () with Not_found -> [] + and delete () = delete_single key enc () in + { key = Some key ; dependent_keys = (=) key ; + store ; retrieve ; delete ; listeners = [] } + + diff --git a/src/app/learnocaml_local_storage.mli b/src/app/learnocaml_local_storage.mli index 6e84819bd..18f3fb65a 100644 --- a/src/app/learnocaml_local_storage.mli +++ b/src/app/learnocaml_local_storage.mli @@ -50,3 +50,4 @@ val nickname : string storage_key val editor_index : Editor.editor_state SMap.t storage_key +val editor_templates : Editor.editor_template list storage_key diff --git a/src/editor/editor.ml b/src/editor/editor.ml index afbc3dff9..a09f16975 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -352,40 +352,30 @@ let () = else (select_tab "toplevel" ; Lwt.return ()) end; - (* Generate 1 *) - let echo_lol = - H.(a ~a: [a_onclick (fun _ -> js_log "lol";true)] [pcdata "log lol"]) + (* templates *) + let default_templates = + Templates.init(); + Templates.give_first_templates () + |> List.map (fun Editor.{name; template} -> + H.(a ~a:[ a_onclick (fun _ -> + let position = Ace.get_cursor_position ace_t in + Ace.insert ace_t position template;true)] + [pcdata name])) in - let against_solution_template = - (*let solution = - Editor.TestAgainstSol - {name = "plus"; ty = "int -> int -> int "; - gen=10; suite= "[1 @:!! 4 ; 3 @:!! 3 ]"; - tester = ""; sampler = ""} - in - let string_to_insert = question_typed solution in *) - let string_to_insert = "let q_plus =\n let prot = arg_ty [%ty:int] (last_ty [%ty: int] [%ty: int ]) in (* type: int-> int -> int *)\n test_function_against_solution ~gen:(10) prot (*10 random tests *)\n \"plus\" (* function name = plus *)\n [1 @:!! 4 ; 3 @:!! 3 ];; (* compare (plus 1 4) and \n (plus 3 3) against professor\'s solution *)" - in - H.(a ~a:[ a_onclick (fun _ -> - let position = Ace.get_cursor_position ace_t in - Ace.insert ace_t position string_to_insert;true) ] - [pcdata "Against solution template"]) - in - - let generate1 = + let templates = dropup ~icon:"sync" ~theme:"light" - "Generate 1" - [echo_lol;against_solution_template] + "Templates" + default_templates in - Manip.appendChild test_toolbar generate1; -(* end generate 1 *) + Manip.appendChild test_toolbar templates; +(* end templates *) let typecheck_testml () = let prelprep = (Ace.get_contents ace_prel ^ "\n" - ^ Ace.get_contents ace_prep ^ "\n") in + ^ Ace.get_contents ace_prep ^ "\n") in Editor_lib.typecheck true ace_t editor_t top prelprep ~mock:true ~onpasterr:(fun () -> select_tab "prepare"; typecheck_prepare ()) (Ace.get_contents ace_t) in diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 34d7e7ec4..db41925d6 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -462,3 +462,58 @@ module Editor_io = struct Js.Unsafe.inject callback|] in Lwt.return_unit) end + +module Templates = struct + + let give_templates () = + Learnocaml_local_storage.(retrieve editor_templates) + + (*gives the first 3 templates to show *) + let give_first_templates () = + let templates = + give_templates () + in + match templates with + | [] -> [] + | hd :: [] -> [hd] + | hd :: snd :: [] -> [hd; snd] + | hd :: snd :: thrd :: _ -> [ hd; snd; thrd] + + let against_solution_template = + { name = "Against solution"; + template = {| + let q_plus = + let prot = arg_ty [%ty:int] (last_ty [%ty: int] [%ty: int ]) in (* type: int-> int -> int *) + test_function_against_solution ~gen:(10) prot (*10 random tests *) + "plus" (* function name = plus *) + [1 @:!! 4 ; 3 @:!! 3 ];; (* compare (plus 1 4) and + (plus 3 3) against professor\'s solution *) + |} + } + + let test_suite_template = + { name = "Test Suite"; + template = {| + let q_plus2 = + let prot = arg_ty [%ty:int] (last_ty [%ty: int] [%ty: int ]) in (*type : int -> int ->int *) + test_function prot + (lookup_student (ty_of_prot prot) "plus") (*function name :"plus" *) + [5 @:!! 4 ==> 9; (* plus 5 4 = 9 *) + 5 @:!! 5 ==> 10; + 1 @:!! 1 ==> 2; + 0 @:!! 0 ==> 0];; + |} + } + + let save templates = + Learnocaml_local_storage.(store editor_templates templates) + + (* adding default templates if empty *) + let init () = let templates = give_templates () in + if templates = [] then + [against_solution_template; + test_suite_template] + |> save + + +end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index 7f9e4b856..da304af8d 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -118,3 +118,13 @@ module Editor_io : sig val upload : unit -> unit val download_all : unit -> unit end + +module Templates : sig + val give_templates : unit -> Learnocaml_data.Editor.editor_template list + val give_first_templates : + unit -> Learnocaml_data.Editor.editor_template list + val against_solution_template : Learnocaml_data.Editor.editor_template + val test_suite_template : Learnocaml_data.Editor.editor_template + val save : Learnocaml_data.Editor.editor_template list -> unit + val init : unit -> unit +end diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 06a871a6f..b76ff460f 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -326,3 +326,46 @@ let compile indexed_list = acc ^ section name (cat_question name list_qst)) tests indexed_list in tests ^ " ]" + +(* +module Generate_1 = struct + open Tyxml_js.Html5 + open Learnocaml_common + open Learnocaml_data + open Lwt.Infix + + let ask_name top = + ask_string ~title:"Name" [ pcdata "Enter the function name"] >>= + (fun name -> + let questions = extract_functions (get_answer top) in + match List.assoc_opt name questions with + | None -> Learnocaml_common.alert "No question with this name found"; Lwt.return None + | Some s -> Lwt.return (Some (name,s)) + ) + + let generate_against_solution tuple_opt = + match tuple_opt with + | None -> "" + | Some (name, ty) -> let question = + Editor.TestAgainstSol + {name = name; ty; + gen=10; suite= "[1 @:!! 4 ; 3 @:!! 3 ]"; + tester = ""; sampler = ""} + in + question_typed question + + let generate_test_suite tuple_opt = + match tuple_opt with + | None -> "" + | Some (name, ty) -> let question = + Editor.TestSuite + {name = name; ty; + gen=10; suite= "[1 @:!! 4 ; 3 @:!! 3 ]"; + tester = ""; sampler = ""} + in + question_typed question + + +end + + *) diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 884fa78fa..092dcba70 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -1314,4 +1314,32 @@ type exercise = (J.req "exercise" exercise_encoding) (J.req "metadata" Exercise.Meta.enc)) + type editor_template = + { name : string; + template : string} + + let editor_template_enc = + J.conv + (fun {name; template } -> + (name, template)) + (fun (name, template) -> + {name; template}) + (J.obj2 + (J.req "name" J.string) + (J.req "template" J.string)) + + + module IMap = struct + + include Map.Make(struct type t = int let compare (x:t) y = compare x y end) + + (** Useful for serialization *) + let string_of_int_map iv = + + fold (fun i v sv -> SMap.add (string_of_int i) v sv) iv SMap.empty + + let int_of_string_map iv = + SMap.fold (fun s v iv -> add (int_of_string s) v iv) iv empty + end + end diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index fcd215356..14a3bcb5a 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -461,5 +461,11 @@ module Editor : sig metadata : Exercise.Meta.t; } val editor_state_enc : editor_state Json_encoding.encoding + + type editor_template = + { name : string; + template : string} + + val editor_template_enc : editor_template Json_encoding.encoding end From 21cbbd51944709cfa0e27438990ad338b667e065 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Tue, 6 Aug 2019 19:27:47 +0200 Subject: [PATCH 45/91] feat : add templates configuration menu --- src/app/learnocaml_common.ml | 12 +++---- src/editor/editor.ml | 61 +++++++++++++++++++++++++++++--- static/css/learnocaml_editor.css | 27 ++++++++++++++ 3 files changed, 90 insertions(+), 10 deletions(-) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index cc8980a1f..0d1a16fbe 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -111,13 +111,13 @@ let ext_alert ~title ?(buttons = [close_button [%i"OK"]]) message = Manip.(appendChild Elt.body) div; div in Manip.replaceChildren div [ - H.div [ - H.h3 [ H.pcdata title ]; - H.div message; - H.div ~a:[ H.a_class ["buttons"] ] buttons; + H.div [ + H.h3 [ H.pcdata title ]; + H.div message; + H.div ~a:[ H.a_class ["buttons"] ] buttons; + ] ] - ] - + let lwt_alert ~title ~buttons message = let waiter, wakener = Lwt.task () in let buttons = diff --git a/src/editor/editor.ml b/src/editor/editor.ml index a09f16975..83eae1821 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -35,13 +35,44 @@ let dropup ~icon ~theme name items = in Manip.Ev.onclick drop_button (fun _ -> Manip.toggleClass dropup_content "show"); - (* TODO translate it to js_of_ocaml *) let _ = Js.Unsafe.js_expr " //Close the dropdown menu if the user clicks outside of it\nwindow.onclick = function(event) {\n if (!event.target.matches(\'.dropbtn\')) {\n var dropdowns = document.getElementsByClassName(\"dropup-content\");\n var i;\n for (i = 0; i < dropdowns.length; i++) {\n var openDropdown = dropdowns[i];\n if (openDropdown.classList.contains(\'show\')) {\n openDropdown.classList.remove(\'show\');\n }\n }\n }\n} " in (); H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) - + +let ace_editor_container ~save ~size ~editor ~box_title = + let layer = H.(div ~a: + [a_class ["learnocaml-dialog-overlay"; "json-editor-overlay"] ] + []) in + + let close_btn = + H.(button ~a:[ a_onclick (fun _ -> + Manip.removeChild Manip.Elt.body layer;false + )] [pcdata "Cancel"]) + in + let save_btn = + H.(button ~a:[ a_onclick (fun _ -> + save(); + Manip.removeChild Manip.Elt.body layer;false + )] [pcdata "Save"]) + in + let container = + H.(div + [ + h3 [pcdata box_title]; + div []; + editor; + div ~a:[a_class ["buttons"] ] [ close_btn; save_btn] + ] + ) + in + let (width, height) = size in + Manip.SetCss.width container width; + Manip.SetCss.height container height; + Manip.replaceChildren layer [container]; + + layer (*----------------------------------------------------------------------*) let init_tabs, select_tab = @@ -363,12 +394,34 @@ let () = [pcdata name])) in - let templates = + let json_editor_div = H.(div ~a: [ a_class ["json-editor"]] []) in + + + let json_editor_ace = json_editor_div + |> Tyxml_js.To_dom.of_div + |> Ace.create_editor + in + Ace.set_font_size json_editor_ace 18; + + let configuration = + H.(a ~a: [ a_onclick (fun _ -> + let div = + ace_editor_container + ~box_title: "Template Configuration" + ~size: ("90%","80%") + ~save: (fun ()-> ()) + ~editor: json_editor_div + in + Manip.appendToBody div; + true )] + [pcdata "Configuration"]) + in +let templates = dropup ~icon:"sync" ~theme:"light" "Templates" - default_templates + (configuration :: default_templates) in Manip.appendChild test_toolbar templates; (* end templates *) diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index 9bed2a7db..764f4ae4a 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -636,6 +636,33 @@ body { } /* end generate 1*/ +/*template editor */ + +.json-editor { + font-size: 18px; + font-family: 'Inconsolata', monospace; + position: relative !important; + flex-grow: 12; + background: #666; + color: #fff; + z-index: 1002; + width: 80%; + margin: 0 10%; +} +div.json-editor-overlay > div { + display:flex; + flex-direction:column +} + +div.json-editor-overlay > div::before, div.json-editor-overlay > div::after { + content: ""; + flex: 0 !important; +} + +.json-editor > ::before +/* end template editor */ + + /* question tab */ From b5508a67e52a0427cebb967ec414479e7faa3224 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Wed, 7 Aug 2019 14:11:18 +0200 Subject: [PATCH 46/91] feat : templates beta version --- src/editor/editor.ml | 122 +++++++++++++++++++++++-------- src/editor/editor_lib.ml | 28 ++++++- src/editor/editor_lib.mli | 6 ++ static/css/learnocaml_editor.css | 23 +++++- 4 files changed, 145 insertions(+), 34 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 83eae1821..e87cd83f1 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -40,39 +40,77 @@ let dropup ~icon ~theme name items = Js.Unsafe.js_expr " //Close the dropdown menu if the user clicks outside of it\nwindow.onclick = function(event) {\n if (!event.target.matches(\'.dropbtn\')) {\n var dropdowns = document.getElementsByClassName(\"dropup-content\");\n var i;\n for (i = 0; i < dropdowns.length; i++) {\n var openDropdown = dropdowns[i];\n if (openDropdown.classList.contains(\'show\')) {\n openDropdown.classList.remove(\'show\');\n }\n }\n }\n} " in (); H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) +let editor_overlay () = + H.(div ~a:[a_class ["learnocaml-dialog-overlay"; "json-editor-overlay"] ] + []) + -let ace_editor_container ~save ~size ~editor ~box_title = - let layer = H.(div ~a: - [a_class ["learnocaml-dialog-overlay"; "json-editor-overlay"] ] - []) in - - let close_btn = - H.(button ~a:[ a_onclick (fun _ -> - Manip.removeChild Manip.Elt.body layer;false - )] [pcdata "Cancel"]) - in - let save_btn = - H.(button ~a:[ a_onclick (fun _ -> - save(); - Manip.removeChild Manip.Elt.body layer;false - )] [pcdata "Save"]) - in +let editor_container ~size ~contents ~buttons ~box_title = let container = H.(div [ h3 [pcdata box_title]; div []; - editor; - div ~a:[a_class ["buttons"] ] [ close_btn; save_btn] + contents; + div ~a:[a_class ["buttons"] ] buttons ] ) in let (width, height) = size in Manip.SetCss.width container width; Manip.SetCss.height container height; - Manip.replaceChildren layer [container]; + container - layer + +let ace_editor_container ~save ~size ~editor ~box_title = + let overlay = editor_overlay () in + let close_btn = + H.(button ~a:[ a_onclick (fun _ -> + Manip.removeChild Manip.Elt.body overlay;false + )] [pcdata "Cancel"]) + in + let save_btn = + H.(button ~a:[ a_onclick (fun _ -> + save(); + reload(); false + )] [pcdata "Save"]) + in + let container = editor_container + ~size + ~contents: editor + ~buttons: [close_btn;save_btn] + ~box_title + in + Manip.replaceChildren overlay [container]; + overlay + +let all_templates_container ~size ~elements ~box_title = + let overlay = editor_overlay () in + let close () = Manip.removeChild Manip.Elt.body overlay in + let ok_btn = + H.(button ~a:[ a_onclick (fun _ -> + close ();false + )] [pcdata "Ok"]) + in + + List.iter + (fun elt -> + let dom_elt = Tyxml_js.To_dom.of_a elt in + Dom_html.addEventListener dom_elt Dom_html.Event.click + (Dom_html.handler ( fun _ -> close ();Js._true )) + Js._true + |> ignore) + elements; + + let container = editor_container + ~size + ~contents: H.(div ~a: [a_style "overflow:auto"] elements) + ~buttons: [ok_btn] + ~box_title + in + Manip.replaceChildren overlay [container]; + overlay + (*----------------------------------------------------------------------*) let init_tabs, select_tab = @@ -387,11 +425,7 @@ let () = let default_templates = Templates.init(); Templates.give_first_templates () - |> List.map (fun Editor.{name; template} -> - H.(a ~a:[ a_onclick (fun _ -> - let position = Ace.get_cursor_position ace_t in - Ace.insert ace_t position template;true)] - [pcdata name])) + |> List.map (Templates.template_to_a_elt ace_t) in let json_editor_div = H.(div ~a: [ a_class ["json-editor"]] []) in @@ -404,24 +438,54 @@ let () = Ace.set_font_size json_editor_ace 18; let configuration = + let save () = + run_async_with_log @@ + fun () -> + Ace.get_contents json_editor_ace + |> Templates.from_string + |> Templates.save + |> Lwt.return + in H.(a ~a: [ a_onclick (fun _ -> let div = ace_editor_container ~box_title: "Template Configuration" ~size: ("90%","80%") - ~save: (fun ()-> ()) + ~save ~editor: json_editor_div in - Manip.appendToBody div; + Manip.appendToBody div; + Templates.give_templates () + |> Templates.to_string + |> Ace.set_contents json_editor_ace; true )] [pcdata "Configuration"]) in -let templates = + + let all_templates = + H.(a ~a:[a_class [ "editor-template"]; + a_onclick (fun _ -> + let content = + Templates.give_templates () + |> List.map (Templates.template_to_a_elt ace_t) + in + let div = + all_templates_container + ~box_title: "All templates" + ~size: ("90%","80%") + ~elements: content + in + Manip.appendToBody div; + true)] + [pcdata "All templates"]) + in + + let templates = dropup ~icon:"sync" ~theme:"light" "Templates" - (configuration :: default_templates) + (configuration :: all_templates :: default_templates) in Manip.appendChild test_toolbar templates; (* end templates *) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index db41925d6..bb3c7d503 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -14,10 +14,12 @@ open Learnocaml_common open Learnocaml_index open Lwt.Infix open Js_utils -open Tyxml_js.Html5 open Dom_html open Editor open Exercise.Meta + +module H = Tyxml_js.Html + (* Internationalization *) let get_editor_state id= @@ -515,5 +517,27 @@ module Templates = struct test_suite_template] |> save - + let to_string templates = + let json = + Json_repr_browser.Json_encoding.construct + (Json_encoding.list Editor.editor_template_enc) + templates + in + Json_repr_browser.js_stringify ~indent:2 json + |> Js.to_string + + let from_string string = + let json = Json_repr_browser.parse string in + Json_repr_browser.Json_encoding.destruct + (Json_encoding.list Editor.editor_template_enc) + json + + + let template_to_a_elt ace_t Editor.{name; template} = + H.(a ~a:[ a_onclick (fun _ -> + let position = Ace.get_cursor_position ace_t in + Ace.insert ace_t position template;true); + a_class ["editor-template"]] + [pcdata name]) + end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index da304af8d..e6b1fd850 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -11,6 +11,8 @@ open Learnocaml_data open Editor +module H = Tyxml_js.Html + val update_index : Editor.editor_state -> unit (** Getters of an editor exercise @@ -127,4 +129,8 @@ module Templates : sig val test_suite_template : Learnocaml_data.Editor.editor_template val save : Learnocaml_data.Editor.editor_template list -> unit val init : unit -> unit + val to_string : Learnocaml_data.Editor.editor_template list -> string + val from_string : string -> Learnocaml_data.Editor.editor_template list + val template_to_a_elt : 'a Ace.editor -> Learnocaml_data.Editor.editor_template -> + [> [> Html_types.pcdata ] Html_types.a ] H.elt end diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index 764f4ae4a..e3984a6bb 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -577,7 +577,7 @@ body { } } -/* generate 1 of Test tab */ +/* templaates of Test tab */ /* Dropup Button */ .dropbtn { @@ -634,7 +634,7 @@ body { #learnocaml-exo-tab-test > .buttons > div:not(:first-child) { border-left: 1px #eee solid; } -/* end generate 1*/ +/* end templates 1*/ /*template editor */ @@ -659,9 +659,26 @@ div.json-editor-overlay > div::before, div.json-editor-overlay > div::after { flex: 0 !important; } -.json-editor > ::before /* end template editor */ +/*all templates */ + +.editor-template{ + color: #eee; + padding: 12px 16px; + text-decoration: none; + display: block; + text-shadow: 2px 2px 5px rgba(0,0,0,0.4); + background-color: #333 ; + +} + +.editor-template:hover{ + background-color: cadetblue; +} + +/* all templates */ + /* question tab */ From 54ff959dc4304b47dbc357f476b03a750de00677 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Wed, 7 Aug 2019 19:54:54 +0200 Subject: [PATCH 47/91] feat : add auto recovering for the exercise when saving templates configuration --- src/editor/editor.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index e87cd83f1..f19433fae 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -175,7 +175,8 @@ let onchange ace_list = (fun _ -> activate_before_unload ();) in List.iter (fun ace -> add_change_listener ace) ace_list - +let recovering_callback = ref (fun () -> ()) + let () = run_async_with_log @@ fun () -> (*set_string_translations ();*) @@ -444,6 +445,7 @@ let () = Ace.get_contents json_editor_ace |> Templates.from_string |> Templates.save + |> !recovering_callback |> Lwt.return in H.(a ~a: [ a_onclick (fun _ -> @@ -556,6 +558,7 @@ let () = let old_state = get_editor_state id in let new_state = {metadata=old_state.metadata;exercise} in update_index new_state in + recovering_callback:= recovering; begin editor_button ~icon: "save" [%i"Save"] @@ fun () -> recovering (); From 11a5b00baa5a48419f2fc4bd7642dfe6bd2a4e4e Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 13:17:29 +0200 Subject: [PATCH 48/91] wip --- src/editor/editor.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index f19433fae..4f3d81a0b 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -431,10 +431,12 @@ let () = let json_editor_div = H.(div ~a: [ a_class ["json-editor"]] []) in - - let json_editor_ace = json_editor_div - |> Tyxml_js.To_dom.of_div - |> Ace.create_editor + let json_editor= json_editor_div + |> Tyxml_js.To_dom.of_div + |> Ocaml_mode.create_ocaml_editor + in + let json_editor_ace = Ocaml_mode.get_editor json_editor + in Ace.set_font_size json_editor_ace 18; From 91942d6cb06421b411fc2de8ec5a0e03c372b310 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 14:52:03 +0200 Subject: [PATCH 49/91] feat : add json mode to template's configuration editor --- src/editor/editor.ml | 11 +- static/editor.html | 3 + static/js/ace/mode-json.js | 326 +++++ static/js/ace/worker-json.js | 2401 ++++++++++++++++++++++++++++++++++ 4 files changed, 2735 insertions(+), 6 deletions(-) create mode 100644 static/js/ace/mode-json.js create mode 100644 static/js/ace/worker-json.js diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 4f3d81a0b..792d6af9f 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -431,14 +431,13 @@ let () = let json_editor_div = H.(div ~a: [ a_class ["json-editor"]] []) in - let json_editor= json_editor_div - |> Tyxml_js.To_dom.of_div - |> Ocaml_mode.create_ocaml_editor - in - let json_editor_ace = Ocaml_mode.get_editor json_editor - + + let json_editor_ace = json_editor_div + |> Tyxml_js.To_dom.of_div + |> Ace.create_editor in Ace.set_font_size json_editor_ace 18; + Ace.set_mode json_editor_ace "ace/mode/json"; let configuration = let save () = diff --git a/static/editor.html b/static/editor.html index 1cbe4c30a..f9641c1f7 100644 --- a/static/editor.html +++ b/static/editor.html @@ -14,6 +14,9 @@ + + + diff --git a/static/js/ace/mode-json.js b/static/js/ace/mode-json.js new file mode 100644 index 000000000..fca04d6b0 --- /dev/null +++ b/static/js/ace/mode-json.js @@ -0,0 +1,326 @@ +ace.define("ace/mode/json_highlight_rules",["require","exports","module","ace/lib/oop","ace/mode/text_highlight_rules"], function(require, exports, module) { +"use strict"; + +var oop = require("../lib/oop"); +var TextHighlightRules = require("./text_highlight_rules").TextHighlightRules; + +var JsonHighlightRules = function() { + this.$rules = { + "start" : [ + { + token : "variable", // single line + regex : '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]\\s*(?=:)' + }, { + token : "string", // single line + regex : '"', + next : "string" + }, { + token : "constant.numeric", // hex + regex : "0[xX][0-9a-fA-F]+\\b" + }, { + token : "constant.numeric", // float + regex : "[+-]?\\d+(?:(?:\\.\\d*)?(?:[eE][+-]?\\d+)?)?\\b" + }, { + token : "constant.language.boolean", + regex : "(?:true|false)\\b" + }, { + token : "text", // single quoted strings are not allowed + regex : "['](?:(?:\\\\.)|(?:[^'\\\\]))*?[']" + }, { + token : "comment", // comments are not allowed, but who cares? + regex : "\\/\\/.*$" + }, { + token : "comment.start", // comments are not allowed, but who cares? + regex : "\\/\\*", + next : "comment" + }, { + token : "paren.lparen", + regex : "[[({]" + }, { + token : "paren.rparen", + regex : "[\\])}]" + }, { + token : "text", + regex : "\\s+" + } + ], + "string" : [ + { + token : "constant.language.escape", + regex : /\\(?:x[0-9a-fA-F]{2}|u[0-9a-fA-F]{4}|["\\\/bfnrt])/ + }, { + token : "string", + regex : '"|$', + next : "start" + }, { + defaultToken : "string" + } + ], + "comment" : [ + { + token : "comment.end", // comments are not allowed, but who cares? + regex : "\\*\\/", + next : "start" + }, { + defaultToken: "comment" + } + ] + }; + +}; + +oop.inherits(JsonHighlightRules, TextHighlightRules); + +exports.JsonHighlightRules = JsonHighlightRules; +}); + +ace.define("ace/mode/matching_brace_outdent",["require","exports","module","ace/range"], function(require, exports, module) { +"use strict"; + +var Range = require("../range").Range; + +var MatchingBraceOutdent = function() {}; + +(function() { + + this.checkOutdent = function(line, input) { + if (! /^\s+$/.test(line)) + return false; + + return /^\s*\}/.test(input); + }; + + this.autoOutdent = function(doc, row) { + var line = doc.getLine(row); + var match = line.match(/^(\s*\})/); + + if (!match) return 0; + + var column = match[1].length; + var openBracePos = doc.findMatchingBracket({row: row, column: column}); + + if (!openBracePos || openBracePos.row == row) return 0; + + var indent = this.$getIndent(doc.getLine(openBracePos.row)); + doc.replace(new Range(row, 0, row, column-1), indent); + }; + + this.$getIndent = function(line) { + return line.match(/^\s*/)[0]; + }; + +}).call(MatchingBraceOutdent.prototype); + +exports.MatchingBraceOutdent = MatchingBraceOutdent; +}); + +ace.define("ace/mode/folding/cstyle",["require","exports","module","ace/lib/oop","ace/range","ace/mode/folding/fold_mode"], function(require, exports, module) { +"use strict"; + +var oop = require("../../lib/oop"); +var Range = require("../../range").Range; +var BaseFoldMode = require("./fold_mode").FoldMode; + +var FoldMode = exports.FoldMode = function(commentRegex) { + if (commentRegex) { + this.foldingStartMarker = new RegExp( + this.foldingStartMarker.source.replace(/\|[^|]*?$/, "|" + commentRegex.start) + ); + this.foldingStopMarker = new RegExp( + this.foldingStopMarker.source.replace(/\|[^|]*?$/, "|" + commentRegex.end) + ); + } +}; +oop.inherits(FoldMode, BaseFoldMode); + +(function() { + + this.foldingStartMarker = /([\{\[\(])[^\}\]\)]*$|^\s*(\/\*)/; + this.foldingStopMarker = /^[^\[\{\(]*([\}\]\)])|^[\s\*]*(\*\/)/; + this.singleLineBlockCommentRe= /^\s*(\/\*).*\*\/\s*$/; + this.tripleStarBlockCommentRe = /^\s*(\/\*\*\*).*\*\/\s*$/; + this.startRegionRe = /^\s*(\/\*|\/\/)#?region\b/; + this._getFoldWidgetBase = this.getFoldWidget; + this.getFoldWidget = function(session, foldStyle, row) { + var line = session.getLine(row); + + if (this.singleLineBlockCommentRe.test(line)) { + if (!this.startRegionRe.test(line) && !this.tripleStarBlockCommentRe.test(line)) + return ""; + } + + var fw = this._getFoldWidgetBase(session, foldStyle, row); + + if (!fw && this.startRegionRe.test(line)) + return "start"; // lineCommentRegionStart + + return fw; + }; + + this.getFoldWidgetRange = function(session, foldStyle, row, forceMultiline) { + var line = session.getLine(row); + + if (this.startRegionRe.test(line)) + return this.getCommentRegionBlock(session, line, row); + + var match = line.match(this.foldingStartMarker); + if (match) { + var i = match.index; + + if (match[1]) + return this.openingBracketBlock(session, match[1], row, i); + + var range = session.getCommentFoldRange(row, i + match[0].length, 1); + + if (range && !range.isMultiLine()) { + if (forceMultiline) { + range = this.getSectionRange(session, row); + } else if (foldStyle != "all") + range = null; + } + + return range; + } + + if (foldStyle === "markbegin") + return; + + var match = line.match(this.foldingStopMarker); + if (match) { + var i = match.index + match[0].length; + + if (match[1]) + return this.closingBracketBlock(session, match[1], row, i); + + return session.getCommentFoldRange(row, i, -1); + } + }; + + this.getSectionRange = function(session, row) { + var line = session.getLine(row); + var startIndent = line.search(/\S/); + var startRow = row; + var startColumn = line.length; + row = row + 1; + var endRow = row; + var maxRow = session.getLength(); + while (++row < maxRow) { + line = session.getLine(row); + var indent = line.search(/\S/); + if (indent === -1) + continue; + if (startIndent > indent) + break; + var subRange = this.getFoldWidgetRange(session, "all", row); + + if (subRange) { + if (subRange.start.row <= startRow) { + break; + } else if (subRange.isMultiLine()) { + row = subRange.end.row; + } else if (startIndent == indent) { + break; + } + } + endRow = row; + } + + return new Range(startRow, startColumn, endRow, session.getLine(endRow).length); + }; + this.getCommentRegionBlock = function(session, line, row) { + var startColumn = line.search(/\s*$/); + var maxRow = session.getLength(); + var startRow = row; + + var re = /^\s*(?:\/\*|\/\/|--)#?(end)?region\b/; + var depth = 1; + while (++row < maxRow) { + line = session.getLine(row); + var m = re.exec(line); + if (!m) continue; + if (m[1]) depth--; + else depth++; + + if (!depth) break; + } + + var endRow = row; + if (endRow > startRow) { + return new Range(startRow, startColumn, endRow, line.length); + } + }; + +}).call(FoldMode.prototype); + +}); + +ace.define("ace/mode/json",["require","exports","module","ace/lib/oop","ace/mode/text","ace/mode/json_highlight_rules","ace/mode/matching_brace_outdent","ace/mode/behaviour/cstyle","ace/mode/folding/cstyle","ace/worker/worker_client"], function(require, exports, module) { +"use strict"; + +var oop = require("../lib/oop"); +var TextMode = require("./text").Mode; +var HighlightRules = require("./json_highlight_rules").JsonHighlightRules; +var MatchingBraceOutdent = require("./matching_brace_outdent").MatchingBraceOutdent; +var CstyleBehaviour = require("./behaviour/cstyle").CstyleBehaviour; +var CStyleFoldMode = require("./folding/cstyle").FoldMode; +var WorkerClient = require("../worker/worker_client").WorkerClient; + +var Mode = function() { + this.HighlightRules = HighlightRules; + this.$outdent = new MatchingBraceOutdent(); + this.$behaviour = new CstyleBehaviour(); + this.foldingRules = new CStyleFoldMode(); +}; +oop.inherits(Mode, TextMode); + +(function() { + + this.getNextLineIndent = function(state, line, tab) { + var indent = this.$getIndent(line); + + if (state == "start") { + var match = line.match(/^.*[\{\(\[]\s*$/); + if (match) { + indent += tab; + } + } + + return indent; + }; + + this.checkOutdent = function(state, line, input) { + return this.$outdent.checkOutdent(line, input); + }; + + this.autoOutdent = function(state, doc, row) { + this.$outdent.autoOutdent(doc, row); + }; + + this.createWorker = function(session) { + var worker = new WorkerClient(["ace"], "ace/mode/json_worker", "JsonWorker"); + worker.attachToDocument(session.getDocument()); + + worker.on("annotate", function(e) { + session.setAnnotations(e.data); + }); + + worker.on("terminate", function() { + session.clearAnnotations(); + }); + + return worker; + }; + + + this.$id = "ace/mode/json"; +}).call(Mode.prototype); + +exports.Mode = Mode; +}); (function() { + ace.require(["ace/mode/json"], function(m) { + if (typeof module == "object" && typeof exports == "object" && module) { + module.exports = m; + } + }); + })(); + \ No newline at end of file diff --git a/static/js/ace/worker-json.js b/static/js/ace/worker-json.js new file mode 100644 index 000000000..1b1a6a55e --- /dev/null +++ b/static/js/ace/worker-json.js @@ -0,0 +1,2401 @@ +"no use strict"; +!(function(window) { +if (typeof window.window != "undefined" && window.document) + return; +if (window.require && window.define) + return; + +if (!window.console) { + window.console = function() { + var msgs = Array.prototype.slice.call(arguments, 0); + postMessage({type: "log", data: msgs}); + }; + window.console.error = + window.console.warn = + window.console.log = + window.console.trace = window.console; +} +window.window = window; +window.ace = window; + +window.onerror = function(message, file, line, col, err) { + postMessage({type: "error", data: { + message: message, + data: err.data, + file: file, + line: line, + col: col, + stack: err.stack + }}); +}; + +window.normalizeModule = function(parentId, moduleName) { + // normalize plugin requires + if (moduleName.indexOf("!") !== -1) { + var chunks = moduleName.split("!"); + return window.normalizeModule(parentId, chunks[0]) + "!" + window.normalizeModule(parentId, chunks[1]); + } + // normalize relative requires + if (moduleName.charAt(0) == ".") { + var base = parentId.split("/").slice(0, -1).join("/"); + moduleName = (base ? base + "/" : "") + moduleName; + + while (moduleName.indexOf(".") !== -1 && previous != moduleName) { + var previous = moduleName; + moduleName = moduleName.replace(/^\.\//, "").replace(/\/\.\//, "/").replace(/[^\/]+\/\.\.\//, ""); + } + } + + return moduleName; +}; + +window.require = function require(parentId, id) { + if (!id) { + id = parentId; + parentId = null; + } + if (!id.charAt) + throw new Error("worker.js require() accepts only (parentId, id) as arguments"); + + id = window.normalizeModule(parentId, id); + + var module = window.require.modules[id]; + if (module) { + if (!module.initialized) { + module.initialized = true; + module.exports = module.factory().exports; + } + return module.exports; + } + + if (!window.require.tlns) + return console.log("unable to load " + id); + + var path = resolveModuleId(id, window.require.tlns); + if (path.slice(-3) != ".js") path += ".js"; + + window.require.id = id; + window.require.modules[id] = {}; // prevent infinite loop on broken modules + importScripts(path); + return window.require(parentId, id); +}; +function resolveModuleId(id, paths) { + var testPath = id, tail = ""; + while (testPath) { + var alias = paths[testPath]; + if (typeof alias == "string") { + return alias + tail; + } else if (alias) { + return alias.location.replace(/\/*$/, "/") + (tail || alias.main || alias.name); + } else if (alias === false) { + return ""; + } + var i = testPath.lastIndexOf("/"); + if (i === -1) break; + tail = testPath.substr(i) + tail; + testPath = testPath.slice(0, i); + } + return id; +} +window.require.modules = {}; +window.require.tlns = {}; + +window.define = function(id, deps, factory) { + if (arguments.length == 2) { + factory = deps; + if (typeof id != "string") { + deps = id; + id = window.require.id; + } + } else if (arguments.length == 1) { + factory = id; + deps = []; + id = window.require.id; + } + + if (typeof factory != "function") { + window.require.modules[id] = { + exports: factory, + initialized: true + }; + return; + } + + if (!deps.length) + // If there is no dependencies, we inject "require", "exports" and + // "module" as dependencies, to provide CommonJS compatibility. + deps = ["require", "exports", "module"]; + + var req = function(childId) { + return window.require(id, childId); + }; + + window.require.modules[id] = { + exports: {}, + factory: function() { + var module = this; + var returnExports = factory.apply(this, deps.slice(0, factory.length).map(function(dep) { + switch (dep) { + // Because "require", "exports" and "module" aren't actual + // dependencies, we must handle them seperately. + case "require": return req; + case "exports": return module.exports; + case "module": return module; + // But for all other dependencies, we can just go ahead and + // require them. + default: return req(dep); + } + })); + if (returnExports) + module.exports = returnExports; + return module; + } + }; +}; +window.define.amd = {}; +require.tlns = {}; +window.initBaseUrls = function initBaseUrls(topLevelNamespaces) { + for (var i in topLevelNamespaces) + require.tlns[i] = topLevelNamespaces[i]; +}; + +window.initSender = function initSender() { + + var EventEmitter = window.require("ace/lib/event_emitter").EventEmitter; + var oop = window.require("ace/lib/oop"); + + var Sender = function() {}; + + (function() { + + oop.implement(this, EventEmitter); + + this.callback = function(data, callbackId) { + postMessage({ + type: "call", + id: callbackId, + data: data + }); + }; + + this.emit = function(name, data) { + postMessage({ + type: "event", + name: name, + data: data + }); + }; + + }).call(Sender.prototype); + + return new Sender(); +}; + +var main = window.main = null; +var sender = window.sender = null; + +window.onmessage = function(e) { + var msg = e.data; + if (msg.event && sender) { + sender._signal(msg.event, msg.data); + } + else if (msg.command) { + if (main[msg.command]) + main[msg.command].apply(main, msg.args); + else if (window[msg.command]) + window[msg.command].apply(window, msg.args); + else + throw new Error("Unknown command:" + msg.command); + } + else if (msg.init) { + window.initBaseUrls(msg.tlns); + require("ace/lib/es5-shim"); + sender = window.sender = window.initSender(); + var clazz = require(msg.module)[msg.classname]; + main = window.main = new clazz(sender); + } +}; +})(this); + +ace.define("ace/lib/oop",[], function(require, exports, module) { +"use strict"; + +exports.inherits = function(ctor, superCtor) { + ctor.super_ = superCtor; + ctor.prototype = Object.create(superCtor.prototype, { + constructor: { + value: ctor, + enumerable: false, + writable: true, + configurable: true + } + }); +}; + +exports.mixin = function(obj, mixin) { + for (var key in mixin) { + obj[key] = mixin[key]; + } + return obj; +}; + +exports.implement = function(proto, mixin) { + exports.mixin(proto, mixin); +}; + +}); + +ace.define("ace/range",[], function(require, exports, module) { +"use strict"; +var comparePoints = function(p1, p2) { + return p1.row - p2.row || p1.column - p2.column; +}; +var Range = function(startRow, startColumn, endRow, endColumn) { + this.start = { + row: startRow, + column: startColumn + }; + + this.end = { + row: endRow, + column: endColumn + }; +}; + +(function() { + this.isEqual = function(range) { + return this.start.row === range.start.row && + this.end.row === range.end.row && + this.start.column === range.start.column && + this.end.column === range.end.column; + }; + this.toString = function() { + return ("Range: [" + this.start.row + "/" + this.start.column + + "] -> [" + this.end.row + "/" + this.end.column + "]"); + }; + + this.contains = function(row, column) { + return this.compare(row, column) == 0; + }; + this.compareRange = function(range) { + var cmp, + end = range.end, + start = range.start; + + cmp = this.compare(end.row, end.column); + if (cmp == 1) { + cmp = this.compare(start.row, start.column); + if (cmp == 1) { + return 2; + } else if (cmp == 0) { + return 1; + } else { + return 0; + } + } else if (cmp == -1) { + return -2; + } else { + cmp = this.compare(start.row, start.column); + if (cmp == -1) { + return -1; + } else if (cmp == 1) { + return 42; + } else { + return 0; + } + } + }; + this.comparePoint = function(p) { + return this.compare(p.row, p.column); + }; + this.containsRange = function(range) { + return this.comparePoint(range.start) == 0 && this.comparePoint(range.end) == 0; + }; + this.intersects = function(range) { + var cmp = this.compareRange(range); + return (cmp == -1 || cmp == 0 || cmp == 1); + }; + this.isEnd = function(row, column) { + return this.end.row == row && this.end.column == column; + }; + this.isStart = function(row, column) { + return this.start.row == row && this.start.column == column; + }; + this.setStart = function(row, column) { + if (typeof row == "object") { + this.start.column = row.column; + this.start.row = row.row; + } else { + this.start.row = row; + this.start.column = column; + } + }; + this.setEnd = function(row, column) { + if (typeof row == "object") { + this.end.column = row.column; + this.end.row = row.row; + } else { + this.end.row = row; + this.end.column = column; + } + }; + this.inside = function(row, column) { + if (this.compare(row, column) == 0) { + if (this.isEnd(row, column) || this.isStart(row, column)) { + return false; + } else { + return true; + } + } + return false; + }; + this.insideStart = function(row, column) { + if (this.compare(row, column) == 0) { + if (this.isEnd(row, column)) { + return false; + } else { + return true; + } + } + return false; + }; + this.insideEnd = function(row, column) { + if (this.compare(row, column) == 0) { + if (this.isStart(row, column)) { + return false; + } else { + return true; + } + } + return false; + }; + this.compare = function(row, column) { + if (!this.isMultiLine()) { + if (row === this.start.row) { + return column < this.start.column ? -1 : (column > this.end.column ? 1 : 0); + } + } + + if (row < this.start.row) + return -1; + + if (row > this.end.row) + return 1; + + if (this.start.row === row) + return column >= this.start.column ? 0 : -1; + + if (this.end.row === row) + return column <= this.end.column ? 0 : 1; + + return 0; + }; + this.compareStart = function(row, column) { + if (this.start.row == row && this.start.column == column) { + return -1; + } else { + return this.compare(row, column); + } + }; + this.compareEnd = function(row, column) { + if (this.end.row == row && this.end.column == column) { + return 1; + } else { + return this.compare(row, column); + } + }; + this.compareInside = function(row, column) { + if (this.end.row == row && this.end.column == column) { + return 1; + } else if (this.start.row == row && this.start.column == column) { + return -1; + } else { + return this.compare(row, column); + } + }; + this.clipRows = function(firstRow, lastRow) { + if (this.end.row > lastRow) + var end = {row: lastRow + 1, column: 0}; + else if (this.end.row < firstRow) + var end = {row: firstRow, column: 0}; + + if (this.start.row > lastRow) + var start = {row: lastRow + 1, column: 0}; + else if (this.start.row < firstRow) + var start = {row: firstRow, column: 0}; + + return Range.fromPoints(start || this.start, end || this.end); + }; + this.extend = function(row, column) { + var cmp = this.compare(row, column); + + if (cmp == 0) + return this; + else if (cmp == -1) + var start = {row: row, column: column}; + else + var end = {row: row, column: column}; + + return Range.fromPoints(start || this.start, end || this.end); + }; + + this.isEmpty = function() { + return (this.start.row === this.end.row && this.start.column === this.end.column); + }; + this.isMultiLine = function() { + return (this.start.row !== this.end.row); + }; + this.clone = function() { + return Range.fromPoints(this.start, this.end); + }; + this.collapseRows = function() { + if (this.end.column == 0) + return new Range(this.start.row, 0, Math.max(this.start.row, this.end.row-1), 0); + else + return new Range(this.start.row, 0, this.end.row, 0); + }; + this.toScreenRange = function(session) { + var screenPosStart = session.documentToScreenPosition(this.start); + var screenPosEnd = session.documentToScreenPosition(this.end); + + return new Range( + screenPosStart.row, screenPosStart.column, + screenPosEnd.row, screenPosEnd.column + ); + }; + this.moveBy = function(row, column) { + this.start.row += row; + this.start.column += column; + this.end.row += row; + this.end.column += column; + }; + +}).call(Range.prototype); +Range.fromPoints = function(start, end) { + return new Range(start.row, start.column, end.row, end.column); +}; +Range.comparePoints = comparePoints; + +Range.comparePoints = function(p1, p2) { + return p1.row - p2.row || p1.column - p2.column; +}; + + +exports.Range = Range; +}); + +ace.define("ace/apply_delta",[], function(require, exports, module) { +"use strict"; + +function throwDeltaError(delta, errorText){ + console.log("Invalid Delta:", delta); + throw "Invalid Delta: " + errorText; +} + +function positionInDocument(docLines, position) { + return position.row >= 0 && position.row < docLines.length && + position.column >= 0 && position.column <= docLines[position.row].length; +} + +function validateDelta(docLines, delta) { + if (delta.action != "insert" && delta.action != "remove") + throwDeltaError(delta, "delta.action must be 'insert' or 'remove'"); + if (!(delta.lines instanceof Array)) + throwDeltaError(delta, "delta.lines must be an Array"); + if (!delta.start || !delta.end) + throwDeltaError(delta, "delta.start/end must be an present"); + var start = delta.start; + if (!positionInDocument(docLines, delta.start)) + throwDeltaError(delta, "delta.start must be contained in document"); + var end = delta.end; + if (delta.action == "remove" && !positionInDocument(docLines, end)) + throwDeltaError(delta, "delta.end must contained in document for 'remove' actions"); + var numRangeRows = end.row - start.row; + var numRangeLastLineChars = (end.column - (numRangeRows == 0 ? start.column : 0)); + if (numRangeRows != delta.lines.length - 1 || delta.lines[numRangeRows].length != numRangeLastLineChars) + throwDeltaError(delta, "delta.range must match delta lines"); +} + +exports.applyDelta = function(docLines, delta, doNotValidate) { + + var row = delta.start.row; + var startColumn = delta.start.column; + var line = docLines[row] || ""; + switch (delta.action) { + case "insert": + var lines = delta.lines; + if (lines.length === 1) { + docLines[row] = line.substring(0, startColumn) + delta.lines[0] + line.substring(startColumn); + } else { + var args = [row, 1].concat(delta.lines); + docLines.splice.apply(docLines, args); + docLines[row] = line.substring(0, startColumn) + docLines[row]; + docLines[row + delta.lines.length - 1] += line.substring(startColumn); + } + break; + case "remove": + var endColumn = delta.end.column; + var endRow = delta.end.row; + if (row === endRow) { + docLines[row] = line.substring(0, startColumn) + line.substring(endColumn); + } else { + docLines.splice( + row, endRow - row + 1, + line.substring(0, startColumn) + docLines[endRow].substring(endColumn) + ); + } + break; + } +}; +}); + +ace.define("ace/lib/event_emitter",[], function(require, exports, module) { +"use strict"; + +var EventEmitter = {}; +var stopPropagation = function() { this.propagationStopped = true; }; +var preventDefault = function() { this.defaultPrevented = true; }; + +EventEmitter._emit = +EventEmitter._dispatchEvent = function(eventName, e) { + this._eventRegistry || (this._eventRegistry = {}); + this._defaultHandlers || (this._defaultHandlers = {}); + + var listeners = this._eventRegistry[eventName] || []; + var defaultHandler = this._defaultHandlers[eventName]; + if (!listeners.length && !defaultHandler) + return; + + if (typeof e != "object" || !e) + e = {}; + + if (!e.type) + e.type = eventName; + if (!e.stopPropagation) + e.stopPropagation = stopPropagation; + if (!e.preventDefault) + e.preventDefault = preventDefault; + + listeners = listeners.slice(); + for (var i=0; i this.row) + return; + + var point = $getTransformedPoint(delta, {row: this.row, column: this.column}, this.$insertRight); + this.setPosition(point.row, point.column, true); + }; + + function $pointsInOrder(point1, point2, equalPointsInOrder) { + var bColIsAfter = equalPointsInOrder ? point1.column <= point2.column : point1.column < point2.column; + return (point1.row < point2.row) || (point1.row == point2.row && bColIsAfter); + } + + function $getTransformedPoint(delta, point, moveIfEqual) { + var deltaIsInsert = delta.action == "insert"; + var deltaRowShift = (deltaIsInsert ? 1 : -1) * (delta.end.row - delta.start.row); + var deltaColShift = (deltaIsInsert ? 1 : -1) * (delta.end.column - delta.start.column); + var deltaStart = delta.start; + var deltaEnd = deltaIsInsert ? deltaStart : delta.end; // Collapse insert range. + if ($pointsInOrder(point, deltaStart, moveIfEqual)) { + return { + row: point.row, + column: point.column + }; + } + if ($pointsInOrder(deltaEnd, point, !moveIfEqual)) { + return { + row: point.row + deltaRowShift, + column: point.column + (point.row == deltaEnd.row ? deltaColShift : 0) + }; + } + + return { + row: deltaStart.row, + column: deltaStart.column + }; + } + this.setPosition = function(row, column, noClip) { + var pos; + if (noClip) { + pos = { + row: row, + column: column + }; + } else { + pos = this.$clipPositionToDocument(row, column); + } + + if (this.row == pos.row && this.column == pos.column) + return; + + var old = { + row: this.row, + column: this.column + }; + + this.row = pos.row; + this.column = pos.column; + this._signal("change", { + old: old, + value: pos + }); + }; + this.detach = function() { + this.document.removeEventListener("change", this.$onChange); + }; + this.attach = function(doc) { + this.document = doc || this.document; + this.document.on("change", this.$onChange); + }; + this.$clipPositionToDocument = function(row, column) { + var pos = {}; + + if (row >= this.document.getLength()) { + pos.row = Math.max(0, this.document.getLength() - 1); + pos.column = this.document.getLine(pos.row).length; + } + else if (row < 0) { + pos.row = 0; + pos.column = 0; + } + else { + pos.row = row; + pos.column = Math.min(this.document.getLine(pos.row).length, Math.max(0, column)); + } + + if (column < 0) + pos.column = 0; + + return pos; + }; + +}).call(Anchor.prototype); + +}); + +ace.define("ace/document",[], function(require, exports, module) { +"use strict"; + +var oop = require("./lib/oop"); +var applyDelta = require("./apply_delta").applyDelta; +var EventEmitter = require("./lib/event_emitter").EventEmitter; +var Range = require("./range").Range; +var Anchor = require("./anchor").Anchor; + +var Document = function(textOrLines) { + this.$lines = [""]; + if (textOrLines.length === 0) { + this.$lines = [""]; + } else if (Array.isArray(textOrLines)) { + this.insertMergedLines({row: 0, column: 0}, textOrLines); + } else { + this.insert({row: 0, column:0}, textOrLines); + } +}; + +(function() { + + oop.implement(this, EventEmitter); + this.setValue = function(text) { + var len = this.getLength() - 1; + this.remove(new Range(0, 0, len, this.getLine(len).length)); + this.insert({row: 0, column: 0}, text); + }; + this.getValue = function() { + return this.getAllLines().join(this.getNewLineCharacter()); + }; + this.createAnchor = function(row, column) { + return new Anchor(this, row, column); + }; + if ("aaa".split(/a/).length === 0) { + this.$split = function(text) { + return text.replace(/\r\n|\r/g, "\n").split("\n"); + }; + } else { + this.$split = function(text) { + return text.split(/\r\n|\r|\n/); + }; + } + + + this.$detectNewLine = function(text) { + var match = text.match(/^.*?(\r\n|\r|\n)/m); + this.$autoNewLine = match ? match[1] : "\n"; + this._signal("changeNewLineMode"); + }; + this.getNewLineCharacter = function() { + switch (this.$newLineMode) { + case "windows": + return "\r\n"; + case "unix": + return "\n"; + default: + return this.$autoNewLine || "\n"; + } + }; + + this.$autoNewLine = ""; + this.$newLineMode = "auto"; + this.setNewLineMode = function(newLineMode) { + if (this.$newLineMode === newLineMode) + return; + + this.$newLineMode = newLineMode; + this._signal("changeNewLineMode"); + }; + this.getNewLineMode = function() { + return this.$newLineMode; + }; + this.isNewLine = function(text) { + return (text == "\r\n" || text == "\r" || text == "\n"); + }; + this.getLine = function(row) { + return this.$lines[row] || ""; + }; + this.getLines = function(firstRow, lastRow) { + return this.$lines.slice(firstRow, lastRow + 1); + }; + this.getAllLines = function() { + return this.getLines(0, this.getLength()); + }; + this.getLength = function() { + return this.$lines.length; + }; + this.getTextRange = function(range) { + return this.getLinesForRange(range).join(this.getNewLineCharacter()); + }; + this.getLinesForRange = function(range) { + var lines; + if (range.start.row === range.end.row) { + lines = [this.getLine(range.start.row).substring(range.start.column, range.end.column)]; + } else { + lines = this.getLines(range.start.row, range.end.row); + lines[0] = (lines[0] || "").substring(range.start.column); + var l = lines.length - 1; + if (range.end.row - range.start.row == l) + lines[l] = lines[l].substring(0, range.end.column); + } + return lines; + }; + this.insertLines = function(row, lines) { + console.warn("Use of document.insertLines is deprecated. Use the insertFullLines method instead."); + return this.insertFullLines(row, lines); + }; + this.removeLines = function(firstRow, lastRow) { + console.warn("Use of document.removeLines is deprecated. Use the removeFullLines method instead."); + return this.removeFullLines(firstRow, lastRow); + }; + this.insertNewLine = function(position) { + console.warn("Use of document.insertNewLine is deprecated. Use insertMergedLines(position, ['', '']) instead."); + return this.insertMergedLines(position, ["", ""]); + }; + this.insert = function(position, text) { + if (this.getLength() <= 1) + this.$detectNewLine(text); + + return this.insertMergedLines(position, this.$split(text)); + }; + this.insertInLine = function(position, text) { + var start = this.clippedPos(position.row, position.column); + var end = this.pos(position.row, position.column + text.length); + + this.applyDelta({ + start: start, + end: end, + action: "insert", + lines: [text] + }, true); + + return this.clonePos(end); + }; + + this.clippedPos = function(row, column) { + var length = this.getLength(); + if (row === undefined) { + row = length; + } else if (row < 0) { + row = 0; + } else if (row >= length) { + row = length - 1; + column = undefined; + } + var line = this.getLine(row); + if (column == undefined) + column = line.length; + column = Math.min(Math.max(column, 0), line.length); + return {row: row, column: column}; + }; + + this.clonePos = function(pos) { + return {row: pos.row, column: pos.column}; + }; + + this.pos = function(row, column) { + return {row: row, column: column}; + }; + + this.$clipPosition = function(position) { + var length = this.getLength(); + if (position.row >= length) { + position.row = Math.max(0, length - 1); + position.column = this.getLine(length - 1).length; + } else { + position.row = Math.max(0, position.row); + position.column = Math.min(Math.max(position.column, 0), this.getLine(position.row).length); + } + return position; + }; + this.insertFullLines = function(row, lines) { + row = Math.min(Math.max(row, 0), this.getLength()); + var column = 0; + if (row < this.getLength()) { + lines = lines.concat([""]); + column = 0; + } else { + lines = [""].concat(lines); + row--; + column = this.$lines[row].length; + } + this.insertMergedLines({row: row, column: column}, lines); + }; + this.insertMergedLines = function(position, lines) { + var start = this.clippedPos(position.row, position.column); + var end = { + row: start.row + lines.length - 1, + column: (lines.length == 1 ? start.column : 0) + lines[lines.length - 1].length + }; + + this.applyDelta({ + start: start, + end: end, + action: "insert", + lines: lines + }); + + return this.clonePos(end); + }; + this.remove = function(range) { + var start = this.clippedPos(range.start.row, range.start.column); + var end = this.clippedPos(range.end.row, range.end.column); + this.applyDelta({ + start: start, + end: end, + action: "remove", + lines: this.getLinesForRange({start: start, end: end}) + }); + return this.clonePos(start); + }; + this.removeInLine = function(row, startColumn, endColumn) { + var start = this.clippedPos(row, startColumn); + var end = this.clippedPos(row, endColumn); + + this.applyDelta({ + start: start, + end: end, + action: "remove", + lines: this.getLinesForRange({start: start, end: end}) + }, true); + + return this.clonePos(start); + }; + this.removeFullLines = function(firstRow, lastRow) { + firstRow = Math.min(Math.max(0, firstRow), this.getLength() - 1); + lastRow = Math.min(Math.max(0, lastRow ), this.getLength() - 1); + var deleteFirstNewLine = lastRow == this.getLength() - 1 && firstRow > 0; + var deleteLastNewLine = lastRow < this.getLength() - 1; + var startRow = ( deleteFirstNewLine ? firstRow - 1 : firstRow ); + var startCol = ( deleteFirstNewLine ? this.getLine(startRow).length : 0 ); + var endRow = ( deleteLastNewLine ? lastRow + 1 : lastRow ); + var endCol = ( deleteLastNewLine ? 0 : this.getLine(endRow).length ); + var range = new Range(startRow, startCol, endRow, endCol); + var deletedLines = this.$lines.slice(firstRow, lastRow + 1); + + this.applyDelta({ + start: range.start, + end: range.end, + action: "remove", + lines: this.getLinesForRange(range) + }); + return deletedLines; + }; + this.removeNewLine = function(row) { + if (row < this.getLength() - 1 && row >= 0) { + this.applyDelta({ + start: this.pos(row, this.getLine(row).length), + end: this.pos(row + 1, 0), + action: "remove", + lines: ["", ""] + }); + } + }; + this.replace = function(range, text) { + if (!(range instanceof Range)) + range = Range.fromPoints(range.start, range.end); + if (text.length === 0 && range.isEmpty()) + return range.start; + if (text == this.getTextRange(range)) + return range.end; + + this.remove(range); + var end; + if (text) { + end = this.insert(range.start, text); + } + else { + end = range.start; + } + + return end; + }; + this.applyDeltas = function(deltas) { + for (var i=0; i=0; i--) { + this.revertDelta(deltas[i]); + } + }; + this.applyDelta = function(delta, doNotValidate) { + var isInsert = delta.action == "insert"; + if (isInsert ? delta.lines.length <= 1 && !delta.lines[0] + : !Range.comparePoints(delta.start, delta.end)) { + return; + } + + if (isInsert && delta.lines.length > 20000) { + this.$splitAndapplyLargeDelta(delta, 20000); + } + else { + applyDelta(this.$lines, delta, doNotValidate); + this._signal("change", delta); + } + }; + + this.$splitAndapplyLargeDelta = function(delta, MAX) { + var lines = delta.lines; + var l = lines.length - MAX + 1; + var row = delta.start.row; + var column = delta.start.column; + for (var from = 0, to = 0; from < l; from = to) { + to += MAX - 1; + var chunk = lines.slice(from, to); + chunk.push(""); + this.applyDelta({ + start: this.pos(row + from, column), + end: this.pos(row + to, column = 0), + action: delta.action, + lines: chunk + }, true); + } + delta.lines = lines.slice(from); + delta.start.row = row + from; + delta.start.column = column; + this.applyDelta(delta, true); + }; + this.revertDelta = function(delta) { + this.applyDelta({ + start: this.clonePos(delta.start), + end: this.clonePos(delta.end), + action: (delta.action == "insert" ? "remove" : "insert"), + lines: delta.lines.slice() + }); + }; + this.indexToPosition = function(index, startRow) { + var lines = this.$lines || this.getAllLines(); + var newlineLength = this.getNewLineCharacter().length; + for (var i = startRow || 0, l = lines.length; i < l; i++) { + index -= lines[i].length + newlineLength; + if (index < 0) + return {row: i, column: index + lines[i].length + newlineLength}; + } + return {row: l-1, column: index + lines[l-1].length + newlineLength}; + }; + this.positionToIndex = function(pos, startRow) { + var lines = this.$lines || this.getAllLines(); + var newlineLength = this.getNewLineCharacter().length; + var index = 0; + var row = Math.min(pos.row, lines.length); + for (var i = startRow || 0; i < row; ++i) + index += lines[i].length + newlineLength; + + return index + pos.column; + }; + +}).call(Document.prototype); + +exports.Document = Document; +}); + +ace.define("ace/lib/lang",[], function(require, exports, module) { +"use strict"; + +exports.last = function(a) { + return a[a.length - 1]; +}; + +exports.stringReverse = function(string) { + return string.split("").reverse().join(""); +}; + +exports.stringRepeat = function (string, count) { + var result = ''; + while (count > 0) { + if (count & 1) + result += string; + + if (count >>= 1) + string += string; + } + return result; +}; + +var trimBeginRegexp = /^\s\s*/; +var trimEndRegexp = /\s\s*$/; + +exports.stringTrimLeft = function (string) { + return string.replace(trimBeginRegexp, ''); +}; + +exports.stringTrimRight = function (string) { + return string.replace(trimEndRegexp, ''); +}; + +exports.copyObject = function(obj) { + var copy = {}; + for (var key in obj) { + copy[key] = obj[key]; + } + return copy; +}; + +exports.copyArray = function(array){ + var copy = []; + for (var i=0, l=array.length; i= '0' && ch <= '9') { + string += ch; + next(); + } + if (ch === '.') { + string += '.'; + while (next() && ch >= '0' && ch <= '9') { + string += ch; + } + } + if (ch === 'e' || ch === 'E') { + string += ch; + next(); + if (ch === '-' || ch === '+') { + string += ch; + next(); + } + while (ch >= '0' && ch <= '9') { + string += ch; + next(); + } + } + number = +string; + if (isNaN(number)) { + error("Bad number"); + } else { + return number; + } + }, + + string = function () { + + var hex, + i, + string = '', + uffff; + + if (ch === '"') { + while (next()) { + if (ch === '"') { + next(); + return string; + } else if (ch === '\\') { + next(); + if (ch === 'u') { + uffff = 0; + for (i = 0; i < 4; i += 1) { + hex = parseInt(next(), 16); + if (!isFinite(hex)) { + break; + } + uffff = uffff * 16 + hex; + } + string += String.fromCharCode(uffff); + } else if (typeof escapee[ch] === 'string') { + string += escapee[ch]; + } else { + break; + } + } else if (ch == "\n" || ch == "\r") { + break; + } else { + string += ch; + } + } + } + error("Bad string"); + }, + + white = function () { + + while (ch && ch <= ' ') { + next(); + } + }, + + word = function () { + + switch (ch) { + case 't': + next('t'); + next('r'); + next('u'); + next('e'); + return true; + case 'f': + next('f'); + next('a'); + next('l'); + next('s'); + next('e'); + return false; + case 'n': + next('n'); + next('u'); + next('l'); + next('l'); + return null; + } + error("Unexpected '" + ch + "'"); + }, + + value, // Place holder for the value function. + + array = function () { + + var array = []; + + if (ch === '[') { + next('['); + white(); + if (ch === ']') { + next(']'); + return array; // empty array + } + while (ch) { + array.push(value()); + white(); + if (ch === ']') { + next(']'); + return array; + } + next(','); + white(); + } + } + error("Bad array"); + }, + + object = function () { + + var key, + object = {}; + + if (ch === '{') { + next('{'); + white(); + if (ch === '}') { + next('}'); + return object; // empty object + } + while (ch) { + key = string(); + white(); + next(':'); + if (Object.hasOwnProperty.call(object, key)) { + error('Duplicate key "' + key + '"'); + } + object[key] = value(); + white(); + if (ch === '}') { + next('}'); + return object; + } + next(','); + white(); + } + } + error("Bad object"); + }; + + value = function () { + + white(); + switch (ch) { + case '{': + return object(); + case '[': + return array(); + case '"': + return string(); + case '-': + return number(); + default: + return ch >= '0' && ch <= '9' ? number() : word(); + } + }; + + return function (source, reviver) { + var result; + + text = source; + at = 0; + ch = ' '; + result = value(); + white(); + if (ch) { + error("Syntax error"); + } + + return typeof reviver === 'function' ? function walk(holder, key) { + var k, v, value = holder[key]; + if (value && typeof value === 'object') { + for (k in value) { + if (Object.hasOwnProperty.call(value, k)) { + v = walk(value, k); + if (v !== undefined) { + value[k] = v; + } else { + delete value[k]; + } + } + } + } + return reviver.call(holder, key, value); + }({'': result}, '') : result; + }; +}); + +ace.define("ace/mode/json_worker",[], function(require, exports, module) { +"use strict"; + +var oop = require("../lib/oop"); +var Mirror = require("../worker/mirror").Mirror; +var parse = require("./json/json_parse"); + +var JsonWorker = exports.JsonWorker = function(sender) { + Mirror.call(this, sender); + this.setTimeout(200); +}; + +oop.inherits(JsonWorker, Mirror); + +(function() { + + this.onUpdate = function() { + var value = this.doc.getValue(); + var errors = []; + try { + if (value) + parse(value); + } catch (e) { + var pos = this.doc.indexToPosition(e.at-1); + errors.push({ + row: pos.row, + column: pos.column, + text: e.message, + type: "error" + }); + } + this.sender.emit("annotate", errors); + }; + +}).call(JsonWorker.prototype); + +}); + +ace.define("ace/lib/es5-shim",[], function(require, exports, module) { + +function Empty() {} + +if (!Function.prototype.bind) { + Function.prototype.bind = function bind(that) { // .length is 1 + var target = this; + if (typeof target != "function") { + throw new TypeError("Function.prototype.bind called on incompatible " + target); + } + var args = slice.call(arguments, 1); // for normal call + var bound = function () { + + if (this instanceof bound) { + + var result = target.apply( + this, + args.concat(slice.call(arguments)) + ); + if (Object(result) === result) { + return result; + } + return this; + + } else { + return target.apply( + that, + args.concat(slice.call(arguments)) + ); + + } + + }; + if(target.prototype) { + Empty.prototype = target.prototype; + bound.prototype = new Empty(); + Empty.prototype = null; + } + return bound; + }; +} +var call = Function.prototype.call; +var prototypeOfArray = Array.prototype; +var prototypeOfObject = Object.prototype; +var slice = prototypeOfArray.slice; +var _toString = call.bind(prototypeOfObject.toString); +var owns = call.bind(prototypeOfObject.hasOwnProperty); +var defineGetter; +var defineSetter; +var lookupGetter; +var lookupSetter; +var supportsAccessors; +if ((supportsAccessors = owns(prototypeOfObject, "__defineGetter__"))) { + defineGetter = call.bind(prototypeOfObject.__defineGetter__); + defineSetter = call.bind(prototypeOfObject.__defineSetter__); + lookupGetter = call.bind(prototypeOfObject.__lookupGetter__); + lookupSetter = call.bind(prototypeOfObject.__lookupSetter__); +} +if ([1,2].splice(0).length != 2) { + if(function() { // test IE < 9 to splice bug - see issue #138 + function makeArray(l) { + var a = new Array(l+2); + a[0] = a[1] = 0; + return a; + } + var array = [], lengthBefore; + + array.splice.apply(array, makeArray(20)); + array.splice.apply(array, makeArray(26)); + + lengthBefore = array.length; //46 + array.splice(5, 0, "XXX"); // add one element + + lengthBefore + 1 == array.length + + if (lengthBefore + 1 == array.length) { + return true;// has right splice implementation without bugs + } + }()) {//IE 6/7 + var array_splice = Array.prototype.splice; + Array.prototype.splice = function(start, deleteCount) { + if (!arguments.length) { + return []; + } else { + return array_splice.apply(this, [ + start === void 0 ? 0 : start, + deleteCount === void 0 ? (this.length - start) : deleteCount + ].concat(slice.call(arguments, 2))) + } + }; + } else {//IE8 + Array.prototype.splice = function(pos, removeCount){ + var length = this.length; + if (pos > 0) { + if (pos > length) + pos = length; + } else if (pos == void 0) { + pos = 0; + } else if (pos < 0) { + pos = Math.max(length + pos, 0); + } + + if (!(pos+removeCount < length)) + removeCount = length - pos; + + var removed = this.slice(pos, pos+removeCount); + var insert = slice.call(arguments, 2); + var add = insert.length; + if (pos === length) { + if (add) { + this.push.apply(this, insert); + } + } else { + var remove = Math.min(removeCount, length - pos); + var tailOldPos = pos + remove; + var tailNewPos = tailOldPos + add - remove; + var tailCount = length - tailOldPos; + var lengthAfterRemove = length - remove; + + if (tailNewPos < tailOldPos) { // case A + for (var i = 0; i < tailCount; ++i) { + this[tailNewPos+i] = this[tailOldPos+i]; + } + } else if (tailNewPos > tailOldPos) { // case B + for (i = tailCount; i--; ) { + this[tailNewPos+i] = this[tailOldPos+i]; + } + } // else, add == remove (nothing to do) + + if (add && pos === lengthAfterRemove) { + this.length = lengthAfterRemove; // truncate array + this.push.apply(this, insert); + } else { + this.length = lengthAfterRemove + add; // reserves space + for (i = 0; i < add; ++i) { + this[pos+i] = insert[i]; + } + } + } + return removed; + }; + } +} +if (!Array.isArray) { + Array.isArray = function isArray(obj) { + return _toString(obj) == "[object Array]"; + }; +} +var boxedString = Object("a"), + splitString = boxedString[0] != "a" || !(0 in boxedString); + +if (!Array.prototype.forEach) { + Array.prototype.forEach = function forEach(fun /*, thisp*/) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + thisp = arguments[1], + i = -1, + length = self.length >>> 0; + if (_toString(fun) != "[object Function]") { + throw new TypeError(); // TODO message + } + + while (++i < length) { + if (i in self) { + fun.call(thisp, self[i], i, object); + } + } + }; +} +if (!Array.prototype.map) { + Array.prototype.map = function map(fun /*, thisp*/) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0, + result = Array(length), + thisp = arguments[1]; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + + for (var i = 0; i < length; i++) { + if (i in self) + result[i] = fun.call(thisp, self[i], i, object); + } + return result; + }; +} +if (!Array.prototype.filter) { + Array.prototype.filter = function filter(fun /*, thisp */) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0, + result = [], + value, + thisp = arguments[1]; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + + for (var i = 0; i < length; i++) { + if (i in self) { + value = self[i]; + if (fun.call(thisp, value, i, object)) { + result.push(value); + } + } + } + return result; + }; +} +if (!Array.prototype.every) { + Array.prototype.every = function every(fun /*, thisp */) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0, + thisp = arguments[1]; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + + for (var i = 0; i < length; i++) { + if (i in self && !fun.call(thisp, self[i], i, object)) { + return false; + } + } + return true; + }; +} +if (!Array.prototype.some) { + Array.prototype.some = function some(fun /*, thisp */) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0, + thisp = arguments[1]; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + + for (var i = 0; i < length; i++) { + if (i in self && fun.call(thisp, self[i], i, object)) { + return true; + } + } + return false; + }; +} +if (!Array.prototype.reduce) { + Array.prototype.reduce = function reduce(fun /*, initial*/) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + if (!length && arguments.length == 1) { + throw new TypeError("reduce of empty array with no initial value"); + } + + var i = 0; + var result; + if (arguments.length >= 2) { + result = arguments[1]; + } else { + do { + if (i in self) { + result = self[i++]; + break; + } + if (++i >= length) { + throw new TypeError("reduce of empty array with no initial value"); + } + } while (true); + } + + for (; i < length; i++) { + if (i in self) { + result = fun.call(void 0, result, self[i], i, object); + } + } + + return result; + }; +} +if (!Array.prototype.reduceRight) { + Array.prototype.reduceRight = function reduceRight(fun /*, initial*/) { + var object = toObject(this), + self = splitString && _toString(this) == "[object String]" ? + this.split("") : + object, + length = self.length >>> 0; + if (_toString(fun) != "[object Function]") { + throw new TypeError(fun + " is not a function"); + } + if (!length && arguments.length == 1) { + throw new TypeError("reduceRight of empty array with no initial value"); + } + + var result, i = length - 1; + if (arguments.length >= 2) { + result = arguments[1]; + } else { + do { + if (i in self) { + result = self[i--]; + break; + } + if (--i < 0) { + throw new TypeError("reduceRight of empty array with no initial value"); + } + } while (true); + } + + do { + if (i in this) { + result = fun.call(void 0, result, self[i], i, object); + } + } while (i--); + + return result; + }; +} +if (!Array.prototype.indexOf || ([0, 1].indexOf(1, 2) != -1)) { + Array.prototype.indexOf = function indexOf(sought /*, fromIndex */ ) { + var self = splitString && _toString(this) == "[object String]" ? + this.split("") : + toObject(this), + length = self.length >>> 0; + + if (!length) { + return -1; + } + + var i = 0; + if (arguments.length > 1) { + i = toInteger(arguments[1]); + } + i = i >= 0 ? i : Math.max(0, length + i); + for (; i < length; i++) { + if (i in self && self[i] === sought) { + return i; + } + } + return -1; + }; +} +if (!Array.prototype.lastIndexOf || ([0, 1].lastIndexOf(0, -3) != -1)) { + Array.prototype.lastIndexOf = function lastIndexOf(sought /*, fromIndex */) { + var self = splitString && _toString(this) == "[object String]" ? + this.split("") : + toObject(this), + length = self.length >>> 0; + + if (!length) { + return -1; + } + var i = length - 1; + if (arguments.length > 1) { + i = Math.min(i, toInteger(arguments[1])); + } + i = i >= 0 ? i : length - Math.abs(i); + for (; i >= 0; i--) { + if (i in self && sought === self[i]) { + return i; + } + } + return -1; + }; +} +if (!Object.getPrototypeOf) { + Object.getPrototypeOf = function getPrototypeOf(object) { + return object.__proto__ || ( + object.constructor ? + object.constructor.prototype : + prototypeOfObject + ); + }; +} +if (!Object.getOwnPropertyDescriptor) { + var ERR_NON_OBJECT = "Object.getOwnPropertyDescriptor called on a " + + "non-object: "; + Object.getOwnPropertyDescriptor = function getOwnPropertyDescriptor(object, property) { + if ((typeof object != "object" && typeof object != "function") || object === null) + throw new TypeError(ERR_NON_OBJECT + object); + if (!owns(object, property)) + return; + + var descriptor, getter, setter; + descriptor = { enumerable: true, configurable: true }; + if (supportsAccessors) { + var prototype = object.__proto__; + object.__proto__ = prototypeOfObject; + + var getter = lookupGetter(object, property); + var setter = lookupSetter(object, property); + object.__proto__ = prototype; + + if (getter || setter) { + if (getter) descriptor.get = getter; + if (setter) descriptor.set = setter; + return descriptor; + } + } + descriptor.value = object[property]; + return descriptor; + }; +} +if (!Object.getOwnPropertyNames) { + Object.getOwnPropertyNames = function getOwnPropertyNames(object) { + return Object.keys(object); + }; +} +if (!Object.create) { + var createEmpty; + if (Object.prototype.__proto__ === null) { + createEmpty = function () { + return { "__proto__": null }; + }; + } else { + createEmpty = function () { + var empty = {}; + for (var i in empty) + empty[i] = null; + empty.constructor = + empty.hasOwnProperty = + empty.propertyIsEnumerable = + empty.isPrototypeOf = + empty.toLocaleString = + empty.toString = + empty.valueOf = + empty.__proto__ = null; + return empty; + } + } + + Object.create = function create(prototype, properties) { + var object; + if (prototype === null) { + object = createEmpty(); + } else { + if (typeof prototype != "object") + throw new TypeError("typeof prototype["+(typeof prototype)+"] != 'object'"); + var Type = function () {}; + Type.prototype = prototype; + object = new Type(); + object.__proto__ = prototype; + } + if (properties !== void 0) + Object.defineProperties(object, properties); + return object; + }; +} + +function doesDefinePropertyWork(object) { + try { + Object.defineProperty(object, "sentinel", {}); + return "sentinel" in object; + } catch (exception) { + } +} +if (Object.defineProperty) { + var definePropertyWorksOnObject = doesDefinePropertyWork({}); + var definePropertyWorksOnDom = typeof document == "undefined" || + doesDefinePropertyWork(document.createElement("div")); + if (!definePropertyWorksOnObject || !definePropertyWorksOnDom) { + var definePropertyFallback = Object.defineProperty; + } +} + +if (!Object.defineProperty || definePropertyFallback) { + var ERR_NON_OBJECT_DESCRIPTOR = "Property description must be an object: "; + var ERR_NON_OBJECT_TARGET = "Object.defineProperty called on non-object: " + var ERR_ACCESSORS_NOT_SUPPORTED = "getters & setters can not be defined " + + "on this javascript engine"; + + Object.defineProperty = function defineProperty(object, property, descriptor) { + if ((typeof object != "object" && typeof object != "function") || object === null) + throw new TypeError(ERR_NON_OBJECT_TARGET + object); + if ((typeof descriptor != "object" && typeof descriptor != "function") || descriptor === null) + throw new TypeError(ERR_NON_OBJECT_DESCRIPTOR + descriptor); + if (definePropertyFallback) { + try { + return definePropertyFallback.call(Object, object, property, descriptor); + } catch (exception) { + } + } + if (owns(descriptor, "value")) { + + if (supportsAccessors && (lookupGetter(object, property) || + lookupSetter(object, property))) + { + var prototype = object.__proto__; + object.__proto__ = prototypeOfObject; + delete object[property]; + object[property] = descriptor.value; + object.__proto__ = prototype; + } else { + object[property] = descriptor.value; + } + } else { + if (!supportsAccessors) + throw new TypeError(ERR_ACCESSORS_NOT_SUPPORTED); + if (owns(descriptor, "get")) + defineGetter(object, property, descriptor.get); + if (owns(descriptor, "set")) + defineSetter(object, property, descriptor.set); + } + + return object; + }; +} +if (!Object.defineProperties) { + Object.defineProperties = function defineProperties(object, properties) { + for (var property in properties) { + if (owns(properties, property)) + Object.defineProperty(object, property, properties[property]); + } + return object; + }; +} +if (!Object.seal) { + Object.seal = function seal(object) { + return object; + }; +} +if (!Object.freeze) { + Object.freeze = function freeze(object) { + return object; + }; +} +try { + Object.freeze(function () {}); +} catch (exception) { + Object.freeze = (function freeze(freezeObject) { + return function freeze(object) { + if (typeof object == "function") { + return object; + } else { + return freezeObject(object); + } + }; + })(Object.freeze); +} +if (!Object.preventExtensions) { + Object.preventExtensions = function preventExtensions(object) { + return object; + }; +} +if (!Object.isSealed) { + Object.isSealed = function isSealed(object) { + return false; + }; +} +if (!Object.isFrozen) { + Object.isFrozen = function isFrozen(object) { + return false; + }; +} +if (!Object.isExtensible) { + Object.isExtensible = function isExtensible(object) { + if (Object(object) === object) { + throw new TypeError(); // TODO message + } + var name = ''; + while (owns(object, name)) { + name += '?'; + } + object[name] = true; + var returnValue = owns(object, name); + delete object[name]; + return returnValue; + }; +} +if (!Object.keys) { + var hasDontEnumBug = true, + dontEnums = [ + "toString", + "toLocaleString", + "valueOf", + "hasOwnProperty", + "isPrototypeOf", + "propertyIsEnumerable", + "constructor" + ], + dontEnumsLength = dontEnums.length; + + for (var key in {"toString": null}) { + hasDontEnumBug = false; + } + + Object.keys = function keys(object) { + + if ( + (typeof object != "object" && typeof object != "function") || + object === null + ) { + throw new TypeError("Object.keys called on a non-object"); + } + + var keys = []; + for (var name in object) { + if (owns(object, name)) { + keys.push(name); + } + } + + if (hasDontEnumBug) { + for (var i = 0, ii = dontEnumsLength; i < ii; i++) { + var dontEnum = dontEnums[i]; + if (owns(object, dontEnum)) { + keys.push(dontEnum); + } + } + } + return keys; + }; + +} +if (!Date.now) { + Date.now = function now() { + return new Date().getTime(); + }; +} +var ws = "\x09\x0A\x0B\x0C\x0D\x20\xA0\u1680\u180E\u2000\u2001\u2002\u2003" + + "\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u202F\u205F\u3000\u2028" + + "\u2029\uFEFF"; +if (!String.prototype.trim || ws.trim()) { + ws = "[" + ws + "]"; + var trimBeginRegexp = new RegExp("^" + ws + ws + "*"), + trimEndRegexp = new RegExp(ws + ws + "*$"); + String.prototype.trim = function trim() { + return String(this).replace(trimBeginRegexp, "").replace(trimEndRegexp, ""); + }; +} + +function toInteger(n) { + n = +n; + if (n !== n) { // isNaN + n = 0; + } else if (n !== 0 && n !== (1/0) && n !== -(1/0)) { + n = (n > 0 || -1) * Math.floor(Math.abs(n)); + } + return n; +} + +function isPrimitive(input) { + var type = typeof input; + return ( + input === null || + type === "undefined" || + type === "boolean" || + type === "number" || + type === "string" + ); +} + +function toPrimitive(input) { + var val, valueOf, toString; + if (isPrimitive(input)) { + return input; + } + valueOf = input.valueOf; + if (typeof valueOf === "function") { + val = valueOf.call(input); + if (isPrimitive(val)) { + return val; + } + } + toString = input.toString; + if (typeof toString === "function") { + val = toString.call(input); + if (isPrimitive(val)) { + return val; + } + } + throw new TypeError(); +} +var toObject = function (o) { + if (o == null) { // this matches both null and undefined + throw new TypeError("can't convert "+o+" to object"); + } + return Object(o); +}; + +}); From 5bde0b7fcf834358bad03aacd9a501961f3d494f Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 15:00:03 +0200 Subject: [PATCH 50/91] refactor : add explanation in the templates configuration --- src/editor/editor.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 792d6af9f..eb848d66c 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -45,12 +45,12 @@ let editor_overlay () = []) -let editor_container ~size ~contents ~buttons ~box_title = +let editor_container ~size ~contents ~buttons ~box_title ~box_header = let container = H.(div [ h3 [pcdata box_title]; - div []; + div [pcdata box_header]; contents; div ~a:[a_class ["buttons"] ] buttons ] @@ -62,7 +62,7 @@ let editor_container ~size ~contents ~buttons ~box_title = container -let ace_editor_container ~save ~size ~editor ~box_title = +let ace_editor_container ~save ~size ~editor ~box_title ~box_header = let overlay = editor_overlay () in let close_btn = H.(button ~a:[ a_onclick (fun _ -> @@ -80,11 +80,12 @@ let ace_editor_container ~save ~size ~editor ~box_title = ~contents: editor ~buttons: [close_btn;save_btn] ~box_title + ~box_header in Manip.replaceChildren overlay [container]; overlay -let all_templates_container ~size ~elements ~box_title = +let all_templates_container ~size ~elements ~box_title ~box_header = let overlay = editor_overlay () in let close () = Manip.removeChild Manip.Elt.body overlay in let ok_btn = @@ -107,6 +108,7 @@ let all_templates_container ~size ~elements ~box_title = ~contents: H.(div ~a: [a_style "overflow:auto"] elements) ~buttons: [ok_btn] ~box_title + ~box_header in Manip.replaceChildren overlay [container]; overlay @@ -453,6 +455,7 @@ let () = let div = ace_editor_container ~box_title: "Template Configuration" + ~box_header: "The three first templates will be visible in the menu" ~size: ("90%","80%") ~save ~editor: json_editor_div @@ -477,6 +480,7 @@ let () = ~box_title: "All templates" ~size: ("90%","80%") ~elements: content + ~box_header:"" in Manip.appendToBody div; true)] From 7e297c59b5d78e172bc112b80d2f480ff9c7325f Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 22:15:11 +0200 Subject: [PATCH 51/91] feat : Add research bar for all templates vue --- src/editor/editor.ml | 36 +++++++++++++++++++++++++++++++----- 1 file changed, 31 insertions(+), 5 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index eb848d66c..de46925e2 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -50,7 +50,7 @@ let editor_container ~size ~contents ~buttons ~box_title ~box_header = H.(div [ h3 [pcdata box_title]; - div [pcdata box_header]; + div [box_header]; contents; div ~a:[a_class ["buttons"] ] buttons ] @@ -80,7 +80,7 @@ let ace_editor_container ~save ~size ~editor ~box_title ~box_header = ~contents: editor ~buttons: [close_btn;save_btn] ~box_title - ~box_header + ~box_header: (H.pcdata box_header) in Manip.replaceChildren overlay [container]; overlay @@ -102,10 +102,12 @@ let all_templates_container ~size ~elements ~box_title ~box_header = Js._true |> ignore) elements; - + let contents = H.(div ~a: [a_style "overflow:auto"; + a_class["templates-to-change"]] elements) + in let container = editor_container ~size - ~contents: H.(div ~a: [a_style "overflow:auto"] elements) + ~contents ~buttons: [ok_btn] ~box_title ~box_header @@ -475,14 +477,38 @@ let () = Templates.give_templates () |> List.map (Templates.template_to_a_elt ace_t) in + + let input_elt = + (H.input ()) + in + + let div = all_templates_container ~box_title: "All templates" ~size: ("90%","80%") ~elements: content - ~box_header:"" + ~box_header: input_elt in Manip.appendToBody div; + let to_change = + match Manip.by_classname "templates-to-change" with + | [] -> H.div [] + | div :: _ -> div + in + Manip.Ev.oninput input_elt + (fun _ -> let value = Manip.value input_elt in + let content = + Templates.give_templates () + |> List.filter ( fun Editor.{name; _ } -> + let reg_exp = Regexp.regexp value in + match Regexp.string_match reg_exp name 0 with + | None -> false + | Some _ -> true) + |> List.map (Templates.template_to_a_elt ace_t) + in + Manip.replaceChildren to_change content;true); + true)] [pcdata "All templates"]) in From 39ff8c1018de1cdb3d1932d0065afc620409c030 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 23:00:05 +0200 Subject: [PATCH 52/91] feat : add 'markdown ocaml' syntax for the edition of templates --- src/editor/editor_lib.ml | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index bb3c7d503..1c03b22c7 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -518,20 +518,28 @@ module Templates = struct |> save let to_string templates = - let json = - Json_repr_browser.Json_encoding.construct - (Json_encoding.list Editor.editor_template_enc) - templates + let rec aux acc = function + | [] -> acc + | Editor.{name; template} :: l -> + let new_acc = acc ^ "#" + ^ name ^ "\n" ^ template + in + aux new_acc l in - Json_repr_browser.js_stringify ~indent:2 json - |> Js.to_string - + aux "" templates + let from_string string = - let json = Json_repr_browser.parse string in - Json_repr_browser.Json_encoding.destruct - (Json_encoding.list Editor.editor_template_enc) - json + let extract = + Regexp.(split (regexp_with_flag "^#+\\s*(.*)\n" "m")) string + in + let rec aux acc = function + | name :: template :: l -> aux ({name;template}:: acc) l + | _ -> acc + in + match extract with + | [] -> [] + | _ ::l -> List.rev (aux [] l) let template_to_a_elt ace_t Editor.{name; template} = H.(a ~a:[ a_onclick (fun _ -> From e3551b23c09b0927ebbdb3889a07ff5a44875e40 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 23:13:51 +0200 Subject: [PATCH 53/91] feat : change the mode of the template's configuration editor also made the text editor and the view of all templates bigger --- src/editor/editor.ml | 16 +- static/css/learnocaml_editor.css | 11 +- static/editor.html | 5 +- static/js/ace/mode-json.js | 326 ---- static/js/ace/mode-ocaml.js | 421 ++++++ static/js/ace/worker-json.js | 2401 ------------------------------ 6 files changed, 438 insertions(+), 2742 deletions(-) delete mode 100644 static/js/ace/mode-json.js create mode 100644 static/js/ace/mode-ocaml.js delete mode 100644 static/js/ace/worker-json.js diff --git a/src/editor/editor.ml b/src/editor/editor.ml index de46925e2..007729334 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -41,7 +41,7 @@ let dropup ~icon ~theme name items = H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) let editor_overlay () = - H.(div ~a:[a_class ["learnocaml-dialog-overlay"; "json-editor-overlay"] ] + H.(div ~a:[a_class ["learnocaml-dialog-overlay"; "config-editor-overlay"] ] []) @@ -433,21 +433,21 @@ let () = |> List.map (Templates.template_to_a_elt ace_t) in - let json_editor_div = H.(div ~a: [ a_class ["json-editor"]] []) in + let config_editor_div = H.(div ~a: [ a_class ["config-editor"]] []) in - let json_editor_ace = json_editor_div + let config_editor_ace = config_editor_div |> Tyxml_js.To_dom.of_div |> Ace.create_editor in - Ace.set_font_size json_editor_ace 18; - Ace.set_mode json_editor_ace "ace/mode/json"; + Ace.set_font_size config_editor_ace 18; + Ace.set_mode config_editor_ace "ace/mode/ocaml"; let configuration = let save () = run_async_with_log @@ fun () -> - Ace.get_contents json_editor_ace + Ace.get_contents config_editor_ace |> Templates.from_string |> Templates.save |> !recovering_callback @@ -460,12 +460,12 @@ let () = ~box_header: "The three first templates will be visible in the menu" ~size: ("90%","80%") ~save - ~editor: json_editor_div + ~editor: config_editor_div in Manip.appendToBody div; Templates.give_templates () |> Templates.to_string - |> Ace.set_contents json_editor_ace; + |> Ace.set_contents config_editor_ace; true )] [pcdata "Configuration"]) in diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index e3984a6bb..cca078922 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -638,7 +638,7 @@ body { /*template editor */ -.json-editor { +.config-editor { font-size: 18px; font-family: 'Inconsolata', monospace; position: relative !important; @@ -649,12 +649,15 @@ body { width: 80%; margin: 0 10%; } -div.json-editor-overlay > div { + +div.config-editor-overlay > div { display:flex; - flex-direction:column + flex-direction:column; + max-width: 100% !important; + } -div.json-editor-overlay > div::before, div.json-editor-overlay > div::after { +div.config-editor-overlay > div::before, div.config-editor-overlay > div::after { content: ""; flex: 0 !important; } diff --git a/static/editor.html b/static/editor.html index f9641c1f7..b038996d7 100644 --- a/static/editor.html +++ b/static/editor.html @@ -14,9 +14,8 @@ - - - + + diff --git a/static/js/ace/mode-json.js b/static/js/ace/mode-json.js deleted file mode 100644 index fca04d6b0..000000000 --- a/static/js/ace/mode-json.js +++ /dev/null @@ -1,326 +0,0 @@ -ace.define("ace/mode/json_highlight_rules",["require","exports","module","ace/lib/oop","ace/mode/text_highlight_rules"], function(require, exports, module) { -"use strict"; - -var oop = require("../lib/oop"); -var TextHighlightRules = require("./text_highlight_rules").TextHighlightRules; - -var JsonHighlightRules = function() { - this.$rules = { - "start" : [ - { - token : "variable", // single line - regex : '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]\\s*(?=:)' - }, { - token : "string", // single line - regex : '"', - next : "string" - }, { - token : "constant.numeric", // hex - regex : "0[xX][0-9a-fA-F]+\\b" - }, { - token : "constant.numeric", // float - regex : "[+-]?\\d+(?:(?:\\.\\d*)?(?:[eE][+-]?\\d+)?)?\\b" - }, { - token : "constant.language.boolean", - regex : "(?:true|false)\\b" - }, { - token : "text", // single quoted strings are not allowed - regex : "['](?:(?:\\\\.)|(?:[^'\\\\]))*?[']" - }, { - token : "comment", // comments are not allowed, but who cares? - regex : "\\/\\/.*$" - }, { - token : "comment.start", // comments are not allowed, but who cares? - regex : "\\/\\*", - next : "comment" - }, { - token : "paren.lparen", - regex : "[[({]" - }, { - token : "paren.rparen", - regex : "[\\])}]" - }, { - token : "text", - regex : "\\s+" - } - ], - "string" : [ - { - token : "constant.language.escape", - regex : /\\(?:x[0-9a-fA-F]{2}|u[0-9a-fA-F]{4}|["\\\/bfnrt])/ - }, { - token : "string", - regex : '"|$', - next : "start" - }, { - defaultToken : "string" - } - ], - "comment" : [ - { - token : "comment.end", // comments are not allowed, but who cares? - regex : "\\*\\/", - next : "start" - }, { - defaultToken: "comment" - } - ] - }; - -}; - -oop.inherits(JsonHighlightRules, TextHighlightRules); - -exports.JsonHighlightRules = JsonHighlightRules; -}); - -ace.define("ace/mode/matching_brace_outdent",["require","exports","module","ace/range"], function(require, exports, module) { -"use strict"; - -var Range = require("../range").Range; - -var MatchingBraceOutdent = function() {}; - -(function() { - - this.checkOutdent = function(line, input) { - if (! /^\s+$/.test(line)) - return false; - - return /^\s*\}/.test(input); - }; - - this.autoOutdent = function(doc, row) { - var line = doc.getLine(row); - var match = line.match(/^(\s*\})/); - - if (!match) return 0; - - var column = match[1].length; - var openBracePos = doc.findMatchingBracket({row: row, column: column}); - - if (!openBracePos || openBracePos.row == row) return 0; - - var indent = this.$getIndent(doc.getLine(openBracePos.row)); - doc.replace(new Range(row, 0, row, column-1), indent); - }; - - this.$getIndent = function(line) { - return line.match(/^\s*/)[0]; - }; - -}).call(MatchingBraceOutdent.prototype); - -exports.MatchingBraceOutdent = MatchingBraceOutdent; -}); - -ace.define("ace/mode/folding/cstyle",["require","exports","module","ace/lib/oop","ace/range","ace/mode/folding/fold_mode"], function(require, exports, module) { -"use strict"; - -var oop = require("../../lib/oop"); -var Range = require("../../range").Range; -var BaseFoldMode = require("./fold_mode").FoldMode; - -var FoldMode = exports.FoldMode = function(commentRegex) { - if (commentRegex) { - this.foldingStartMarker = new RegExp( - this.foldingStartMarker.source.replace(/\|[^|]*?$/, "|" + commentRegex.start) - ); - this.foldingStopMarker = new RegExp( - this.foldingStopMarker.source.replace(/\|[^|]*?$/, "|" + commentRegex.end) - ); - } -}; -oop.inherits(FoldMode, BaseFoldMode); - -(function() { - - this.foldingStartMarker = /([\{\[\(])[^\}\]\)]*$|^\s*(\/\*)/; - this.foldingStopMarker = /^[^\[\{\(]*([\}\]\)])|^[\s\*]*(\*\/)/; - this.singleLineBlockCommentRe= /^\s*(\/\*).*\*\/\s*$/; - this.tripleStarBlockCommentRe = /^\s*(\/\*\*\*).*\*\/\s*$/; - this.startRegionRe = /^\s*(\/\*|\/\/)#?region\b/; - this._getFoldWidgetBase = this.getFoldWidget; - this.getFoldWidget = function(session, foldStyle, row) { - var line = session.getLine(row); - - if (this.singleLineBlockCommentRe.test(line)) { - if (!this.startRegionRe.test(line) && !this.tripleStarBlockCommentRe.test(line)) - return ""; - } - - var fw = this._getFoldWidgetBase(session, foldStyle, row); - - if (!fw && this.startRegionRe.test(line)) - return "start"; // lineCommentRegionStart - - return fw; - }; - - this.getFoldWidgetRange = function(session, foldStyle, row, forceMultiline) { - var line = session.getLine(row); - - if (this.startRegionRe.test(line)) - return this.getCommentRegionBlock(session, line, row); - - var match = line.match(this.foldingStartMarker); - if (match) { - var i = match.index; - - if (match[1]) - return this.openingBracketBlock(session, match[1], row, i); - - var range = session.getCommentFoldRange(row, i + match[0].length, 1); - - if (range && !range.isMultiLine()) { - if (forceMultiline) { - range = this.getSectionRange(session, row); - } else if (foldStyle != "all") - range = null; - } - - return range; - } - - if (foldStyle === "markbegin") - return; - - var match = line.match(this.foldingStopMarker); - if (match) { - var i = match.index + match[0].length; - - if (match[1]) - return this.closingBracketBlock(session, match[1], row, i); - - return session.getCommentFoldRange(row, i, -1); - } - }; - - this.getSectionRange = function(session, row) { - var line = session.getLine(row); - var startIndent = line.search(/\S/); - var startRow = row; - var startColumn = line.length; - row = row + 1; - var endRow = row; - var maxRow = session.getLength(); - while (++row < maxRow) { - line = session.getLine(row); - var indent = line.search(/\S/); - if (indent === -1) - continue; - if (startIndent > indent) - break; - var subRange = this.getFoldWidgetRange(session, "all", row); - - if (subRange) { - if (subRange.start.row <= startRow) { - break; - } else if (subRange.isMultiLine()) { - row = subRange.end.row; - } else if (startIndent == indent) { - break; - } - } - endRow = row; - } - - return new Range(startRow, startColumn, endRow, session.getLine(endRow).length); - }; - this.getCommentRegionBlock = function(session, line, row) { - var startColumn = line.search(/\s*$/); - var maxRow = session.getLength(); - var startRow = row; - - var re = /^\s*(?:\/\*|\/\/|--)#?(end)?region\b/; - var depth = 1; - while (++row < maxRow) { - line = session.getLine(row); - var m = re.exec(line); - if (!m) continue; - if (m[1]) depth--; - else depth++; - - if (!depth) break; - } - - var endRow = row; - if (endRow > startRow) { - return new Range(startRow, startColumn, endRow, line.length); - } - }; - -}).call(FoldMode.prototype); - -}); - -ace.define("ace/mode/json",["require","exports","module","ace/lib/oop","ace/mode/text","ace/mode/json_highlight_rules","ace/mode/matching_brace_outdent","ace/mode/behaviour/cstyle","ace/mode/folding/cstyle","ace/worker/worker_client"], function(require, exports, module) { -"use strict"; - -var oop = require("../lib/oop"); -var TextMode = require("./text").Mode; -var HighlightRules = require("./json_highlight_rules").JsonHighlightRules; -var MatchingBraceOutdent = require("./matching_brace_outdent").MatchingBraceOutdent; -var CstyleBehaviour = require("./behaviour/cstyle").CstyleBehaviour; -var CStyleFoldMode = require("./folding/cstyle").FoldMode; -var WorkerClient = require("../worker/worker_client").WorkerClient; - -var Mode = function() { - this.HighlightRules = HighlightRules; - this.$outdent = new MatchingBraceOutdent(); - this.$behaviour = new CstyleBehaviour(); - this.foldingRules = new CStyleFoldMode(); -}; -oop.inherits(Mode, TextMode); - -(function() { - - this.getNextLineIndent = function(state, line, tab) { - var indent = this.$getIndent(line); - - if (state == "start") { - var match = line.match(/^.*[\{\(\[]\s*$/); - if (match) { - indent += tab; - } - } - - return indent; - }; - - this.checkOutdent = function(state, line, input) { - return this.$outdent.checkOutdent(line, input); - }; - - this.autoOutdent = function(state, doc, row) { - this.$outdent.autoOutdent(doc, row); - }; - - this.createWorker = function(session) { - var worker = new WorkerClient(["ace"], "ace/mode/json_worker", "JsonWorker"); - worker.attachToDocument(session.getDocument()); - - worker.on("annotate", function(e) { - session.setAnnotations(e.data); - }); - - worker.on("terminate", function() { - session.clearAnnotations(); - }); - - return worker; - }; - - - this.$id = "ace/mode/json"; -}).call(Mode.prototype); - -exports.Mode = Mode; -}); (function() { - ace.require(["ace/mode/json"], function(m) { - if (typeof module == "object" && typeof exports == "object" && module) { - module.exports = m; - } - }); - })(); - \ No newline at end of file diff --git a/static/js/ace/mode-ocaml.js b/static/js/ace/mode-ocaml.js new file mode 100644 index 000000000..3b1a3e7be --- /dev/null +++ b/static/js/ace/mode-ocaml.js @@ -0,0 +1,421 @@ +ace.define("ace/mode/ocaml_highlight_rules",["require","exports","module","ace/lib/oop","ace/mode/text_highlight_rules"], function(require, exports, module) { +"use strict"; + +var oop = require("../lib/oop"); +var TextHighlightRules = require("./text_highlight_rules").TextHighlightRules; + +var OcamlHighlightRules = function() { + + var keywords = ( + "and|as|assert|begin|class|constraint|do|done|downto|else|end|" + + "exception|external|for|fun|function|functor|if|in|include|" + + "inherit|initializer|lazy|let|match|method|module|mutable|new|" + + "object|of|open|or|private|rec|sig|struct|then|to|try|type|val|" + + "virtual|when|while|with" + ); + + var builtinConstants = ("true|false"); + + var builtinFunctions = ( + "abs|abs_big_int|abs_float|abs_num|abstract_tag|accept|access|acos|add|" + + "add_available_units|add_big_int|add_buffer|add_channel|add_char|" + + "add_initializer|add_int_big_int|add_interfaces|add_num|add_string|" + + "add_substitute|add_substring|alarm|allocated_bytes|allow_only|" + + "allow_unsafe_modules|always|append|appname_get|appname_set|" + + "approx_num_exp|approx_num_fix|arg|argv|arith_status|array|" + + "array1_of_genarray|array2_of_genarray|array3_of_genarray|asin|asr|" + + "assoc|assq|at_exit|atan|atan2|auto_synchronize|background|basename|" + + "beginning_of_input|big_int_of_int|big_int_of_num|big_int_of_string|bind|" + + "bind_class|bind_tag|bits|bits_of_float|black|blit|blit_image|blue|bool|" + + "bool_of_string|bounded_full_split|bounded_split|bounded_split_delim|" + + "bprintf|break|broadcast|bscanf|button_down|c_layout|capitalize|cardinal|" + + "cardinal|catch|catch_break|ceil|ceiling_num|channel|char|char_of_int|" + + "chdir|check|check_suffix|chmod|choose|chop_extension|chop_suffix|chown|" + + "chown|chr|chroot|classify_float|clear|clear_available_units|" + + "clear_close_on_exec|clear_graph|clear_nonblock|clear_parser|" + + "close|close|closeTk|close_box|close_graph|close_in|close_in_noerr|" + + "close_out|close_out_noerr|close_process|close_process|" + + "close_process_full|close_process_in|close_process_out|close_subwindow|" + + "close_tag|close_tbox|closedir|closedir|closure_tag|code|combine|" + + "combine|combine|command|compact|compare|compare_big_int|compare_num|" + + "complex32|complex64|concat|conj|connect|contains|contains_from|contents|" + + "copy|cos|cosh|count|count|counters|create|create_alarm|create_image|" + + "create_matrix|create_matrix|create_matrix|create_object|" + + "create_object_and_run_initializers|create_object_opt|create_process|" + + "create_process|create_process_env|create_process_env|create_table|" + + "current|current_dir_name|current_point|current_x|current_y|curveto|" + + "custom_tag|cyan|data_size|decr|decr_num|default_available_units|delay|" + + "delete_alarm|descr_of_in_channel|descr_of_out_channel|destroy|diff|dim|" + + "dim1|dim2|dim3|dims|dirname|display_mode|div|div_big_int|div_num|" + + "double_array_tag|double_tag|draw_arc|draw_char|draw_circle|draw_ellipse|" + + "draw_image|draw_poly|draw_poly_line|draw_rect|draw_segments|draw_string|" + + "dummy_pos|dummy_table|dump_image|dup|dup2|elements|empty|end_of_input|" + + "environment|eprintf|epsilon_float|eq_big_int|eq_num|equal|err_formatter|" + + "error_message|escaped|establish_server|executable_name|execv|execve|execvp|" + + "execvpe|exists|exists2|exit|exp|failwith|fast_sort|fchmod|fchown|field|" + + "file|file_exists|fill|fill_arc|fill_circle|fill_ellipse|fill_poly|fill_rect|" + + "filter|final_tag|finalise|find|find_all|first_chars|firstkey|flatten|" + + "float|float32|float64|float_of_big_int|float_of_bits|float_of_int|" + + "float_of_num|float_of_string|floor|floor_num|flush|flush_all|flush_input|" + + "flush_str_formatter|fold|fold_left|fold_left2|fold_right|fold_right2|" + + "for_all|for_all2|force|force_newline|force_val|foreground|fork|" + + "format_of_string|formatter_of_buffer|formatter_of_out_channel|" + + "fortran_layout|forward_tag|fprintf|frexp|from|from_channel|from_file|" + + "from_file_bin|from_function|from_string|fscanf|fst|fstat|ftruncate|" + + "full_init|full_major|full_split|gcd_big_int|ge_big_int|ge_num|" + + "genarray_of_array1|genarray_of_array2|genarray_of_array3|get|" + + "get_all_formatter_output_functions|get_approx_printing|get_copy|" + + "get_ellipsis_text|get_error_when_null_denominator|get_floating_precision|" + + "get_formatter_output_functions|get_formatter_tag_functions|get_image|" + + "get_margin|get_mark_tags|get_max_boxes|get_max_indent|get_method|" + + "get_method_label|get_normalize_ratio|get_normalize_ratio_when_printing|" + + "get_print_tags|get_state|get_variable|getcwd|getegid|getegid|getenv|" + + "getenv|getenv|geteuid|geteuid|getgid|getgid|getgrgid|getgrgid|getgrnam|" + + "getgrnam|getgroups|gethostbyaddr|gethostbyname|gethostname|getitimer|" + + "getlogin|getpeername|getpid|getppid|getprotobyname|getprotobynumber|" + + "getpwnam|getpwuid|getservbyname|getservbyport|getsockname|getsockopt|" + + "getsockopt_float|getsockopt_int|getsockopt_optint|gettimeofday|getuid|" + + "global_replace|global_substitute|gmtime|green|grid|group_beginning|" + + "group_end|gt_big_int|gt_num|guard|handle_unix_error|hash|hash_param|" + + "hd|header_size|i|id|ignore|in_channel_length|in_channel_of_descr|incr|" + + "incr_num|index|index_from|inet_addr_any|inet_addr_of_string|infinity|" + + "infix_tag|init|init_class|input|input_binary_int|input_byte|input_char|" + + "input_line|input_value|int|int16_signed|int16_unsigned|int32|int64|" + + "int8_signed|int8_unsigned|int_of_big_int|int_of_char|int_of_float|" + + "int_of_num|int_of_string|integer_num|inter|interactive|inv|invalid_arg|" + + "is_block|is_empty|is_implicit|is_int|is_int_big_int|is_integer_num|" + + "is_relative|iter|iter2|iteri|join|junk|key_pressed|kill|kind|kprintf|" + + "kscanf|land|last_chars|layout|lazy_from_fun|lazy_from_val|lazy_is_val|" + + "lazy_tag|ldexp|le_big_int|le_num|length|lexeme|lexeme_char|lexeme_end|" + + "lexeme_end_p|lexeme_start|lexeme_start_p|lineto|link|list|listen|lnot|" + + "loadfile|loadfile_private|localtime|lock|lockf|log|log10|logand|lognot|" + + "logor|logxor|lor|lower_window|lowercase|lseek|lsl|lsr|lstat|lt_big_int|" + + "lt_num|lxor|magenta|magic|mainLoop|major|major_slice|make|make_formatter|" + + "make_image|make_lexer|make_matrix|make_self_init|map|map2|map_file|mapi|" + + "marshal|match_beginning|match_end|matched_group|matched_string|max|" + + "max_array_length|max_big_int|max_elt|max_float|max_int|max_num|" + + "max_string_length|mem|mem_assoc|mem_assq|memq|merge|min|min_big_int|" + + "min_elt|min_float|min_int|min_num|minor|minus_big_int|minus_num|" + + "minus_one|mkdir|mkfifo|mktime|mod|mod_big_int|mod_float|mod_num|modf|" + + "mouse_pos|moveto|mul|mult_big_int|mult_int_big_int|mult_num|nan|narrow|" + + "nat_of_num|nativeint|neg|neg_infinity|new_block|new_channel|new_method|" + + "new_variable|next|nextkey|nice|nice|no_scan_tag|norm|norm2|not|npeek|" + + "nth|nth_dim|num_digits_big_int|num_dims|num_of_big_int|num_of_int|" + + "num_of_nat|num_of_ratio|num_of_string|O|obj|object_tag|ocaml_version|" + + "of_array|of_channel|of_float|of_int|of_int32|of_list|of_nativeint|" + + "of_string|one|openTk|open_box|open_connection|open_graph|open_hbox|" + + "open_hovbox|open_hvbox|open_in|open_in_bin|open_in_gen|open_out|" + + "open_out_bin|open_out_gen|open_process|open_process_full|open_process_in|" + + "open_process_out|open_subwindow|open_tag|open_tbox|open_temp_file|" + + "open_vbox|opendbm|opendir|openfile|or|os_type|out_channel_length|" + + "out_channel_of_descr|output|output_binary_int|output_buffer|output_byte|" + + "output_char|output_string|output_value|over_max_boxes|pack|params|" + + "parent_dir_name|parse|parse_argv|partition|pause|peek|pipe|pixels|" + + "place|plot|plots|point_color|polar|poll|pop|pos_in|pos_out|pow|" + + "power_big_int_positive_big_int|power_big_int_positive_int|" + + "power_int_positive_big_int|power_int_positive_int|power_num|" + + "pp_close_box|pp_close_tag|pp_close_tbox|pp_force_newline|" + + "pp_get_all_formatter_output_functions|pp_get_ellipsis_text|" + + "pp_get_formatter_output_functions|pp_get_formatter_tag_functions|" + + "pp_get_margin|pp_get_mark_tags|pp_get_max_boxes|pp_get_max_indent|" + + "pp_get_print_tags|pp_open_box|pp_open_hbox|pp_open_hovbox|pp_open_hvbox|" + + "pp_open_tag|pp_open_tbox|pp_open_vbox|pp_over_max_boxes|pp_print_as|" + + "pp_print_bool|pp_print_break|pp_print_char|pp_print_cut|pp_print_float|" + + "pp_print_flush|pp_print_if_newline|pp_print_int|pp_print_newline|" + + "pp_print_space|pp_print_string|pp_print_tab|pp_print_tbreak|" + + "pp_set_all_formatter_output_functions|pp_set_ellipsis_text|" + + "pp_set_formatter_out_channel|pp_set_formatter_output_functions|" + + "pp_set_formatter_tag_functions|pp_set_margin|pp_set_mark_tags|" + + "pp_set_max_boxes|pp_set_max_indent|pp_set_print_tags|pp_set_tab|" + + "pp_set_tags|pred|pred_big_int|pred_num|prerr_char|prerr_endline|" + + "prerr_float|prerr_int|prerr_newline|prerr_string|print|print_as|" + + "print_bool|print_break|print_char|print_cut|print_endline|print_float|" + + "print_flush|print_if_newline|print_int|print_newline|print_space|" + + "print_stat|print_string|print_tab|print_tbreak|printf|prohibit|" + + "public_method_label|push|putenv|quo_num|quomod_big_int|quote|raise|" + + "raise_window|ratio_of_num|rcontains_from|read|read_float|read_int|" + + "read_key|read_line|readdir|readdir|readlink|really_input|receive|recv|" + + "recvfrom|red|ref|regexp|regexp_case_fold|regexp_string|" + + "regexp_string_case_fold|register|register_exception|rem|remember_mode|" + + "remove|remove_assoc|remove_assq|rename|replace|replace_first|" + + "replace_matched|repr|reset|reshape|reshape_1|reshape_2|reshape_3|rev|" + + "rev_append|rev_map|rev_map2|rewinddir|rgb|rhs_end|rhs_end_pos|rhs_start|" + + "rhs_start_pos|rindex|rindex_from|rlineto|rmdir|rmoveto|round_num|" + + "run_initializers|run_initializers_opt|scanf|search_backward|" + + "search_forward|seek_in|seek_out|select|self|self_init|send|sendto|set|" + + "set_all_formatter_output_functions|set_approx_printing|" + + "set_binary_mode_in|set_binary_mode_out|set_close_on_exec|" + + "set_close_on_exec|set_color|set_ellipsis_text|" + + "set_error_when_null_denominator|set_field|set_floating_precision|" + + "set_font|set_formatter_out_channel|set_formatter_output_functions|" + + "set_formatter_tag_functions|set_line_width|set_margin|set_mark_tags|" + + "set_max_boxes|set_max_indent|set_method|set_nonblock|set_nonblock|" + + "set_normalize_ratio|set_normalize_ratio_when_printing|set_print_tags|" + + "set_signal|set_state|set_tab|set_tag|set_tags|set_text_size|" + + "set_window_title|setgid|setgid|setitimer|setitimer|setsid|setsid|" + + "setsockopt|setsockopt|setsockopt_float|setsockopt_float|setsockopt_int|" + + "setsockopt_int|setsockopt_optint|setsockopt_optint|setuid|setuid|" + + "shift_left|shift_left|shift_left|shift_right|shift_right|shift_right|" + + "shift_right_logical|shift_right_logical|shift_right_logical|show_buckets|" + + "shutdown|shutdown|shutdown_connection|shutdown_connection|sigabrt|" + + "sigalrm|sigchld|sigcont|sigfpe|sighup|sigill|sigint|sigkill|sign_big_int|" + + "sign_num|signal|signal|sigpending|sigpending|sigpipe|sigprocmask|" + + "sigprocmask|sigprof|sigquit|sigsegv|sigstop|sigsuspend|sigsuspend|" + + "sigterm|sigtstp|sigttin|sigttou|sigusr1|sigusr2|sigvtalrm|sin|singleton|" + + "sinh|size|size|size_x|size_y|sleep|sleep|sleep|slice_left|slice_left|" + + "slice_left_1|slice_left_2|slice_right|slice_right|slice_right_1|" + + "slice_right_2|snd|socket|socket|socket|socketpair|socketpair|sort|sound|" + + "split|split_delim|sprintf|sprintf|sqrt|sqrt|sqrt_big_int|square_big_int|" + + "square_num|sscanf|stable_sort|stable_sort|stable_sort|stable_sort|stable_sort|" + + "stable_sort|stat|stat|stat|stat|stat|stats|stats|std_formatter|stdbuf|" + + "stderr|stderr|stderr|stdib|stdin|stdin|stdin|stdout|stdout|stdout|" + + "str_formatter|string|string_after|string_before|string_match|" + + "string_of_big_int|string_of_bool|string_of_float|string_of_format|" + + "string_of_inet_addr|string_of_inet_addr|string_of_int|string_of_num|" + + "string_partial_match|string_tag|sub|sub|sub_big_int|sub_left|sub_num|" + + "sub_right|subset|subset|substitute_first|substring|succ|succ|" + + "succ|succ|succ_big_int|succ_num|symbol_end|symbol_end_pos|symbol_start|" + + "symbol_start_pos|symlink|symlink|sync|synchronize|system|system|system|" + + "tag|take|tan|tanh|tcdrain|tcdrain|tcflow|tcflow|tcflush|tcflush|" + + "tcgetattr|tcgetattr|tcsendbreak|tcsendbreak|tcsetattr|tcsetattr|" + + "temp_file|text_size|time|time|time|timed_read|timed_write|times|times|" + + "tl|tl|tl|to_buffer|to_channel|to_float|to_hex|to_int|to_int32|to_list|" + + "to_list|to_list|to_nativeint|to_string|to_string|to_string|to_string|" + + "to_string|top|top|total_size|transfer|transp|truncate|truncate|truncate|" + + "truncate|truncate|truncate|try_lock|umask|umask|uncapitalize|uncapitalize|" + + "uncapitalize|union|union|unit_big_int|unlink|unlink|unlock|unmarshal|" + + "unsafe_blit|unsafe_fill|unsafe_get|unsafe_get|unsafe_set|unsafe_set|" + + "update|uppercase|uppercase|uppercase|uppercase|usage|utimes|utimes|wait|" + + "wait|wait|wait|wait_next_event|wait_pid|wait_read|wait_signal|" + + "wait_timed_read|wait_timed_write|wait_write|waitpid|white|" + + "widen|window_id|word_size|wrap|wrap_abort|write|yellow|yield|zero|zero_big_int|" + + + "Arg|Arith_status|Array|Array1|Array2|Array3|ArrayLabels|Big_int|Bigarray|" + + "Buffer|Callback|CamlinternalOO|Char|Complex|Condition|Dbm|Digest|Dynlink|" + + "Event|Filename|Format|Gc|Genarray|Genlex|Graphics|GraphicsX11|Hashtbl|" + + "Int32|Int64|LargeFile|Lazy|Lexing|List|ListLabels|Make|Map|Marshal|" + + "MoreLabels|Mutex|Nativeint|Num|Obj|Oo|Parsing|Pervasives|Printexc|" + + "Printf|Queue|Random|Scanf|Scanning|Set|Sort|Stack|State|StdLabels|Str|" + + "Stream|String|StringLabels|Sys|Thread|ThreadUnix|Tk|Unix|UnixLabels|Weak" + ); + + var keywordMapper = this.createKeywordMapper({ + "variable.language": "this", + "keyword": keywords, + "constant.language": builtinConstants, + "support.function": builtinFunctions + }, "identifier"); + + var decimalInteger = "(?:(?:[1-9]\\d*)|(?:0))"; + var octInteger = "(?:0[oO]?[0-7]+)"; + var hexInteger = "(?:0[xX][\\dA-Fa-f]+)"; + var binInteger = "(?:0[bB][01]+)"; + var integer = "(?:" + decimalInteger + "|" + octInteger + "|" + hexInteger + "|" + binInteger + ")"; + + var exponent = "(?:[eE][+-]?\\d+)"; + var fraction = "(?:\\.\\d+)"; + var intPart = "(?:\\d+)"; + var pointFloat = "(?:(?:" + intPart + "?" + fraction + ")|(?:" + intPart + "\\.))"; + var exponentFloat = "(?:(?:" + pointFloat + "|" + intPart + ")" + exponent + ")"; + var floatNumber = "(?:" + exponentFloat + "|" + pointFloat + ")"; + + this.$rules = { + "start" : [ + { + token : "comment", + regex : '\\(\\*.*?\\*\\)\\s*?$' + }, + { + token : "comment", + regex : '\\(\\*.*', + next : "comment" + }, + { + token : "string", // single line + regex : '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' + }, + { + token : "string", // single char + regex : "'.'" + }, + { + token : "string", // " string + regex : '"', + next : "qstring" + }, + { + token : "constant.numeric", // imaginary + regex : "(?:" + floatNumber + "|\\d+)[jJ]\\b" + }, + { + token : "constant.numeric", // float + regex : floatNumber + }, + { + token : "constant.numeric", // integer + regex : integer + "\\b" + }, + { + token : keywordMapper, + regex : "[a-zA-Z_$][a-zA-Z0-9_$]*\\b" + }, + { + token : "keyword.operator", + regex : "\\+\\.|\\-\\.|\\*\\.|\\/\\.|#|;;|\\+|\\-|\\*|\\*\\*\\/|\\/\\/|%|<<|>>|&|\\||\\^|~|<|>|<=|=>|==|!=|<>|<-|=" + }, + { + token : "paren.lparen", + regex : "[[({]" + }, + { + token : "paren.rparen", + regex : "[\\])}]" + }, + { + token : "text", + regex : "\\s+" + } + ], + "comment" : [ + { + token : "comment", // closing comment + regex : "\\*\\)", + next : "start" + }, + { + defaultToken : "comment" + } + ], + + "qstring" : [ + { + token : "string", + regex : '"', + next : "start" + }, { + token : "string", + regex : '.+' + } + ] + }; +}; + +oop.inherits(OcamlHighlightRules, TextHighlightRules); + +exports.OcamlHighlightRules = OcamlHighlightRules; +}); + +ace.define("ace/mode/matching_brace_outdent",["require","exports","module","ace/range"], function(require, exports, module) { +"use strict"; + +var Range = require("../range").Range; + +var MatchingBraceOutdent = function() {}; + +(function() { + + this.checkOutdent = function(line, input) { + if (! /^\s+$/.test(line)) + return false; + + return /^\s*\}/.test(input); + }; + + this.autoOutdent = function(doc, row) { + var line = doc.getLine(row); + var match = line.match(/^(\s*\})/); + + if (!match) return 0; + + var column = match[1].length; + var openBracePos = doc.findMatchingBracket({row: row, column: column}); + + if (!openBracePos || openBracePos.row == row) return 0; + + var indent = this.$getIndent(doc.getLine(openBracePos.row)); + doc.replace(new Range(row, 0, row, column-1), indent); + }; + + this.$getIndent = function(line) { + return line.match(/^\s*/)[0]; + }; + +}).call(MatchingBraceOutdent.prototype); + +exports.MatchingBraceOutdent = MatchingBraceOutdent; +}); + +ace.define("ace/mode/ocaml",["require","exports","module","ace/lib/oop","ace/mode/text","ace/mode/ocaml_highlight_rules","ace/mode/matching_brace_outdent","ace/range"], function(require, exports, module) { +"use strict"; + +var oop = require("../lib/oop"); +var TextMode = require("./text").Mode; +var OcamlHighlightRules = require("./ocaml_highlight_rules").OcamlHighlightRules; +var MatchingBraceOutdent = require("./matching_brace_outdent").MatchingBraceOutdent; +var Range = require("../range").Range; + +var Mode = function() { + this.HighlightRules = OcamlHighlightRules; + this.$behaviour = this.$defaultBehaviour; + + this.$outdent = new MatchingBraceOutdent(); +}; +oop.inherits(Mode, TextMode); + +var indenter = /(?:[({[=:]|[-=]>|\b(?:else|try|with))\s*$/; + +(function() { + + this.toggleCommentLines = function(state, doc, startRow, endRow) { + var i, line; + var outdent = true; + var re = /^\s*\(\*(.*)\*\)/; + + for (i=startRow; i<= endRow; i++) { + if (!re.test(doc.getLine(i))) { + outdent = false; + break; + } + } + + var range = new Range(0, 0, 0, 0); + for (i=startRow; i<= endRow; i++) { + line = doc.getLine(i); + range.start.row = i; + range.end.row = i; + range.end.column = line.length; + + doc.replace(range, outdent ? line.match(re)[1] : "(*" + line + "*)"); + } + }; + + this.getNextLineIndent = function(state, line, tab) { + var indent = this.$getIndent(line); + var tokens = this.getTokenizer().getLineTokens(line, state).tokens; + + if (!(tokens.length && tokens[tokens.length - 1].type === 'comment') && + state === 'start' && indenter.test(line)) + indent += tab; + return indent; + }; + + this.checkOutdent = function(state, line, input) { + return this.$outdent.checkOutdent(line, input); + }; + + this.autoOutdent = function(state, doc, row) { + this.$outdent.autoOutdent(doc, row); + }; + + this.$id = "ace/mode/ocaml"; +}).call(Mode.prototype); + +exports.Mode = Mode; +}); (function() { + ace.require(["ace/mode/ocaml"], function(m) { + if (typeof module == "object" && typeof exports == "object" && module) { + module.exports = m; + } + }); + })(); + \ No newline at end of file diff --git a/static/js/ace/worker-json.js b/static/js/ace/worker-json.js deleted file mode 100644 index 1b1a6a55e..000000000 --- a/static/js/ace/worker-json.js +++ /dev/null @@ -1,2401 +0,0 @@ -"no use strict"; -!(function(window) { -if (typeof window.window != "undefined" && window.document) - return; -if (window.require && window.define) - return; - -if (!window.console) { - window.console = function() { - var msgs = Array.prototype.slice.call(arguments, 0); - postMessage({type: "log", data: msgs}); - }; - window.console.error = - window.console.warn = - window.console.log = - window.console.trace = window.console; -} -window.window = window; -window.ace = window; - -window.onerror = function(message, file, line, col, err) { - postMessage({type: "error", data: { - message: message, - data: err.data, - file: file, - line: line, - col: col, - stack: err.stack - }}); -}; - -window.normalizeModule = function(parentId, moduleName) { - // normalize plugin requires - if (moduleName.indexOf("!") !== -1) { - var chunks = moduleName.split("!"); - return window.normalizeModule(parentId, chunks[0]) + "!" + window.normalizeModule(parentId, chunks[1]); - } - // normalize relative requires - if (moduleName.charAt(0) == ".") { - var base = parentId.split("/").slice(0, -1).join("/"); - moduleName = (base ? base + "/" : "") + moduleName; - - while (moduleName.indexOf(".") !== -1 && previous != moduleName) { - var previous = moduleName; - moduleName = moduleName.replace(/^\.\//, "").replace(/\/\.\//, "/").replace(/[^\/]+\/\.\.\//, ""); - } - } - - return moduleName; -}; - -window.require = function require(parentId, id) { - if (!id) { - id = parentId; - parentId = null; - } - if (!id.charAt) - throw new Error("worker.js require() accepts only (parentId, id) as arguments"); - - id = window.normalizeModule(parentId, id); - - var module = window.require.modules[id]; - if (module) { - if (!module.initialized) { - module.initialized = true; - module.exports = module.factory().exports; - } - return module.exports; - } - - if (!window.require.tlns) - return console.log("unable to load " + id); - - var path = resolveModuleId(id, window.require.tlns); - if (path.slice(-3) != ".js") path += ".js"; - - window.require.id = id; - window.require.modules[id] = {}; // prevent infinite loop on broken modules - importScripts(path); - return window.require(parentId, id); -}; -function resolveModuleId(id, paths) { - var testPath = id, tail = ""; - while (testPath) { - var alias = paths[testPath]; - if (typeof alias == "string") { - return alias + tail; - } else if (alias) { - return alias.location.replace(/\/*$/, "/") + (tail || alias.main || alias.name); - } else if (alias === false) { - return ""; - } - var i = testPath.lastIndexOf("/"); - if (i === -1) break; - tail = testPath.substr(i) + tail; - testPath = testPath.slice(0, i); - } - return id; -} -window.require.modules = {}; -window.require.tlns = {}; - -window.define = function(id, deps, factory) { - if (arguments.length == 2) { - factory = deps; - if (typeof id != "string") { - deps = id; - id = window.require.id; - } - } else if (arguments.length == 1) { - factory = id; - deps = []; - id = window.require.id; - } - - if (typeof factory != "function") { - window.require.modules[id] = { - exports: factory, - initialized: true - }; - return; - } - - if (!deps.length) - // If there is no dependencies, we inject "require", "exports" and - // "module" as dependencies, to provide CommonJS compatibility. - deps = ["require", "exports", "module"]; - - var req = function(childId) { - return window.require(id, childId); - }; - - window.require.modules[id] = { - exports: {}, - factory: function() { - var module = this; - var returnExports = factory.apply(this, deps.slice(0, factory.length).map(function(dep) { - switch (dep) { - // Because "require", "exports" and "module" aren't actual - // dependencies, we must handle them seperately. - case "require": return req; - case "exports": return module.exports; - case "module": return module; - // But for all other dependencies, we can just go ahead and - // require them. - default: return req(dep); - } - })); - if (returnExports) - module.exports = returnExports; - return module; - } - }; -}; -window.define.amd = {}; -require.tlns = {}; -window.initBaseUrls = function initBaseUrls(topLevelNamespaces) { - for (var i in topLevelNamespaces) - require.tlns[i] = topLevelNamespaces[i]; -}; - -window.initSender = function initSender() { - - var EventEmitter = window.require("ace/lib/event_emitter").EventEmitter; - var oop = window.require("ace/lib/oop"); - - var Sender = function() {}; - - (function() { - - oop.implement(this, EventEmitter); - - this.callback = function(data, callbackId) { - postMessage({ - type: "call", - id: callbackId, - data: data - }); - }; - - this.emit = function(name, data) { - postMessage({ - type: "event", - name: name, - data: data - }); - }; - - }).call(Sender.prototype); - - return new Sender(); -}; - -var main = window.main = null; -var sender = window.sender = null; - -window.onmessage = function(e) { - var msg = e.data; - if (msg.event && sender) { - sender._signal(msg.event, msg.data); - } - else if (msg.command) { - if (main[msg.command]) - main[msg.command].apply(main, msg.args); - else if (window[msg.command]) - window[msg.command].apply(window, msg.args); - else - throw new Error("Unknown command:" + msg.command); - } - else if (msg.init) { - window.initBaseUrls(msg.tlns); - require("ace/lib/es5-shim"); - sender = window.sender = window.initSender(); - var clazz = require(msg.module)[msg.classname]; - main = window.main = new clazz(sender); - } -}; -})(this); - -ace.define("ace/lib/oop",[], function(require, exports, module) { -"use strict"; - -exports.inherits = function(ctor, superCtor) { - ctor.super_ = superCtor; - ctor.prototype = Object.create(superCtor.prototype, { - constructor: { - value: ctor, - enumerable: false, - writable: true, - configurable: true - } - }); -}; - -exports.mixin = function(obj, mixin) { - for (var key in mixin) { - obj[key] = mixin[key]; - } - return obj; -}; - -exports.implement = function(proto, mixin) { - exports.mixin(proto, mixin); -}; - -}); - -ace.define("ace/range",[], function(require, exports, module) { -"use strict"; -var comparePoints = function(p1, p2) { - return p1.row - p2.row || p1.column - p2.column; -}; -var Range = function(startRow, startColumn, endRow, endColumn) { - this.start = { - row: startRow, - column: startColumn - }; - - this.end = { - row: endRow, - column: endColumn - }; -}; - -(function() { - this.isEqual = function(range) { - return this.start.row === range.start.row && - this.end.row === range.end.row && - this.start.column === range.start.column && - this.end.column === range.end.column; - }; - this.toString = function() { - return ("Range: [" + this.start.row + "/" + this.start.column + - "] -> [" + this.end.row + "/" + this.end.column + "]"); - }; - - this.contains = function(row, column) { - return this.compare(row, column) == 0; - }; - this.compareRange = function(range) { - var cmp, - end = range.end, - start = range.start; - - cmp = this.compare(end.row, end.column); - if (cmp == 1) { - cmp = this.compare(start.row, start.column); - if (cmp == 1) { - return 2; - } else if (cmp == 0) { - return 1; - } else { - return 0; - } - } else if (cmp == -1) { - return -2; - } else { - cmp = this.compare(start.row, start.column); - if (cmp == -1) { - return -1; - } else if (cmp == 1) { - return 42; - } else { - return 0; - } - } - }; - this.comparePoint = function(p) { - return this.compare(p.row, p.column); - }; - this.containsRange = function(range) { - return this.comparePoint(range.start) == 0 && this.comparePoint(range.end) == 0; - }; - this.intersects = function(range) { - var cmp = this.compareRange(range); - return (cmp == -1 || cmp == 0 || cmp == 1); - }; - this.isEnd = function(row, column) { - return this.end.row == row && this.end.column == column; - }; - this.isStart = function(row, column) { - return this.start.row == row && this.start.column == column; - }; - this.setStart = function(row, column) { - if (typeof row == "object") { - this.start.column = row.column; - this.start.row = row.row; - } else { - this.start.row = row; - this.start.column = column; - } - }; - this.setEnd = function(row, column) { - if (typeof row == "object") { - this.end.column = row.column; - this.end.row = row.row; - } else { - this.end.row = row; - this.end.column = column; - } - }; - this.inside = function(row, column) { - if (this.compare(row, column) == 0) { - if (this.isEnd(row, column) || this.isStart(row, column)) { - return false; - } else { - return true; - } - } - return false; - }; - this.insideStart = function(row, column) { - if (this.compare(row, column) == 0) { - if (this.isEnd(row, column)) { - return false; - } else { - return true; - } - } - return false; - }; - this.insideEnd = function(row, column) { - if (this.compare(row, column) == 0) { - if (this.isStart(row, column)) { - return false; - } else { - return true; - } - } - return false; - }; - this.compare = function(row, column) { - if (!this.isMultiLine()) { - if (row === this.start.row) { - return column < this.start.column ? -1 : (column > this.end.column ? 1 : 0); - } - } - - if (row < this.start.row) - return -1; - - if (row > this.end.row) - return 1; - - if (this.start.row === row) - return column >= this.start.column ? 0 : -1; - - if (this.end.row === row) - return column <= this.end.column ? 0 : 1; - - return 0; - }; - this.compareStart = function(row, column) { - if (this.start.row == row && this.start.column == column) { - return -1; - } else { - return this.compare(row, column); - } - }; - this.compareEnd = function(row, column) { - if (this.end.row == row && this.end.column == column) { - return 1; - } else { - return this.compare(row, column); - } - }; - this.compareInside = function(row, column) { - if (this.end.row == row && this.end.column == column) { - return 1; - } else if (this.start.row == row && this.start.column == column) { - return -1; - } else { - return this.compare(row, column); - } - }; - this.clipRows = function(firstRow, lastRow) { - if (this.end.row > lastRow) - var end = {row: lastRow + 1, column: 0}; - else if (this.end.row < firstRow) - var end = {row: firstRow, column: 0}; - - if (this.start.row > lastRow) - var start = {row: lastRow + 1, column: 0}; - else if (this.start.row < firstRow) - var start = {row: firstRow, column: 0}; - - return Range.fromPoints(start || this.start, end || this.end); - }; - this.extend = function(row, column) { - var cmp = this.compare(row, column); - - if (cmp == 0) - return this; - else if (cmp == -1) - var start = {row: row, column: column}; - else - var end = {row: row, column: column}; - - return Range.fromPoints(start || this.start, end || this.end); - }; - - this.isEmpty = function() { - return (this.start.row === this.end.row && this.start.column === this.end.column); - }; - this.isMultiLine = function() { - return (this.start.row !== this.end.row); - }; - this.clone = function() { - return Range.fromPoints(this.start, this.end); - }; - this.collapseRows = function() { - if (this.end.column == 0) - return new Range(this.start.row, 0, Math.max(this.start.row, this.end.row-1), 0); - else - return new Range(this.start.row, 0, this.end.row, 0); - }; - this.toScreenRange = function(session) { - var screenPosStart = session.documentToScreenPosition(this.start); - var screenPosEnd = session.documentToScreenPosition(this.end); - - return new Range( - screenPosStart.row, screenPosStart.column, - screenPosEnd.row, screenPosEnd.column - ); - }; - this.moveBy = function(row, column) { - this.start.row += row; - this.start.column += column; - this.end.row += row; - this.end.column += column; - }; - -}).call(Range.prototype); -Range.fromPoints = function(start, end) { - return new Range(start.row, start.column, end.row, end.column); -}; -Range.comparePoints = comparePoints; - -Range.comparePoints = function(p1, p2) { - return p1.row - p2.row || p1.column - p2.column; -}; - - -exports.Range = Range; -}); - -ace.define("ace/apply_delta",[], function(require, exports, module) { -"use strict"; - -function throwDeltaError(delta, errorText){ - console.log("Invalid Delta:", delta); - throw "Invalid Delta: " + errorText; -} - -function positionInDocument(docLines, position) { - return position.row >= 0 && position.row < docLines.length && - position.column >= 0 && position.column <= docLines[position.row].length; -} - -function validateDelta(docLines, delta) { - if (delta.action != "insert" && delta.action != "remove") - throwDeltaError(delta, "delta.action must be 'insert' or 'remove'"); - if (!(delta.lines instanceof Array)) - throwDeltaError(delta, "delta.lines must be an Array"); - if (!delta.start || !delta.end) - throwDeltaError(delta, "delta.start/end must be an present"); - var start = delta.start; - if (!positionInDocument(docLines, delta.start)) - throwDeltaError(delta, "delta.start must be contained in document"); - var end = delta.end; - if (delta.action == "remove" && !positionInDocument(docLines, end)) - throwDeltaError(delta, "delta.end must contained in document for 'remove' actions"); - var numRangeRows = end.row - start.row; - var numRangeLastLineChars = (end.column - (numRangeRows == 0 ? start.column : 0)); - if (numRangeRows != delta.lines.length - 1 || delta.lines[numRangeRows].length != numRangeLastLineChars) - throwDeltaError(delta, "delta.range must match delta lines"); -} - -exports.applyDelta = function(docLines, delta, doNotValidate) { - - var row = delta.start.row; - var startColumn = delta.start.column; - var line = docLines[row] || ""; - switch (delta.action) { - case "insert": - var lines = delta.lines; - if (lines.length === 1) { - docLines[row] = line.substring(0, startColumn) + delta.lines[0] + line.substring(startColumn); - } else { - var args = [row, 1].concat(delta.lines); - docLines.splice.apply(docLines, args); - docLines[row] = line.substring(0, startColumn) + docLines[row]; - docLines[row + delta.lines.length - 1] += line.substring(startColumn); - } - break; - case "remove": - var endColumn = delta.end.column; - var endRow = delta.end.row; - if (row === endRow) { - docLines[row] = line.substring(0, startColumn) + line.substring(endColumn); - } else { - docLines.splice( - row, endRow - row + 1, - line.substring(0, startColumn) + docLines[endRow].substring(endColumn) - ); - } - break; - } -}; -}); - -ace.define("ace/lib/event_emitter",[], function(require, exports, module) { -"use strict"; - -var EventEmitter = {}; -var stopPropagation = function() { this.propagationStopped = true; }; -var preventDefault = function() { this.defaultPrevented = true; }; - -EventEmitter._emit = -EventEmitter._dispatchEvent = function(eventName, e) { - this._eventRegistry || (this._eventRegistry = {}); - this._defaultHandlers || (this._defaultHandlers = {}); - - var listeners = this._eventRegistry[eventName] || []; - var defaultHandler = this._defaultHandlers[eventName]; - if (!listeners.length && !defaultHandler) - return; - - if (typeof e != "object" || !e) - e = {}; - - if (!e.type) - e.type = eventName; - if (!e.stopPropagation) - e.stopPropagation = stopPropagation; - if (!e.preventDefault) - e.preventDefault = preventDefault; - - listeners = listeners.slice(); - for (var i=0; i this.row) - return; - - var point = $getTransformedPoint(delta, {row: this.row, column: this.column}, this.$insertRight); - this.setPosition(point.row, point.column, true); - }; - - function $pointsInOrder(point1, point2, equalPointsInOrder) { - var bColIsAfter = equalPointsInOrder ? point1.column <= point2.column : point1.column < point2.column; - return (point1.row < point2.row) || (point1.row == point2.row && bColIsAfter); - } - - function $getTransformedPoint(delta, point, moveIfEqual) { - var deltaIsInsert = delta.action == "insert"; - var deltaRowShift = (deltaIsInsert ? 1 : -1) * (delta.end.row - delta.start.row); - var deltaColShift = (deltaIsInsert ? 1 : -1) * (delta.end.column - delta.start.column); - var deltaStart = delta.start; - var deltaEnd = deltaIsInsert ? deltaStart : delta.end; // Collapse insert range. - if ($pointsInOrder(point, deltaStart, moveIfEqual)) { - return { - row: point.row, - column: point.column - }; - } - if ($pointsInOrder(deltaEnd, point, !moveIfEqual)) { - return { - row: point.row + deltaRowShift, - column: point.column + (point.row == deltaEnd.row ? deltaColShift : 0) - }; - } - - return { - row: deltaStart.row, - column: deltaStart.column - }; - } - this.setPosition = function(row, column, noClip) { - var pos; - if (noClip) { - pos = { - row: row, - column: column - }; - } else { - pos = this.$clipPositionToDocument(row, column); - } - - if (this.row == pos.row && this.column == pos.column) - return; - - var old = { - row: this.row, - column: this.column - }; - - this.row = pos.row; - this.column = pos.column; - this._signal("change", { - old: old, - value: pos - }); - }; - this.detach = function() { - this.document.removeEventListener("change", this.$onChange); - }; - this.attach = function(doc) { - this.document = doc || this.document; - this.document.on("change", this.$onChange); - }; - this.$clipPositionToDocument = function(row, column) { - var pos = {}; - - if (row >= this.document.getLength()) { - pos.row = Math.max(0, this.document.getLength() - 1); - pos.column = this.document.getLine(pos.row).length; - } - else if (row < 0) { - pos.row = 0; - pos.column = 0; - } - else { - pos.row = row; - pos.column = Math.min(this.document.getLine(pos.row).length, Math.max(0, column)); - } - - if (column < 0) - pos.column = 0; - - return pos; - }; - -}).call(Anchor.prototype); - -}); - -ace.define("ace/document",[], function(require, exports, module) { -"use strict"; - -var oop = require("./lib/oop"); -var applyDelta = require("./apply_delta").applyDelta; -var EventEmitter = require("./lib/event_emitter").EventEmitter; -var Range = require("./range").Range; -var Anchor = require("./anchor").Anchor; - -var Document = function(textOrLines) { - this.$lines = [""]; - if (textOrLines.length === 0) { - this.$lines = [""]; - } else if (Array.isArray(textOrLines)) { - this.insertMergedLines({row: 0, column: 0}, textOrLines); - } else { - this.insert({row: 0, column:0}, textOrLines); - } -}; - -(function() { - - oop.implement(this, EventEmitter); - this.setValue = function(text) { - var len = this.getLength() - 1; - this.remove(new Range(0, 0, len, this.getLine(len).length)); - this.insert({row: 0, column: 0}, text); - }; - this.getValue = function() { - return this.getAllLines().join(this.getNewLineCharacter()); - }; - this.createAnchor = function(row, column) { - return new Anchor(this, row, column); - }; - if ("aaa".split(/a/).length === 0) { - this.$split = function(text) { - return text.replace(/\r\n|\r/g, "\n").split("\n"); - }; - } else { - this.$split = function(text) { - return text.split(/\r\n|\r|\n/); - }; - } - - - this.$detectNewLine = function(text) { - var match = text.match(/^.*?(\r\n|\r|\n)/m); - this.$autoNewLine = match ? match[1] : "\n"; - this._signal("changeNewLineMode"); - }; - this.getNewLineCharacter = function() { - switch (this.$newLineMode) { - case "windows": - return "\r\n"; - case "unix": - return "\n"; - default: - return this.$autoNewLine || "\n"; - } - }; - - this.$autoNewLine = ""; - this.$newLineMode = "auto"; - this.setNewLineMode = function(newLineMode) { - if (this.$newLineMode === newLineMode) - return; - - this.$newLineMode = newLineMode; - this._signal("changeNewLineMode"); - }; - this.getNewLineMode = function() { - return this.$newLineMode; - }; - this.isNewLine = function(text) { - return (text == "\r\n" || text == "\r" || text == "\n"); - }; - this.getLine = function(row) { - return this.$lines[row] || ""; - }; - this.getLines = function(firstRow, lastRow) { - return this.$lines.slice(firstRow, lastRow + 1); - }; - this.getAllLines = function() { - return this.getLines(0, this.getLength()); - }; - this.getLength = function() { - return this.$lines.length; - }; - this.getTextRange = function(range) { - return this.getLinesForRange(range).join(this.getNewLineCharacter()); - }; - this.getLinesForRange = function(range) { - var lines; - if (range.start.row === range.end.row) { - lines = [this.getLine(range.start.row).substring(range.start.column, range.end.column)]; - } else { - lines = this.getLines(range.start.row, range.end.row); - lines[0] = (lines[0] || "").substring(range.start.column); - var l = lines.length - 1; - if (range.end.row - range.start.row == l) - lines[l] = lines[l].substring(0, range.end.column); - } - return lines; - }; - this.insertLines = function(row, lines) { - console.warn("Use of document.insertLines is deprecated. Use the insertFullLines method instead."); - return this.insertFullLines(row, lines); - }; - this.removeLines = function(firstRow, lastRow) { - console.warn("Use of document.removeLines is deprecated. Use the removeFullLines method instead."); - return this.removeFullLines(firstRow, lastRow); - }; - this.insertNewLine = function(position) { - console.warn("Use of document.insertNewLine is deprecated. Use insertMergedLines(position, ['', '']) instead."); - return this.insertMergedLines(position, ["", ""]); - }; - this.insert = function(position, text) { - if (this.getLength() <= 1) - this.$detectNewLine(text); - - return this.insertMergedLines(position, this.$split(text)); - }; - this.insertInLine = function(position, text) { - var start = this.clippedPos(position.row, position.column); - var end = this.pos(position.row, position.column + text.length); - - this.applyDelta({ - start: start, - end: end, - action: "insert", - lines: [text] - }, true); - - return this.clonePos(end); - }; - - this.clippedPos = function(row, column) { - var length = this.getLength(); - if (row === undefined) { - row = length; - } else if (row < 0) { - row = 0; - } else if (row >= length) { - row = length - 1; - column = undefined; - } - var line = this.getLine(row); - if (column == undefined) - column = line.length; - column = Math.min(Math.max(column, 0), line.length); - return {row: row, column: column}; - }; - - this.clonePos = function(pos) { - return {row: pos.row, column: pos.column}; - }; - - this.pos = function(row, column) { - return {row: row, column: column}; - }; - - this.$clipPosition = function(position) { - var length = this.getLength(); - if (position.row >= length) { - position.row = Math.max(0, length - 1); - position.column = this.getLine(length - 1).length; - } else { - position.row = Math.max(0, position.row); - position.column = Math.min(Math.max(position.column, 0), this.getLine(position.row).length); - } - return position; - }; - this.insertFullLines = function(row, lines) { - row = Math.min(Math.max(row, 0), this.getLength()); - var column = 0; - if (row < this.getLength()) { - lines = lines.concat([""]); - column = 0; - } else { - lines = [""].concat(lines); - row--; - column = this.$lines[row].length; - } - this.insertMergedLines({row: row, column: column}, lines); - }; - this.insertMergedLines = function(position, lines) { - var start = this.clippedPos(position.row, position.column); - var end = { - row: start.row + lines.length - 1, - column: (lines.length == 1 ? start.column : 0) + lines[lines.length - 1].length - }; - - this.applyDelta({ - start: start, - end: end, - action: "insert", - lines: lines - }); - - return this.clonePos(end); - }; - this.remove = function(range) { - var start = this.clippedPos(range.start.row, range.start.column); - var end = this.clippedPos(range.end.row, range.end.column); - this.applyDelta({ - start: start, - end: end, - action: "remove", - lines: this.getLinesForRange({start: start, end: end}) - }); - return this.clonePos(start); - }; - this.removeInLine = function(row, startColumn, endColumn) { - var start = this.clippedPos(row, startColumn); - var end = this.clippedPos(row, endColumn); - - this.applyDelta({ - start: start, - end: end, - action: "remove", - lines: this.getLinesForRange({start: start, end: end}) - }, true); - - return this.clonePos(start); - }; - this.removeFullLines = function(firstRow, lastRow) { - firstRow = Math.min(Math.max(0, firstRow), this.getLength() - 1); - lastRow = Math.min(Math.max(0, lastRow ), this.getLength() - 1); - var deleteFirstNewLine = lastRow == this.getLength() - 1 && firstRow > 0; - var deleteLastNewLine = lastRow < this.getLength() - 1; - var startRow = ( deleteFirstNewLine ? firstRow - 1 : firstRow ); - var startCol = ( deleteFirstNewLine ? this.getLine(startRow).length : 0 ); - var endRow = ( deleteLastNewLine ? lastRow + 1 : lastRow ); - var endCol = ( deleteLastNewLine ? 0 : this.getLine(endRow).length ); - var range = new Range(startRow, startCol, endRow, endCol); - var deletedLines = this.$lines.slice(firstRow, lastRow + 1); - - this.applyDelta({ - start: range.start, - end: range.end, - action: "remove", - lines: this.getLinesForRange(range) - }); - return deletedLines; - }; - this.removeNewLine = function(row) { - if (row < this.getLength() - 1 && row >= 0) { - this.applyDelta({ - start: this.pos(row, this.getLine(row).length), - end: this.pos(row + 1, 0), - action: "remove", - lines: ["", ""] - }); - } - }; - this.replace = function(range, text) { - if (!(range instanceof Range)) - range = Range.fromPoints(range.start, range.end); - if (text.length === 0 && range.isEmpty()) - return range.start; - if (text == this.getTextRange(range)) - return range.end; - - this.remove(range); - var end; - if (text) { - end = this.insert(range.start, text); - } - else { - end = range.start; - } - - return end; - }; - this.applyDeltas = function(deltas) { - for (var i=0; i=0; i--) { - this.revertDelta(deltas[i]); - } - }; - this.applyDelta = function(delta, doNotValidate) { - var isInsert = delta.action == "insert"; - if (isInsert ? delta.lines.length <= 1 && !delta.lines[0] - : !Range.comparePoints(delta.start, delta.end)) { - return; - } - - if (isInsert && delta.lines.length > 20000) { - this.$splitAndapplyLargeDelta(delta, 20000); - } - else { - applyDelta(this.$lines, delta, doNotValidate); - this._signal("change", delta); - } - }; - - this.$splitAndapplyLargeDelta = function(delta, MAX) { - var lines = delta.lines; - var l = lines.length - MAX + 1; - var row = delta.start.row; - var column = delta.start.column; - for (var from = 0, to = 0; from < l; from = to) { - to += MAX - 1; - var chunk = lines.slice(from, to); - chunk.push(""); - this.applyDelta({ - start: this.pos(row + from, column), - end: this.pos(row + to, column = 0), - action: delta.action, - lines: chunk - }, true); - } - delta.lines = lines.slice(from); - delta.start.row = row + from; - delta.start.column = column; - this.applyDelta(delta, true); - }; - this.revertDelta = function(delta) { - this.applyDelta({ - start: this.clonePos(delta.start), - end: this.clonePos(delta.end), - action: (delta.action == "insert" ? "remove" : "insert"), - lines: delta.lines.slice() - }); - }; - this.indexToPosition = function(index, startRow) { - var lines = this.$lines || this.getAllLines(); - var newlineLength = this.getNewLineCharacter().length; - for (var i = startRow || 0, l = lines.length; i < l; i++) { - index -= lines[i].length + newlineLength; - if (index < 0) - return {row: i, column: index + lines[i].length + newlineLength}; - } - return {row: l-1, column: index + lines[l-1].length + newlineLength}; - }; - this.positionToIndex = function(pos, startRow) { - var lines = this.$lines || this.getAllLines(); - var newlineLength = this.getNewLineCharacter().length; - var index = 0; - var row = Math.min(pos.row, lines.length); - for (var i = startRow || 0; i < row; ++i) - index += lines[i].length + newlineLength; - - return index + pos.column; - }; - -}).call(Document.prototype); - -exports.Document = Document; -}); - -ace.define("ace/lib/lang",[], function(require, exports, module) { -"use strict"; - -exports.last = function(a) { - return a[a.length - 1]; -}; - -exports.stringReverse = function(string) { - return string.split("").reverse().join(""); -}; - -exports.stringRepeat = function (string, count) { - var result = ''; - while (count > 0) { - if (count & 1) - result += string; - - if (count >>= 1) - string += string; - } - return result; -}; - -var trimBeginRegexp = /^\s\s*/; -var trimEndRegexp = /\s\s*$/; - -exports.stringTrimLeft = function (string) { - return string.replace(trimBeginRegexp, ''); -}; - -exports.stringTrimRight = function (string) { - return string.replace(trimEndRegexp, ''); -}; - -exports.copyObject = function(obj) { - var copy = {}; - for (var key in obj) { - copy[key] = obj[key]; - } - return copy; -}; - -exports.copyArray = function(array){ - var copy = []; - for (var i=0, l=array.length; i= '0' && ch <= '9') { - string += ch; - next(); - } - if (ch === '.') { - string += '.'; - while (next() && ch >= '0' && ch <= '9') { - string += ch; - } - } - if (ch === 'e' || ch === 'E') { - string += ch; - next(); - if (ch === '-' || ch === '+') { - string += ch; - next(); - } - while (ch >= '0' && ch <= '9') { - string += ch; - next(); - } - } - number = +string; - if (isNaN(number)) { - error("Bad number"); - } else { - return number; - } - }, - - string = function () { - - var hex, - i, - string = '', - uffff; - - if (ch === '"') { - while (next()) { - if (ch === '"') { - next(); - return string; - } else if (ch === '\\') { - next(); - if (ch === 'u') { - uffff = 0; - for (i = 0; i < 4; i += 1) { - hex = parseInt(next(), 16); - if (!isFinite(hex)) { - break; - } - uffff = uffff * 16 + hex; - } - string += String.fromCharCode(uffff); - } else if (typeof escapee[ch] === 'string') { - string += escapee[ch]; - } else { - break; - } - } else if (ch == "\n" || ch == "\r") { - break; - } else { - string += ch; - } - } - } - error("Bad string"); - }, - - white = function () { - - while (ch && ch <= ' ') { - next(); - } - }, - - word = function () { - - switch (ch) { - case 't': - next('t'); - next('r'); - next('u'); - next('e'); - return true; - case 'f': - next('f'); - next('a'); - next('l'); - next('s'); - next('e'); - return false; - case 'n': - next('n'); - next('u'); - next('l'); - next('l'); - return null; - } - error("Unexpected '" + ch + "'"); - }, - - value, // Place holder for the value function. - - array = function () { - - var array = []; - - if (ch === '[') { - next('['); - white(); - if (ch === ']') { - next(']'); - return array; // empty array - } - while (ch) { - array.push(value()); - white(); - if (ch === ']') { - next(']'); - return array; - } - next(','); - white(); - } - } - error("Bad array"); - }, - - object = function () { - - var key, - object = {}; - - if (ch === '{') { - next('{'); - white(); - if (ch === '}') { - next('}'); - return object; // empty object - } - while (ch) { - key = string(); - white(); - next(':'); - if (Object.hasOwnProperty.call(object, key)) { - error('Duplicate key "' + key + '"'); - } - object[key] = value(); - white(); - if (ch === '}') { - next('}'); - return object; - } - next(','); - white(); - } - } - error("Bad object"); - }; - - value = function () { - - white(); - switch (ch) { - case '{': - return object(); - case '[': - return array(); - case '"': - return string(); - case '-': - return number(); - default: - return ch >= '0' && ch <= '9' ? number() : word(); - } - }; - - return function (source, reviver) { - var result; - - text = source; - at = 0; - ch = ' '; - result = value(); - white(); - if (ch) { - error("Syntax error"); - } - - return typeof reviver === 'function' ? function walk(holder, key) { - var k, v, value = holder[key]; - if (value && typeof value === 'object') { - for (k in value) { - if (Object.hasOwnProperty.call(value, k)) { - v = walk(value, k); - if (v !== undefined) { - value[k] = v; - } else { - delete value[k]; - } - } - } - } - return reviver.call(holder, key, value); - }({'': result}, '') : result; - }; -}); - -ace.define("ace/mode/json_worker",[], function(require, exports, module) { -"use strict"; - -var oop = require("../lib/oop"); -var Mirror = require("../worker/mirror").Mirror; -var parse = require("./json/json_parse"); - -var JsonWorker = exports.JsonWorker = function(sender) { - Mirror.call(this, sender); - this.setTimeout(200); -}; - -oop.inherits(JsonWorker, Mirror); - -(function() { - - this.onUpdate = function() { - var value = this.doc.getValue(); - var errors = []; - try { - if (value) - parse(value); - } catch (e) { - var pos = this.doc.indexToPosition(e.at-1); - errors.push({ - row: pos.row, - column: pos.column, - text: e.message, - type: "error" - }); - } - this.sender.emit("annotate", errors); - }; - -}).call(JsonWorker.prototype); - -}); - -ace.define("ace/lib/es5-shim",[], function(require, exports, module) { - -function Empty() {} - -if (!Function.prototype.bind) { - Function.prototype.bind = function bind(that) { // .length is 1 - var target = this; - if (typeof target != "function") { - throw new TypeError("Function.prototype.bind called on incompatible " + target); - } - var args = slice.call(arguments, 1); // for normal call - var bound = function () { - - if (this instanceof bound) { - - var result = target.apply( - this, - args.concat(slice.call(arguments)) - ); - if (Object(result) === result) { - return result; - } - return this; - - } else { - return target.apply( - that, - args.concat(slice.call(arguments)) - ); - - } - - }; - if(target.prototype) { - Empty.prototype = target.prototype; - bound.prototype = new Empty(); - Empty.prototype = null; - } - return bound; - }; -} -var call = Function.prototype.call; -var prototypeOfArray = Array.prototype; -var prototypeOfObject = Object.prototype; -var slice = prototypeOfArray.slice; -var _toString = call.bind(prototypeOfObject.toString); -var owns = call.bind(prototypeOfObject.hasOwnProperty); -var defineGetter; -var defineSetter; -var lookupGetter; -var lookupSetter; -var supportsAccessors; -if ((supportsAccessors = owns(prototypeOfObject, "__defineGetter__"))) { - defineGetter = call.bind(prototypeOfObject.__defineGetter__); - defineSetter = call.bind(prototypeOfObject.__defineSetter__); - lookupGetter = call.bind(prototypeOfObject.__lookupGetter__); - lookupSetter = call.bind(prototypeOfObject.__lookupSetter__); -} -if ([1,2].splice(0).length != 2) { - if(function() { // test IE < 9 to splice bug - see issue #138 - function makeArray(l) { - var a = new Array(l+2); - a[0] = a[1] = 0; - return a; - } - var array = [], lengthBefore; - - array.splice.apply(array, makeArray(20)); - array.splice.apply(array, makeArray(26)); - - lengthBefore = array.length; //46 - array.splice(5, 0, "XXX"); // add one element - - lengthBefore + 1 == array.length - - if (lengthBefore + 1 == array.length) { - return true;// has right splice implementation without bugs - } - }()) {//IE 6/7 - var array_splice = Array.prototype.splice; - Array.prototype.splice = function(start, deleteCount) { - if (!arguments.length) { - return []; - } else { - return array_splice.apply(this, [ - start === void 0 ? 0 : start, - deleteCount === void 0 ? (this.length - start) : deleteCount - ].concat(slice.call(arguments, 2))) - } - }; - } else {//IE8 - Array.prototype.splice = function(pos, removeCount){ - var length = this.length; - if (pos > 0) { - if (pos > length) - pos = length; - } else if (pos == void 0) { - pos = 0; - } else if (pos < 0) { - pos = Math.max(length + pos, 0); - } - - if (!(pos+removeCount < length)) - removeCount = length - pos; - - var removed = this.slice(pos, pos+removeCount); - var insert = slice.call(arguments, 2); - var add = insert.length; - if (pos === length) { - if (add) { - this.push.apply(this, insert); - } - } else { - var remove = Math.min(removeCount, length - pos); - var tailOldPos = pos + remove; - var tailNewPos = tailOldPos + add - remove; - var tailCount = length - tailOldPos; - var lengthAfterRemove = length - remove; - - if (tailNewPos < tailOldPos) { // case A - for (var i = 0; i < tailCount; ++i) { - this[tailNewPos+i] = this[tailOldPos+i]; - } - } else if (tailNewPos > tailOldPos) { // case B - for (i = tailCount; i--; ) { - this[tailNewPos+i] = this[tailOldPos+i]; - } - } // else, add == remove (nothing to do) - - if (add && pos === lengthAfterRemove) { - this.length = lengthAfterRemove; // truncate array - this.push.apply(this, insert); - } else { - this.length = lengthAfterRemove + add; // reserves space - for (i = 0; i < add; ++i) { - this[pos+i] = insert[i]; - } - } - } - return removed; - }; - } -} -if (!Array.isArray) { - Array.isArray = function isArray(obj) { - return _toString(obj) == "[object Array]"; - }; -} -var boxedString = Object("a"), - splitString = boxedString[0] != "a" || !(0 in boxedString); - -if (!Array.prototype.forEach) { - Array.prototype.forEach = function forEach(fun /*, thisp*/) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - thisp = arguments[1], - i = -1, - length = self.length >>> 0; - if (_toString(fun) != "[object Function]") { - throw new TypeError(); // TODO message - } - - while (++i < length) { - if (i in self) { - fun.call(thisp, self[i], i, object); - } - } - }; -} -if (!Array.prototype.map) { - Array.prototype.map = function map(fun /*, thisp*/) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0, - result = Array(length), - thisp = arguments[1]; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - - for (var i = 0; i < length; i++) { - if (i in self) - result[i] = fun.call(thisp, self[i], i, object); - } - return result; - }; -} -if (!Array.prototype.filter) { - Array.prototype.filter = function filter(fun /*, thisp */) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0, - result = [], - value, - thisp = arguments[1]; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - - for (var i = 0; i < length; i++) { - if (i in self) { - value = self[i]; - if (fun.call(thisp, value, i, object)) { - result.push(value); - } - } - } - return result; - }; -} -if (!Array.prototype.every) { - Array.prototype.every = function every(fun /*, thisp */) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0, - thisp = arguments[1]; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - - for (var i = 0; i < length; i++) { - if (i in self && !fun.call(thisp, self[i], i, object)) { - return false; - } - } - return true; - }; -} -if (!Array.prototype.some) { - Array.prototype.some = function some(fun /*, thisp */) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0, - thisp = arguments[1]; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - - for (var i = 0; i < length; i++) { - if (i in self && fun.call(thisp, self[i], i, object)) { - return true; - } - } - return false; - }; -} -if (!Array.prototype.reduce) { - Array.prototype.reduce = function reduce(fun /*, initial*/) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - if (!length && arguments.length == 1) { - throw new TypeError("reduce of empty array with no initial value"); - } - - var i = 0; - var result; - if (arguments.length >= 2) { - result = arguments[1]; - } else { - do { - if (i in self) { - result = self[i++]; - break; - } - if (++i >= length) { - throw new TypeError("reduce of empty array with no initial value"); - } - } while (true); - } - - for (; i < length; i++) { - if (i in self) { - result = fun.call(void 0, result, self[i], i, object); - } - } - - return result; - }; -} -if (!Array.prototype.reduceRight) { - Array.prototype.reduceRight = function reduceRight(fun /*, initial*/) { - var object = toObject(this), - self = splitString && _toString(this) == "[object String]" ? - this.split("") : - object, - length = self.length >>> 0; - if (_toString(fun) != "[object Function]") { - throw new TypeError(fun + " is not a function"); - } - if (!length && arguments.length == 1) { - throw new TypeError("reduceRight of empty array with no initial value"); - } - - var result, i = length - 1; - if (arguments.length >= 2) { - result = arguments[1]; - } else { - do { - if (i in self) { - result = self[i--]; - break; - } - if (--i < 0) { - throw new TypeError("reduceRight of empty array with no initial value"); - } - } while (true); - } - - do { - if (i in this) { - result = fun.call(void 0, result, self[i], i, object); - } - } while (i--); - - return result; - }; -} -if (!Array.prototype.indexOf || ([0, 1].indexOf(1, 2) != -1)) { - Array.prototype.indexOf = function indexOf(sought /*, fromIndex */ ) { - var self = splitString && _toString(this) == "[object String]" ? - this.split("") : - toObject(this), - length = self.length >>> 0; - - if (!length) { - return -1; - } - - var i = 0; - if (arguments.length > 1) { - i = toInteger(arguments[1]); - } - i = i >= 0 ? i : Math.max(0, length + i); - for (; i < length; i++) { - if (i in self && self[i] === sought) { - return i; - } - } - return -1; - }; -} -if (!Array.prototype.lastIndexOf || ([0, 1].lastIndexOf(0, -3) != -1)) { - Array.prototype.lastIndexOf = function lastIndexOf(sought /*, fromIndex */) { - var self = splitString && _toString(this) == "[object String]" ? - this.split("") : - toObject(this), - length = self.length >>> 0; - - if (!length) { - return -1; - } - var i = length - 1; - if (arguments.length > 1) { - i = Math.min(i, toInteger(arguments[1])); - } - i = i >= 0 ? i : length - Math.abs(i); - for (; i >= 0; i--) { - if (i in self && sought === self[i]) { - return i; - } - } - return -1; - }; -} -if (!Object.getPrototypeOf) { - Object.getPrototypeOf = function getPrototypeOf(object) { - return object.__proto__ || ( - object.constructor ? - object.constructor.prototype : - prototypeOfObject - ); - }; -} -if (!Object.getOwnPropertyDescriptor) { - var ERR_NON_OBJECT = "Object.getOwnPropertyDescriptor called on a " + - "non-object: "; - Object.getOwnPropertyDescriptor = function getOwnPropertyDescriptor(object, property) { - if ((typeof object != "object" && typeof object != "function") || object === null) - throw new TypeError(ERR_NON_OBJECT + object); - if (!owns(object, property)) - return; - - var descriptor, getter, setter; - descriptor = { enumerable: true, configurable: true }; - if (supportsAccessors) { - var prototype = object.__proto__; - object.__proto__ = prototypeOfObject; - - var getter = lookupGetter(object, property); - var setter = lookupSetter(object, property); - object.__proto__ = prototype; - - if (getter || setter) { - if (getter) descriptor.get = getter; - if (setter) descriptor.set = setter; - return descriptor; - } - } - descriptor.value = object[property]; - return descriptor; - }; -} -if (!Object.getOwnPropertyNames) { - Object.getOwnPropertyNames = function getOwnPropertyNames(object) { - return Object.keys(object); - }; -} -if (!Object.create) { - var createEmpty; - if (Object.prototype.__proto__ === null) { - createEmpty = function () { - return { "__proto__": null }; - }; - } else { - createEmpty = function () { - var empty = {}; - for (var i in empty) - empty[i] = null; - empty.constructor = - empty.hasOwnProperty = - empty.propertyIsEnumerable = - empty.isPrototypeOf = - empty.toLocaleString = - empty.toString = - empty.valueOf = - empty.__proto__ = null; - return empty; - } - } - - Object.create = function create(prototype, properties) { - var object; - if (prototype === null) { - object = createEmpty(); - } else { - if (typeof prototype != "object") - throw new TypeError("typeof prototype["+(typeof prototype)+"] != 'object'"); - var Type = function () {}; - Type.prototype = prototype; - object = new Type(); - object.__proto__ = prototype; - } - if (properties !== void 0) - Object.defineProperties(object, properties); - return object; - }; -} - -function doesDefinePropertyWork(object) { - try { - Object.defineProperty(object, "sentinel", {}); - return "sentinel" in object; - } catch (exception) { - } -} -if (Object.defineProperty) { - var definePropertyWorksOnObject = doesDefinePropertyWork({}); - var definePropertyWorksOnDom = typeof document == "undefined" || - doesDefinePropertyWork(document.createElement("div")); - if (!definePropertyWorksOnObject || !definePropertyWorksOnDom) { - var definePropertyFallback = Object.defineProperty; - } -} - -if (!Object.defineProperty || definePropertyFallback) { - var ERR_NON_OBJECT_DESCRIPTOR = "Property description must be an object: "; - var ERR_NON_OBJECT_TARGET = "Object.defineProperty called on non-object: " - var ERR_ACCESSORS_NOT_SUPPORTED = "getters & setters can not be defined " + - "on this javascript engine"; - - Object.defineProperty = function defineProperty(object, property, descriptor) { - if ((typeof object != "object" && typeof object != "function") || object === null) - throw new TypeError(ERR_NON_OBJECT_TARGET + object); - if ((typeof descriptor != "object" && typeof descriptor != "function") || descriptor === null) - throw new TypeError(ERR_NON_OBJECT_DESCRIPTOR + descriptor); - if (definePropertyFallback) { - try { - return definePropertyFallback.call(Object, object, property, descriptor); - } catch (exception) { - } - } - if (owns(descriptor, "value")) { - - if (supportsAccessors && (lookupGetter(object, property) || - lookupSetter(object, property))) - { - var prototype = object.__proto__; - object.__proto__ = prototypeOfObject; - delete object[property]; - object[property] = descriptor.value; - object.__proto__ = prototype; - } else { - object[property] = descriptor.value; - } - } else { - if (!supportsAccessors) - throw new TypeError(ERR_ACCESSORS_NOT_SUPPORTED); - if (owns(descriptor, "get")) - defineGetter(object, property, descriptor.get); - if (owns(descriptor, "set")) - defineSetter(object, property, descriptor.set); - } - - return object; - }; -} -if (!Object.defineProperties) { - Object.defineProperties = function defineProperties(object, properties) { - for (var property in properties) { - if (owns(properties, property)) - Object.defineProperty(object, property, properties[property]); - } - return object; - }; -} -if (!Object.seal) { - Object.seal = function seal(object) { - return object; - }; -} -if (!Object.freeze) { - Object.freeze = function freeze(object) { - return object; - }; -} -try { - Object.freeze(function () {}); -} catch (exception) { - Object.freeze = (function freeze(freezeObject) { - return function freeze(object) { - if (typeof object == "function") { - return object; - } else { - return freezeObject(object); - } - }; - })(Object.freeze); -} -if (!Object.preventExtensions) { - Object.preventExtensions = function preventExtensions(object) { - return object; - }; -} -if (!Object.isSealed) { - Object.isSealed = function isSealed(object) { - return false; - }; -} -if (!Object.isFrozen) { - Object.isFrozen = function isFrozen(object) { - return false; - }; -} -if (!Object.isExtensible) { - Object.isExtensible = function isExtensible(object) { - if (Object(object) === object) { - throw new TypeError(); // TODO message - } - var name = ''; - while (owns(object, name)) { - name += '?'; - } - object[name] = true; - var returnValue = owns(object, name); - delete object[name]; - return returnValue; - }; -} -if (!Object.keys) { - var hasDontEnumBug = true, - dontEnums = [ - "toString", - "toLocaleString", - "valueOf", - "hasOwnProperty", - "isPrototypeOf", - "propertyIsEnumerable", - "constructor" - ], - dontEnumsLength = dontEnums.length; - - for (var key in {"toString": null}) { - hasDontEnumBug = false; - } - - Object.keys = function keys(object) { - - if ( - (typeof object != "object" && typeof object != "function") || - object === null - ) { - throw new TypeError("Object.keys called on a non-object"); - } - - var keys = []; - for (var name in object) { - if (owns(object, name)) { - keys.push(name); - } - } - - if (hasDontEnumBug) { - for (var i = 0, ii = dontEnumsLength; i < ii; i++) { - var dontEnum = dontEnums[i]; - if (owns(object, dontEnum)) { - keys.push(dontEnum); - } - } - } - return keys; - }; - -} -if (!Date.now) { - Date.now = function now() { - return new Date().getTime(); - }; -} -var ws = "\x09\x0A\x0B\x0C\x0D\x20\xA0\u1680\u180E\u2000\u2001\u2002\u2003" + - "\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u202F\u205F\u3000\u2028" + - "\u2029\uFEFF"; -if (!String.prototype.trim || ws.trim()) { - ws = "[" + ws + "]"; - var trimBeginRegexp = new RegExp("^" + ws + ws + "*"), - trimEndRegexp = new RegExp(ws + ws + "*$"); - String.prototype.trim = function trim() { - return String(this).replace(trimBeginRegexp, "").replace(trimEndRegexp, ""); - }; -} - -function toInteger(n) { - n = +n; - if (n !== n) { // isNaN - n = 0; - } else if (n !== 0 && n !== (1/0) && n !== -(1/0)) { - n = (n > 0 || -1) * Math.floor(Math.abs(n)); - } - return n; -} - -function isPrimitive(input) { - var type = typeof input; - return ( - input === null || - type === "undefined" || - type === "boolean" || - type === "number" || - type === "string" - ); -} - -function toPrimitive(input) { - var val, valueOf, toString; - if (isPrimitive(input)) { - return input; - } - valueOf = input.valueOf; - if (typeof valueOf === "function") { - val = valueOf.call(input); - if (isPrimitive(val)) { - return val; - } - } - toString = input.toString; - if (typeof toString === "function") { - val = toString.call(input); - if (isPrimitive(val)) { - return val; - } - } - throw new TypeError(); -} -var toObject = function (o) { - if (o == null) { // this matches both null and undefined - throw new TypeError("can't convert "+o+" to object"); - } - return Object(o); -}; - -}); From fec482ff612ca6645c0e3db25bcdab0d3da2678f Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Fri, 9 Aug 2019 23:43:07 +0200 Subject: [PATCH 54/91] fix : fix a bug when editing templates see the comment added in editor_lib --- src/editor/editor_lib.ml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 1c03b22c7..deae4a5b2 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -480,7 +480,11 @@ module Templates = struct | hd :: [] -> [hd] | hd :: snd :: [] -> [hd; snd] | hd :: snd :: thrd :: _ -> [ hd; snd; thrd] - + + (* WARNING very important that |} is without indenitng and in a new line + if not there will be a bug for the first edition of the templates in the editor: + add templates after the last template is not possible if you don't know the trick. + The trick is to remove the new line of the last template and then manually type return in the keyboard *) let against_solution_template = { name = "Against solution"; template = {| @@ -490,7 +494,7 @@ module Templates = struct "plus" (* function name = plus *) [1 @:!! 4 ; 3 @:!! 3 ];; (* compare (plus 1 4) and (plus 3 3) against professor\'s solution *) - |} +|} } let test_suite_template = @@ -504,7 +508,7 @@ module Templates = struct 5 @:!! 5 ==> 10; 1 @:!! 1 ==> 2; 0 @:!! 0 ==> 0];; - |} +|} } let save templates = From 971b40f4de52926cc2dd4eee1afc3a147e4755d4 Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Sat, 10 Aug 2019 00:20:06 +0200 Subject: [PATCH 55/91] refactor : put custom html components into a module in editor_lib --- src/editor/editor.ml | 95 +------------------------------------- src/editor/editor_lib.ml | 96 +++++++++++++++++++++++++++++++++++++++ src/editor/editor_lib.mli | 27 +++++++++++ 3 files changed, 124 insertions(+), 94 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 007729334..1f720d59c 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -18,102 +18,9 @@ open Js_of_ocaml open Editor_lib open Dom_html open Test_spec - +open Editor_components module H = Tyxml_js.Html - -let dropup ~icon ~theme name items = - let dropup_content = - H.(div ~a:[a_class ["dropup-content"]] items) - in - let drop_button = - H.(button ~a:[a_class ["dropbtn"]] [ - img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; - pcdata " " ; - span ~a:[ a_class [ "label" ] ] [ pcdata name ] - ]) - in - Manip.Ev.onclick drop_button - (fun _ -> Manip.toggleClass dropup_content "show"); - (* TODO translate it to js_of_ocaml *) - let _ = - Js.Unsafe.js_expr " //Close the dropdown menu if the user clicks outside of it\nwindow.onclick = function(event) {\n if (!event.target.matches(\'.dropbtn\')) {\n var dropdowns = document.getElementsByClassName(\"dropup-content\");\n var i;\n for (i = 0; i < dropdowns.length; i++) {\n var openDropdown = dropdowns[i];\n if (openDropdown.classList.contains(\'show\')) {\n openDropdown.classList.remove(\'show\');\n }\n }\n }\n} " in (); - H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) - -let editor_overlay () = - H.(div ~a:[a_class ["learnocaml-dialog-overlay"; "config-editor-overlay"] ] - []) - - -let editor_container ~size ~contents ~buttons ~box_title ~box_header = - let container = - H.(div - [ - h3 [pcdata box_title]; - div [box_header]; - contents; - div ~a:[a_class ["buttons"] ] buttons - ] - ) - in - let (width, height) = size in - Manip.SetCss.width container width; - Manip.SetCss.height container height; - container - - -let ace_editor_container ~save ~size ~editor ~box_title ~box_header = - let overlay = editor_overlay () in - let close_btn = - H.(button ~a:[ a_onclick (fun _ -> - Manip.removeChild Manip.Elt.body overlay;false - )] [pcdata "Cancel"]) - in - let save_btn = - H.(button ~a:[ a_onclick (fun _ -> - save(); - reload(); false - )] [pcdata "Save"]) - in - let container = editor_container - ~size - ~contents: editor - ~buttons: [close_btn;save_btn] - ~box_title - ~box_header: (H.pcdata box_header) - in - Manip.replaceChildren overlay [container]; - overlay - -let all_templates_container ~size ~elements ~box_title ~box_header = - let overlay = editor_overlay () in - let close () = Manip.removeChild Manip.Elt.body overlay in - let ok_btn = - H.(button ~a:[ a_onclick (fun _ -> - close ();false - )] [pcdata "Ok"]) - in - - List.iter - (fun elt -> - let dom_elt = Tyxml_js.To_dom.of_a elt in - Dom_html.addEventListener dom_elt Dom_html.Event.click - (Dom_html.handler ( fun _ -> close ();Js._true )) - Js._true - |> ignore) - elements; - let contents = H.(div ~a: [a_style "overflow:auto"; - a_class["templates-to-change"]] elements) - in - let container = editor_container - ~size - ~contents - ~buttons: [ok_btn] - ~box_title - ~box_header - in - Manip.replaceChildren overlay [container]; - overlay (*----------------------------------------------------------------------*) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index deae4a5b2..d462174d0 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -553,3 +553,99 @@ module Templates = struct [pcdata name]) end + +module Editor_components = struct + + let dropup ~icon ~theme name items = + let dropup_content = + H.(div ~a:[a_class ["dropup-content"]] items) + in + let drop_button = + H.(button ~a:[a_class ["dropbtn"]] [ + img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + pcdata " " ; + span ~a:[ a_class [ "label" ] ] [ pcdata name ] + ]) + in + Manip.Ev.onclick drop_button + (fun _ -> Manip.toggleClass dropup_content "show"); + (* TODO translate it to js_of_ocaml *) + let _ = + Js.Unsafe.js_expr " //Close the dropdown menu if the user clicks outside of it\nwindow.onclick = function(event) {\n if (!event.target.matches(\'.dropbtn\')) {\n var dropdowns = document.getElementsByClassName(\"dropup-content\");\n var i;\n for (i = 0; i < dropdowns.length; i++) {\n var openDropdown = dropdowns[i];\n if (openDropdown.classList.contains(\'show\')) {\n openDropdown.classList.remove(\'show\');\n }\n }\n }\n} " in (); + H.(div ~a:[a_class ["dropup"]] [drop_button; dropup_content]) + + let editor_overlay () = + H.(div ~a:[a_class ["learnocaml-dialog-overlay"; "config-editor-overlay"] ] + []) + + + let editor_container ~size ~contents ~buttons ~box_title ~box_header = + let container = + H.(div + [ + h3 [pcdata box_title]; + div [box_header]; + contents; + div ~a:[a_class ["buttons"] ] buttons + ] + ) + in + let (width, height) = size in + Manip.SetCss.width container width; + Manip.SetCss.height container height; + container + + + let ace_editor_container ~save ~size ~editor ~box_title ~box_header = + let overlay = editor_overlay () in + let close_btn = + H.(button ~a:[ a_onclick (fun _ -> + Manip.removeChild Manip.Elt.body overlay;false + )] [pcdata "Cancel"]) + in + let save_btn = + H.(button ~a:[ a_onclick (fun _ -> + save(); + reload(); false + )] [pcdata "Save"]) + in + let container = editor_container + ~size + ~contents: editor + ~buttons: [close_btn;save_btn] + ~box_title + ~box_header: (H.pcdata box_header) + in + Manip.replaceChildren overlay [container]; + overlay + + let all_templates_container ~size ~elements ~box_title ~box_header = + let overlay = editor_overlay () in + let close () = Manip.removeChild Manip.Elt.body overlay in + let ok_btn = + H.(button ~a:[ a_onclick (fun _ -> + close ();false + )] [pcdata "Ok"]) + in + + List.iter + (fun elt -> + let dom_elt = Tyxml_js.To_dom.of_a elt in + Dom_html.addEventListener dom_elt Dom_html.Event.click + (Dom_html.handler ( fun _ -> close ();Js._true )) + Js._true + |> ignore) + elements; + let contents = H.(div ~a: [a_style "overflow:auto"; + a_class["templates-to-change"]] elements) + in + let container = editor_container + ~size + ~contents + ~buttons: [ok_btn] + ~box_title + ~box_header + in + Manip.replaceChildren overlay [container]; + overlay +end diff --git a/src/editor/editor_lib.mli b/src/editor/editor_lib.mli index e6b1fd850..cd744b7a0 100644 --- a/src/editor/editor_lib.mli +++ b/src/editor/editor_lib.mli @@ -134,3 +134,30 @@ module Templates : sig val template_to_a_elt : 'a Ace.editor -> Learnocaml_data.Editor.editor_template -> [> [> Html_types.pcdata ] Html_types.a ] H.elt end + +module Editor_components : sig + + val dropup : + icon:string -> + theme:string -> + string H.wrap -> + [< Html_types.div_content_fun ] H.elt H.list_wrap -> + [> Html_types.div ] H.elt + + val editor_overlay : unit -> [> Html_types.div ] H.elt + + val ace_editor_container : + save:(unit -> 'a) -> + size:string * string -> + editor:[< Html_types.div_content_fun > `Div `H3 ] H.elt -> + box_title:string H.wrap -> + box_header:string H.wrap -> [> Html_types.div ] H.elt + + val all_templates_container : + size:string * string -> + elements:[< `A of Html_types.flow5_without_interactive & 'a ] H.elt + H.list_wrap -> + box_title:string H.wrap -> + box_header:[< Html_types.div_content_fun ] H.elt -> + [> Html_types.div ] H.elt +end From 123e82fce5689140559a9bf0001b8f2c08e3a93e Mon Sep 17 00:00:00 2001 From: Manuel CABARCOS BAULINA Date: Thu, 15 Aug 2019 02:12:08 +0200 Subject: [PATCH 56/91] fix : remove all_templates vue when applying a template --- src/editor/editor.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 1f720d59c..b86903d8a 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -414,6 +414,7 @@ let () = | Some _ -> true) |> List.map (Templates.template_to_a_elt ace_t) in + Manip.removeChild Manip.Elt.body div; Manip.replaceChildren to_change content;true); true)] From bebed705f20632864a577d325d6af476be77d4de Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 1 Feb 2020 12:36:15 +0100 Subject: [PATCH 57/91] Simplify src/editor/test_spec.ml using [%funty: int -> int] syntax href: https://github.com/ocaml-sf/learn-ocaml/pull/302 --- src/editor/test_spec.ml | 62 ++--------------------------------------- 1 file changed, 3 insertions(+), 59 deletions(-) diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 5814a9950..7a7a68266 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -17,63 +17,7 @@ let rec to_string_aux char_list =match char_list with | []-> "" | c::l -> (string_of_char c) ^ ( to_string_aux l) -(* FIXME: it seems "str" always starts (and sometimes ends) with a space. - This should be fix so that the space comes from [to_ty] itself. *) -let to_ty str = "[%ty:" ^ str ^ "]" - -let rec decompositionSol str n = - if str = "" then [] - else if n + 1 = String.length str then [(str.[n])] - else (str.[n])::(decompositionSol str (n+1)) - -let parse_type string = - let char_list_ref = ref (List.rev (decompositionSol string 0)) in - let para_cpt =ref 0 in - let esp_cpt= ref 0 in - (* reverse char_list before using it *) - let rec last_arg char_list acc = - match char_list with - []->char_list_ref:=[];acc - |elt :: l -> - if elt = ')' then - incr para_cpt; - if elt ='(' then - decr para_cpt; - if elt='>' && !para_cpt=0 then - match l with - '-'::l2 -> char_list_ref:=l2;acc - |_ -> failwith "toto" - else - begin - if !esp_cpt=0 && elt=' ' then - begin - esp_cpt:=1; - last_arg l ( elt::acc ) - end - else - begin - if elt<>' ' then - begin - esp_cpt:=0; - last_arg l (elt::acc) - end - else - last_arg l acc - end - end in - let init_acc () = - let arg1=last_arg (!char_list_ref ) [] in - let arg2=last_arg (!char_list_ref) [] in - let ty1=to_ty (to_string_aux arg1) in - let ty2=to_ty (to_string_aux arg2) in - "last_ty "^ty2^" "^ty1 in - let acc =ref (init_acc ()) in - while !char_list_ref <>[] do - let arg=last_arg (!char_list_ref) [] in - let ty= to_ty (to_string_aux arg) in - acc:="arg_ty "^ty^" ("^(!acc)^")" ; - done; - !acc;; +let to_funty str = "[%funty: " ^ str ^ "]" (* The tester arg could take into account exceptions/sorted lists/etc. *) let question_typed ?num question = @@ -93,7 +37,7 @@ let question_typed ?num question = ^ "(TestAgainstSpec not currently supported by the learn-ocaml runtime) *)" | TestSuite a -> let name, prot, tester, suite = - a.name, parse_type a.ty, opt_string "test" a.tester, a.suite in + a.name, to_funty a.ty, opt_string "test" a.tester, a.suite in (* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 1/3) *) Format.sprintf "let q_%s%s =@. \ let prot = %s in@. \ @@ -103,7 +47,7 @@ let question_typed ?num question = name suffix prot tester name suite | TestAgainstSol a -> let name = a.name - and prot = parse_type a.ty + and prot = to_funty a.ty and gen = a.gen and sampler = opt_string "sampler" (sampler_args a.sampler) and tester = opt_string "test" a.tester From 3bb86786c775f5ec771c377c8f29e77574521306 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 1 Feb 2020 12:43:55 +0100 Subject: [PATCH 58/91] docs: Add TODOs --- src/editor/editor_lib.ml | 3 +++ src/editor/test_spec.ml | 1 + 2 files changed, 4 insertions(+) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 34d7e7ec4..2e8ba5672 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -249,6 +249,9 @@ let gen2 i = if q + 1 = r then List.nth base 0 else List.nth base (q + 1) +(* TODO/FIXME: when the considered function is higher-order, + we should insert a comment and disable automatic testcases (~gen:0) + in order to avoid the Exception: Failure "unsamplable type". *) let monomorph_generator l = let f ty = let vars = diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index 7a7a68266..d0c855a61 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -244,6 +244,7 @@ let cat_question name list_qst = (2, "q_" ^ name ^ "_1") l |> snd +(* TODO/FIXME: Add some "let () = set_progress ..." lines *) let compile indexed_list = let tests = test_prel ^ (ast_fonction true true) in let tests = List.fold_left (fun acc (_name, list_qst) -> From 597856b37969e5ae4abc013ddfead33ae9afccd2 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 1 Feb 2020 12:54:52 +0100 Subject: [PATCH 59/91] fix: Workaround ocaml-sf/learn-ocaml#300 --- src/editor/test_spec.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index d0c855a61..054809ba5 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -216,7 +216,7 @@ let ast_fonction quality imperative = else fonction ^ " and report = []" in let fonction = fonction ^ {| in if imperative_report = [] && report = [] - then [ Message ([ Text "OK (no prohibited construction detected)"], Success 0) ] + then [ Message ([ Text "OK (no prohibited construction detected)"], Important) ] else imperative_report @ report;; |} in From 9bde8252f12c3e059925816171f2888f076f5c91 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 25 Nov 2020 19:12:41 +0100 Subject: [PATCH 60/91] fix(src/editor/dune): Missing package spec --- src/editor/dune | 1 + 1 file changed, 1 insertion(+) diff --git a/src/editor/dune b/src/editor/dune index b8ace9f48..096e32ee9 100644 --- a/src/editor/dune +++ b/src/editor/dune @@ -127,6 +127,7 @@ (install (section share) + (package learn-ocaml) (files (editor.bc.js as www/js/editor.js) (new_exercise.bc.js as www/js/new_exercise.js))) From cda2fa4e651f32935444b5efb7bb995465dfabd7 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 12 Dec 2020 02:18:07 +0100 Subject: [PATCH 61/91] fix: missing "Editor" button in static deployment mode * Note: this should be made conditional (opt-in) e.g. with some "learn-ocaml build" CLI option. --- src/app/learnocaml_index_main.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index db02ccc80..547dc3701 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -694,9 +694,12 @@ let () = then [ "playground", ([%i"Playground"], playground_tab token) ] else []) @ (match token with | Some t when Token.is_teacher t -> - [ "teacher", ([%i"Teach"], teacher_tab t);"editor",([%i"Editor"], editor_tab )] - | _ -> []) - + [ "teacher", ([%i"Teach"], teacher_tab t); + "editor", ([%i"Editor"], editor_tab) ] + | None -> + (* FIXME: could be enabled only if desired at build time *) + [ "editor", ([%i"Editor"], editor_tab) ] + | _ -> []) in let container = El.tab_buttons_container in let current_btn = ref None in From 31c463f2714dd8823f4f0b5eb99822c773f3a810 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 12 Dec 2020 02:22:01 +0100 Subject: [PATCH 62/91] fix(merge): learn-ocaml-editor + static deployment * fix: Uncaught ReferenceError: learnocaml_config is not defined --- src/editor/editor.ml | 14 +++++++------- src/editor/new_exercise.ml | 7 ++++--- static/editor.html | 3 ++- static/new_exercise.html | 1 + 4 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index b86903d8a..a0592ace6 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -13,15 +13,16 @@ open Js_utils open Lwt.Infix open Learnocaml_common open Grade_exercise +open Learnocaml_config open Learnocaml_data open Js_of_ocaml open Editor_lib open Dom_html open Test_spec open Editor_components + module H = Tyxml_js.Html - (*----------------------------------------------------------------------*) let init_tabs, select_tab = @@ -537,24 +538,23 @@ let () = begin toolbar_button ~icon: "left" [%i"Metadata"] @@ fun () -> Dom_html.window##.location##assign - (Js.string ("new_exercise.html#id=" ^ id ^ "&action=open")); + (Js.string (api_server ^ "/new_exercise.html#id=" ^ id ^ "&action=open")); Lwt.return () end; begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> Dom_html.window##.location##assign - (Js.string "index.html#activity=editor"); + (* FIXME/TODO: Test! *) + (Js.string (api_server ^ "/index.html#activity=editor")); Lwt.return () - end ; - + end; begin toolbar_button ~icon: "upload" [%i"Experiment"] @@ fun ()-> Dom_html.window##.location##assign - (Js.string ("exercise.html#id=." ^ id)); + (Js.string (api_server ^ "/exercise.html#id=." ^ id)); Lwt.return_unit end; - (* TODO : factorize somehow this with src/app/learnocaml_exercise_main grade to learnocaml_common *) diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index f5cab0a86..17cf4fab1 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -14,9 +14,10 @@ open Dom_html open Js_utils open Learnocaml_common open Editor_lib +open Learnocaml_config open Learnocaml_data -open Learnocaml_data.Editor -open Learnocaml_data.Exercise.Meta +open Learnocaml_data.Editor +open Learnocaml_data.Exercise.Meta module StringMap = Map.Make (String) (* @@ -223,7 +224,7 @@ let _ = begin store metadata; Dom_html.window##.location##assign - (Js.string ("editor.html#id=" ^ id)); + (Js.string (api_server ^ "/editor.html#id=" ^ id)); end; Js._true); diff --git a/static/editor.html b/static/editor.html index b038996d7..4dae60a66 100644 --- a/static/editor.html +++ b/static/editor.html @@ -21,6 +21,7 @@ + @@ -187,4 +188,4 @@
- \ No newline at end of file + diff --git a/static/new_exercise.html b/static/new_exercise.html index ad28a3e8f..0ae9276ba 100644 --- a/static/new_exercise.html +++ b/static/new_exercise.html @@ -12,6 +12,7 @@ + From bc55e7ea54c30cabfac479417270f6c86e72fceb Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Thu, 6 May 2021 16:11:13 +0200 Subject: [PATCH 63/91] feat: integrate the exercice's number in the title --- src/editor/editor.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index a0592ace6..63002f39a 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -95,8 +95,6 @@ let () = Learnocaml_local_storage.init () ; (* ---- launch everything --------------------------------------------- *) - let id = arg "id" - in let toplevel_buttons_group = button_group () in disable_button_group toplevel_buttons_group (* enabled after init *) ; let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in @@ -111,6 +109,13 @@ let () = let template_button = button ~container: template_toolbar ~theme: "light" in let prelude_button = button ~container: prelude_toolbar ~theme: "light" in let prepare_button = button ~container: prepare_toolbar ~theme: "light" in + let id = match Url.Current.path with + | "" :: "exercises" :: p | "exercises" :: p -> + String.concat "/" (List.map Url.urldecode (List.filter ((<>) "") p)) + | _ -> arg "id" + in + Dom_html.document##.title := + Js.string (id ^ " - " ^ "Learn OCaml" ^" v."^ Learnocaml_api.version); let after_init top = begin From b868d62e34c324feabe0baeea168ffa74a6686d5 Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Mon, 10 May 2021 10:49:28 +0200 Subject: [PATCH 64/91] fix: click on a hyperlink in the html generate by markdown open it in a newtab now --- src/editor/editor.ml | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 63002f39a..a207b10d9 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -217,6 +217,18 @@ let () = end; (*-------question pane -------------------------------------------------*) + + let override_url = function + | Omd_representation.Url(href,[Omd_representation.Text(text)],title) -> + Some ( let title_url = if title <> "" then + String.concat " " [" title='";title;"'"] + else "" in + let url = + String.concat + "" + ["";text;""] + in url) + | _ -> None in let editor_question = find_component "learnocaml-exo-question-mark" in let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in let question = @@ -230,7 +242,7 @@ let () = Ace.set_font_size ace_quest 18; let question = get_question id in - let question =Omd.to_html (Omd.of_string question) in + let question = Omd.to_html ~override:override_url (Omd.of_string question) in let text_container = find_component "learnocaml-exo-question-html" in let text_iframe = Dom_html.createIframe Dom_html.document in @@ -281,7 +293,7 @@ let () = \ " (get_titre id) - (Omd.to_html (Omd.of_string text)) in + (Omd.to_html ~override:override_url (Omd.of_string text)) in d##open_; d##write (Js.string html); d##close); From a6f335cd5f2f9670559109bce98e479c9686319f Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Mon, 10 May 2021 11:42:47 +0200 Subject: [PATCH 65/91] fix: hyperlink's text can be bold or any type of more complex mardown syntax; added rel='noopener noreferrer' for security purpose --- src/editor/editor.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index a207b10d9..0097a4221 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -217,18 +217,20 @@ let () = end; (*-------question pane -------------------------------------------------*) - + let open Omd_representation in let override_url = function - | Omd_representation.Url(href,[Omd_representation.Text(text)],title) -> - Some ( let title_url = if title <> "" then - String.concat " " [" title='";title;"'"] - else "" in - let url = - String.concat - "" - ["";text;""] - in url) - | _ -> None in + | Url(href,s,title) -> + Some ( let title_url = if title <> "" then + String.concat " " [" title='";title;"'"] + else "" in + let url = + String.concat + "" + ["";Omd_backend.html_of_md s;""] + in url) + | _ -> None in let editor_question = find_component "learnocaml-exo-question-mark" in let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in let question = From c6c1a86c2d25db5b388ba9a109a3445833fd8526 Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Tue, 11 May 2021 09:50:45 +0200 Subject: [PATCH 66/91] fix: style modification to make the code more elegant --- src/editor/editor.ml | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 0097a4221..96df2797a 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -220,16 +220,14 @@ let () = let open Omd_representation in let override_url = function | Url(href,s,title) -> - Some ( let title_url = if title <> "" then - String.concat " " [" title='";title;"'"] - else "" in - let url = - String.concat - "" - ["";Omd_backend.html_of_md s;""] - in url) + Some ( let title_url = + if title <> "" + then + Printf.sprintf {| title="%s"|} title + else "" in + Printf.sprintf + {|%s|} + href title_url (Omd_backend.html_of_md s)) | _ -> None in let editor_question = find_component "learnocaml-exo-question-mark" in let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in From 1624bbc39729cee91a6d4bb1316f8a016d0051d8 Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Wed, 12 May 2021 16:35:42 +0200 Subject: [PATCH 67/91] fix: replace the iFrame question pane by a div to avoid blinking and scroll problems. Still little problems with CSS. (wip) --- src/editor/editor.ml | 51 ++++---------------------------- static/css/learnocaml_editor.css | 15 ++++++++-- 2 files changed, 19 insertions(+), 47 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 96df2797a..6a65630dd 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -245,58 +245,19 @@ let () = let question = Omd.to_html ~override:override_url (Omd.of_string question) in let text_container = find_component "learnocaml-exo-question-html" in - let text_iframe = Dom_html.createIframe Dom_html.document in + let text_iframe = Dom_html.createDiv Dom_html.document in Manip.replaceChildren text_container - Tyxml_js.Html5.[ Tyxml_js.Of_dom.of_iFrame text_iframe ] ; - Js.Opt.case - (text_iframe##.contentDocument) - (fun () -> failwith "cannot edit iframe document") - (fun d -> - let html = Format.asprintf - "\ - \ - %s - exercise text\ - \ - \ - \ - \ - %s\ - \ - " - (get_titre id) - question in - d##open_; - d##write (Js.string html); - d##close); + Tyxml_js.Html5.[ Tyxml_js.Of_dom.of_div text_iframe ] ; + text_iframe##.innerHTML := (Js.string question); let old_text = ref "" in let onload () = let rec dyn_preview = - let text = Ace.get_contents ace_quest in + let text = Ace.get_contents ace_quest in + let question = Omd.to_html ~override:override_url (Omd.of_string text) in if text <> !old_text then begin - Js.Opt.case - (text_iframe##.contentDocument) - (fun () -> failwith "cannot edit iframe document") - (fun d -> - let html = Format.asprintf - "\ - \ - %s - exercise text\ - \ - \ - \ - \ - %s\ - \ - " - (get_titre id) - (Omd.to_html ~override:override_url (Omd.of_string text)) in - d##open_; - d##write (Js.string html); - d##close); + text_iframe##.innerHTML := (Js.string question); old_text := text end in dyn_preview; () in diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index cca078922..32e11ca42 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -686,11 +686,22 @@ div.config-editor-overlay > div::before, div.config-editor-overlay > div::after /* question tab */ -#learnocaml-exo-question-html > iframe { +#learnocaml-exo-question-html > div { border: none; overflow: auto; flex: 1 3 auto ; } + +#learnocaml-exo-question-html > div > pre { + background: #ddd; +} + + +#learnocaml-exo-question-html > div > h2 { + background: #ddd; +line-height: 40px; +} + #learnocaml-exo-tab-question > .questions-mark { position: absolute; left: 0; top: 0; bottom: 50%; width: 100%; @@ -703,12 +714,12 @@ div.config-editor-overlay > div::before, div.config-editor-overlay > div::after position: absolute; left: 0; top: 50%; bottom: 0px; width: 100%; background: white; - color: #fff; z-index: 1002; } #learnocaml-exo-tab-question > .questions-html > * { position: absolute; + padding-left: 20px; left: 0; top: 0; bottom: 0px; width: 100%; height: 100%; } From 3f6673c7ec628b001fe270fd754f72cda7aed543 Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Wed, 12 May 2021 18:27:53 +0200 Subject: [PATCH 68/91] fix: resolve few problems with CSS on the editor view --- static/css/learnocaml_editor.css | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index 32e11ca42..9e7223202 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -1,7 +1,12 @@ +*{ +box-sizing: border-box; +} + body { margin: 0; padding: 0; background: #666; +overflow: hidden; } #learnocaml-main-loading { @@ -690,10 +695,14 @@ div.config-editor-overlay > div::before, div.config-editor-overlay > div::after border: none; overflow: auto; flex: 1 3 auto ; +font-family: 'Fontin', 'Linux Biolinum', sans-serif; } #learnocaml-exo-question-html > div > pre { background: #ddd; +line-height: 25px; +overflow: auto; +padding: 0 10px; } From 046b3e942dc841833f56578689d5d08e717ddedd Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Fri, 14 May 2021 10:41:32 +0200 Subject: [PATCH 69/91] fix: internal links were open in a new tab, also quick refactoring of override_url --- src/editor/editor.ml | 29 ++++++++++++++++------------- static/css/learnocaml_editor.css | 1 + 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 6a65630dd..9d95a2c52 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -217,17 +217,20 @@ let () = end; (*-------question pane -------------------------------------------------*) - let open Omd_representation in let override_url = function - | Url(href,s,title) -> - Some ( let title_url = - if title <> "" - then - Printf.sprintf {| title="%s"|} title - else "" in - Printf.sprintf + | Omd_representation.Url(href,s,title) -> + if String.length href > 0 then + if Char.equal (String.get href 0) '#' then + None + else + let title_url = + if title <> "" then Printf.sprintf {| title="%s"|} title else "" in + let html = + Printf.sprintf {|%s|} - href title_url (Omd_backend.html_of_md s)) + href title_url (Omd_backend.html_of_md s) in + Some html + else None | _ -> None in let editor_question = find_component "learnocaml-exo-question-mark" in let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in @@ -245,10 +248,10 @@ let () = let question = Omd.to_html ~override:override_url (Omd.of_string question) in let text_container = find_component "learnocaml-exo-question-html" in - let text_iframe = Dom_html.createDiv Dom_html.document in + let text_div = Dom_html.createDiv Dom_html.document in Manip.replaceChildren text_container - Tyxml_js.Html5.[ Tyxml_js.Of_dom.of_div text_iframe ] ; - text_iframe##.innerHTML := (Js.string question); + Tyxml_js.Html5.[ Tyxml_js.Of_dom.of_div text_div ] ; + text_div##.innerHTML := (Js.string question); let old_text = ref "" in @@ -257,7 +260,7 @@ let () = let text = Ace.get_contents ace_quest in let question = Omd.to_html ~override:override_url (Omd.of_string text) in if text <> !old_text then begin - text_iframe##.innerHTML := (Js.string question); + text_div##.innerHTML := (Js.string question); old_text := text end in dyn_preview; () in diff --git a/static/css/learnocaml_editor.css b/static/css/learnocaml_editor.css index 9e7223202..3d7b173c4 100644 --- a/static/css/learnocaml_editor.css +++ b/static/css/learnocaml_editor.css @@ -703,6 +703,7 @@ font-family: 'Fontin', 'Linux Biolinum', sans-serif; line-height: 25px; overflow: auto; padding: 0 10px; +border-radius : 8px; } From cbdec8d7868791d4a15d3eeafd511fb7a34bce7e Mon Sep 17 00:00:00 2001 From: LouisAyroles Date: Tue, 18 May 2021 10:37:31 +0200 Subject: [PATCH 70/91] fix: update overrideurl to handle escape character in URL --- src/editor/editor.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 9d95a2c52..031d11294 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -224,11 +224,13 @@ let () = None else let title_url = - if title <> "" then Printf.sprintf {| title="%s"|} title else "" in + if title <> "" then Printf.sprintf {| title="%s"|} + (Omd_utils.htmlentities ~md:true title) else "" in let html = Printf.sprintf {|%s|} - href title_url (Omd_backend.html_of_md s) in + (Omd_utils.htmlentities ~md:true href) title_url + (Omd_backend.html_of_md s) in Some html else None | _ -> None in From 85e80551ed70bc084a355abe902fddbffcbfc0b1 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Dec 2020 18:39:48 +0100 Subject: [PATCH 71/91] fix(opam): "odoc" constraint MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The following dependencies couldn't be met: - learn-ocaml-client → dune = 2.0.1 - learn-ocaml → odoc = 1.3.0 → dune < 2.0 --- learn-ocaml.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/learn-ocaml.opam b/learn-ocaml.opam index 19c67b877..592e0cc74 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -45,7 +45,7 @@ depends: [ "ocp-indent-nlfork" "ocp-ocamlres" {>= "0.4"} "ocplib-json-typed" {= "0.6"} - "odoc" {build & >= "1.3.0"} + "odoc" {build & >= "1.4.0"} "omd" "pprint" "ppx_cstruct" From b4a0fc41faf67ec75ffa508828ae1b188ab84fe3 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 31 Dec 2020 16:57:48 +0100 Subject: [PATCH 72/91] fix: editor/editor.ml MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit That code was different w.r.t. that of app/learnocaml_exercise_main.ml because in learn-ocaml-editor, the "test.ml" code *does* change. But the "(worker ()) := get_grade ~callback (exo_creator id)" phrasing was questionable… --- src/editor/editor.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 031d11294..1b0792346 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -545,7 +545,12 @@ let () = let callback text = Manip.appendChild messages Tyxml_js.Html5.(li [ pcdata text ]) in - let worker () = ref (Grading_jsoo.get_grade ~callback (exo_creator id) ) in + let reset_worker () : + (string -> + (Learnocaml_report.item list * string * string * string) Lwt.t) Lwt.t = + Lwt.return (fun _s -> failwith "no worker") in + let gen_worker () = Grading_jsoo.get_grade ~callback (exo_creator id) in + let worker = ref (reset_worker ()) in let grade () = let aborted, abort_message = let t, u = Lwt.task () in @@ -561,6 +566,7 @@ let () = Manip.replaceChildren messages Tyxml_js.Html5.[ li [ pcdata [%i"Launching the grader"] ] ] ; show_load "learnocaml-exo-loading" [ messages ; abort_message ]; + worker := gen_worker () ; Lwt_js.sleep 1. >>= fun () -> let prelprep = (Ace.get_contents ace_prel ^ "\n" ^ Ace.get_contents ace_prep ^ "\n") in let solution = Ace.get_contents ace in @@ -570,12 +576,12 @@ let () = let grading = Lwt.finalize (fun () -> - !(worker ()) >>= fun w -> + !worker >>= fun w -> w solution >>= fun (report, _, _, _) -> Lwt.return report) (fun () -> - (worker ()) := get_grade ~callback (exo_creator id); - Lwt.return_unit) + worker := reset_worker () ; + Lwt.return_unit) in let abortion = Lwt_js.sleep 5. >>= fun () -> @@ -585,13 +591,13 @@ let () = ([ Text [%i"Grading aborted by user."] ], Failure) ] in Lwt.pick [ grading ; abortion ] >>= fun report -> let _grade = display_report (exo_creator id) report in - (worker() ) := Grading_jsoo.get_grade ~callback (exo_creator id) ; select_tab "report" ; Lwt_js.yield () >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; Lwt.return () | Toploop_results.Error _ -> select_tab "report" ; + worker := reset_worker () ; Lwt_js.yield () >>= fun () -> hide_loading ~id:"learnocaml-exo-loading" () ; typecheck_editor () in From a595709949058c7fc127be1a7b2cbfb928865f55 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 5 Jan 2021 23:53:41 +0100 Subject: [PATCH 73/91] fix: avoid Invalid_argument "Learnocaml_toplevel.protect_execution" if (one creates a new exercise in the editor and) adds a solution+test then click on Check and very quickly, click on Save&Grade! Now, the "Check" button disables "Save&Grade!" and conversely. --- src/editor/editor.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 1b0792346..a78db3540 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -602,8 +602,10 @@ let () = hide_loading ~id:"learnocaml-exo-loading" () ; typecheck_editor () in begin toolbar_button + ~group: toplevel_buttons_group + (* so "Check" disables "Save&Grade!" and conversely *) ~icon: "reload" [%i"Save&Grade!"] @@ fun () -> - recovering (); + recovering (); grade (); end ; onchange [ace_temp; ace_t; ace_prep; ace_prel; ace_quest; ace ]; From ec7f365e13cff47b9f2c0513dd30fa128a32253c Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 00:03:29 +0100 Subject: [PATCH 74/91] fix(static/*.html): Add missing leading slash or baseUrl * Fix static deployment of learn-ocaml-editor --- static/editor.html | 26 +++++++++++++------------- static/new_exercise.html | 30 +++++++++++++++--------------- 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/static/editor.html b/static/editor.html index 4dae60a66..00bbcc0bf 100644 --- a/static/editor.html +++ b/static/editor.html @@ -5,8 +5,8 @@ Learn OCaml by OCamlPro - Editor - - + + @@ -47,13 +47,13 @@
- + @@ -132,15 +132,15 @@ - + - + - +
@@ -148,7 +148,7 @@
- + diff --git a/static/new_exercise.html b/static/new_exercise.html index 0ae9276ba..1ac5f696f 100644 --- a/static/new_exercise.html +++ b/static/new_exercise.html @@ -5,15 +5,15 @@ Learn OCaml by OCamlPro - Editor - - - - - - - + + + + + + + - + @@ -32,19 +32,19 @@
- - - - + + + +
- + From 1693e95bd2c0e1a4a13c3305397cdce0239f8314 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 16:55:25 +0100 Subject: [PATCH 75/91] fix(learnocaml_exercise_main.ml): Add missing baseUrl prefix --- src/app/learnocaml_exercise_main.ml | 2 +- src/editor/editor.ml | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index b44602ee5..f650196ce 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -220,7 +220,7 @@ let () = begin toolbar_button ~icon: "upload" [%i"Edit"] @@ fun ()-> Dom_html.window##.location##assign - (Js.string ("editor.html#id=" ^ id ^ "&action=open")); + (Js.string (api_server ^ "/editor.html#id=" ^ id ^ "&action=open")); Lwt.return_unit end; end diff --git a/src/editor/editor.ml b/src/editor/editor.ml index a78db3540..a2aa225b7 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -527,7 +527,6 @@ let () = begin toolbar_button ~icon: "list" [%i"Exercises"] @@ fun () -> Dom_html.window##.location##assign - (* FIXME/TODO: Test! *) (Js.string (api_server ^ "/index.html#activity=editor")); Lwt.return () end; From 283ae61f5867ab7aaf88b62754ef1c4044113a84 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 01:28:37 +0100 Subject: [PATCH 76/91] fix(editor.ml): Loading of "/js/learnocaml-toplevel-worker.js" --- src/editor/editor.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index a2aa225b7..4afeb75f0 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -12,7 +12,6 @@ open Js_utils open Lwt.Infix open Learnocaml_common -open Grade_exercise open Learnocaml_config open Learnocaml_data open Js_of_ocaml @@ -20,6 +19,7 @@ open Editor_lib open Dom_html open Test_spec open Editor_components +open Grade_exercise module H = Tyxml_js.Html @@ -147,9 +147,9 @@ let () = ~on_update ~max_size: 99 ~snapshot () in - + get_worker_code "learnocaml-toplevel-worker.js" () >>= fun worker_js_file -> let toplevel_launch = - Learnocaml_toplevel.create + Learnocaml_toplevel.create ~worker_js_file ~after_init ~timeout_prompt ~flood_prompt ~on_disable_input: (fun _ -> disable_button_group toplevel_buttons_group) ~on_enable_input: (fun _ -> enable_button_group toplevel_buttons_group) @@ -548,7 +548,7 @@ let () = (string -> (Learnocaml_report.item list * string * string * string) Lwt.t) Lwt.t = Lwt.return (fun _s -> failwith "no worker") in - let gen_worker () = Grading_jsoo.get_grade ~callback (exo_creator id) in + let gen_worker () = get_grade ~callback (exo_creator id) in let worker = ref (reset_worker ()) in let grade () = let aborted, abort_message = From 53dff9883c96e180516567c5e97d9f20c5f4b0f8 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 18:15:58 +0100 Subject: [PATCH 77/91] fix(editor_lib.ml): Add missing api_server prefix --- src/editor/editor_lib.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index 4cb23c39a..a3d593eb8 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -11,6 +11,7 @@ open Learnocaml_data open Learnocaml_common +open Learnocaml_config open Learnocaml_index open Lwt.Infix open Js_utils @@ -96,7 +97,7 @@ let show_load id contents = Manip.(removeClass elt "loaded") ; Manip.(addClass elt "loading") ; let chamo_src = - "icons/tryocaml_loading_" ^ string_of_int (Random.int 8 + 1) ^ ".gif" in + api_server ^ "/icons/tryocaml_loading_" ^ string_of_int (Random.int 8 + 1) ^ ".gif" in Manip.replaceChildren elt Tyxml_js.Html.[ div ~a: [ a_id "chamo" ] [ img ~alt: "loading" ~src: chamo_src () ] ; @@ -562,7 +563,7 @@ module Editor_components = struct in let drop_button = H.(button ~a:[a_class ["dropbtn"]] [ - img ~alt:"" ~src:("/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; + img ~alt:"" ~src:(api_server ^ "/icons/icon_" ^ icon ^ "_" ^ theme ^ ".svg") () ; pcdata " " ; span ~a:[ a_class [ "label" ] ] [ pcdata name ] ]) From 991430b53ddbfb34b15adac8c56bd431d5c1e124 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 18:21:29 +0100 Subject: [PATCH 78/91] refactor(learnocaml_exercise_main.ml): Remove duplicate code Follow-up of 1d2052dffd03acaea8f2c7f333b99ee9664bf8cc --- src/app/learnocaml_exercise_main.ml | 36 ----------------------------- 1 file changed, 36 deletions(-) diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index f650196ce..adcfca87f 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -35,42 +35,6 @@ let check_if_need_refresh has_server = else Lwt.return_unit -let get_grade = - let get_worker = get_worker_code "learnocaml-grader-worker.js" in - fun ?callback ?timeout exercise -> - get_worker () >>= fun worker_js_file -> - Grading_jsoo.get_grade ~worker_js_file ?callback ?timeout exercise - -let display_report exo report = - let score, _failed = Report.result report in - let report_button = find_component "learnocaml-exo-button-report" in - Manip.removeClass report_button "success" ; - Manip.removeClass report_button "failure" ; - Manip.removeClass report_button "partial" ; - let grade = - let max = Learnocaml_exercise.(access File.max_score exo) in - if max = 0 then 999 else score * 100 / max - in - if grade >= 100 then begin - Manip.addClass report_button "success" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ txt [%i"Report"] ] - end else if grade = 0 then begin - Manip.addClass report_button "failure" ; - Manip.replaceChildren report_button - Tyxml_js.Html5.[ txt [%i"Report"] ] - end else begin - Manip.addClass report_button "partial" ; - let pct = Format.asprintf "%2d%%" grade in - Manip.replaceChildren report_button - Tyxml_js.Html5.[ txt [%i"Report"] ; - span ~a: [ a_class [ "score" ] ] [ txt pct ]] - end ; - let report_container = find_component "learnocaml-exo-tab-report" in - Manip.setInnerHtml report_container - (Format.asprintf "%a" Report.(output_html ~bare: true) report) ; - grade - module Exercise_link = struct let exercise_link ?(cl = []) id content = From f4ffac84c7f8e33bca154fb5f755df04a16727e2 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 18:25:21 +0100 Subject: [PATCH 79/91] fix(learnocaml_editor_tab.ml): Add missing api_server prefix --- src/editor/learnocaml_editor_tab.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 8a274b803..256c59171 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -13,8 +13,9 @@ open Js_utils open Lwt open Learnocaml_data open Learnocaml_common +open Learnocaml_config open Editor -open Editor_lib +open Editor_lib open Tyxml_js.Html5 @@ -90,12 +91,12 @@ let editor_tab _ _ () = (fun exercise_id editor_sate acc -> div ~a:[a_id "toolbar"; a_class ["button"]] [ (let button = button ~a:[a_id exercise_id] - [img ~src:"icons/icon_cleanup_dark.svg" + [img ~src:(api_server ^ "/icons/icon_cleanup_dark.svg") ~alt:"" () ; pcdata "" ] in Manip.Ev.onclick button (delete_button_handler exercise_id); button); (let download_button = button ~a:[a_id exercise_id] - [img ~src:"icons/icon_download_dark.svg" + [img ~src:(api_server ^ "/icons/icon_download_dark.svg") ~alt:"" () ; pcdata "" ] in Manip.Ev.onclick download_button (fun _ -> Editor_io.download exercise_id; true) ;download_button @@ -117,7 +118,7 @@ let editor_tab _ _ () = let alt = Format.asprintf "difficulty: %d / 40" num in let src = - Format.asprintf "icons/stars_%02d.svg" num in + api_server ^ (Format.asprintf "/icons/stars_%02d.svg" num) in img ~alt ~src () ] ; div ~a:[ a_class [ "length" ] ] [ From ab0f4f04d31e2185c6624b843895fe1ace439518 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 6 Jan 2021 18:52:10 +0100 Subject: [PATCH 80/91] docs: Add todo-refactor --- src/editor/editor.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 4afeb75f0..da5fe30ae 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -117,6 +117,7 @@ let () = Dom_html.document##.title := Js.string (id ^ " - " ^ "Learn OCaml" ^" v."^ Learnocaml_api.version); + (* TODO/FIXME: Extend and Use Learnocaml_common.toplevel_launch *) let after_init top = begin Lwt.return true @@ -126,6 +127,7 @@ let () = if not r1 || not r2 then failwith [%i"unexpected error"]; Learnocaml_toplevel.set_checking_environment top >>= fun () -> Lwt.return () in + let timeout_prompt = Learnocaml_toplevel.make_timeout_popup ~on_show: (fun () -> select_tab "toplevel") From 44cd018a89f09ed64d488d24795c4dc9935b2a77 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 9 Jan 2021 18:54:08 +0100 Subject: [PATCH 81/91] fix(learnocaml_common.mli): Expose (box_button, close_button) * otherwise the interface is quite unpractical, e.g., using ext_alert with custom buttons would need to copy in the client code, the definition of box_button; so, DRY! --- src/app/learnocaml_common.mli | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 87186f0e8..c2d959558 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -23,6 +23,14 @@ val fatal : ?title: string -> string -> unit val alert : ?title: string -> ?buttons: Html_types.div_content Tyxml_js.Html.elt list -> string -> unit +val box_button : + string Tyxml_js.Html5.wrap -> (unit -> 'a) -> + [> Html_types.button ] Tyxml_js.Html5.elt + +val close_button : + string Tyxml_js.Html5.wrap -> + [> Html_types.button ] Tyxml_js.Html5.elt + val ext_alert : title: string -> ?buttons: Html_types.div_content_fun Tyxml_js.Html.elt list -> From af85f61abfcb7e0a6105dd152ffa824a797867a1 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 10 Jan 2021 13:59:25 +0100 Subject: [PATCH 82/91] fix: Remove unused 'rec' --- src/editor/editor.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index da5fe30ae..dd497d89d 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -260,7 +260,7 @@ let () = let old_text = ref "" in let onload () = - let rec dyn_preview = + let dyn_preview = let text = Ace.get_contents ace_quest in let question = Omd.to_html ~override:override_url (Omd.of_string text) in if text <> !old_text then begin From a06f37ef6ebdcecef0bd7d7b4f196f7802eb48be Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 10 Jan 2021 14:02:27 +0100 Subject: [PATCH 83/91] fix: Isolate & Workaround the Stack_overflow raised by 'Experiment' * Add some (commented-out) debug code facilities; * Add some TODO/FIXME/XXX remarks; * Workaround the issue by ignoring the 'exercise.descr' string in editor_lib.ml (otherwise its encoding-then-*decoding* fails) --- src/app/learnocaml_exercise_main.ml | 12 +++++++++--- src/editor/editor_lib.ml | 11 +++++++---- src/repo/learnocaml_exercise.ml | 23 +++++++++++++++++------ 3 files changed, 33 insertions(+), 13 deletions(-) diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index adcfca87f..1346c0926 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -90,18 +90,24 @@ let () = (* if we came from a true exercise we search in the server. In the other case we get the exercise information from the Local storage *) + (* FIXME: for debug purposes; to be removed: + let ok str = lwt_alert ~title:"TEST1" ~buttons:["OK", (fun () -> Lwt.return_unit)] + [ H.p [H.txt (String.trim str)] ] in *) let exercise_fetch = match idEditor id with | false -> token >>= fun token -> retrieve (Learnocaml_api.Exercise (token, id)) | true -> let proper_id = String.sub id 1 ((String.length id)-1) in - Lwt.return ((Editor_lib.get_editor_state proper_id).Editor.metadata, - (Editor_lib.exo_creator proper_id ), - None) + let state = Editor_lib.get_editor_state proper_id in + (* FIXME: for debug purposes; to be removed: + ok state.Editor.metadata.title >>= fun () -> *) + let exo = Editor_lib.exo_creator proper_id in + Lwt.return (state.Editor.metadata, exo, None) in let after_init top = exercise_fetch >>= fun (_meta, exo, _deadline) -> + begin match Learnocaml_exercise.(decipher File.prelude exo) with | "" -> Lwt.return true | prelude -> diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index a3d593eb8..b646677e4 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -293,18 +293,21 @@ let genTemplate top ?(on_err = fun () -> ()) sol = else Lwt.return (let () = on_err () in "") (* ---- create an exo ------------------------------------------------------- *) + let exo_creator proper_id = let exercise = (get_editor_state proper_id).exercise in let read_field field = match field with - | "id"-> Some exercise.id + | "id" -> Some exercise.id (* XXX = proper_id *) | "prelude.ml" -> Some exercise.prelude | "template.ml" -> Some exercise.template - | "descr.md" -> Some exercise.descr + | "descr.md" -> (* FIXME: SHOULD BE 'Some exercise.descr' *) + Some "

Note: question export disabled for the time being; otherwise descrs_from_string raises a Stack_overflow on strings of size 14000.

" | "prepare.ml" -> Some exercise.prepare - | "test.ml" -> Some exercise.test | "solution.ml" -> Some exercise.solution - | "max_score" -> Some (string_of_int exercise.max_score) + | "test.ml" -> Some exercise.test + | "max_score.txt" -> Some (string_of_int exercise.max_score) + | "depend.txt" -> None (* TODO: Add support *) | _ -> None in Learnocaml_exercise.read diff --git a/src/repo/learnocaml_exercise.ml b/src/repo/learnocaml_exercise.ml index 5157b05e0..5759d4f16 100644 --- a/src/repo/learnocaml_exercise.ml +++ b/src/repo/learnocaml_exercise.ml @@ -21,6 +21,8 @@ type t = dependencies : string list; } +(* XXX: a change to this type may require another change in editor_lib.ml *) + let encoding = let open Json_encoding in conv @@ -192,7 +194,7 @@ module File = struct let depend = { key = "depend.txt" ; ciphered = false ; - decode = (fun v -> Some v) ; + decode = (fun v -> Some v) ; (* XXX should this produce None sometimes? *) encode = (function | None -> "" (* no `depend` ~ empty `depend` *) | Some txt -> txt) ; @@ -289,7 +291,7 @@ module File = struct * return () * with _ -> return () * in *) - let descrs = ref [] in + let descrs : (string option * string) list ref = ref [] in let rec read_descr lang = function | [] -> (* If there are no extensions to try, we just give up. *) @@ -314,7 +316,7 @@ module File = struct | Some raw -> (* If it does, we apply the function, add the description to [!descrs] and return. *) - descrs := (lang, f raw) :: !descrs; + descrs := (lang, f raw) :: !descrs ; return () in let markdown_to_html md = @@ -322,15 +324,24 @@ module File = struct in let read_descrs () = let langs = [] in + (* XXX: Really [] ? *) let exts = [ (Filename.extension descr.key, fun h -> h) ; (".md", markdown_to_html) ] in join (read_descr None exts :: List.map (fun l -> read_descr (Some l) exts) langs) >>= fun () -> - ex := set descr - (List.map (function (None, v) -> "", v | (Some l, v) -> l, v) !descrs) - !ex; + let res = (List.map (function (None, v) -> "", v | (Some l, v) -> l, v) !descrs) in + (* let res' = descr.encode res in + let stack_overflow = descr.decode res' in () *) + + (* Also reproducible with: + let html = (* markdown_to_html md (* length = 13711 *) *) + String.init 14000 (fun n -> if n mod 2 = 0 then 'A' else ' ') in + let res' = descrs_to_string [("", html)] (* length = 13857 *) in + let stack_overflow = descrs_from_string res' in () *) + + ex := set descr res !ex; return () in join From 388e338d85646da99283a75e78c09bfe387e2fb2 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 26 Aug 2021 18:48:42 +0200 Subject: [PATCH 84/91] feat: Add property enableEditor It is enabled by default: $ learn-ocaml build <=> $ learn-ocaml build --enable-editor unless we run the command line: $ learn-ocaml build --disable-editor --- src/app/learnocaml_config.ml | 1 + src/app/learnocaml_config.mli | 1 + src/app/learnocaml_index_main.ml | 9 +++++---- src/main/learnocaml_main.ml | 14 +++++++++++--- 4 files changed, 18 insertions(+), 7 deletions(-) diff --git a/src/app/learnocaml_config.ml b/src/app/learnocaml_config.ml index f99afef34..335971396 100644 --- a/src/app/learnocaml_config.ml +++ b/src/app/learnocaml_config.ml @@ -9,6 +9,7 @@ class type learnocaml_config = object method enableTryocaml: bool Js.optdef_prop method enableLessons: bool Js.optdef_prop method enableExercises: bool Js.optdef_prop + method enableEditor: 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 diff --git a/src/app/learnocaml_config.mli b/src/app/learnocaml_config.mli index ba20ae535..5d2c4c31c 100644 --- a/src/app/learnocaml_config.mli +++ b/src/app/learnocaml_config.mli @@ -13,6 +13,7 @@ class type learnocaml_config = object method enableTryocaml: bool Js.optdef_prop method enableLessons: bool Js.optdef_prop method enableExercises: bool Js.optdef_prop + method enableEditor: 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 diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 547dc3701..b1a41d55b 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -694,10 +694,11 @@ let () = then [ "playground", ([%i"Playground"], playground_tab token) ] else []) @ (match token with | Some t when Token.is_teacher t -> - [ "teacher", ([%i"Teach"], teacher_tab t); - "editor", ([%i"Editor"], editor_tab) ] - | None -> - (* FIXME: could be enabled only if desired at build time *) + [ "teacher", ([%i"Teach"], teacher_tab t) ] @ + if get_opt config##.enableEditor then + [ "editor", ([%i"Editor"], editor_tab) ] + else [] + | None when get_opt config##.enableEditor -> [ "editor", ([%i"Editor"], editor_tab) ] | _ -> []) in diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 859cfaad6..21c4063ae 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -173,6 +173,10 @@ module Args = struct "the 'Lessons' tab (enabled by default if the repository contains a \ $(i,lessons) directory)" + let editor = enable "editor" + "the 'Editor' tab (enabled by default), for users connected with a \ + teacher token, or all users if static deployment is used." + let exercises = enable "exercises" "the 'Exercises' tab (enabled by default if the repository contains an \ $(i,exercises) directory)" @@ -193,6 +197,7 @@ module Args = struct contents_dir: string; try_ocaml: bool option; lessons: bool option; + editor: bool option; exercises: bool option; playground: bool option; toplevel: bool option; @@ -201,10 +206,10 @@ module Args = struct let builder_conf = let apply - contents_dir try_ocaml lessons exercises playground toplevel base_url - = { contents_dir; try_ocaml; lessons; exercises; playground; toplevel; base_url } + contents_dir try_ocaml lessons editor exercises playground toplevel base_url + = { contents_dir; try_ocaml; lessons; editor; exercises; playground; toplevel; base_url } in - Term.(const apply $contents_dir $try_ocaml $lessons $exercises $playground $toplevel $base_url) + Term.(const apply $contents_dir $try_ocaml $lessons $editor $exercises $playground $toplevel $base_url) let repo_conf = let apply repo_dir exercises_filtered jobs = @@ -372,6 +377,7 @@ let main o = \ enablePlayground: %b,\n\ \ enableLessons: %b,\n\ \ enableExercises: %b,\n\ + \ enableEditor: %b,\n\ \ enableToplevel: %b,\n\ \ baseUrl: \"%s\"\n\ }\n" @@ -379,9 +385,11 @@ let main o = (playground_ret <> None) (lessons_ret <> None) (exercises_ret <> None) + (o.builder.Builder.editor <> Some false) (o.builder.Builder.toplevel <> Some false) o.builder.Builder.base_url >>= fun () -> Lwt.return (tutorials_ret <> Some false && exercises_ret <> Some false))) + (* TODO: double-check if a condition is not missing in previous line *) else Lwt.return true in From 4a2601f233b47c0db083f3c77801d334e747f27f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 26 Aug 2021 20:07:24 +0200 Subject: [PATCH 85/91] feat: Move editor files apart * In sub-directories: - static/editor/ (*.html) - _opam/share/learn-ocaml/editor/ (*.js|*.html) * Rename one resource as well (s/new_exercise/new-exercise/) * Ensure `learn-ocaml build --disable-editor` does not copy files into www. --- src/editor/build.ocp | 2 +- src/editor/dune | 5 +-- src/editor/editor.ml | 2 +- src/editor/learnocaml_editor_tab.ml | 2 +- src/main/learnocaml_main.ml | 40 +++++++++++++------ src/state/learnocaml_api.ml | 2 +- static/Makefile | 7 +++- static/{ => editor}/editor.html | 0 .../new-exercise.html} | 2 +- 9 files changed, 40 insertions(+), 22 deletions(-) rename static/{ => editor}/editor.html (100%) rename static/{new_exercise.html => editor/new-exercise.html} (98%) diff --git a/src/editor/build.ocp b/src/editor/build.ocp index 5cefc1d0e..c02e14431 100644 --- a/src/editor/build.ocp +++ b/src/editor/build.ocp @@ -20,7 +20,7 @@ begin program "new_exercise" "new_exercise.ml" ( comp = [ ppx_js ppx_ocplib_i18n] ) ] build_rules = [ - "%{new_exercise_FULL_DST_DIR}%/new_exercise.js" ( + "%{new_exercise_FULL_DST_DIR}%/new-exercise.js" ( build_target = true sources = %byte_exe( p = "new_exercise" ) commands = [ { diff --git a/src/editor/dune b/src/editor/dune index 096e32ee9..06bec26ac 100644 --- a/src/editor/dune +++ b/src/editor/dune @@ -128,6 +128,5 @@ (install (section share) (package learn-ocaml) - (files (editor.bc.js as www/js/editor.js) - (new_exercise.bc.js as www/js/new_exercise.js))) - + (files (editor.bc.js as editor/js/editor.js) + (new_exercise.bc.js as editor/js/new-exercise.js))) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index dd497d89d..334ac391a 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -523,7 +523,7 @@ let () = begin toolbar_button ~icon: "left" [%i"Metadata"] @@ fun () -> Dom_html.window##.location##assign - (Js.string (api_server ^ "/new_exercise.html#id=" ^ id ^ "&action=open")); + (Js.string (api_server ^ "/new-exercise.html#id=" ^ id ^ "&action=open")); Lwt.return () end; begin toolbar_button diff --git a/src/editor/learnocaml_editor_tab.ml b/src/editor/learnocaml_editor_tab.ml index 256c59171..ea19f42d7 100644 --- a/src/editor/learnocaml_editor_tab.ml +++ b/src/editor/learnocaml_editor_tab.ml @@ -64,7 +64,7 @@ let export_all_bar = p [pcdata [%i"Export all exercises to a zip file"]]]] let new_exercise_bar = - a ~a:[ a_href "new_exercise.html"; + a ~a:[ a_href "new-exercise.html"; a_class [ "exercise" ] ] [ div ~a:[ a_class [ "descr" ] ] [ h1 [ pcdata [%i"New exercise"] ]; diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 21c4063ae..82c481e9b 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -155,6 +155,14 @@ module Args = struct value & opt dir default & info ["contents-dir"] ~docv:"DIR" ~doc: "directory containing the base learn-ocaml app contents" + let editor_dir = + let default = + readlink (Filename.dirname (Filename.dirname (Sys.executable_name)) + /"share"/"learn-ocaml"/"editor") + in + value & opt dir default & info ["editor-dir"] ~docv:"DIR" ~doc: + "directory containing the learn-ocaml-editor app contents" + let enable opt doc = value & vflag None [ Some true, info ["enable-"^opt] ~doc:("Enable "^doc); @@ -195,6 +203,7 @@ module Args = struct type t = { contents_dir: string; + editor_dir: string; try_ocaml: bool option; lessons: bool option; editor: bool option; @@ -206,10 +215,10 @@ module Args = struct let builder_conf = let apply - contents_dir try_ocaml lessons editor exercises playground toplevel base_url - = { contents_dir; try_ocaml; lessons; editor; exercises; playground; toplevel; base_url } + contents_dir editor_dir try_ocaml lessons editor exercises playground toplevel base_url + = { contents_dir; editor_dir; try_ocaml; lessons; editor; exercises; playground; toplevel; base_url } in - Term.(const apply $contents_dir $try_ocaml $lessons $editor $exercises $playground $toplevel $base_url) + Term.(const apply $contents_dir $editor_dir $try_ocaml $lessons $editor $exercises $playground $toplevel $base_url) let repo_conf = let apply repo_dir exercises_filtered jobs = @@ -309,17 +318,22 @@ let main o = else Lwt.return_none in let generate () = + let copy title src_dir = + Printf.printf "Updating %s at %s\n%!" title o.app_dir; + Lwt.catch + (fun () -> Lwt_utils.copy_tree src_dir o.app_dir) + (function + | Failure _ -> + Lwt.fail_with @@ + Printf.sprintf "Failed to copy %s app contents from %s" + title (readlink src_dir) + | e -> Lwt.fail e) + in if List.mem Build o.commands then - (Printf.printf "Updating app at %s\n%!" o.app_dir; - Lwt.catch - (fun () -> Lwt_utils.copy_tree o.builder.Builder.contents_dir o.app_dir) - (function - | Failure _ -> - Lwt.fail_with @@ Printf.sprintf - "Failed to copy base app contents from %s" - (readlink o.builder.Builder.contents_dir) - | e -> Lwt.fail e) - >>= fun () -> + (copy "learn-ocaml" o.builder.Builder.contents_dir >>= fun () -> + (if o.builder.Builder.editor <> Some false then + copy "learn-ocaml-editor" o.builder.Builder.editor_dir + else Lwt.return_unit) >>= fun () -> let server_config = o.repo_dir/"server_config.json" and www_server_config = o.app_dir/"server_config.json" in let module ServerData = Learnocaml_data.Server in diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 1e3a7c3dd..2cff8e6d5 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -400,7 +400,7 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | ["playground.html"] | ["student-view.html"] | ["description.html"] - | ["new_exercise.html"] + | ["new-exercise.html"] | ["editor.html"] | ["partition-view.html"] | ("js"|"fonts"|"icons"|"css"|"static") :: _ as path), diff --git a/static/Makefile b/static/Makefile index d0153aeb1..40d0ebcb3 100644 --- a/static/Makefile +++ b/static/Makefile @@ -14,9 +14,13 @@ FILES = $(wildcard \ css/*.css\ ) $(shell find js/mathjax ! -type d) +EDITOR_FILES = $(wildcard \ + editor/*.html\ +) + ALWAYS: file-list: icons ALWAYS - @echo ${FILES} >$@ + @echo ${FILES} ${EDITOR_FILES} >$@ icons: @${MAKE} -C icons @@ -27,6 +31,7 @@ dune: file-list @echo ' (package learn-ocaml)' >>$@ @echo ' (files' >>$@ @$(foreach f,$(FILES),echo ' ($f as ${addprefix www/,$f})' >>$@;) + @$(foreach f,$(EDITOR_FILES),echo ' ($f as $f)' >>$@;) @echo ' )' >>$@ @echo ')' >>$@ diff --git a/static/editor.html b/static/editor/editor.html similarity index 100% rename from static/editor.html rename to static/editor/editor.html diff --git a/static/new_exercise.html b/static/editor/new-exercise.html similarity index 98% rename from static/new_exercise.html rename to static/editor/new-exercise.html index 1ac5f696f..19165eaf8 100644 --- a/static/new_exercise.html +++ b/static/editor/new-exercise.html @@ -13,7 +13,7 @@ - + From 76899622574979854bd598bedee4b0556557eb53 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 26 Aug 2021 23:49:09 +0200 Subject: [PATCH 86/91] QoL: Add a set_progress command in learn-ocaml-editor/Test/Generate --- src/editor/test_spec.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index e5e02e088..c2d4c4312 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -244,11 +244,11 @@ let cat_question name list_qst = (2, "q_" ^ name ^ "_1") l |> snd -(* TODO/FIXME: Add some "let () = set_progress ..." lines *) let compile indexed_list = let tests = test_prel ^ (ast_fonction true true) in - let tests = List.fold_left (fun acc (_name, list_qst) -> + let tests = List.fold_left (fun acc (name, list_qst) -> acc ^ + Format.sprintf {|let () = set_progress "Q. %s"@.@.|} name ^ if List.length list_qst > 1 then List.fold_left (fun (i, acc) qst -> (i + 1, acc ^ question_typed ~num:i qst ^" \n")) From 24fc021d110f3ae21515612d7ec4b5c3259e12cd Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 27 Aug 2021 22:58:15 +0200 Subject: [PATCH 87/91] fix: potential name clash in learn-ocaml-editor/Test/Generate To be more precise (using Bash syntax for more clarity): * Beforehand, we used "q_${name}" and "q_${name}_1", "q_${name}_2" which could be problematic if some ${name} ends in "_1". * Henceforth, we use "q_${name}" and "q1_${name}", "q2_${name}". --- src/editor/test_spec.ml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/editor/test_spec.ml b/src/editor/test_spec.ml index c2d4c4312..f89a5f6ee 100644 --- a/src/editor/test_spec.ml +++ b/src/editor/test_spec.ml @@ -29,7 +29,7 @@ let question_typed ?num question = | "" -> "" | f -> Format.sprintf "fun () -> last ((%s) ())" f in - let suffix = match num with None -> "" | Some n -> "_" ^ string_of_int n in + let prefix = match num with None -> "" | Some n -> string_of_int n in match question with | TestAgainstSpec a -> (* FIXME *) @@ -38,13 +38,13 @@ let question_typed ?num question = | TestSuite a -> let name, prot, tester, suite = a.name, to_funty a.ty, opt_string "test" a.tester, a.suite in - (* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 1/3) *) - Format.sprintf "let q_%s%s =@. \ + (* Naming convention: [q_name], [q1_name; q2_name] (occurrence 1/3) *) + Format.sprintf "let q%s_%s =@. \ let prot = %s in@. \ test_function%s prot@. \ (lookup_student (ty_of_prot prot) %s)@. \ %s;;@." - name suffix prot tester name suite + prefix name prot tester name suite | TestAgainstSol a -> let name = a.name and prot = to_funty a.ty @@ -53,13 +53,13 @@ let question_typed ?num question = and tester = opt_string "test" a.tester and suite = a.suite in - (* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 2/3) *) - Format.sprintf "let q_%s%s =@. \ + (* Naming convention: [q_name], [q1_name; q2_name] (occurrence 2/3) *) + Format.sprintf "let q%s_%s =@. \ let prot = %s in@. \ test_function_against_solution ~gen:(%d)%s%s prot@. \ \"%s\"@. \ %s;;@." - name suffix prot gen sampler tester name suite + prefix name prot gen sampler tester name suite (*****************) (* compile stuff *) @@ -231,17 +231,17 @@ let fonction = "" in fonction -(* Naming convention: [q_name], [q_name_1; q_name_2] (occurrence 3/3) *) +(* Naming convention: [q_name], [q1_name; q2_name] (occurrence 3/3) *) (* [cat_question "foo" [42] = "q_foo"] - [cat_question "foo" [42; 42; 42] = "q_foo_1 @ q_foo_2 @ q_foo_3"] *) + [cat_question "foo" [42; 42; 42] = "q1_foo @ q2_foo @ q3_foo"] *) let cat_question name list_qst = match list_qst with | [] -> invalid_arg "cat_question" | [_] -> "q_" ^ name | _q :: ((_ :: _) as l) -> List.fold_left (fun (i, acc) _e -> - (i + 1, acc ^" @ q_"^ name ^ "_" ^ string_of_int i)) - (2, "q_" ^ name ^ "_1") l + (i + 1, acc ^ " @ q" ^ string_of_int i ^ "_" ^ name)) + (2, "q1_" ^ name) l |> snd let compile indexed_list = From 507a7d3b22f15bbf5b94c04aa345581935ba6a2a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 27 Aug 2021 23:07:32 +0200 Subject: [PATCH 88/91] fix: s/Fonction/Function/ (albeit learn-ocaml-editor might be internationalized at some point) --- src/editor/editor_lib.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/editor/editor_lib.ml b/src/editor/editor_lib.ml index b646677e4..434d4bdd4 100644 --- a/src/editor/editor_lib.ml +++ b/src/editor/editor_lib.ml @@ -183,7 +183,7 @@ let init = "let () = set_result @@ ast_sanity_check code_ast @@ fun () ->\n" -let section name report = {|Section ([ Text "Fonction:" ; Code "|} +let section name report = {|Section ([ Text "Function:" ; Code "|} ^ name ^ {|" ], |} ^ report ^ " );\n" From 95af8d2bf7b18ab45dafb2c9e24bc1a7a113881f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 31 Aug 2021 01:24:24 +0200 Subject: [PATCH 89/91] =?UTF-8?q?QoL:=20Specify=20a=20JS-RegExp=20pattern?= =?UTF-8?q?=20in=20?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Regarding optional e-mails, for the sake of consistency, use the same as that of PR #362 (branch oauth-moodle-dev). & Do some minor HTML cleanup as well. --- src/editor/new_exercise.ml | 55 ++++++++++++++------------------- static/editor/new-exercise.html | 23 ++++++++------ 2 files changed, 37 insertions(+), 41 deletions(-) diff --git a/src/editor/new_exercise.ml b/src/editor/new_exercise.ml index 17cf4fab1..8c999cd39 100644 --- a/src/editor/new_exercise.ml +++ b/src/editor/new_exercise.ml @@ -100,21 +100,18 @@ let backward_input =get (getElementById_coerce "backward" CoerceTo.input) let forward_input = get (getElementById_coerce "forward" CoerceTo.input) let previous_state = match get_editor_state previous_id with - | exception Not_found -> None + | exception Not_found -> None | state->Some state (*filling the form eventualy *) let _ = match previous_state with | None -> () | Some state -> identifier_input##.value := Js.string previous_id; - title_input##.value := Js.string state.metadata.title; - - let s = (List.fold_left - (fun acc (a,b) ->acc^a^", "^b^"; ") - "" - state.metadata.author) - in + let s = List.fold_left + (fun acc (a, b) -> acc ^ a ^ " <" ^ b ^ ">, ") + "" + state.metadata.author in authors_input##.value := if s="" then Js.string "" else @@ -166,29 +163,24 @@ let _ = (Regexp.regexp " ") string in - - let requirements= string_parser (Js.to_string required_input##.value) - and focus= string_parser (Js.to_string trained_input##.value) - and backward = string_parser (Js.to_string backward_input##.value) - and forward = string_parser (Js.to_string forward_input##.value) - and authors= - if String.trim (Js.to_string authors_input##.value) = "" then - [] - else - Regexp.split - (Regexp.regexp ";") - (Js.to_string authors_input##.value) - |> List.map @@ - fun s -> - match List.map String.trim @@ Regexp.split - (Regexp.regexp ",") - s - with - a::b::[]->(a,b) - | _ -> - Dom_html.window##alert (Js.string "Incorrect value for the authors field"); - failwith "bad syntax" - + let requirements = string_parser (Js.to_string required_input##.value) + and focus = string_parser (Js.to_string trained_input##.value) + and backward = string_parser (Js.to_string backward_input##.value) + and forward = string_parser (Js.to_string forward_input##.value) + and authors = + if String.trim (Js.to_string authors_input##.value) = "" then [] + else + Regexp.split (Regexp.regexp ", ?") (Js.to_string authors_input##.value) + |> List.map @@ fun s -> + match Regexp.string_match + (Regexp.regexp "^([^<>]+) <([^<>]*)>$") s 0 with + (* TODO Keep up-to-date with static/editor/new-exercise.html *) + | Some res -> let odflt = (function Some s -> s | None -> "") in + String.trim @@ odflt @@ Regexp.matched_group res 1, + String.trim @@ odflt @@ Regexp.matched_group res 2 + | None -> + Dom_html.window##alert (Js.string "Incorrect value for the authors field"); + failwith "bad syntax" in let metadata={requirements;focus;backward;forward; kind= Exercise;title; id=Some id; @@ -225,6 +217,5 @@ let _ = store metadata; Dom_html.window##.location##assign (Js.string (api_server ^ "/editor.html#id=" ^ id)); - end; Js._true); diff --git a/static/editor/new-exercise.html b/static/editor/new-exercise.html index 19165eaf8..b85e7dd17 100644 --- a/static/editor/new-exercise.html +++ b/static/editor/new-exercise.html @@ -21,11 +21,9 @@ a:link { text-decoration: none; } - input:invalid { box-shadow: 0 0 1px 1px red; } - .error { color: darkred; } @@ -67,18 +65,25 @@

New Exercise

- - + +
+ + Each author follows the syntax:   + Firstname Lastname <address@email.com>
+ But their email can be omitted:   + Firstname Lastname <>

- +
- -
+
@@ -103,12 +108,12 @@

New Exercise

- +
- +
From 1a047a57042543e1cd31d18987b339799eefec1b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 31 Aug 2021 01:29:31 +0200 Subject: [PATCH 90/91] =?UTF-8?q?QoL:=20Reverse=20the=20order=20of=20items?= =?UTF-8?q?=20in=20?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (so that 4 is at the top) --- static/editor/new-exercise.html | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/static/editor/new-exercise.html b/static/editor/new-exercise.html index b85e7dd17..653eee00b 100644 --- a/static/editor/new-exercise.html +++ b/static/editor/new-exercise.html @@ -95,15 +95,15 @@

New Exercise

From 8aa71e65a3d24d112ad0e5ea7ed2ddf9e41ab5c5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 1 Sep 2021 01:25:20 +0200 Subject: [PATCH 91/91] docs: Improve the default text in learn-ocaml-editor/Question --- src/editor/editor.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/editor/editor.ml b/src/editor/editor.ml index 334ac391a..6ff5da802 100644 --- a/src/editor/editor.ml +++ b/src/editor/editor.ml @@ -240,9 +240,12 @@ let () = let ace_quest = Ace.create_editor (Tyxml_js.To_dom.of_div editor_question ) in let question = let a = get_question id in - if a = "" then [%i"# Questions\n\n\ - You can write here your questions using\n\ - the **Markdown** markup language\n"] + if a = "" then {|# Exercise Title + +1. You can write here your questions using the + [**Markdown**](https://commonmark.org/) lightweight markup language. + +1. For details, see the [CommonMark spec](https://spec.commonmark.org/).|} else a in Ace.set_contents ace_quest question ;