pkg: build and make ocamlformat dev-tool available (#10647)

Signed-off-by: Alpha DIALLO <[email protected]>

bin/build_cmd.ml

@@ -231,6 +231,20 @@ let fmt =
     in
     let common, config = Common.init builder in
     let request (setup : Import.Main.build_system) =
+      let open Action_builder.O in
+      let* () =
+        if Lazy.force Lock_dev_tool.is_enabled
+        then
+          (* Note that generating the ocamlformat lockdir here means
+             that it will be created when a user runs `dune fmt` but not
+             when a user runs `dune build @fmt`. It's important that
+             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)
+        else Action_builder.return ()
+      in
       let dir = Path.(relative root) (Common.prefix_target common ".") in
       Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request

bin/lock_dev_tool.ml

@@ -0,0 +1,82 @@
+open Dune_config
+open Import
+
+let enabled =
+  Config.make_toggle ~name:"lock_dev_tool" ~default:Dune_rules.Setup.lock_dev_tool
+;;
+
+let is_enabled =
+  lazy
+    (match Config.get enabled with
+     | `Enabled -> true
+     | `Disabled -> false)
+;;
+
+(* 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
+  : Dune_pkg.Local_package.t
+  =
+  let dev_tool_pkg_name = Dune_pkg.Dev_tool.package_name dev_tool in
+  let dependency =
+    let open Dune_lang in
+    let open Package_dependency in
+    let constraint_ =
+      Option.map dev_tool_version ~f:(fun version ->
+        Package_constraint.Uop
+          ( Relop.Eq
+          , Package_constraint.Value.String_literal (Package_version.to_string version) ))
+    in
+    { name = dev_tool_pkg_name; constraint_ }
+  in
+  let local_package_name =
+    Package_name.of_string (Package_name.to_string dev_tool_pkg_name ^ "_dev_tool_wrapper")
+  in
+  { Dune_pkg.Local_package.name = local_package_name
+  ; version = None
+  ; dependencies = [ dependency ]
+  ; conflicts = []
+  ; depopts = []
+  ; pins = Package_name.Map.empty
+  ; conflict_class = []
+  ; loc = Loc.none
+  }
+;;
+
+let solve ~local_packages ~lock_dirs =
+  let open Fiber.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
+    >>| Option.some
+  and* workspace =
+    Memo.run
+    @@
+    let open Memo.O in
+    let+ workspace = Workspace.workspace () in
+    workspace
+  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 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
+  in
+  if not (Path.exists @@ Path.source ocamlformat_dev_tool_lock_dir)
+  then (
+    let local_pkg =
+      make_local_package_wrapping_dev_tool ~dev_tool:Ocamlformat ~dev_tool_version:version
+    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 ()
+;;

bin/lock_dev_tool.mli

@@ -0,0 +1,2 @@
+val is_enabled : bool Lazy.t
+val lock_ocamlformat : unit -> unit Fiber.t

bin/pkg/lock.ml

@@ -144,16 +144,13 @@ let solve
   ~project_sources
   ~solver_env_from_current_system
   ~version_preference
-  ~lock_dirs_arg
+  ~lock_dirs
   =
   let open Fiber.O in
   (* a list of thunks that will perform all the file IO side
      effects after performing validation so that if materializing any
      lockdir would fail then no side effect takes place. *)
   (let+ errors, solutions =
-     let lock_dirs =
-       Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace
-     in
      let progress_indicator =
        List.map lock_dirs ~f:Progress_indicator.Per_lockdir.create
      in
@@ -216,13 +213,16 @@ let lock ~version_preference ~lock_dirs_arg =
     and+ project_sources = project_sources in
     workspace, local_packages, project_sources
   in
+  let lock_dirs =
+    Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace
+  in
   solve
     workspace
     ~local_packages
     ~project_sources
     ~solver_env_from_current_system
     ~version_preference
-    ~lock_dirs_arg
+    ~lock_dirs
 ;;
 
 let term =

bin/pkg/lock.mli

@@ -1,4 +1,13 @@
 open Import
 
+val solve
+  :  Workspace.t
+  -> local_packages:Dune_pkg.Local_package.t Package_name.Map.t
+  -> project_sources:Dune_pkg.Pin_stanza.DB.t
+  -> solver_env_from_current_system:Dune_pkg.Solver_env.t option
+  -> version_preference:Dune_pkg.Version_preference.t option
+  -> lock_dirs:Path.Source.t list
+  -> unit Fiber.t
+
 (** Command to create lock directory *)
 val command : unit Cmd.t

boot/configure.ml

@@ -18,7 +18,7 @@ let out =
 ;;
 
 let default_toggles : (string * [ `Disabled | `Enabled ]) list =
-  [ "toolchains", `Disabled; "pkg_build_progress", `Disabled ]
+  [ "toolchains", `Disabled; "pkg_build_progress", `Disabled; "lock_dev_tool", `Disabled ]
 ;;
 
 let () =
@@ -87,6 +87,11 @@ let () =
       , Arg.Unit (toggle "pkg_build_progress")
       , " Enable the displaying of package build progress.\n\
         \      This flag is experimental and shouldn't be relied on by packagers." )
+    ; ( "--enable-lock-dev-tool"
+      , Arg.Unit (toggle "lock_dev_tool")
+      , " Enable ocamlformat dev-tool, allows 'dune fmt' to build ocamlformat and use \
+         it, independently from the project depenedencies .\n\
+        \      This flag is experimental and shouldn't be relied on by packagers." )
     ]
   in
   let anon s = bad "Don't know what to do with %s" s in

src/dune_pkg/dev_tool.ml

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

src/dune_pkg/dev_tool.mli

@@ -0,0 +1,12 @@
+open! Import
+
+type t = Ocamlformat
+
+val equal : t -> t -> bool
+val package_name : t -> Package_name.t
+val of_package_name : Package_name.t -> t
+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

src/dune_pkg/dune_pkg.ml

@@ -22,3 +22,5 @@ module Variable_value = Variable_value
 module Resolved_package = Resolved_package
 module Pin_stanza = Pin_stanza
 module Package_name = Package_name
+module Ocamlformat = Ocamlformat
+module Dev_tool = Dev_tool

src/dune_pkg/lock_dir.ml

@@ -392,6 +392,14 @@ let create_latest_version
   }
 ;;
 
+let dev_tools_path = Path.Source.(relative root "dev-tools.locks")
+
+let dev_tool_lock_dir_path dev_tool =
+  Path.Source.relative
+    dev_tools_path
+    (Package_name.to_string (Dev_tool.package_name dev_tool))
+;;
+
 let default_path = Path.Source.(relative root "dune.lock")
 let metadata_filename = "lock.dune"
 

src/dune_pkg/lock_dir.mli

@@ -36,6 +36,10 @@ module Pkg : sig
   val files_dir : Package_name.t -> lock_dir:Path.Source.t -> Path.Source.t
 end
 
+module Package_filename : sig
+  val of_package_name : Package_name.t -> string
+end
+
 module Repositories : sig
   type t
 end
@@ -74,6 +78,10 @@ val create_latest_version
 
 val default_path : Path.Source.t
 
+(** Returns the path to the lockdir that will be used to lock the
+    given dev tool *)
+val dev_tool_lock_dir_path : Dev_tool.t -> Path.Source.t
+
 module Metadata : Dune_sexp.Versioned_file.S with type data := unit
 
 val metadata_filename : Filename.t

src/dune_pkg/ocamlformat.ml

@@ -0,0 +1,16 @@
+open Import
+
+let version_of_ocamlformat_config ocamlformat_config =
+  Io.lines_of_file ocamlformat_config
+  |> List.find_map ~f:(fun line ->
+    match String.split_on_char ~sep:'=' line |> List.map ~f:String.trim with
+    | [ "version"; value ] -> Some (Package_version.of_string value)
+    | _ -> None)
+;;
+
+let version_of_current_project's_ocamlformat_config () =
+  let ocamlformat_config = Path.Source.of_string ".ocamlformat" |> Path.source in
+  match Path.exists ocamlformat_config with
+  | false -> None
+  | true -> version_of_ocamlformat_config ocamlformat_config
+;;

src/dune_pkg/ocamlformat.mli

@@ -0,0 +1,5 @@
+open! Import
+
+(** Returns the version from the current project's .ocamlformat file,
+    if it exists *)
+val version_of_current_project's_ocamlformat_config : unit -> Package_version.t option

src/dune_rules/fetch_rules.ml

@@ -9,6 +9,7 @@ include struct
   module Pkg = Lock_dir.Pkg
   module OpamUrl = OpamUrl
   module Source = Source
+  module Ocamlformat = Ocamlformat
 end
 
 let context_name = Context_name.of_string "_fetch"
@@ -154,16 +155,24 @@ let extract_checksums_and_urls (lockdir : Dune_pkg.Lock_dir.t) =
 ;;
 
 let find_checksum, find_url =
+  let add_checksums_and_urls (checksums, urls) lockdir =
+    let checksums', urls' = extract_checksums_and_urls lockdir in
+    Checksum.Map.superpose checksums checksums', Digest.Map.superpose urls urls'
+  in
   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
+      in
       Per_context.list ()
       >>= Memo.parallel_map ~f:Lock_dir.get
       >>| List.filter_map ~f:Result.to_option
-      >>| List.fold_left
-            ~init:(Checksum.Map.empty, Digest.Map.empty)
-            ~f:(fun (checksums, urls) (lockdir : Dune_pkg.Lock_dir.t) ->
-              let checksums', urls' = extract_checksums_and_urls lockdir in
-              Checksum.Map.superpose checksums checksums', Digest.Map.superpose urls urls'))
+      >>| List.fold_left ~init ~f:add_checksums_and_urls)
   in
   let find_url digest =
     let+ _, urls = Memo.Lazy.force all in