From ab91e5dee06e80a48d140de0783cdbfbd4006785 Mon Sep 17 00:00:00 2001
From: cqc <cqc@conrailqualitycontent.net>
Date: Fri, 3 Mar 2023 18:47:24 -0600
Subject: [PATCH] toplevel emits round trip pprint of ast to console.

---
 dune         | 38 ++++++++++++++---------------------
 log_js.ml    | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 ppx_graph.ml | 11 +++++++++++
 toplevel.ml  | 18 ++++++++++++++++-
 4 files changed, 99 insertions(+), 24 deletions(-)
 create mode 100644 log_js.ml
 create mode 100644 ppx_graph.ml

diff --git a/dune b/dune
index 5675309..3d29515 100644
--- a/dune
+++ b/dune
@@ -4,6 +4,15 @@
    (build_runtime_flags :standard --no-inline --debug-info)
    (link_flags :standard))))
 
+(library
+ (name log_js)
+  (modes byte)
+ (preprocess (pps js_of_ocaml-ppx))
+ (flags (:standard -rectypes -linkall))
+ (modules log_js)
+ (libraries
+   logs))
+
 (executable
  (name boot_js)
  (modes byte js)
@@ -12,7 +21,6 @@
  (modules boot_js human)
  (libraries
    fmt
-   logs
    graphv_webgl
    js_of_ocaml-lwt
    js_of_ocaml-compiler
@@ -27,12 +35,12 @@
    uri
    gg
    lwd
+   log_js
 ))
 
 (executables
  (names toplevel)
- (modules
-  (:standard \ human boot_js test_dynlink examples))
+ (modules toplevel ppx_graph)
  (libraries
   js_of_ocaml-compiler
   js_of_ocaml-tyxml
@@ -42,29 +50,13 @@
   ;; not used directly
   graphics
   js_of_ocaml.deriving
+  js_of_ocaml-lwt.graphics
+  js_of_ocaml-ppx.as-lib
+  ocp-indent.lib
   react
   reactiveData
   str
-  (select
-   ocp_indent.ml
-   from
-   (ocp-indent.lib -> ocp_indent.ok.ml)
-   (-> ocp_indent.fake.ml))
-  (select
-   colorize.ml
-   from
-   (higlo -> colorize.higlo.ml)
-   (!higlo -> colorize.fake.ml))
-  (select
-   graphics_support.ml
-   from
-   (js_of_ocaml-lwt.graphics -> graphics_support.enabled.ml)
-   (-> graphics_support.disabled.ml))
-  (select
-   ppx_support.ml
-   from
-   (js_of_ocaml-ppx -> ppx_support.enabled.ml)
-   (-> ppx_support.disabled.ml)))
+  log_js)
  (flags
   (:standard -rectypes -linkall))
  (modes byte)
diff --git a/log_js.ml b/log_js.ml
new file mode 100644
index 0000000..de0512d
--- /dev/null
+++ b/log_js.ml
@@ -0,0 +1,56 @@
+module Logs_reporter = struct
+  (* Console reporter *)
+
+  open Jsoo_runtime
+
+  let console : Logs.level -> string -> unit =
+   fun level s ->
+    let meth =
+      match level with
+      | Logs.Error -> "error"
+      | Logs.Warning -> "warn"
+      | Logs.Info -> "info"
+      | Logs.Debug -> "debug"
+      | Logs.App -> "log"
+    in
+    ignore
+      (Js.meth_call
+         (Js.pure_js_expr "console")
+         meth
+         [| Js.string s |])
+
+  let ppf, flush =
+    let b = Buffer.create 255 in
+    let flush () =
+      let s = Buffer.contents b in
+      Buffer.clear b;
+      s
+    in
+    (Format.formatter_of_buffer b, flush)
+
+  let hook =
+    ref (fun level s ->
+        ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
+
+  let console_report _src level ~over k msgf =
+    let k _ =
+      let s = flush () in
+      console level s;
+      !hook level s;
+      over ();
+      k ()
+    in
+    msgf @@ fun ?header ?tags fmt ->
+    let _tags = tags in
+    match header with
+    | None -> Format.kfprintf k ppf ("@[" ^^ fmt ^^ "@]@.")
+    | Some h -> Format.kfprintf k ppf ("[%s] @[" ^^ fmt ^^ "@]@.") h
+
+  let console_reporter () = { Logs.report = console_report }
+end
+
+let _ =
+  Logs.set_reporter (Logs_reporter.console_reporter ());
+  Logs.set_level (Some Debug)
+
+module Log = Logs
diff --git a/ppx_graph.ml b/ppx_graph.ml
new file mode 100644
index 0000000..15e7868
--- /dev/null
+++ b/ppx_graph.ml
@@ -0,0 +1,11 @@
+open Ppxlib
+open Log_js
+
+let log_info pp exp =
+  Log.info (fun m -> m "ppx_graph: %a" pp exp);
+  exp
+
+let init () =
+  Driver.register_transformation
+    ~impl:(log_info Ocaml_common.Pprintast.structure)
+    "ppx_graph"
diff --git a/toplevel.ml b/toplevel.ml
index 9050556..abbadb3 100644
--- a/toplevel.ml
+++ b/toplevel.ml
@@ -28,9 +28,25 @@ module Graphics_support = struct
   let init elt = Graphics_js.open_canvas elt
 end
 
+open Log_js
+
 module Ppx_support = struct
   let init () =
-    Ast_mapper.register "js_of_ocaml" (fun _ -> Ppx_js.mapper)
+    Ppx_graph.init ();
+    Ast_mapper.register "js_of_ocaml" (fun _ -> Ppx_js.mapper);
+    Ast_mapper.register "ppxlib" (fun _ ->
+        Log.info (fun m -> m "Ppxlib.mapper");
+        {
+          Ast_mapper.default_mapper with
+          structure =
+            (fun _ ->
+              Log.info (fun m -> m "Ppxlib.Driver.map_structure");
+              Ppxlib.Driver.map_structure);
+          signature =
+            (fun _ ->
+              Log.info (fun m -> m "Ppxlib.Driver.map_signature");
+              Ppxlib.Driver.map_signature);
+        })
 end
 
 module Colorize = struct