Fix search url of aliased modules

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/search/entry.ml

@@ -49,9 +49,14 @@ type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim
 
 type value_entry = { value : Value.value; type_ : TypeExpr.t }
 
+type module_entry =
+  | With_expansion
+  | Alias_of of Odoc_model.Paths.Identifier.Any.t
+  | Without_expansion
+
 type kind =
   | TypeDecl of type_decl_entry
-  | Module
+  | Module of module_entry
   | Value of value_entry
   | Doc of doc_entry
   | Exception of constructor_entry
@@ -150,7 +155,7 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
   match x with
   | CompilationUnit u -> (
       match u.content with
-      | Module m -> [ entry ~id:u.id ~doc:m.doc ~kind:Module ]
+      | Module m -> [ entry ~id:u.id ~doc:m.doc ~kind:(Module With_expansion) ]
       | Pack _ -> [])
   | TypeDecl td ->
       let kind =
@@ -172,7 +177,18 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
         | Some Extensible -> []
       in
       td_entry :: subtype_entries
-  | Module m -> [ entry ~id:m.id ~doc:m.doc ~kind:Module ]
+  | Module m ->
+      let kind =
+        match m.Module.type_ with
+        | ModuleType _ -> Module With_expansion
+        | Alias (`Resolved path, _expansion) ->
+            Module
+              (Alias_of
+                 (Odoc_model.Paths.Path.Resolved.identifier
+                    (path :> Odoc_model.Paths.Path.Resolved.t)))
+        | Alias (_, _expansion) -> Module Without_expansion
+      in
+      [ entry ~id:m.id ~doc:m.doc ~kind ]
   | Value v ->
       let kind = Value { value = v.value; type_ = v.type_ } in
       [ entry ~id:v.id ~doc:v.doc ~kind ]

src/search/entry.mli

@@ -40,9 +40,14 @@ type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim
 
 type value_entry = { value : Value.value; type_ : TypeExpr.t }
 
+type module_entry =
+  | With_expansion
+  | Alias_of of Odoc_model.Paths.Identifier.Any.t
+  | Without_expansion
+
 type kind =
   | TypeDecl of type_decl_entry
-  | Module
+  | Module of module_entry
   | Value of value_entry
   | Doc of doc_entry
   | Exception of constructor_entry

src/search/html.ml

@@ -3,11 +3,15 @@ type html = Html_types.div_content Tyxml.Html.elt
 open Odoc_model
 open Lang
 
-let url id =
-  match
-    Odoc_document.Url.from_identifier ~stop_before:false
-      (id :> Odoc_model.Paths.Identifier.t)
-  with
+let url { Entry.id; kind; doc = _ } =
+  let open Entry in
+  let url_id, stop_before =
+    match kind with
+    | Module Without_expansion -> (id, true)
+    | Module (Alias_of id) -> (id, false)
+    | _ -> (id, false)
+  in
+  match Odoc_document.Url.from_identifier ~stop_before url_id with
   | Ok url ->
       let config =
         Odoc_html.Config.v ~search_result:true ~semantic_uris:false
@@ -147,7 +151,7 @@ let string_of_kind =
   | Field _ -> kind_field
   | ExtensionConstructor _ -> kind_extension_constructor
   | TypeDecl _ -> kind_typedecl
-  | Module -> kind_module
+  | Module _ -> kind_module
   | Value _ -> kind_value
   | Exception _ -> kind_exception
   | Class_type _ -> kind_class_type
@@ -172,7 +176,7 @@ let rhs_of_kind (entry : Entry.kind) =
   | Constructor t | ExtensionConstructor t | Exception t ->
       Some (constructor_rhs t)
   | Field f -> Some (field_rhs f)
-  | Module | Class_type _ | Method _ | Class _ | TypeExtension _ | ModuleType
+  | Module _ | Class_type _ | Method _ | Class _ | TypeExtension _ | ModuleType
   | Doc _ ->
       None
 

src/search/html.mli

@@ -4,9 +4,7 @@ type html = Html_types.div_content Tyxml.Html.elt
 
 val of_entry : Entry.t -> html list
 
-val url :
-  Odoc_model.Paths.Identifier.Any.t ->
-  (string, Odoc_document.Url.Error.t) Result.result
+val url : Entry.t -> (string, Odoc_document.Url.Error.t) Result.result
 
 (** The below is intended for search engine that do not use the Json output but
     Odoc as a library. Most search engine will use their own representation

src/search/json_index/json_display.ml

@@ -1,7 +1,7 @@
 open Odoc_search
 
-let of_entry { Entry.id; doc = _; kind = _ } h =
-  match Html.url id with
+let of_entry entry h =
+  match Html.url entry with
   | Result.Ok url ->
       let html =
         h

src/search/json_index/json_search.ml

@@ -124,7 +124,7 @@ let of_entry ({ Entry.id; doc; kind } as entry) html =
             ("manifest", manifest);
             ("constraints", constraints);
           ]
-    | Module -> return "Module" []
+    | Module _ -> return "Module" []
     | Value { value = _; type_ } ->
         return "Value" [ ("type", `String (Text.of_type type_)) ]
     | Doc Paragraph -> return "Doc" [ ("subkind", `String "Paragraph") ]

test/search/module_aliases.t/main.ml

@@ -3,3 +3,6 @@ module X = struct
 end
 
 module Y = X
+module Z = Y
+
+module L = Stdlib.List

test/search/module_aliases.t/run.t

@@ -8,12 +8,13 @@ Compile and link the documentation
   $ odoc link main.odoc
   $ odoc compile-index main.odocl
 
-We have a problem: The ID for Y generates an URL to a file which is not
-generated (as the module does not have an expansion).
+Module with expansions (aliased or not) redirect to their expansions, while
+module without expansions redirect to their definition point.
 
-  $ cat index.json | jq | grep url |grep Y
-        "url": "Main/Y/index.html",
-
-  $ odoc html-generate -o html main.odocl && ls Main/Y/index.html
-  ls: cannot access 'Main/Y/index.html': No such file or directory
-  [2]
+  $ cat index.json | jq -r '.[] | "\(.id[-1].name) -> \(.display.url)"'
+  Main -> Main/index.html
+  X -> Main/X/index.html
+  x -> Main/X/index.html#val-x
+  Y -> Main/X/index.html
+  Z -> Main/X/index.html
+  L -> Main/index.html#module-L