Include VG in Toplevel and exercices

learn-ocaml-client.opam

@@ -19,6 +19,8 @@ depends: [
   "cmdliner"
   "omd" {<= "1.3.1"}
   "asak"
+  "gg"
+  "vg"
   "cohttp" {>= "1.0.0" & < "2.0.0"}
   "cohttp-lwt-unix" {>= "1.0.0" & < "2.0.0"}
   "ssl" {= "0.5.5"}

learn-ocaml.opam

@@ -50,7 +50,9 @@ depends: [
   "pprint"
   "ppx_cstruct"
   "ppx_tools"
+  "re"
   "uutf" {>= "1.0" }
+  "vg"
   "yojson" {>= "1.4.0" }
   "asak" {>= "0.1"}
 ]

learn-ocaml.opam.locked

@@ -112,6 +112,7 @@ depends: [
   "uri" {= "1.9.7"}
   "uutf" {= "1.0.2"}
   "yojson" {= "1.7.0"}
+  "vg" {= "0.9.3"}
 ]
 build: [
   [make "static"]

src/grader/dune

@@ -46,53 +46,72 @@
                 (run odoc html %{dep:test_lib.odoc} -o %{workspace_root}/_doc/_html)))
 )
 
+
+
 (rule
  (targets embedded_cmis.ml)
- (deps %{ocaml-config:standard_library}/array.cmi
-       %{ocaml-config:standard_library}/arrayLabels.cmi
-       %{ocaml-config:standard_library}/buffer.cmi
-       %{ocaml-config:standard_library}/bytes.cmi
-       %{ocaml-config:standard_library}/bigarray.cmi
-       %{ocaml-config:standard_library}/camlinternalFormatBasics.cmi
-       %{ocaml-config:standard_library}/camlinternalFormat.cmi
-       %{ocaml-config:standard_library}/camlinternalLazy.cmi
-       %{ocaml-config:standard_library}/camlinternalMod.cmi
-       %{ocaml-config:standard_library}/camlinternalOO.cmi
-       %{ocaml-config:standard_library}/compiler-libs/topdirs.cmi
-       %{ocaml-config:standard_library}/char.cmi
-       %{ocaml-config:standard_library}/complex.cmi
-       %{ocaml-config:standard_library}/digest.cmi
-       %{ocaml-config:standard_library}/filename.cmi
-       %{ocaml-config:standard_library}/format.cmi
-       %{ocaml-config:standard_library}/hashtbl.cmi
-       %{ocaml-config:standard_library}/int32.cmi
-       %{ocaml-config:standard_library}/int64.cmi
-       %{ocaml-config:standard_library}/lazy.cmi
-       %{ocaml-config:standard_library}/lexing.cmi
-       %{ocaml-config:standard_library}/list.cmi
-       %{ocaml-config:standard_library}/map.cmi
-       %{ocaml-config:standard_library}/marshal.cmi
-       %{ocaml-config:standard_library}/pervasives.cmi
-       %{ocaml-config:standard_library}/printexc.cmi
-       %{ocaml-config:standard_library}/printf.cmi
-       %{ocaml-config:standard_library}/queue.cmi
-       %{ocaml-config:standard_library}/random.cmi
-       %{ocaml-config:standard_library}/scanf.cmi
-       %{ocaml-config:standard_library}/set.cmi
-       %{ocaml-config:standard_library}/stack.cmi
-       %{ocaml-config:standard_library}/string.cmi
-       %{ocaml-config:standard_library}/sys.cmi
-       %{ocaml-config:standard_library}/uchar.cmi
-       %{ocaml-config:standard_library}/weak.cmi)
- (action (with-stdout-to %{targets} (run ocp-ocamlres -format ocamlres %{deps})))
+ (deps
+      (:stdlib_cmis
+        %{ocaml-config:standard_library}/array.cmi
+        %{ocaml-config:standard_library}/arrayLabels.cmi
+        %{ocaml-config:standard_library}/buffer.cmi
+        %{ocaml-config:standard_library}/bytes.cmi
+        %{ocaml-config:standard_library}/bigarray.cmi
+        %{ocaml-config:standard_library}/camlinternalFormatBasics.cmi
+        %{ocaml-config:standard_library}/camlinternalFormat.cmi
+        %{ocaml-config:standard_library}/camlinternalLazy.cmi
+        %{ocaml-config:standard_library}/camlinternalMod.cmi
+        %{ocaml-config:standard_library}/camlinternalOO.cmi
+        %{ocaml-config:standard_library}/compiler-libs/topdirs.cmi
+        %{ocaml-config:standard_library}/char.cmi
+        %{ocaml-config:standard_library}/complex.cmi
+        %{ocaml-config:standard_library}/digest.cmi
+        %{ocaml-config:standard_library}/filename.cmi
+        %{ocaml-config:standard_library}/format.cmi
+        %{ocaml-config:standard_library}/hashtbl.cmi
+        %{ocaml-config:standard_library}/int32.cmi
+        %{ocaml-config:standard_library}/int64.cmi
+        %{ocaml-config:standard_library}/lazy.cmi
+        %{ocaml-config:standard_library}/lexing.cmi
+        %{ocaml-config:standard_library}/list.cmi
+        %{ocaml-config:standard_library}/map.cmi
+        %{ocaml-config:standard_library}/marshal.cmi
+        %{ocaml-config:standard_library}/pervasives.cmi
+        %{ocaml-config:standard_library}/printexc.cmi
+        %{ocaml-config:standard_library}/printf.cmi
+        %{ocaml-config:standard_library}/queue.cmi
+        %{ocaml-config:standard_library}/random.cmi
+        %{ocaml-config:standard_library}/scanf.cmi
+        %{ocaml-config:standard_library}/set.cmi
+        %{ocaml-config:standard_library}/stack.cmi
+        %{ocaml-config:standard_library}/string.cmi
+        %{ocaml-config:standard_library}/sys.cmi
+        %{ocaml-config:standard_library}/uchar.cmi
+        %{ocaml-config:standard_library}/weak.cmi)
+
+       (:local_cmis
+         ../toplevel/.learnocaml_toplevel_pp.objs/byte/learnocaml_toplevel_pp.cmi)
+
+       (:lib_cmis
+         %{lib:re:re.cmi}
+         %{lib:gg:gg.cmi}
+         %{lib:vg:vg.cmi}
+         %{lib:vg:vgr_svg.cmi}))
+ (action
+   (with-stdout-to %{targets}
+    (run ocp-ocamlres -format ocamlres %{stdlib_cmis} %{local_cmis} %{lib_cmis}))
+ )
 )
 
 (library
  (name embedded_cmis)
  (wrapped false)
  (modes byte)
  (modules Embedded_cmis)
- (libraries ocplib-ocamlres.runtime bigarray)
+ (libraries ocplib-ocamlres.runtime bigarray
+            learnocaml_toplevel_pp
+            vg gg vg.svg
+            re)
 )
 
 (rule
@@ -177,6 +196,7 @@
  (name grader_jsoo_worker)
  (modes byte)
  (flags :standard -warn-error -9-27)
+ (link_flags :standard -linkall)
  (libraries toploop_jsoo
             grading
             ezjsonm

src/toplevel/dune

@@ -34,6 +34,14 @@
  (modules Learnocaml_toplevel_history)
 )
 
+(library
+  (name learnocaml_toplevel_pp)
+  (wrapped false)
+  (modes byte)
+  (libraries vg gg vg.svg)
+  (modules Learnocaml_toplevel_pp)
+)
+
 (library
  (name learnocaml_toplevel)
  (wrapped false)
@@ -48,6 +56,7 @@
             ocplib-json-typed
             learnocaml_toplevel_history
             learnocaml_toplevel_worker_messages
+            learnocaml_toplevel_pp
             ocplib_i18n)
  (modules Learnocaml_toplevel_worker_caller
           Learnocaml_toplevel_output
@@ -56,6 +65,8 @@
  (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx))
 )
 
+
+
 (install
  (package learn-ocaml)
  (section share)

src/toplevel/learnocaml_toplevel.ml

@@ -380,6 +380,22 @@ let wrap_flusher_to_prevent_flood top name hook real =
       flooded := total
     end
 
+let load_pp err top pps =
+  let prelude_pp =
+    Format.sprintf "open Learnocaml_toplevel_pp;; %s"
+      Learnocaml_toplevel_pp.prelude_pp
+  in
+  let rec loading = function
+    | [] -> Lwt.return_unit
+    | code :: cs ->
+      load ~print_outcome:false top code
+      >>= (fun _ -> loading cs)
+  in
+  let pps =
+    List.map (fun pp -> Format.sprintf "#install_printer %s;;" pp) pps
+  in
+  err >>= (fun _ -> loading (prelude_pp::pps))
+
 let welcome_phrase () =
   [%i"Printf.printf \"Welcome to OCaml %s\\n%!\" (Sys.ocaml_version);\n\
       print_endline \" - type your OCaml phrase in the box below and press [Enter]\";\n\
@@ -495,10 +511,16 @@ let create
     else
       first_time := false ;
     Learnocaml_toplevel_worker_caller.register_callback worker "print_html"
-      (Learnocaml_toplevel_output.output_html output) >>= fun _ ->
+      (Learnocaml_toplevel_output.output_html output)
+    >>= fun _ ->
+      Learnocaml_toplevel_worker_caller.register_callback worker "print_svg"
+        (Learnocaml_toplevel_output.output_svg output)
+    >>= fun err -> load_pp (Lwt.return err) top Learnocaml_toplevel_pp.pp_list
+    >>= fun _ ->
     match after_init with
     | None -> Lwt.return_unit
-    | Some f -> f top in
+    | Some f -> f top
+  in
   after_init top >>= fun () ->
   Learnocaml_toplevel_worker_caller.set_after_init top.worker (fun _ -> after_init top);
   Lwt.return top

src/toplevel/learnocaml_toplevel_output.ml

@@ -180,6 +180,37 @@ let output_html ?phrase output html =
   Js_utils.Manip.appendChild output.container div ;
   insert output ?phrase (Html (html, div)) div
 
+let get_fresh_id =
+  let r = ref 0 in
+  fun () -> incr r ; !r
+
+(* It replaces markup field id by "id-<number>" to avoid interferences 
+   between svg images when they are inserted in the same DOM. 
+   In other words, we ensure that every identifier is unique. *)
+let replace_markup idx markup svg =
+  let open Re in
+  let f g = Format.sprintf " %s=\"%s-%d\"" markup (Group.get g 1) idx in
+  let regexp = Format.sprintf "[ ]+%s=\"(#?[A-Za-z0-9]+)\"" markup in
+  let regexp = Posix.compile_pat regexp in
+  replace ~f regexp svg
+
+(* It adapts link markup to be supported in web app. *)
+let replace_link svg =
+  let open Re in
+  let regexp = Posix.compile_pat "l:href" in
+  replace_string regexp ~by:"href" svg
+
+(* It cleans the svg string to be readable in the web app. *)
+let rewrite_svg svg =
+  let idx = get_fresh_id () in
+  replace_markup idx "id" svg
+  |> replace_markup idx "l:href"
+  |> replace_link
+
+let output_svg ?phrase output svg =
+  let svg = rewrite_svg svg  in
+  output_html ?phrase output svg
+
 let output_code ?phrase output code =
   let snapshot =
     let blocks = match phrase with

src/toplevel/learnocaml_toplevel_output.mli

@@ -77,6 +77,8 @@ val output_stderr : ?phrase: phrase -> output -> string -> unit
 (** Output HTML in a [div] element with class [toplevel-html-block]. *)
 val output_html : ?phrase: phrase -> output -> string -> unit
 
+val output_svg : ?phrase: phrase -> output -> string -> unit
+
 (** Output ocaml code in a [pre] element with class [toplevel-code].
     Code tokens are wrapped in [span] elements with classes as
     documented in {!Ocaml_mode.token_type}. An intermediate level of

src/toplevel/learnocaml_toplevel_pp.ml

@@ -0,0 +1,33 @@
+(* 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. *)
+
+
+(** [construct_image img] renders an image as a svg code string. This code is
+    used to display the image in the toplevel, using the toplevel directive
+    "#install_printer".
+
+    The size isn't taken into account in this function because a pretty printer
+    doesn't take one. *)
+let construct_image i =
+  let coeff = 1.0 in
+  let b = Buffer.create 2048 in
+  let size = Gg.Size2.v (coeff *. 100.) (coeff *. 100.) in
+  let view = Gg.Box2.v Gg.P2.o (Gg.Size2.v coeff coeff) in
+  let r = Vg.Vgr.create (Vgr_svg.target ()) (`Buffer b) in
+  ignore (Vg.Vgr.render r (`Image (size, view, i)));
+  ignore (Vg.Vgr.render r `End);
+  Buffer.contents b
+
+(* Prelude for pretty printers *)
+let prelude_pp = "let pp_svg _ i = construct_image i |> print_svg;;"
+
+
+(* List of pretty printers to deploy in toplevel *)
+let pp_list = [
+ "pp_svg";
+]