pkg: utop dev tool (ocaml#12027)

This adds utop as a dev tool. Unlike most dev tools there is no "dune
tools exec utop" command, but rather the existing "dune utop" command
has been modified such that if a lockdir exists for the utop dev tool,
then dune will install the utop library (downloading it if necessary)
within the _build directory and use that library to create the custom
utop toplevel for the project.

It's possible to install utop as a dev tool without running it by
running the "dune tools install utop" command.

Signed-off-by: Stephen Sherratt <[email protected]>

Author: gridbugs

bin/lock_dev_tool.ml

@@ -247,12 +247,8 @@ let lock_ocamlformat () =
   lock_dev_tool_at_version Ocamlformat version
 ;;
 
-let lock_odoc () = lock_dev_tool_at_version Odoc None
-let lock_ocamllsp () = lock_dev_tool_at_version Ocamllsp None
-
 let lock_dev_tool dev_tool =
   match (dev_tool : Dune_pkg.Dev_tool.t) with
   | Ocamlformat -> lock_ocamlformat ()
-  | Odoc -> lock_odoc ()
-  | Ocamllsp -> lock_ocamllsp ()
+  | other -> lock_dev_tool_at_version other None
 ;;

bin/ocaml/utop.ml

@@ -12,6 +12,12 @@ let man =
 
 let info = Cmd.info "utop" ~doc ~man
 
+let lock_utop_if_dev_tool_enabled () =
+  match Lazy.force Lock_dev_tool.is_enabled with
+  | false -> Memo.return ()
+  | true -> Lock_dev_tool.lock_dev_tool Utop
+;;
+
 let term =
   let+ builder = Common.Builder.term
   and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR")
@@ -21,25 +27,41 @@ let term =
   let dir = Common.prefix_target common dir in
   if not (Path.is_directory (Path.of_string dir))
   then User_error.raise [ Pp.textf "cannot find directory: %s" (String.maybe_quoted dir) ];
-  let env, lib_config, utop_path, requires =
+  let env, utop_path =
     Scheduler.go_with_rpc_server ~common ~config (fun () ->
       let open Fiber.O in
       let* setup = Import.Main.setup () in
       build_exn (fun () ->
         let open Memo.O in
         let* setup = setup in
         let context = Import.Main.find_context_exn setup ~name:ctx_name in
-        let utop_target =
-          let utop_target = Filename.concat dir Utop.utop_exe in
-          Path.build (Path.Build.relative (Context.build_dir context) utop_target)
+        let utop_target_path filename =
+          Path.build
+            (Path.Build.relative
+               (Context.build_dir context)
+               (Filename.concat dir filename))
         in
-        Build_system.file_exists utop_target
+        let utop_exe = utop_target_path Utop.utop_exe in
+        let utop_findlib_conf = utop_target_path Utop.utop_findlib_conf in
+        Build_system.file_exists utop_exe
         >>= function
         | false ->
           User_error.raise
             [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ]
         | true ->
-          let* () = Build_system.build_file utop_target in
+          let* () = Build_system.build_file utop_exe in
+          let* () = lock_utop_if_dev_tool_enabled () in
+          let* utop_dev_tool_lock_dir_exists =
+            Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists
+          in
+          let* () =
+            if utop_dev_tool_lock_dir_exists
+            then
+              (* Generate the custom findlib.conf file needed when utop is run
+                 as a dev tool. *)
+              Build_system.build_file utop_findlib_conf
+            else Memo.return ()
+          in
           let sctx = Import.Main.find_scontext_exn setup ~name:ctx_name in
           let* requires =
             let dir = Path.Build.relative (Context.build_dir context) dir in
@@ -50,15 +72,29 @@ let term =
             let+ ocaml = Context.ocaml context in
             ocaml.lib_config
           and+ env = Super_context.context_env sctx in
-          env, lib_config, Path.to_string utop_target, requires))
+          let env =
+            Dune_rules.Lib_flags.L.toplevel_ld_paths requires lib_config
+            |> Path.Set.fold
+                 ~f:(fun dir env ->
+                   Env_path.cons ~var:Ocaml.Env.caml_ld_library_path env ~dir)
+                 ~init:env
+          in
+          let env =
+            if utop_dev_tool_lock_dir_exists
+            then
+              (* If there's a utop lockdir then dune will have built utop as a
+                 dev tool. In order for it to run correctly dune needed to
+                 generate a custom findlib.conf that contains the locations of
+                 all of utop's dependencies within the project's _build
+                 directory. Setting this environment variable causes the custom
+                 findlib.conf file to be used instead of the default
+                 findlib.conf. *)
+              Env.add env ~var:"OCAMLFIND_CONF" ~value:(Path.to_string utop_findlib_conf)
+            else env
+          in
+          env, Path.to_string utop_exe))
   in
   Hooks.End_of_build.run ();
-  let env =
-    Dune_rules.Lib_flags.L.toplevel_ld_paths requires lib_config
-    |> Path.Set.fold
-         ~f:(fun dir env -> Env_path.cons ~var:Ocaml.Env.caml_ld_library_path env ~dir)
-         ~init:env
-  in
   restore_cwd_and_execve (Common.root common) utop_path args env
 ;;
 

bin/tools/tools.ml

@@ -11,7 +11,7 @@ module Install = struct
   let info = Cmd.info ~doc "install"
 
   let group =
-    Cmd.group info (List.map [ Ocamlformat; Ocamllsp ] ~f:Tools_common.install_command)
+    Cmd.group info (List.map Dune_pkg.Dev_tool.all ~f:Tools_common.install_command)
   ;;
 end
 
@@ -20,7 +20,7 @@ module Which = struct
   let info = Cmd.info ~doc "which"
 
   let group =
-    Cmd.group info (List.map [ Ocamlformat; Ocamllsp ] ~f:Tools_common.which_command)
+    Cmd.group info (List.map Dune_pkg.Dev_tool.all ~f:Tools_common.which_command)
   ;;
 end
 

src/dune_pkg/dev_tool.ml

@@ -4,46 +4,60 @@ type t =
   | Ocamlformat
   | Odoc
   | Ocamllsp
+  | Utop
 
-let all = [ Ocamlformat; Odoc; Ocamllsp ]
+let to_dyn = function
+  | Ocamlformat -> Dyn.variant "Ocamlformat" []
+  | Odoc -> Dyn.variant "Odoc" []
+  | Ocamllsp -> Dyn.variant "Ocamllsp" []
+  | Utop -> Dyn.variant "Utop" []
+;;
+
+let all = [ Ocamlformat; Odoc; Ocamllsp; Utop ]
 
 let equal a b =
   match a, b with
   | Ocamlformat, Ocamlformat -> true
   | Odoc, Odoc -> true
   | Ocamllsp, Ocamllsp -> true
-  | _ -> false
+  | Utop, Utop -> true
+  | (Ocamlformat | Odoc | Ocamllsp | Utop), _ -> false
 ;;
 
 let package_name = function
   | Ocamlformat -> Package_name.of_string "ocamlformat"
   | Odoc -> Package_name.of_string "odoc"
   | Ocamllsp -> Package_name.of_string "ocaml-lsp-server"
+  | Utop -> Package_name.of_string "utop"
 ;;
 
 let of_package_name package_name =
   match Package_name.to_string package_name with
   | "ocamlformat" -> Ocamlformat
   | "odoc" -> Odoc
   | "ocaml-lsp-server" -> Ocamllsp
+  | "utop" -> Utop
   | other -> User_error.raise [ Pp.textf "No such dev tool: %s" other ]
 ;;
 
 let exe_name = function
   | Ocamlformat -> "ocamlformat"
   | Odoc -> "odoc"
   | Ocamllsp -> "ocamllsp"
+  | Utop -> "utop"
 ;;
 
 let exe_path_components_within_package t =
   match t with
   | Ocamlformat -> [ "bin"; exe_name t ]
   | Odoc -> [ "bin"; exe_name t ]
   | Ocamllsp -> [ "bin"; exe_name t ]
+  | Utop -> [ "bin"; exe_name t ]
 ;;
 
 let needs_to_build_with_same_compiler_as_project = function
   | Ocamlformat -> false
   | Odoc -> true
   | Ocamllsp -> true
+  | Utop -> false
 ;;

src/dune_pkg/dev_tool.mli

@@ -4,7 +4,9 @@ type t =
   | Ocamlformat
   | Odoc
   | Ocamllsp
+  | Utop
 
+val to_dyn : t -> Dyn.t
 val all : t list
 val equal : t -> t -> bool
 val package_name : t -> Package_name.t

src/dune_pkg/lock_dir.mli

@@ -12,6 +12,7 @@ module Pkg_info : sig
     ; extra_sources : (Path.Local.t * Source.t) list
     }
 
+  val to_dyn : t -> Dyn.t
   val default_version : Package_version.t
   val variables : t -> OpamVariable.variable_contents Package_variable_name.Map.t
 end

src/dune_rules/context.ml

@@ -438,7 +438,7 @@ let create (builder : Builder.t) ~(kind : Kind.t) =
         Pp.textf "loading OCAMLPATH for context %S" (Context_name.to_string builder.name))
       (fun () ->
          match kind with
-         | Lock _ -> Pkg_rules.ocamlpath builder.name
+         | Lock _ -> Pkg_rules.project_ocamlpath builder.name
          | Default | Opam _ ->
            let+ ocamlpath = builder.env >>| Findlib_config.ocamlpath_of_env in
            Kind.ocamlpath kind ~ocamlpath ~findlib_toolchain:builder.findlib_toolchain)

src/dune_rules/findlib.ml

@@ -569,12 +569,11 @@ end
 
 type t = DB.t
 
-let create =
+let create_with_paths ~paths =
   Per_context.create_by_name ~name:"findlib" (fun context ->
     Memo.lazy_ (fun () ->
       let* context = Context.DB.get context in
-      let* paths = Context.findlib_paths context
-      and* lib_config =
+      let* lib_config =
         let+ ocaml = Context.ocaml context in
         ocaml.lib_config
       in
@@ -583,4 +582,10 @@ let create =
   |> Staged.unstage
 ;;
 
+let create context_name =
+  let* context = Context.DB.get context_name in
+  let* paths = Context.findlib_paths context in
+  create_with_paths context_name ~paths
+;;
+
 include Public

src/dune_rules/findlib.mli

@@ -32,6 +32,10 @@ val all_broken_packages : t -> (Package.Name.t * User_message.t) list Memo.t
 
 val create : Context_name.t -> t Memo.t
 
+(** Create a findlib database with a given list of paths corresponding to the
+    "path" field in the findlib.conf file. *)
+val create_with_paths : paths:Path.t list -> Context_name.t -> t Memo.t
+
 module For_tests : sig
   val create : paths:Path.t list -> lib_config:Lib_config.t -> t Memo.t
 end

src/dune_rules/lib.ml

@@ -1954,6 +1954,18 @@ module DB = struct
           Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name)
   ;;
 
+  let with_parent t ~parent = { t with parent }
+
+  let of_paths context ~paths =
+    let open Memo.O in
+    let+ ocaml = Context.ocaml context
+    and+ findlib = Findlib.create_with_paths (Context.name context) ~paths in
+    create_from_findlib
+      findlib
+      ~has_bigarray_library:(Ocaml.Version.has_bigarray_library ocaml.version)
+      ~instrument_with:(Context.instrument_with context)
+  ;;
+
   let installed (context : Context.t) =
     let open Memo.O in
     let+ ocaml = Context.ocaml context