Refactor package version handling (#2108)

Signed-off-by: Jeremie Dimino <[email protected]>

src/dune_project.ml

@@ -830,6 +830,16 @@ let parse ~dir ~lang ~packages ~file =
      in
      let allow_approx_merlin =
        Option.value ~default:false allow_approx_merlin in
+     let packages =
+       match version with
+       | None -> packages
+       | Some version ->
+         let version = Some (version, Package.Version_source.Project) in
+         Package.Name.Map.map packages ~f:(fun p ->
+           match p.version with
+           | Some _ -> p
+           | None -> { p with version })
+     in
      { name
      ; root = dir
      ; version
@@ -894,7 +904,7 @@ let load ~dir ~files =
     String.Set.fold files ~init:[] ~f:(fun fn acc ->
       match Filename.split_extension fn with
       | (pkg, ".opam") when pkg <> "" ->
-        let version_from_opam_file =
+        let version =
           let open Option.O in
           let* opam =
             let opam_file = Path.Source.relative dir fn in
@@ -909,15 +919,15 @@ let load ~dir ~files =
           in
           let* version = Opam_file.get_field opam "version" in
           match version with
-          | String (_, s) -> Some s
+          | String (_, s) -> Some (s, Package.Version_source.Package)
           | _ -> None
         in
         let name = Package.Name.of_string pkg in
         (name,
          { Package.
            name
          ; path = dir
-         ; version_from_opam_file
+         ; version
          }) :: acc
       | _ -> acc)
     |> Package.Name.Map.of_list_exn

src/install_rules.ml

@@ -58,42 +58,35 @@ let gen_dune_package sctx ~version ~(pkg : Local_package.t) =
   Build.write_file_dyn dune_package_file
   |> Super_context.add_rule sctx ~dir:ctx.build_dir
 
-let version_from_dune_project sctx ~(pkg : Package.t) =
-  let dir = Path.append_source (Super_context.build_dir sctx) pkg.path in
-  let project = Scope.project (Super_context.find_scope_by_dir sctx dir) in
-  Dune_project.version project
-
 type version_method =
   | File of string
-  | From_dune_project
+  | From_metadata of Package.Version_source.t
 
-let pkg_version sctx ~path ~(pkg : Package.t) =
-  match pkg.version_from_opam_file with
-  | Some s -> Build.return (Some s)
-  | None ->
-    let rec loop = function
-      | [] -> Build.return None
-      | candidate :: rest ->
-        match candidate with
-        | File fn ->
-          let p = Path.relative path fn in
-          Build.if_file_exists p
-            ~then_:(Build.lines_of p
-                    >>^ function
-                    | ver :: _ -> Some ver
-                    | _ -> Some "")
-            ~else_:(loop rest)
-        | From_dune_project ->
-          match version_from_dune_project sctx ~pkg with
-          | None -> loop rest
-          | Some _ as x -> Build.return x
-    in
-    loop
-      [ File (Package.Name.version_fn pkg.name)
-      ; From_dune_project
-      ; File "version"
-      ; File "VERSION"
-      ]
+let pkg_version ~path ~(pkg : Package.t) =
+  let rec loop = function
+    | [] -> Build.return None
+    | candidate :: rest ->
+      match candidate with
+      | File fn ->
+        let p = Path.relative path fn in
+        Build.if_file_exists p
+          ~then_:(Build.lines_of p
+                  >>^ function
+                  | ver :: _ -> Some ver
+                  | _ -> Some "")
+          ~else_:(loop rest)
+      | From_metadata source ->
+        match pkg.version with
+        | Some (v, source') when source = source' -> Build.return (Some v)
+        | _ -> loop rest
+  in
+  loop
+    [ From_metadata Package
+    ; File (Package.Name.version_fn pkg.name)
+    ; From_metadata Project
+    ; File "version"
+    ; File "VERSION"
+    ]
 
 let init_meta sctx ~dir =
   Local_package.defined_in sctx ~dir
@@ -105,7 +98,7 @@ let init_meta sctx ~dir =
     let meta_template = Local_package.meta_template pkg in
     let version =
       let pkg = Local_package.package pkg in
-      let get = pkg_version sctx ~pkg ~path in
+      let get = pkg_version ~pkg ~path in
       Super_context.Pkg_version.set sctx pkg get
     in
 

src/odoc.ml

@@ -251,10 +251,10 @@ let setup_toplevel_index_rule sctx =
       let name = Package.Name.to_string name in
       let link = sp {|<a href="%s/index.html">%s</a>|} name name in
       let version_suffix =
-        match pkg.Package.version_from_opam_file with
+        match pkg.Package.version with
         | None ->
           ""
-        | Some v ->
+        | Some (v, _) ->
           sp {| <span class="version">%s</span>|} v
       in
       Some (sp "<li>%s%s</li>" link version_suffix))

src/package.ml

@@ -26,27 +26,40 @@ module Name = struct
   module Infix = Comparable.Operators(T)
 end
 
+module Version_source = struct
+  type t =
+    | Package
+    | Project
+
+  let to_dyn t =
+    Dyn.Variant
+      ((match t with
+         | Package -> "Package"
+         | Project -> "Project"),
+       [])
+end
 
 type t =
-  { name                   : Name.t
-  ; path                   : Path.Source.t
-  ; version_from_opam_file : string option
+  { name    : Name.t
+  ; path    : Path.Source.t
+  ; version : (string * Version_source.t) option
   }
 
-let hash { name; path; version_from_opam_file } =
+let hash { name; path; version } =
   Hashtbl.hash
     ( Name.hash name
     , Path.Source.hash path
-    , Option.hash String.hash version_from_opam_file
+    , Hashtbl.hash version
     )
 
-let to_dyn { name; path; version_from_opam_file } =
+let to_dyn { name; path; version } =
   let open Dyn in
   Record
     [ "name", Name.to_dyn name
     ; "path", Path.Source.to_dyn path
-    ; "version_from_opam_file"
-    , Option (Option.map ~f:(fun s -> String s) version_from_opam_file)
+    ; "version",
+      Option (Option.map ~f:(fun (v, s) ->
+        Tuple [String v; Version_source.to_dyn s]) version)
     ]
 
 let pp fmt t = Dyn.pp fmt (to_dyn t)

src/package.mli

@@ -18,10 +18,18 @@ module Name : sig
   module Infix : Comparable.OPS with type t = t
 end
 
+module Version_source : sig
+  (** Wether this version comes from the project wide version or the
+      package particular version *)
+  type t =
+    | Package
+    | Project
+end
+
 type t =
-  { name                   : Name.t
-  ; path                   : Path.Source.t
-  ; version_from_opam_file : string option
+  { name    : Name.t
+  ; path    : Path.Source.t
+  ; version : (string * Version_source.t) option
   }
 
 val pp : Format.formatter -> t -> unit