Merge pull request #10914 from gridbugs/dev-tool-odoc

Add odoc dev tool

bin/build_cmd.ml

@@ -241,8 +241,7 @@ let fmt =
              this logic remain outside of `dune build`, as `dune
              build` is intended to only build targets, and generating
              a lockdir is not building a target. *)
-          Action_builder.of_memo
-            (Lock_dev_tool.lock_ocamlformat () |> Memo.of_non_reproducible_fiber)
+          Action_builder.of_memo (Lock_dev_tool.lock_ocamlformat ())
         else Action_builder.return ()
       in
       let dir = Path.(relative root) (Common.prefix_target common ".") in

bin/lock_dev_tool.ml

@@ -1,5 +1,6 @@
 open Dune_config
 open Import
+module Lock_dir = Dune_pkg.Lock_dir
 
 let enabled =
   Config.make_toggle ~name:"lock_dev_tool" ~default:Dune_rules.Setup.lock_dev_tool
@@ -15,7 +16,7 @@ let is_enabled =
 (* The solver satisfies dependencies for local packages, but dev tools
    are not local packages. As a workaround, create an empty local package
    which depends on the dev tool package. *)
-let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version
+let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_dependencies
   : Dune_pkg.Local_package.t
   =
   let dev_tool_pkg_name = Dune_pkg.Dev_tool.package_name dev_tool in
@@ -35,7 +36,7 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version
   in
   { Dune_pkg.Local_package.name = local_package_name
   ; version = None
-  ; dependencies = [ dependency ]
+  ; dependencies = dependency :: extra_dependencies
   ; conflicts = []
   ; depopts = []
   ; pins = Package_name.Map.empty
@@ -44,39 +45,166 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version
   }
 ;;
 
-let solve ~local_packages ~lock_dirs =
-  let open Fiber.O in
+let solve ~dev_tool ~local_packages =
+  let open Memo.O in
   let* solver_env_from_current_system =
     Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial)
     |> Dune_pkg.Sys_poll.solver_env_from_current_system
+    |> Memo.of_reproducible_fiber
     >>| Option.some
-  and* workspace =
-    Memo.run
-    @@
-    let open Memo.O in
-    let+ workspace = Workspace.workspace () in
-    workspace
+  and* workspace = Workspace.workspace () in
+  let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
+  Memo.of_reproducible_fiber
+  @@ Lock.solve
+       workspace
+       ~local_packages
+       ~project_sources:Dune_pkg.Pin_stanza.DB.empty
+       ~solver_env_from_current_system
+       ~version_preference:None
+       ~lock_dirs:[ lock_dir ]
+;;
+
+let compiler_package_name = Package_name.of_string "ocaml"
+
+(* Some dev tools must be built with the same version of the ocaml
+   compiler as the project. This function returns the version of the
+   "ocaml" package used to compile the project in the default build
+   context.
+
+   TODO: This only makes sure that the version of compiler used to
+   build the dev tool matches the version of the compiler used to
+   build this project. This will fail if the project is built with a
+   custom compiler (e.g. ocaml-variants) since the version of the
+   compiler will be the same between the project and dev tool while
+   they still use different compilers. A more robust solution would be
+   to ensure that the exact compiler package used to build the dev
+   tool matches the package used to build the compiler. *)
+let locked_ocaml_compiler_version () =
+  let open Memo.O in
+  let context =
+    (* Dev tools are only ever built with the default context. *)
+    Context_name.default
   in
-  Lock.solve
-    workspace
-    ~local_packages
-    ~project_sources:Dune_pkg.Pin_stanza.DB.empty
-    ~solver_env_from_current_system
-    ~version_preference:None
-    ~lock_dirs
+  let* result = Dune_rules.Lock_dir.get context in
+  match result with
+  | Error _ ->
+    User_error.raise
+      [ Pp.text "Unable to load the lockdir for the default build context." ]
+      ~hints:
+        [ Pp.concat
+            ~sep:Pp.space
+            [ Pp.text "Try running"; User_message.command "dune pkg lock" ]
+        ]
+  | Ok { packages; _ } ->
+    (match Package_name.Map.find packages compiler_package_name with
+     | None ->
+       User_error.raise
+         [ Pp.textf
+             "The lockdir doesn't contain a lockfile for the package %S."
+             (Package_name.to_string compiler_package_name)
+         ]
+         ~hints:
+           [ Pp.concat
+               ~sep:Pp.space
+               [ Pp.textf
+                   "Add a dependency on %S to one of the packages in dune-project and \
+                    then run"
+                   (Package_name.to_string compiler_package_name)
+               ; User_message.command "dune pkg lock"
+               ]
+           ]
+     | Some pkg -> Memo.return pkg.info.version)
 ;;
 
-let lock_ocamlformat () : unit Fiber.t =
-  let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in
-  let ocamlformat_dev_tool_lock_dir =
-    Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat
+(* Returns a dependency constraint on the version of the ocaml
+   compiler in the lockdir associated with the default context. *)
+let locked_ocaml_compiler_constraint () =
+  let open Dune_lang in
+  let open Memo.O in
+  let+ ocaml_compiler_version = locked_ocaml_compiler_version () in
+  let constraint_ =
+    Some
+      (Package_constraint.Uop
+         (Eq, String_literal (Package_version.to_string ocaml_compiler_version)))
+  in
+  { Package_dependency.name = compiler_package_name; constraint_ }
+;;
+
+let extra_dependencies dev_tool =
+  let open Memo.O in
+  match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with
+  | false -> Memo.return []
+  | true ->
+    let+ constraint_ = locked_ocaml_compiler_constraint () in
+    [ constraint_ ]
+;;
+
+let lockdir_status dev_tool =
+  let open Memo.O in
+  let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in
+  match Lock_dir.read_disk dev_tool_lock_dir with
+  | Error _ -> Memo.return `No_lockdir
+  | Ok { packages; _ } ->
+    (match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with
+     | false -> Memo.return `Lockdir_ok
+     | true ->
+       (match Package_name.Map.find packages compiler_package_name with
+        | None -> Memo.return `No_compiler_lockfile_in_lockdir
+        | Some { info; _ } ->
+          let+ ocaml_compiler_version = locked_ocaml_compiler_version () in
+          (match Package_version.equal info.version ocaml_compiler_version with
+           | true -> `Lockdir_ok
+           | false ->
+             `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed
+               (User_message.make
+                  [ Pp.textf
+                      "The version of the compiler package (%S) in this project's \
+                       lockdir has changed to %s (formerly the compiler version was %s). \
+                       The dev-tool %S will be re-locked and rebuilt with this version \
+                       of the compiler."
+                      (Package_name.to_string compiler_package_name)
+                      (Package_version.to_string ocaml_compiler_version)
+                      (Package_version.to_string info.version)
+                      (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string)
+                  ]))))
+;;
+
+let lock_dev_tool dev_tool version =
+  let open Memo.O in
+  let* need_to_solve =
+    lockdir_status dev_tool
+    >>| function
+    | `Lockdir_ok -> false
+    | `No_lockdir -> true
+    | `No_compiler_lockfile_in_lockdir ->
+      Console.print
+        [ Pp.textf
+            "The lockdir for %s lacks a lockfile for %s. Regenerating..."
+            (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string)
+            (Package_name.to_string compiler_package_name)
+        ];
+      true
+    | `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed message ->
+      Console.print_user_message message;
+      true
   in
-  if not (Path.exists @@ Path.source ocamlformat_dev_tool_lock_dir)
-  then (
+  if need_to_solve
+  then
+    let* extra_dependencies = extra_dependencies dev_tool in
     let local_pkg =
-      make_local_package_wrapping_dev_tool ~dev_tool:Ocamlformat ~dev_tool_version:version
+      make_local_package_wrapping_dev_tool
+        ~dev_tool
+        ~dev_tool_version:version
+        ~extra_dependencies
     in
     let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in
-    solve ~local_packages ~lock_dirs:[ ocamlformat_dev_tool_lock_dir ])
-  else Fiber.return ()
+    solve ~dev_tool ~local_packages
+  else Memo.return ()
 ;;
+
+let lock_ocamlformat () =
+  let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in
+  lock_dev_tool Ocamlformat version
+;;
+
+let lock_odoc () = lock_dev_tool Odoc None

bin/lock_dev_tool.mli

@@ -1,2 +1,5 @@
+open! Import
+
 val is_enabled : bool Lazy.t
-val lock_ocamlformat : unit -> unit Fiber.t
+val lock_ocamlformat : unit -> unit Memo.t
+val lock_odoc : unit -> unit Memo.t

bin/ocaml/doc.ml

@@ -13,12 +13,19 @@ let man =
 
 let info = Cmd.info "doc" ~doc ~man
 
+let lock_odoc_if_dev_tool_enabled () =
+  match Lazy.force Lock_dev_tool.is_enabled with
+  | false -> Action_builder.return ()
+  | true -> Action_builder.of_memo (Lock_dev_tool.lock_odoc ())
+;;
+
 let term =
   let+ builder = Common.Builder.term in
   let common, config = Common.init builder in
   let request (setup : Main.build_system) =
     let dir = Path.(relative root) (Common.prefix_target common ".") in
     let open Action_builder.O in
+    let* () = lock_odoc_if_dev_tool_enabled () in
     let+ () =
       Alias.in_dir ~name:Dune_rules.Alias.doc ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request

src/dune_pkg/dev_tool.ml

@@ -1,27 +1,42 @@
 open! Import
 
-type t = Ocamlformat
+type t =
+  | Ocamlformat
+  | Odoc
+
+let all = [ Ocamlformat; Odoc ]
 
 let equal a b =
   match a, b with
   | Ocamlformat, Ocamlformat -> true
+  | Odoc, Odoc -> true
+  | _ -> false
 ;;
 
 let package_name = function
   | Ocamlformat -> Package_name.of_string "ocamlformat"
+  | Odoc -> Package_name.of_string "odoc"
 ;;
 
 let of_package_name package_name =
   match Package_name.to_string package_name with
   | "ocamlformat" -> Ocamlformat
+  | "odoc" -> Odoc
   | other -> User_error.raise [ Pp.textf "No such dev tool: %s" other ]
 ;;
 
 let exe_name = function
   | Ocamlformat -> "ocamlformat"
+  | Odoc -> "odoc"
 ;;
 
 let exe_path_components_within_package t =
   match t with
   | Ocamlformat -> [ "bin"; exe_name t ]
+  | Odoc -> [ "bin"; exe_name t ]
+;;
+
+let needs_to_build_with_same_compiler_as_project = function
+  | Ocamlformat -> false
+  | Odoc -> true
 ;;

src/dune_pkg/dev_tool.mli

@@ -1,7 +1,10 @@
 open! Import
 
-type t = Ocamlformat
+type t =
+  | Ocamlformat
+  | Odoc
 
+val all : t list
 val equal : t -> t -> bool
 val package_name : t -> Package_name.t
 val of_package_name : Package_name.t -> t
@@ -10,3 +13,5 @@ val exe_name : t -> string
 (** Returns the path to this tool's executable relative to the root of
     this tool's package directory *)
 val exe_path_components_within_package : t -> string list
+
+val needs_to_build_with_same_compiler_as_project : t -> bool

src/dune_rules/dune_rules.ml

@@ -69,6 +69,7 @@ module Melange_stanzas = Melange_stanzas
 module Executables = Executables
 module Tests = Tests
 module Stanzas = Stanzas
+module Lock_dir = Lock_dir
 
 module Install_rules = struct
   let install_file = Install_rules.install_file

src/dune_rules/fetch_rules.ml

@@ -162,12 +162,15 @@ let find_checksum, find_url =
   let all =
     Memo.lazy_ (fun () ->
       let* init =
-        let init = Checksum.Map.empty, Digest.Map.empty in
-        Fs_memo.dir_exists
-          (In_source_dir (Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat))
-        >>= function
-        | false -> Memo.return init
-        | true -> Lock_dir.of_dev_tool Ocamlformat >>| add_checksums_and_urls init
+        Memo.List.fold_left
+          Dune_pkg.Dev_tool.all
+          ~init:(Checksum.Map.empty, Digest.Map.empty)
+          ~f:(fun acc dev_tool ->
+            Fs_memo.dir_exists
+              (In_source_dir (Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool))
+            >>= function
+            | false -> Memo.return acc
+            | true -> Lock_dir.of_dev_tool dev_tool >>| add_checksums_and_urls acc)
       in
       Per_context.list ()
       >>= Memo.parallel_map ~f:Lock_dir.get

src/dune_rules/odoc.ml

@@ -245,14 +245,33 @@ let odoc_base_flags quiet build_dir =
   | Nonfatal -> S []
 ;;
 
+let odoc_dev_tool_lock_dir_exists () =
+  let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Odoc in
+  Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir path)
+;;
+
+let odoc_dev_tool_exe_path_building_if_necessary () =
+  let open Action_builder.O in
+  let path = Path.build (Pkg_dev_tool.exe_path Odoc) in
+  let+ () = Action_builder.path path in
+  Ok path
+;;
+
 let odoc_program sctx dir =
-  Super_context.resolve_program
-    sctx
-    ~dir
-    ~where:Original_path
-    "odoc"
-    ~loc:None
-    ~hint:"opam install odoc"
+  let open Action_builder.O in
+  let* odoc_dev_tool_lock_dir_exists =
+    Action_builder.of_memo (odoc_dev_tool_lock_dir_exists ())
+  in
+  match odoc_dev_tool_lock_dir_exists with
+  | true -> odoc_dev_tool_exe_path_building_if_necessary ()
+  | false ->
+    Super_context.resolve_program
+      sctx
+      ~dir
+      ~where:Original_path
+      "odoc"
+      ~loc:None
+      ~hint:"opam install odoc"
 ;;
 
 let run_odoc sctx ~dir command ~quiet ~flags_for args =