Add a dune top command for better toplevel integration (#2952)

Add a "dune top" command one is expected to call via:

# #use_output "dune top";;

In the toplevel. This command should work in any toplevel.

CHANGES.md

@@ -32,6 +32,10 @@ Unreleased
 - `dune upgrade` will now try to upgrade projects using versions <2.0 to version
   2.0 of the dune language. (#3174, @voodoos)
 
+- Add a `top` command to integrate dune with any toplevel, not just
+  utop. It is meant to be used with the new `#use_output` directive of
+  OCaml 4.11 (#2952, @mbernat, @diml)
+
 2.4.0 (06/03/2020)
 ------------------
 

bin/main.ml

@@ -194,6 +194,7 @@ let all =
   ; Upgrade.command
   ; Caching.command
   ; Describe.command
+  ; Top.command
   ]
 
 let common_commands_synopsis =

bin/top.ml

@@ -0,0 +1,58 @@
+open Stdune
+open Import
+
+let doc =
+  "Print a list of toplevel directives for including directories and loading \
+   cma files."
+
+let man =
+  [ `S "DESCRIPTION"
+  ; `P
+      {|Print a list of toplevel directives for including directories and loading cma files.|}
+  ; `P
+      {|The output of $(b,dune toplevel-init-file) should be evaluated in a toplevel
+          to make a library available there.|}
+  ; `Blocks Common.help_secs
+  ]
+
+let info = Term.info "top" ~doc ~man
+
+let link_deps link ~lib_config =
+  List.concat_map link ~f:(fun t ->
+      Dune.Lib.link_deps t Dune.Link_mode.Byte lib_config)
+
+let term =
+  let+ common = Common.term
+  and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR")
+  and+ ctx_name =
+    Common.context_arg ~doc:{|Select context where to build/run utop.|}
+  in
+  Common.set_common common ~targets:[];
+  Scheduler.go ~common (fun () ->
+      let open Fiber.O in
+      let* setup = Import.Main.setup common in
+      let sctx =
+        Dune.Context_name.Map.find setup.scontexts ctx_name |> Option.value_exn
+      in
+      let dir =
+        Path.Build.relative
+          (Super_context.build_dir sctx)
+          (Common.prefix_target common dir)
+      in
+      let scope = Super_context.find_scope_by_dir sctx dir in
+      let db = Dune.Scope.libs scope in
+      let libs = Dune.Utop.libs_under_dir sctx ~db ~dir:(Path.build dir) in
+      let requires = Dune.Lib.closure ~linking:true libs |> Result.ok_exn in
+      let include_paths = Dune.Lib.L.include_paths requires in
+      let lib_config = sctx |> Super_context.context |> Context.lib_config in
+      let files = link_deps requires ~lib_config in
+      let* () = do_build (List.map files ~f:(fun f -> Target.File f)) in
+      let files_to_load =
+        List.filter files ~f:(fun p ->
+            let ext = Path.extension p in
+            ext = Dune.Mode.compiled_lib_ext Byte || ext = Dune.Cm_kind.ext Cmo)
+      in
+      Dune.Toplevel.print_toplevel_init_file ~include_paths ~files_to_load;
+      Fiber.return ())
+
+let command = (term, info)

doc/dune.inc

@@ -152,6 +152,15 @@
  (package dune)
  (files   dune-subst.1))
 
+(rule
+ (with-stdout-to dune-top.1
+  (run dune top --help=groff)))
+
+(install
+ (section man)
+ (package dune)
+ (files   dune-top.1))
+
 (rule
  (with-stdout-to dune-uninstall.1
   (run dune uninstall --help=groff)))

doc/index.rst

@@ -29,3 +29,4 @@ Welcome to dune's documentation!
    known-issues
    migration
    caching
+   toplevel-integration

doc/toplevel-integration.rst

@@ -0,0 +1,14 @@
+********************
+Toplevel integration
+********************
+
+It's possible to load dune projects in any toplevel. This is achieved in two stages.
+
+First, `dune toplevel-init-file` builds the project and produces a list of toplevel pragmas
+(#directory and #load). Copying the output of this command to a toplevel lets you
+interact with the project's modules.
+
+Second, to enhance usability, dune also provides a toplevel script, which does the above
+manual work for you. To use it, make sure to have `topfind` available in your toplevel by
+invoking `#use "topfind";;`. Afterwards you can run `#use "dune";;` and your
+modules should be available.

src/dune/context.ml

@@ -442,6 +442,8 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
                   (Config.local_install_dir ~context:name)
                   "lib/stublibs"))
         ; extend_var "OCAMLPATH" ~path_sep:ocamlpath_sep local_lib_path
+        ; extend_var "OCAMLTOP_INCLUDE_PATH"
+            (Path.relative local_lib_path "toplevel")
         ; extend_var "OCAMLFIND_IGNORE_DUPS_IN" ~path_sep:ocamlpath_sep
             local_lib_path
         ; extend_var "MANPATH"

src/dune/toplevel.ml

@@ -93,6 +93,13 @@ let setup_rules t =
     (Build.symlink ~src:(Path.build src) ~dst);
   setup_module_rules t
 
+let print_toplevel_init_file ~include_paths ~files_to_load =
+  let includes = Path.Set.to_list include_paths in
+  List.iter includes ~f:(fun p ->
+      print_endline ("#directory \"" ^ Path.to_absolute_filename p ^ "\";;"));
+  List.iter files_to_load ~f:(fun p ->
+      print_endline ("#load \"" ^ Path.to_absolute_filename p ^ "\";;"))
+
 module Stanza = struct
   let setup ~sctx ~dir ~(toplevel : Dune_file.Toplevel.t) =
     let source = Source.of_stanza ~dir ~toplevel in

src/dune/toplevel.mli

@@ -18,6 +18,9 @@ val setup_rules : t -> unit
 
 val make : cctx:Compilation_context.t -> source:Source.t -> t
 
+val print_toplevel_init_file :
+  include_paths:Path.Set.t -> files_to_load:Path.t list -> unit
+
 module Stanza : sig
   val setup :
        sctx:Super_context.t

src/dune/utop.mli

@@ -8,4 +8,6 @@ val utop_exe : string
 
 val is_utop_dir : Path.Build.t -> bool
 
+val libs_under_dir : Super_context.t -> db:Lib.DB.t -> dir:Path.t -> Lib.L.t
+
 val setup : Super_context.t -> dir:Path.Build.t -> unit

test/blackbox-tests/dune.inc

@@ -1910,6 +1910,14 @@
    test-cases/tests-stanza-action-syntax-version
    (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
 
+(rule
+ (alias toplevel-integration)
+ (deps (package dune) (source_tree test-cases/toplevel-integration))
+ (action
+  (chdir
+   test-cases/toplevel-integration
+   (progn (run dune-cram run run.t) (diff? run.t run.t.corrected)))))
+
 (rule
  (alias toplevel-stanza)
  (deps (package dune) (source_tree test-cases/toplevel-stanza))
@@ -2632,6 +2640,7 @@
   (alias tests-stanza)
   (alias tests-stanza-action)
   (alias tests-stanza-action-syntax-version)
+  (alias toplevel-integration)
   (alias toplevel-stanza)
   (alias trace-file)
   (alias transitive-deps-mode)
@@ -2891,6 +2900,7 @@
   (alias tests-stanza)
   (alias tests-stanza-action)
   (alias tests-stanza-action-syntax-version)
+  (alias toplevel-integration)
   (alias toplevel-stanza)
   (alias trace-file)
   (alias transitive-deps-mode)

test/blackbox-tests/test-cases/toplevel-integration/run.t

@@ -0,0 +1,50 @@
+Test toplevel-init-file on a tiny project
+----------------------------------------------------
+  $ cat >dune-project <<EOF
+  > (lang dune 2.1)
+  > (name test)
+  > EOF
+  $ cat >dune <<EOF
+  > (library
+  >  (name test)
+  >  (public_name test))
+  > EOF
+  $ touch test.opam
+  $ cat >main.ml <<EOF
+  > let hello () = print_endline "hello"
+  > EOF
+
+  $ dune top
+  #directory "$TESTCASE_ROOT/_build/default/.test.objs/byte";;
+  #directory "$TESTCASE_ROOT/_build/default/.test.objs/native";;
+  #load "$TESTCASE_ROOT/_build/default/test.cma";;
+
+  $ ocaml -stdin <<EOF
+  > #use "topfind";;
+  > #use "use_output_compat";;
+  > #use_output "dune top";;
+  > Test.Main.hello ();;
+  > EOF
+  hello
+
+  $ cat >error.ml <<EOF
+  > let oops () = undefined_function ()
+  > EOF
+
+  $ dune top
+  File "error.ml", line 1, characters 14-32:
+  1 | let oops () = undefined_function ()
+                    ^^^^^^^^^^^^^^^^^^
+  Error: Unbound value undefined_function
+  [1]
+
+  $ ocaml -stdin <<EOF
+  > #use "topfind";;
+  > #use "use_output_compat";;
+  > #use_output "dune top";;
+  > EOF
+  File "error.ml", line 1, characters 14-32:
+  1 | let oops () = undefined_function ()
+                    ^^^^^^^^^^^^^^^^^^
+  Error: Unbound value undefined_function
+  Command exited with code 1.

test/blackbox-tests/test-cases/toplevel-integration/use_output_compat

@@ -0,0 +1,27 @@
+(* -*- tuareg -*- *)
+
+let try_finally ~always f =
+  match f () with
+  | x ->
+    always ();
+    x
+  | exception e ->
+    always ();
+    raise e
+
+let use_output command =
+  let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+  try_finally
+    ~always:(fun () -> try Sys.remove fn with Sys_error _ -> ())
+    (fun () ->
+      match
+        Printf.ksprintf Sys.command "%s > %s" command (Filename.quote fn)
+      with
+      | 0 -> ignore (Toploop.use_file Format.std_formatter fn : bool)
+      | n -> Format.printf "Command exited with code %d.@." n)
+
+let () =
+  let name = "use_output" in
+  if not (Hashtbl.mem Toploop.directive_table name) then
+    Hashtbl.add Toploop.directive_table name
+      (Toploop.Directive_string use_output)