Index: Add implementations to the index

src/index/in_progress.ml

@@ -6,6 +6,7 @@ module PageName = Odoc_model.Names.PageName
 module CPH = Id.Hashtbl.ContainerPage
 module LPH = Id.Hashtbl.LeafPage
 module RMH = Id.Hashtbl.RootModule
+module SPH = Id.Hashtbl.SourcePage
 
 type page = Id.Page.t
 type container_page = Id.ContainerPage.t
@@ -18,12 +19,18 @@ type dir_content = {
   leafs : payload LPH.t;
   dirs : in_progress CPH.t;
   modules : Skeleton.t RMH.t;
+  implementations : Lang.Implementation.t SPH.t;
 }
 and in_progress = container_page option * dir_content
 
 let empty_t dir_id =
   ( dir_id,
-    { leafs = LPH.create 10; dirs = CPH.create 10; modules = RMH.create 10 } )
+    {
+      leafs = LPH.create 10;
+      dirs = CPH.create 10;
+      modules = RMH.create 10;
+      implementations = SPH.create 10;
+    } )
 
 let get_parent id : container_page option =
   let id :> page = id in
@@ -86,6 +93,13 @@ let add_module (dir : in_progress) m =
   let skel = Skeleton.from_unit m in
   RMH.replace dir_content.modules m.id skel
 
+let add_implementation (dir : in_progress) (i : Lang.Implementation.t) =
+  match i.id with
+  | None -> ()
+  | Some ({ iv = `SourcePage (parent, _); _ } as id) ->
+      let _, dir_content = get_or_create dir parent in
+      SPH.replace dir_content.implementations id i
+
 let index ((parent_id, _) as dir) =
   let index_id = Id.Mk.leaf_page (parent_id, PageName.make_std "index") in
   match find_leaf dir index_id with

src/index/in_progress.mli

@@ -19,6 +19,9 @@ val add_page : in_progress -> Lang.Page.t -> unit
 val add_module : in_progress -> Lang.Compilation_unit.t -> unit
 (** Add a mpodule in the given dir *)
 
+val add_implementation : in_progress -> Lang.Implementation.t -> unit
+(** Add a mpodule in the given dir *)
+
 (** {1 Getters} *)
 
 val root_dir : in_progress -> Id.ContainerPage.t option

src/index/skeleton_of.ml

@@ -148,8 +148,9 @@ let rec remove_common_root (v : t) =
   | { Tree.children = [ v ]; node = { kind = Dir; _ } } -> remove_common_root v
   | _ -> v
 
-let lang ~pages ~modules =
+let lang ~pages ~modules ~implementations =
   let dir = In_progress.empty_t None in
   List.iter (In_progress.add_page dir) pages;
   List.iter (In_progress.add_module dir) modules;
+  List.iter (In_progress.add_implementation dir) implementations;
   t_of_in_progress dir |> remove_common_root

src/index/skeleton_of.mli

@@ -3,6 +3,9 @@ open Odoc_model
 (** Page hierarchies represent a hierarchy of pages. *)
 
 val lang :
-  pages:Lang.Page.t list -> modules:Lang.Compilation_unit.t list -> Skeleton.t
+  pages:Lang.Page.t list ->
+  modules:Lang.Compilation_unit.t list ->
+  implementations:Lang.Implementation.t list ->
+  Skeleton.t
 (** Uses the convention that the [index] children passes its payload to the
       container directory to output a payload *)

src/model/paths.ml

@@ -382,6 +382,9 @@ module Identifier = struct
   module SourcePage = struct
     type t = Id.source_page
     type t_pv = Id.source_page_pv
+
+    let equal = equal
+    let hash = hash
   end
 
   module SourceLocation = struct
@@ -626,6 +629,7 @@ module Identifier = struct
     module ContainerPage = Hashtbl.Make (ContainerPage)
     module LeafPage = Hashtbl.Make (LeafPage)
     module RootModule = Hashtbl.Make (RootModule)
+    module SourcePage = Hashtbl.Make (SourcePage)
   end
 end
 

src/model/paths.mli

@@ -245,6 +245,7 @@ module Identifier : sig
     module ContainerPage : Hashtbl.S with type key = ContainerPage.t
     module LeafPage : Hashtbl.S with type key = LeafPage.t
     module RootModule : Hashtbl.S with type key = RootModule.t
+    module SourcePage : Hashtbl.S with type key = SourcePage.t
   end
 
   module Mk : sig

src/odoc/indexing.ml

@@ -135,16 +135,17 @@ let compile out_format ~output ~warnings_options ~occurrences ~roots
   let hierarchies =
     (* For each group, we create a hierarchy. *)
     let hierarchy_of_group g =
-      let pages, modules =
-        let read (pages, modules) f =
+      let pages, modules, implementations =
+        let read (pages, modules, impls) f =
           match Odoc_file.load f with
-          | Ok { content = Page_content p; _ } -> (p :: pages, modules)
-          | Ok { content = Unit_content m; _ } -> (pages, m :: modules)
-          | _ -> (pages, modules)
+          | Ok { content = Page_content p; _ } -> (p :: pages, modules, impls)
+          | Ok { content = Unit_content m; _ } -> (pages, m :: modules, impls)
+          | Ok { content = Impl_content i; _ } -> (pages, modules, i :: impls)
+          | _ -> (pages, modules, impls)
         in
-        List.fold_left read ([], []) g
+        List.fold_left read ([], [], []) g
       in
-      Odoc_index.Skeleton_of.lang ~pages ~modules
+      Odoc_index.Skeleton_of.lang ~pages ~modules ~implementations
     in
     List.map hierarchy_of_group root_groups
   in