Driver refactor: reenable rendering source code

This commit also includes a fix: previously, the dependencies for the interface
were used for the implementation. However, an implementation might have more
dependencies than the corresponding interface.

Author: panglesd

src/driver/compile.ml

@@ -93,7 +93,7 @@ let compile ?partial ~output_dir ?linked_dir:_ (all : Odoc_unit.t list) =
         match unit with
         | { kind = `Intf _; _ } as intf ->
             (intf :: intf_units, impl_units, page_units)
-        | { kind = `Impl; _ } as impl ->
+        | { kind = `Impl _; _ } as impl ->
             (intf_units, impl :: impl_units, page_units)
         | { kind = `Mld; _ } as mld ->
             (intf_units, impl_units, mld :: page_units))
@@ -183,8 +183,9 @@ let compile ?partial ~output_dir ?linked_dir:_ (all : Odoc_unit.t list) =
   let _compiled_mlds = Fiber.List.map compile_mld mld_units in
   let compile_impl (unit : Odoc_unit.impl Odoc_unit.unit) =
     let includes = Fpath.Set.of_list unit.include_dirs in
-    Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
-      ~includes ~parent_id:unit.parent_id;
+    let source_id = match unit.kind with `Impl src -> src.src_id in
+    Odoc.compile_impl ~output_dir:unit.output_dir ~input_file:unit.input_file
+      ~includes ~parent_id:unit.parent_id ~source_id;
     Atomic.incr Stats.stats.compiled_impls
   in
   let _compiled_impls = Fiber.List.map compile_impl impl_units in
@@ -223,7 +224,7 @@ let link : compiled list -> _ =
         (match c.kind with
         | `Intf _ -> Atomic.incr Stats.stats.linked_units
         | `Mld -> Atomic.incr Stats.stats.linked_mlds
-        | `Impl -> Atomic.incr Stats.stats.linked_impls);
+        | `Impl _ -> Atomic.incr Stats.stats.linked_impls);
         c
   in
   Fiber.List.map link compiled
@@ -271,6 +272,11 @@ let html_generate output_dir (* ~odocl_dir *) linked =
    fun l ->
     match l.kind with
     | `Intf { hidden = true; _ } -> ()
+    | `Impl { src_path; _ } ->
+        Odoc.html_generate ~search_uris:[] ?index:None
+          ~output_dir:(Fpath.to_string output_dir)
+          ~input_file:l.odocl_file ~source:src_path ();
+        Atomic.incr Stats.stats.generated_units
     | _ ->
         (* let pkg_dir = l. in *)
         (* let search_uris = [ Sherlodoc.db_js_file pkg_dir; Sherlodoc.js_file ] in *)

src/driver/odoc_unit.ml

@@ -19,7 +19,8 @@ type 'a unit = {
 type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
 and intf = [ `Intf of intf_extra ]
 
-type impl = [ `Impl ]
+type impl_extra = { src_id : Odoc.id; src_path : Fpath.t }
+type impl = [ `Impl of impl_extra ]
 
 type mld = [ `Mld ]
 
@@ -112,15 +113,33 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
     let open Fpath in
     match impl.mip_src_info with
     | None -> None
-    | Some _ ->
+    | Some { src_path } ->
         let rel_dir = pkg.Packages.pkg_dir / "lib" / libname in
         let odoc_dir = output_dir // rel_dir in
         let parent_id = rel_dir |> Odoc.id_of_fpath in
         let filename = impl.mip_path |> Fpath.rem_ext |> Fpath.basename in
-        let odoc_file = odoc_dir / (filename ^ ".odoc") in
-        let odocl_file = linked_dir // rel_dir / (filename ^ ".odocl") in
+        let odoc_file = odoc_dir / ("impl-" ^ filename ^ ".odoc") in
+        let odocl_file =
+          linked_dir // rel_dir / ("impl-" ^ filename ^ ".odocl")
+        in
         let input_file = impl.mip_path in
-        let kind = `Impl in
+        let src_name = Fpath.filename src_path in
+        let src_id =
+          Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.id_of_fpath
+        in
+        let deps =
+          List.filter_map
+            (fun (_name, hash) ->
+              match Util.StringMap.find_opt hash hashtable with
+              | None -> None
+              | Some (pkg, lib, mod_) ->
+                  let result = of_intf mod_.m_hidden pkg lib mod_.m_intf in
+                  Hashtbl.add cache mod_.m_intf.mif_hash result;
+                  Some result)
+            impl.mip_deps
+        in
+        let include_dirs = List.map (fun u -> u.odoc_dir) deps in
+        let kind = `Impl { src_id; src_path } in
         Some
           {
             output_dir;
@@ -131,7 +150,7 @@ let of_packages ~output_dir ~linked_dir (pkgs : Packages.t list) : t list =
             odoc_file;
             odocl_file;
             pkg_args;
-            include_dirs = [];
+            include_dirs;
             kind;
           }
   in

src/driver/odoc_unit.mli

@@ -19,7 +19,8 @@ type 'a unit = {
 type intf_extra = { hidden : bool; hash : string; deps : intf unit list }
 and intf = [ `Intf of intf_extra ]
 
-type impl = [ `Impl ]
+type impl_extra = { src_id : Odoc.id; src_path : Fpath.t }
+type impl = [ `Impl of impl_extra ]
 
 type mld = [ `Mld ]
 

src/driver/packages.ml

@@ -10,7 +10,11 @@ let pp_intf fmt i = Format.fprintf fmt "intf: %a" Fpath.pp i.mif_path
 
 type src_info = { src_path : Fpath.t }
 
-type impl = { mip_path : Fpath.t; mip_src_info : src_info option }
+type impl = {
+  mip_path : Fpath.t;
+  mip_src_info : src_info option;
+  mip_deps : dep list;
+}
 
 let pp_impl fmt i = Format.fprintf fmt "impl: %a" Fpath.pp i.mip_path
 
@@ -101,7 +105,12 @@ module Module = struct
                   m "Found source file %a for %s" Fpath.pp src_path m_name);
               Some { src_path }
         in
-        { mip_src_info; mip_path }
+        let mip_deps =
+          match Odoc.compile_deps mip_path with
+          | Ok { digest = _; deps } -> deps
+          | Error _ -> failwith "bad deps"
+        in
+        { mip_src_info; mip_path; mip_deps }
       in
       let state = (exists "cmt", exists "cmti") in
 

src/driver/packages.mli

@@ -12,7 +12,11 @@ val pp_intf : Format.formatter -> intf -> unit
 
 type src_info = { src_path : Fpath.t }
 
-type impl = { mip_path : Fpath.t; mip_src_info : src_info option }
+type impl = {
+  mip_path : Fpath.t;
+  mip_src_info : src_info option;
+  mip_deps : dep list;
+}
 
 val pp_impl : Format.formatter -> impl -> unit