Port to OCaml 4.05.0, JSOO 3.0, OPAM 2.0 and update dependencies

.travis.yml

@@ -3,4 +3,4 @@ sudo: required
 install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-ocaml.sh
 script: bash -c '. .travis-ocaml.sh && . install-opam-deps.sh && make PROCESSING_JOBS=1'
 env:
-  - OCAML_VERSION="4.03"
+  - OCAML_VERSION="4.05"

install-opam-deps.sh

@@ -2,12 +2,13 @@
 
 opam list --installed depext || opam install depext
 opam pin add --yes --no-action ocp-indent \
-     "https://github.com/OCamlPro/ocp-indent.git"
+     "https://github.com/OCamlPro/ocp-indent.git#master"
 opam pin add --yes --no-action ocplib-json-typed \
 	   "https://github.com/OCamlPro/ocplib-json-typed.git"
 opam pin add --yes --no-action ocp-ocamlres \
 	   "https://github.com/OCamlPro/ocp-ocamlres.git"
 opam pin add --yes --no-action learn-ocaml-deps src
+opam install camlp4 --yes
 opam depext learn-ocaml-deps
 if opam list --installed learn-ocaml-deps
 then opam upgrade learn-ocaml-deps ocp-indent ocplib-json-typed ocp-ocamlres

src/.merlin

@@ -8,11 +8,14 @@ PKG ocplib-json-typed
 PKG js_of_ocaml
 PKG tyxml
 PKG tyxml.functor
+PKG js_of_ocaml.compiler
 PKG js_of_ocaml.tyxml
+PKG js_of_ocaml.lwt
 PKG ocp-indent.lib
 PKG cohttp.lwt
 PKG magic-mime
 PKG omd
 PKG markup
+PKG uutf
 EXT syntax
 EXT js

src/ace-lib/build.ocp

@@ -8,6 +8,7 @@ begin library "ace"
   requires = [
     "jsutils"
     "js_of_ocaml"
+    "js_of_ocaml-lwt"
     "lwt"
     "ocp-indent.lib"
   ]

src/app/learnocaml_local_storage.ml

@@ -65,9 +65,12 @@ let init () =
   Dom_html.addEventListener
     Dom_html.window storage_event_typ
     (Dom_html.handler (fun evt ->
-         let name = Js.to_string evt##key in
-         notify (Some name) ;
-         Js._true))
+         Js.Opt.case (evt##key)
+           (fun () -> Js._false)
+           (fun name ->
+              let name = Js.to_string name in
+              notify (Some name) ;
+              Js._true)))
     Js._true |> ignore
 
 let store { store ; key } v =

src/grader/build.ocp

@@ -100,6 +100,7 @@ end
 begin library "grading-jsoo"
   requires = [
     "js_of_ocaml"
+    "js_of_ocaml-lwt"
     "js_of_ocaml.syntax"
     "ezjsonm"
     "ocplib-json-typed.browser"

src/grader/grader_jsoo_worker.ml

@@ -21,9 +21,9 @@ let get_grade ?callback exo solution =
     OCamlRes.Res.merge
       Embedded_cmis.root
       Embedded_grading_cmis.root in
-  Sys_js.register_autoload ~path
-    (fun (prefix, suffix) ->
-       match OCamlRes.Res.find (OCamlRes.Path.of_string suffix) root with
+  Sys_js.mount ~path
+    (fun ~prefix ~path ->
+       match OCamlRes.Res.find (OCamlRes.Path.of_string path) root with
        | cmi ->
            Js.Unsafe.set cmi (Js.string "t") 9 ; (* XXX hack *)
            Some cmi

src/grader/introspection.ml

@@ -121,8 +121,10 @@ let treat_lookup_errors fn = match fn () with
 
 let compatible_type nexp ngot =
   treat_lookup_errors @@ fun () ->
-  let path_exp, decl_exp = Env.lookup_type nexp !Toploop.toplevel_env in
-  let path_got, decl_got = Env.lookup_type ngot !Toploop.toplevel_env in
+  let path_exp = Env.lookup_type nexp !Toploop.toplevel_env in
+  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
   Ctype.unify !Toploop.toplevel_env tgot texp ;

src/grader/test_lib.ml

@@ -721,12 +721,13 @@ module Make
 
   let abstract_type ?(allow_private = true) name =
     let open Learnocaml_report in
-    match Env.lookup_type Longident.(parse ("Code." ^ name)) !Toploop.toplevel_env with
-    | _, { Types. type_kind = Types.Type_abstract } ->
+    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 } ->
         true, [ Message ([Text "Type" ; Code "Exp.e" ; Text "is abstract as expected." ], Success 5) ]
-    | _, { Types. type_kind = _ ; type_private = Asttypes.Private } when allow_private ->
+    | { Types. type_kind = _ ; type_private = Asttypes.Private } when allow_private ->
         true, [ Message ([Text "Type" ; Code "Exp.e" ; Text "is private, I'll accept that :-)." ], Success 5) ]
-    | _, { Types. type_kind = _ } ->
+    | { Types. type_kind = _ } ->
         false, [ Message ([Text "Type" ; Code "Exp.e" ; Text "should be abstract!" ], Failure) ]
 
   let test_student_code ty cb =

src/opam

@@ -3,25 +3,39 @@ name: "learn-ocaml-deps"
 version: "~private"
 maintainer: "Gregoire Henry <gregoire.henry@ocamlpro.com>"
 authors: "Gregoire Henry <gregoire.henry@ocamlpro.com>"
+homepage: "https://github.com/OCamlPro/learn-ocaml"
+bug-reports: "https://github.com/OCamlPro/learn-ocaml/issues"
+dev-repo: "git://git@github.com:OCamlPro/learn-ocaml"
 depends: [
   "ocamlfind" {build}
   "ocp-build" {build}
   "base64"
   "ezjsonm"
-  "js_of_ocaml" {= "2.8"}
+  "js_of_ocaml" {>= "3.0" }
+  "js_of_ocaml-camlp4"
+  "js_of_ocaml-toplevel"
+  "js_of_ocaml-compiler"
+  "js_of_ocaml-lwt"
+  "js_of_ocaml-tyxml"
   "lwt"
-  "ocp-indent" {>= "1.6"}
+  "ocp-indent"
   "ocp-ocamlres"
   "ocplib-json-typed"
   "optcomp"
   "pprint"
-  "ppx_tools" {>= "5.0+4.02.0"}
+  "ppx_tools"
   "react"
   "reactiveData"
-  "tyxml" {>= "4.0.0"}
+  "tyxml"
   "cohttp"
+  "cohttp-lwt-unix" {>= "0.99.0"}
   "magic-mime"
   "omd"
   "markup"
+  "cmdliner"
+  "uutf" {>= "1.0" }
+  "easy-format" {>= "1.3.0" }
+  "yojson" {>= "1.4.0" }
+  "ppx_cstruct"
 ]
-available: [ ocaml-version >= "4.03.0" ]
+available: [ ocaml-version >= "4.05.0" ]

src/ppx-metaquot/genlifter.ml

@@ -15,7 +15,7 @@ module Main : sig end = struct
   open Ast_helper
   open Ast_convenience
 
-  let selfcall ?(this = "this") m args = app (Exp.send (evar this) m) args
+  let selfcall ?(this = "this") m args = app (Exp.send (evar this) (mknoloc m)) args
 
   (*************************************************************************)
 
@@ -38,19 +38,19 @@ module Main : sig end = struct
 
   let existential_method =
     Cf.(method_ (mknoloc "existential") Public
-          (virtual_ Typ.(poly ["a"] (arrow Nolabel (var "a") (var "res"))))
+          (virtual_ Typ.(poly [mknoloc "a"] (arrow Nolabel (var "a") (var "res"))))
        )
 
   let arrow_method =
     Cf.(method_ (mknoloc "arrow") Public
-          (virtual_ Typ.(poly ["a"] (arrow Nolabel (var "a") (var "res"))))
+          (virtual_ Typ.(poly [mknoloc "a"] (arrow Nolabel (var "a") (var "res"))))
        )
 
   let rec gen ty =
     if Hashtbl.mem printed ty then ()
     else let tylid = Longident.parse ty in
-      let (_, td) =
-        try Env.lookup_type tylid env
+      let td =
+        try Env.find_type (Env.lookup_type tylid env) env
         with Not_found ->
           Format.eprintf "** Cannot resolve type %s@." ty;
           exit 2
@@ -63,20 +63,21 @@ module Main : sig end = struct
         | Lapply _ -> assert false
       in
       Hashtbl.add printed ty ();
-      let params = List.mapi (fun i _ -> Printf.sprintf "f%i" i) td.type_params in
-      let env = List.map2 (fun s t -> t.id, evar s) params 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_t tyargs =
         List.fold_right
           (fun arg 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) params 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) params) e in
-        let tyargs = List.map (fun t -> Typ.constr (lid t) []) params 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

src/repo/learnocaml_tutorial_parser.ml

@@ -347,20 +347,22 @@ let print_html_tutorial ~tutorial_name tutorial =
   let utf8_of_cp =
     let tmp = Buffer.create 513 in
     fun cp ->
-      Buffer.clear tmp ;
-      Uutf.Buffer.add_utf_8 tmp cp ;
-      Buffer.contents tmp in
+    Buffer.clear tmp ;
+    Uutf.Buffer.add_utf_8 tmp cp ;
+    Buffer.contents tmp in
   let pp_escaped ppf t =
     Uutf.String.fold_utf_8 (fun () _ cp ->
         match cp with
-        | `Uchar 0x20 -> Format.fprintf ppf "@ "
-        | `Uchar 0x26 -> Format.fprintf ppf "&"
-        | `Uchar 0x3C -> Format.fprintf ppf "<"
-        | `Uchar 0x3E -> Format.fprintf ppf ">"
-        | `Uchar 0xA0 -> Format.fprintf ppf " "
-        | `Uchar cp -> Format.fprintf ppf "%s" (utf8_of_cp cp)
-        | `Malformed _ -> ())
-      () t in
+        | `Uchar c ->
+           begin match Uchar.to_int c with
+           | 0x20 -> Format.fprintf ppf "@ "
+           | 0x26 -> Format.fprintf ppf "&"
+           | 0x3C -> Format.fprintf ppf "<"
+           | 0x3E -> Format.fprintf ppf ">"
+           | 0xA0 -> Format.fprintf ppf " "
+           | cp -> Format.fprintf ppf "%s" (utf8_of_cp c)
+           end
+        | `Malformed _ -> ())() t in
   let rec pp_text ppf = function
     | [] -> ()
     |  Code { code ; runnable = false} :: rest ->
@@ -380,37 +382,38 @@ let print_html_tutorial ~tutorial_name tutorial =
         if rest <> [] then Format.fprintf ppf "@ " ;
         pp_text ppf rest
     | Text t :: rest ->
-        pp_escaped ppf t ;
-        if rest <> [] then Format.fprintf ppf "@ " ;
-        pp_text ppf rest
+       pp_escaped ppf t ;
+       if rest <> [] then Format.fprintf ppf "@ " ;
+       pp_text ppf rest
     | _ -> assert false in
   let rec pp_content ppf = function
     | Code_block { code ; runnable } ->
-        Format.fprintf ppf "@[<v 2><pre%s>@," (if runnable then " data-run" else "") ;
-        let code = reshape_code_block code in
-        Uutf.String.fold_utf_8 (fun () _ cp ->
-            match cp with
-            | `Uchar 0x0A -> Format.fprintf ppf "@,"
-            | `Uchar 0x26 -> Format.fprintf ppf "&amp;"
-            | `Uchar 0x3C -> Format.fprintf ppf "&lt;"
-            | `Uchar 0x3E -> Format.fprintf ppf "&gt;"
-            | `Uchar 0xA0 -> Format.fprintf ppf "&nbsp;"
-            | `Uchar cp -> Format.fprintf ppf "%s" (utf8_of_cp cp)
-            | `Malformed _ -> ())
-          () code ;
-        Format.fprintf ppf "@]@,</pre>"
+       Format.fprintf ppf "@[<v 2><pre%s>@," (if runnable then " data-run" else "") ;
+       let code = reshape_code_block code in
+       Uutf.String.fold_utf_8 (fun () _ cp ->
+           match cp with
+           | `Uchar c ->
+              begin match Uchar.to_int c with
+              | 0x26 -> Format.fprintf ppf "&amp;"
+              | 0x3C -> Format.fprintf ppf "&lt;"
+              | 0x3E -> Format.fprintf ppf "&gt;"
+              | 0xA0 -> Format.fprintf ppf "&nbsp;"
+              | cp -> Format.fprintf ppf "%s" (utf8_of_cp c)
+              end
+           | `Malformed _ -> ()) () code ;
+       Format.fprintf ppf "@]@,</pre>"
     | Paragraph text ->
-        Format.fprintf ppf "@[<hov 2><p>%a@]</p>" pp_text text
+       Format.fprintf ppf "@[<hov 2><p>%a@]</p>" pp_text text
     | Enum items ->
-        let pp_item ppf contents =
-          Format.fprintf ppf "@[<hov 2><li>%a@]</li>"
-            (Format.pp_print_list pp_content) contents in
-        Format.fprintf ppf "@[<v 2><ul>%a@]</ul>"
-          (Format.pp_print_list pp_item) items in
+       let pp_item ppf contents =
+         Format.fprintf ppf "@[<hov 2><li>%a@]</li>"
+                        (Format.pp_print_list pp_content) contents in
+       Format.fprintf ppf "@[<v 2><ul>%a@]</ul>"
+                      (Format.pp_print_list pp_item) items in
   let pp_step ppf { step_title ; step_contents } =
     Format.fprintf ppf "@[<hov 2><h2>%a</h2>@]@,%a"
-      pp_text step_title
-      (Format.pp_print_list pp_content) step_contents in
+                   pp_text step_title
+                   (Format.pp_print_list pp_content) step_contents in
   Format.fprintf ppf "@[<v 2><html>@,\
                       @[<v 2><head>@,\
                       <meta charset='UTF-8'>@,\
@@ -421,9 +424,9 @@ let print_html_tutorial ~tutorial_name tutorial =
                       %a@]@,\
                       </body>@]@,\
                       </html>@."
-    tutorial_name
-    pp_text tutorial_title
-    (Format.pp_print_list pp_step) tutorial_steps ;
+                 tutorial_name
+                 pp_text tutorial_title
+                 (Format.pp_print_list pp_step) tutorial_steps ;
   Buffer.contents buffer
 
 let print_md_tutorial ~tutorial_name tutorial =

src/simple-server/learnocaml_simple_server.ml

@@ -151,7 +151,11 @@ let launch () =
     | `GET, path -> respond_static path
     | _ -> Server.respond_error ~status: `Bad_request ~body: "Bad request" () in
   Random.self_init () ;
-  Server.create ~mode:(`TCP (`Port !port)) (Server.make ~callback ())
+  Server.create
+    ~on_exn: (function
+        | Unix.Unix_error(Unix.EPIPE, "write", "") -> ()
+        | exn -> raise exn)
+    ~mode:(`TCP (`Port !port)) (Server.make ~callback ())
 
 let () =
   Arg.parse args

src/syntax.ocp

@@ -10,12 +10,12 @@ optcomp_opt = %string(strings = [
 camlp4_optcomp_js = [
   "camlp4o"
   "%{optcomp_SRC_DIR}%/optcomp.cma" optcomp_opt
-  "%{js_of_ocaml_SRC_DIR}%/pa_js.cmo"
+  "%{js_of_ocaml-camlp4_SRC_DIR}%/pa_js.cma"
 ]
 
 camlp4_js = [
   "camlp4o"
-  "%{js_of_ocaml_SRC_DIR}%/pa_js.cmo"
+  "%{js_of_ocaml-camlp4_SRC_DIR}%/pa_js.cma"
 ]
 
 camlp4_optcomp = [

src/toplevel/learnocaml_toplevel_worker_main.ml

@@ -257,9 +257,9 @@ let () =
         Lwt.return_unit
   in
   let path = "/worker_cmis" in
-  Sys_js.register_autoload ~path
-    (fun (prefix, suffix) ->
-       match OCamlRes.Res.find (OCamlRes.Path.of_string suffix) Embedded_cmis.root with
+  Sys_js.mount ~path
+    (fun ~prefix ~path ->
+       match OCamlRes.Res.find (OCamlRes.Path.of_string path) Embedded_cmis.root with
        | cmi ->
            Js.Unsafe.set cmi (Js.string "t") 9 ; (* XXX hack *)
            Some cmi