Add dune-style input style

Use as:
    odoc_driver --dune-style _build/default

Author: jonludlam

src/driver/compile.ml

@@ -135,7 +135,7 @@ let compile partial ~output_dir ?linked_dir all =
         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
         let fibers =
-          List.map
+          Fiber.List.map
             (fun (n, h) ->
               match compile_other h with
               | Ok r -> Some r
@@ -202,7 +202,7 @@ let compile partial ~output_dir ?linked_dir all =
         result
   in
   let to_build = Util.StringMap.bindings hashes |> List.map fst in
-  let mod_results = List.map compile to_build in
+  let mod_results = Fiber.List.map compile to_build in
   let zipped_res = List.map2 (fun a b -> (a,b)) to_build mod_results in
   let zipped = List.filter_map (function (a, Ok b) -> Some (a,b) | _ -> None) zipped_res in
   let mods =

src/driver/dune_style.ml

@@ -0,0 +1,42 @@
+(* Dune build tree *)
+
+let of_dune_build dir =
+  let contents = Bos.OS.Dir.fold_contents ~dotfiles:true
+    (fun p acc ->
+      p::acc
+    ) [] Fpath.(v dir) in
+  match contents with
+  | Error _ -> Util.StringMap.empty
+  | Ok c -> 
+    let sorted = List.sort (fun p1 p2 -> Fpath.compare p1 p2) c in
+    let libs = List.filter_map (fun x ->
+      match Fpath.segs x |> List.rev with
+      | "byte" :: libname :: path ->
+        let sz = String.length ".objs" in
+        if Astring.String.is_suffix ~affix:".objs" libname && String.length libname > sz + 1 && libname.[0] = '.'
+        then
+          let libname = String.sub libname 1 (String.length libname - sz - 1) in
+          Some (libname, Fpath.(v (String.concat dir_sep (List.rev path))))
+        else None
+      | _ -> None) sorted in
+    let libs = List.map (fun (libname, path) ->
+      let cmtidir = Fpath.(path / Printf.sprintf ".%s.objs" libname / "byte") in
+      match Fpath.rem_prefix (Fpath.v dir) path with
+      | Some pkg_dir ->
+          (pkg_dir, Packages.Lib.v pkg_dir (Util.StringMap.singleton libname libname) libname path (Some cmtidir))
+      | None -> failwith "Error") libs
+    in
+    let packages = List.filter_map (fun (pkg_dir, lib) ->
+      match lib with
+      | [lib] ->
+        Some (lib.Packages.lib_name, {
+        Packages.name = lib.Packages.lib_name;
+        version="1.0";
+        libraries=[lib];
+        mlds = [];
+        mld_odoc_dir = Fpath.v lib.Packages.lib_name;
+        pkg_dir;
+        other_docs = Fpath.Set.empty;
+        })
+      | _ -> None) libs in
+    Util.StringMap.of_list packages

src/driver/ocamlobjinfo.ml

@@ -17,9 +17,9 @@ let source_possibilities file =
       [ Astring.String.take ~max:pos file ^ "ml" ]
     else []
   in
-  default @ generated @ pp
+  pp @ default @ generated
 
-let get_source file =
+let get_source file srcdirs =
   let cmd = Cmd.(ocamlobjinfo % p file) in
   let lines_res =
     Worker_pool.submit ("Ocamlobjinfo " ^ Fpath.to_string file) cmd None
@@ -43,14 +43,16 @@ let get_source file =
               (String.length line - String.length affix)
           in
           let name = Fpath.(filename (v name)) in
-          let dir, _ = Fpath.split_base file in
           let possibilities =
-            List.map
-              (fun poss -> Fpath.(dir / poss))
-              (source_possibilities name)
+            List.map (fun dir ->
+              List.map
+                (fun poss -> Fpath.(dir / poss))
+                (source_possibilities name)) srcdirs |> List.flatten
           in
           List.find_opt
-            (fun f -> Sys.file_exists (Fpath.to_string f))
+            (fun f ->
+              Logs.debug (fun m -> m "src: checking %a" Fpath.pp f);
+              Sys.file_exists (Fpath.to_string f))
             possibilities
         else None)
       lines

src/driver/ocamlobjinfo.mli

@@ -1,3 +1,3 @@
-val get_source : Fpath.t -> Fpath.t option
+val get_source : Fpath.t -> Fpath.t list -> Fpath.t option
 (** use [ocamlobjinfo] binary to read the input compiled file and try to find
     the source file *)

src/driver/odoc.ml

@@ -182,10 +182,10 @@ let source_tree ?(ignore_output = false) ~parent ~output file =
     Cmd_outputs.(
       add_prefixed_output cmd source_tree_output (Fpath.to_string file) lines)
 
-let classify dir =
+let classify dirs =
   let open Cmd in
-  let cmd = !odoc % "classify" % p dir in
-  let desc = Printf.sprintf "Classifying %s" (Fpath.to_string dir) in
+  let cmd = List.fold_left (fun cmd d -> cmd % p d) (!odoc % "classify") dirs in
+  let desc = Format.asprintf "Classifying [%a]" (Fmt.(list ~sep:sp) Fpath.pp) dirs in
   let lines =
     Cmd_outputs.submit desc cmd None |> List.filter (fun l -> l <> "")
   in

src/driver/odoc.mli

@@ -11,7 +11,7 @@ val odoc : Bos.Cmd.t ref
 
 type compile_deps = { digest : Digest.t; deps : (string * Digest.t) list }
 val compile_deps : Fpath.t -> (compile_deps, [> `Msg of string ]) result
-val classify : Fpath.t -> (string * string list) list
+val classify : Fpath.t list -> (string * string list) list
 val compile_impl :
   output_dir:Fpath.t ->
   input_file:Fpath.t ->

src/driver/odoc_driver.ml

@@ -497,7 +497,7 @@ let render_stats env nprocs =
       in
       inner (0, 0, 0, 0, 0, 0, 0, 0))
 
-let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers odoc_bin voodoo package_name blessed =
+let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers odoc_bin voodoo package_name blessed dune_style =
   Odoc.odoc := Bos.Cmd.v odoc_bin;
   let _ = Voodoo.find_universe_and_version "foo" in
   Eio_main.run @@ fun env ->
@@ -511,7 +511,10 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers o
       match package_name with
       | Some p -> Voodoo.of_voodoo p blessed
       | None -> failwith "Need a package name for voodoo"
-    else
+    else match dune_style with
+    | Some dir ->
+      Dune_style.of_dune_build dir
+     | None ->
       let libs =
         if libs = [] then Ocamlfind.all ()
         else libs
@@ -623,13 +626,16 @@ let blessed =
   let doc = "Blessed" in
   Arg.(value & flag & info ["blessed"] ~doc)
 
+let dune_style =
+  let doc = "Dune style" in
+  Arg.(value & opt (some string) None & info ["dune-style"] ~doc)
 
 let cmd =
   let doc = "Generate odoc documentation" in
   let info = Cmd.info "odoc_driver" ~doc in
   Cmd.v info
     Term.(
-      const run $ packages $ verbose $ packages_dir $ odoc_dir $ odocl_dir $ html_dir $ stats $ nb_workers $ odoc_bin $ voodoo $ package_name $ blessed)
+      const run $ packages $ verbose $ packages_dir $ odoc_dir $ odocl_dir $ html_dir $ stats $ nb_workers $ odoc_bin $ voodoo $ package_name $ blessed $ dune_style)
 
 (* let map = Ocamlfind.package_to_dir_map () in
    let _dirs = List.map (fun lib -> List.assoc lib map) deps in

src/driver/packages.ml

@@ -48,7 +48,6 @@ let pp_mld fmt m = Format.fprintf fmt "%a" Fpath.pp m.mld_path
 
 type libty = {
   lib_name : string;
-  dir : Fpath.t;
   odoc_dir : Fpath.t; (* Relative to [odoc] dir *)
   archive_name : string;
   modules : modulety list;
@@ -90,7 +89,8 @@ module Module = struct
 
   let is_hidden name = Astring.String.is_infix ~affix:"__" name
 
-  let vs pkg_dir lib_name dir modules =
+  let vs pkg_dir lib_name libsdir cmtidir modules =
+    let dir = match cmtidir with | None -> libsdir | Some dir -> dir in
     let mk m_name =
       let exists ext =
         let p =
@@ -136,8 +136,16 @@ module Module = struct
             // add_ext "odoc" (v ("impl-" ^ String.uncapitalize_ascii m_name)))
         in
         let mip_odocl_file = Fpath.(set_ext "odocl" mip_odoc_file) in
+
+        (* Directories in which we should look for source files *)
+        let src_dirs =
+          match cmtidir with
+          | None -> [libsdir]
+          | Some d2 -> [libsdir; d2]
+        in
+          
         let mip_src_info =
-          match Ocamlobjinfo.get_source mip_path with
+          match Ocamlobjinfo.get_source mip_path src_dirs with
           | None ->
               Logs.debug (fun m -> m "No source found for module %s" m_name);
               None
@@ -174,10 +182,15 @@ end
 
 module Lib = struct
 
-  let v pkg_dir libname_of_archive pkg_name dir =
+  let v pkg_dir libname_of_archive pkg_name dir cmtidir =
     Logs.debug (fun m ->
         m "Classifying dir %a for package %s" Fpath.pp dir pkg_name);
-    let results = Odoc.classify dir in
+    let dirs =
+      match cmtidir with
+      | None -> [dir]
+      | Some dir2 -> [dir; dir2]
+    in
+    let results = Odoc.classify dirs in
     Logs.debug (fun m ->
       m "Got %d lines" (List.length results));
     List.filter_map
@@ -200,11 +213,11 @@ module Lib = struct
                 );
             archive_name
           in
-          let modules = Module.vs pkg_dir lib_name dir modules in
+          let modules = Module.vs pkg_dir lib_name dir cmtidir modules in
           let odoc_dir =
             parent_of_lib pkg_dir lib_name
           in
-          Some { lib_name; dir; odoc_dir; archive_name; modules }
+          Some { lib_name; odoc_dir; archive_name; modules }
         with
         | _ ->
             Logs.err (fun m ->
@@ -213,8 +226,8 @@ module Lib = struct
       results
 
   let pp ppf t =
-    Fmt.pf ppf "path: %a archive: %a modules: [@[<hov 2>@,%a@]@,]" Fpath.pp
-      t.dir Fmt.string t.archive_name
+    Fmt.pf ppf "archive: %a modules: [@[<hov 2>@,%a@]@,]"
+      Fmt.string t.archive_name
       Fmt.(list ~sep:sp Module.pp)
       t.modules
 end
@@ -365,7 +378,7 @@ let of_libs packages_dir libs =
       | Some pkg ->
           let pkg_dir = pkg_dir packages_dir pkg.name in
 
-          let libraries = Lib.v pkg_dir libname_of_archive pkg.name dir in
+          let libraries = Lib.v pkg_dir libname_of_archive pkg.name dir None in
           let libraries =
             List.filter
               (fun l -> Util.StringSet.mem l.archive_name archives)

src/driver/packages.mli

@@ -61,7 +61,6 @@ val pp_mld : Format.formatter -> mld -> unit
 
 type libty = {
   lib_name : string;
-  dir : Fpath.t;
   odoc_dir : Fpath.t; (** Relative to dir where all odoc files are, e.g. [_odoc/] by default *)
   archive_name : string;
   modules : modulety list;
@@ -88,5 +87,5 @@ val parent_of_pkg : Fpath.t -> Fpath.t
 
 module Lib : sig
 
-  val v : Fpath.t -> string Util.StringMap.t -> string -> Fpath.t -> libty list
+  val v : Fpath.t -> string Util.StringMap.t -> string -> Fpath.t -> Fpath.t option -> libty list
 end

src/driver/voodoo.ml

@@ -117,7 +117,7 @@ let process_package pkg =
       Logs.debug (fun m -> m "%s,%s\n%!" k v)) libname_of_archive;
     Some (List.map (fun directory ->
       Format.eprintf "Processing directory: %a\n%!" Fpath.pp directory;
-      Packages.Lib.v (top_dir pkg) libname_of_archive pkg.name directory) Fpath.(Set.to_list directories)))
+      Packages.Lib.v (top_dir pkg) libname_of_archive pkg.name directory None) Fpath.(Set.to_list directories)))
   metas in
 (* Check the main package lib directory even if there's no meta file *)
 let extra_libraries =
@@ -131,7 +131,7 @@ let extra_libraries =
   in
   List.map (fun libdir ->
     Logs.debug (fun m -> m "Processing directory without META: %a" Fpath.pp libdir);
-    Packages.Lib.v (top_dir pkg) Util.StringMap.empty pkg.name Fpath.(pkg_path // libdir)) libdirs_without_meta
+    Packages.Lib.v (top_dir pkg) Util.StringMap.empty pkg.name Fpath.(pkg_path // libdir) None) libdirs_without_meta
 in
 Printf.eprintf "Found %d metas" (List.length metas);
 let mld_odoc_dir = Packages.parent_of_pkg (top_dir pkg) in