Avoid possibly unmatched pkg_name and pkg_dir

Propagate both values from the places where they are known at the same
time as it seems that both values are going to be useful almost
everywhere.

Author: Julow

src/driver/compile.ml

@@ -17,18 +17,17 @@ type compiled = {
   include_dirs : Fpath.Set.t;
   impl : impl option;
   pkg_args : pkg_args;
-  pkg_name : string;
-  pkg_dir : Fpath.t;
+  pkgdir : Packages.pkgdir;
 }
 
 let mk_byhash (pkgs : Packages.t Util.StringMap.t) =
   Util.StringMap.fold
-    (fun pkgname pkg acc ->
+    (fun _pkgname pkg acc ->
       List.fold_left
         (fun acc (lib : Packages.libty) ->
           List.fold_left
             (fun acc (m : Packages.modulety) ->
-              Util.StringMap.add m.m_intf.mif_hash (pkgname, m) acc)
+              Util.StringMap.add m.m_intf.mif_hash m acc)
             acc lib.modules)
         acc pkg.Packages.libraries)
     pkgs Util.StringMap.empty
@@ -69,8 +68,7 @@ let init_stats (pkgs : Packages.t Util.StringMap.t) =
 
 open Eio.Std
 
-type partial =
-  (string * compiled) list * (string * Packages.modulety) Util.StringMap.t
+type partial = (string * compiled) list * Packages.modulety Util.StringMap.t
 
 let unmarshal filename =
   let ic = open_in_bin (Fpath.to_string filename) in
@@ -139,7 +137,7 @@ let compile ?partial ~output_dir ?linked_dir all =
     | None ->
         Logs.debug (fun m -> m "Error locating hash: %s" hash);
         Error Not_found
-    | Some (package_name, modty) ->
+    | Some modty ->
         let deps = modty.m_intf.mif_deps in
         let odoc_file = Fpath.(output_dir // modty.m_intf.mif_odoc_file) in
         let odocl_file = Fpath.(linked_dir // modty.m_intf.mif_odocl_file) in
@@ -199,8 +197,7 @@ let compile ?partial ~output_dir ?linked_dir all =
             include_dirs = includes;
             impl;
             pkg_args;
-            pkg_dir = modty.m_pkg_dir;
-            pkg_name = package_name;
+            pkgdir = modty.m_pkg;
           }
   in
 
@@ -226,7 +223,7 @@ let compile ?partial ~output_dir ?linked_dir all =
   in
   let result =
     Util.StringMap.fold
-      (fun package_name (pkg : Packages.t) acc ->
+      (fun _pkgname (pkg : Packages.t) acc ->
         Logs.debug (fun m ->
             m "Package %s mlds: [%a]" pkg.name
               Fmt.(list ~sep:sp Packages.pp_mld)
@@ -255,8 +252,7 @@ let compile ?partial ~output_dir ?linked_dir all =
               include_dirs;
               impl = None;
               pkg_args;
-              pkg_dir = mld.mld_pkg_dir;
-              pkg_name = package_name;
+              pkgdir = mld.mld_pkg;
             }
             :: acc)
           acc pkg.mlds)
@@ -268,17 +264,21 @@ let compile ?partial ~output_dir ?linked_dir all =
   | None -> ());
   result
 
-type linked = { output_file : Fpath.t; src : Fpath.t option; pkg_dir : Fpath.t }
+type linked = {
+  output_file : Fpath.t;
+  src : Fpath.t option;
+  pkgdir : Packages.pkgdir;
+}
 
 let link : compiled list -> _ =
  fun compiled ->
   let link : compiled -> linked list =
    fun c ->
     let includes = Fpath.Set.add c.odoc_output_dir c.include_dirs in
     let link input_file output_file =
-      let { pkg_args = { libs; docs }; pkg_name; _ } = c in
-      Odoc.link ~input_file ~output_file ~includes ~libs ~docs
-        ~current_package:pkg_name ()
+      let { pkg_args = { libs; docs }; pkgdir = current_package, _; _ } = c in
+      Odoc.link ~input_file ~output_file ~includes ~libs ~docs ~current_package
+        ()
     in
     let impl =
       match c.impl with
@@ -287,7 +287,7 @@ let link : compiled list -> _ =
               m "Linking impl: %a -> %a" Fpath.pp impl_odoc Fpath.pp impl_odocl);
           link impl_odoc impl_odocl;
           Atomic.incr Stats.stats.linked_impls;
-          [ { pkg_dir = c.pkg_dir; output_file = impl_odocl; src = Some src } ]
+          [ { pkgdir = c.pkgdir; output_file = impl_odocl; src = Some src } ]
       | None -> []
     in
     match c.m with
@@ -300,12 +300,12 @@ let link : compiled list -> _ =
         (match c.m with
         | Module _ -> Atomic.incr Stats.stats.linked_units
         | Mld _ -> Atomic.incr Stats.stats.linked_mlds);
-        { output_file = c.odocl_file; src = None; pkg_dir = c.pkg_dir } :: impl
+        { output_file = c.odocl_file; src = None; pkgdir = c.pkgdir } :: impl
   in
   Fiber.List.map link compiled |> List.concat
 
 let index_one ~odocl_dir pkgname pkg =
-  let dir = pkg.Packages.pkg_dir in
+  let _, dir = pkg.Packages.pkgdir in
   let output_file = Fpath.(odocl_dir // dir / Odoc.index_filename) in
   let libs =
     List.map
@@ -319,10 +319,9 @@ let index_one ~odocl_dir pkgname pkg =
 let index ~odocl_dir pkgs = Util.StringMap.iter (index_one ~odocl_dir) pkgs
 
 let sherlodoc_index_one ~html_dir ~odocl_dir _ pkg_content =
-  let inputs =
-    [ Fpath.(odocl_dir // pkg_content.Packages.pkg_dir / Odoc.index_filename) ]
-  in
-  let dst = Fpath.(html_dir // Sherlodoc.db_js_file pkg_content.pkg_dir) in
+  let _, pkg_dir = pkg_content.Packages.pkgdir in
+  let inputs = [ Fpath.(odocl_dir // pkg_dir / Odoc.index_filename) ] in
+  let dst = Fpath.(html_dir // Sherlodoc.db_js_file pkg_dir) in
   let dst_dir, _ = Fpath.split_base dst in
   Util.mkdir_p dst_dir;
   Sherlodoc.index ~format:`js ~inputs ~dst ()
@@ -338,15 +337,17 @@ let sherlodoc ~html_dir ~odocl_dir pkgs =
   let inputs =
     pkgs |> Util.StringMap.bindings
     |> List.map (fun (_pkgname, pkg) ->
-           Fpath.(odocl_dir // pkg.Packages.pkg_dir / Odoc.index_filename))
+           let _, pkg_dir = pkg.Packages.pkgdir in
+           Fpath.(odocl_dir // pkg_dir / Odoc.index_filename))
   in
   Sherlodoc.index ~format ~inputs ~dst ()
 
 let html_generate output_dir ~odocl_dir linked =
   let html_generate : linked -> unit =
    fun l ->
-    let search_uris = [ Sherlodoc.db_js_file l.pkg_dir; Sherlodoc.js_file ] in
-    let index = Some Fpath.(odocl_dir // l.pkg_dir / Odoc.index_filename) in
+    let _, pkg_dir = l.pkgdir in
+    let search_uris = [ Sherlodoc.db_js_file pkg_dir; Sherlodoc.js_file ] in
+    let index = Some Fpath.(odocl_dir // pkg_dir / Odoc.index_filename) in
     Odoc.html_generate ~search_uris ?index
       ~output_dir:(Fpath.to_string output_dir)
       ~input_file:l.output_file ?source:l.src ();

src/driver/dune_style.ml

@@ -34,16 +34,17 @@ let of_dune_build dir =
             let cmtidir =
               Fpath.(path / Printf.sprintf ".%s.objs" libname / "byte")
             in
-            let pkg_dir = Fpath.rem_prefix dir path |> Option.get in
-            ( pkg_dir,
-              Packages.Lib.v ~pkg_dir
+            (* Map lib names to package names. *)
+            let pkgdir = (libname, Fpath.rem_prefix dir path |> Option.get) in
+            ( pkgdir,
+              Packages.Lib.v ~pkgdir
                 ~libname_of_archive:(Util.StringMap.singleton libname libname)
-                ~pkg_name:libname ~dir:path ~cmtidir:(Some cmtidir) ))
+                ~dir:path ~cmtidir:(Some cmtidir) ))
           libs
       in
       let packages =
         List.filter_map
-          (fun (pkg_dir, lib) ->
+          (fun (pkgdir, lib) ->
             match lib with
             | [ lib ] ->
                 Some
@@ -54,7 +55,7 @@ let of_dune_build dir =
                       libraries = [ lib ];
                       mlds = [];
                       mld_odoc_dir = Fpath.v lib.Packages.lib_name;
-                      pkg_dir;
+                      pkgdir;
                       other_docs = Fpath.Set.empty;
                     } )
             | _ -> None)

src/driver/packages.ml

@@ -1,5 +1,7 @@
 (* Packages *)
 
+type pkgdir = string * Fpath.t
+
 type dep = string * Digest.t
 
 type id = Odoc.id
@@ -32,7 +34,7 @@ type modulety = {
   m_intf : intf;
   m_impl : impl option;
   m_hidden : bool;
-  m_pkg_dir : Fpath.t;
+  m_pkg : pkgdir;
       (* The 'top dir' of a package, relative to [_odoc] or [_html] *)
 }
 
@@ -42,7 +44,7 @@ type mld = {
   mld_parent_id : id;
   mld_path : Fpath.t; (* Absolute or relative to cwd *)
   mld_deps : Fpath.t list;
-  mld_pkg_dir : Fpath.t;
+  mld_pkg : pkgdir;
       (* The 'top dir' of a package, relative to [_odoc] or [_html] *)
 }
 
@@ -61,20 +63,21 @@ type t = {
   libraries : libty list;
   mlds : mld list;
   mld_odoc_dir : Fpath.t; (* Relative to [odoc] dir *)
-  pkg_dir : Fpath.t;
+  pkgdir : pkgdir;
   other_docs : Fpath.Set.t;
 }
 
 let maybe_prepend_top top_dir dir =
   match top_dir with None -> dir | Some d -> Fpath.(d // dir)
 
-let pkg_dir top_dir pkg_name = maybe_prepend_top top_dir Fpath.(v pkg_name)
+let find_pkg top_dir pkg_name =
+  (pkg_name, maybe_prepend_top top_dir Fpath.(v pkg_name))
 
-let parent_of_lib pkg_dir lib_name = Fpath.(pkg_dir / "lib" / lib_name)
+let parent_of_lib (_, pkg_dir) lib_name = Fpath.(pkg_dir / "lib" / lib_name)
 
-let parent_of_pages pkg_dir = Fpath.(pkg_dir / "doc")
+let parent_of_pages (_, pkg_dir) = Fpath.(pkg_dir / "doc")
 
-let parent_of_src pkg_dir lib_name = Fpath.(pkg_dir / "src" / lib_name)
+let parent_of_src (_, pkg_dir) lib_name = Fpath.(pkg_dir / "src" / lib_name)
 
 module Module = struct
   type t = modulety
@@ -85,7 +88,7 @@ module Module = struct
 
   let is_hidden name = Astring.String.is_infix ~affix:"__" name
 
-  let vs pkg_dir lib_name libsdir cmtidir modules =
+  let vs pkgdir lib_name libsdir cmtidir modules =
     let dir = match cmtidir with None -> libsdir | Some dir -> dir in
     let mk m_name =
       let exists ext =
@@ -105,7 +108,7 @@ module Module = struct
             | _ -> None)
       in
       let mk_intf mif_path =
-        let mif_parent_id = parent_of_lib pkg_dir lib_name in
+        let mif_parent_id = parent_of_lib pkgdir lib_name in
         let mif_odoc_file =
           Fpath.(
             mif_parent_id
@@ -125,7 +128,7 @@ module Module = struct
         | Error _ -> failwith "bad deps"
       in
       let mk_impl mip_path =
-        let mip_parent_id = parent_of_lib pkg_dir lib_name in
+        let mip_parent_id = parent_of_lib pkgdir lib_name in
         let mip_odoc_file =
           Fpath.(
             mip_parent_id
@@ -148,7 +151,7 @@ module Module = struct
                   m "Found source file %a for %s" Fpath.pp src_path m_name);
               let src_name = Fpath.filename src_path in
               let src_id =
-                Fpath.(parent_of_src pkg_dir lib_name / src_name)
+                Fpath.(parent_of_src pkgdir lib_name / src_name)
                 |> Odoc.id_of_fpath
               in
               Some { src_path; src_id }
@@ -166,7 +169,7 @@ module Module = struct
       let m_hidden = is_hidden m_name in
       try
         let r (m_intf, m_impl) =
-          Some { m_name; m_intf; m_impl; m_hidden; m_pkg_dir = pkg_dir }
+          Some { m_name; m_intf; m_impl; m_hidden; m_pkg = pkgdir }
         in
         match state with
         | Some cmt, Some cmti -> r (mk_intf cmti, Some (mk_impl cmt))
@@ -184,7 +187,8 @@ module Module = struct
 end
 
 module Lib = struct
-  let v ~pkg_dir ~libname_of_archive ~pkg_name ~dir ~cmtidir =
+  let v ~pkgdir ~libname_of_archive ~dir ~cmtidir =
+    let pkg_name, _ = pkgdir in
     Logs.debug (fun m ->
         m "Classifying dir %a for package %s" Fpath.pp dir pkg_name);
     let dirs =
@@ -211,8 +215,8 @@ module Lib = struct
                   m "Defaulting to name of library: %s" archive_name);
               archive_name
           in
-          let modules = Module.vs pkg_dir lib_name dir cmtidir modules in
-          let odoc_dir = parent_of_lib pkg_dir lib_name in
+          let modules = Module.vs pkgdir lib_name dir cmtidir modules in
+          let odoc_dir = parent_of_lib pkgdir lib_name in
           Some { lib_name; odoc_dir; archive_name; modules }
         with _ ->
           Logs.err (fun m ->
@@ -335,8 +339,8 @@ let of_libs ~packages_dir libs =
         match rel_path with
         | None -> acc
         | Some rel_path ->
-            let pkg_dir = pkg_dir packages_dir pkg_name in
-            let id = Fpath.(parent_of_pages pkg_dir // rel_path) in
+            let pkgdir = find_pkg packages_dir pkg_name in
+            let id = Fpath.(parent_of_pages pkgdir // rel_path) in
             let mld_parent_id = id |> Fpath.parent |> Fpath.rem_empty_seg in
             let page_name = Fpath.(rem_ext mld_path |> filename) in
             let odoc_file =
@@ -350,7 +354,7 @@ let of_libs ~packages_dir libs =
               mld_parent_id = Odoc.id_of_fpath mld_parent_id;
               mld_path;
               mld_deps;
-              mld_pkg_dir = pkg_dir;
+              mld_pkg = pkgdir;
             }
             :: acc)
       odoc_pages []
@@ -369,11 +373,10 @@ let of_libs ~packages_dir libs =
           Logs.debug (fun m -> m "No package for dir %a\n%!" Fpath.pp dir);
           acc
       | Some pkg ->
-          let pkg_dir = pkg_dir packages_dir pkg.name in
+          let pkgdir = find_pkg packages_dir pkg.name in
 
           let libraries =
-            Lib.v ~pkg_dir ~libname_of_archive ~pkg_name:pkg.name ~dir
-              ~cmtidir:None
+            Lib.v ~pkgdir ~libname_of_archive ~dir ~cmtidir:None
           in
           let libraries =
             List.filter
@@ -404,7 +407,7 @@ let of_libs ~packages_dir libs =
                       mlds = update_mlds pkg.mlds libraries;
                     }
               | None ->
-                  let mld_odoc_dir = parent_of_pages pkg_dir in
+                  let mld_odoc_dir = parent_of_pages pkgdir in
                   Some
                     {
                       name = pkg.name;
@@ -413,7 +416,7 @@ let of_libs ~packages_dir libs =
                       mlds;
                       mld_odoc_dir;
                       other_docs;
-                      pkg_dir;
+                      pkgdir;
                     })
             acc)
     dirs Util.StringMap.empty