Handle @canonical tags of compilation units

Before this, @canonical tags in the top-comments of a file were ignored.
ocaml · Mar 26, 2021 · 2f639d7 · 2f639d7
1 parent 8620e15
commit 2f639d7
Show file tree

Hide file tree

Showing 6 changed files with 23 additions and 6 deletions.
diff --git a/src/loader/odoc_loader.ml b/src/loader/odoc_loader.ml
@@ -38,7 +38,7 @@ exception Not_an_interface
 exception Make_root_error of string
 
 let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
-    content =
+    ?canonical content =
   let open Odoc_model.Lang.Compilation_unit in
   let interface, digest =
     match interface with
@@ -73,13 +73,17 @@ let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     content;
     expansion = None;
     linked = false;
+    canonical;
   }
 
 let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id
     sg =
   let content = Odoc_model.Lang.Compilation_unit.Module sg in
+  let canonical =
+    (Cmi.canonical sg.doc :> Odoc_model.Paths.Path.Module.t option)
+  in
   make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
-    content
+    ?canonical content
 
 let read_cmti ~make_root ~parent ~filename () =
   let cmt_info = Cmt_format.read_cmt filename in

diff --git a/src/model/lang.ml b/src/model/lang.ml
@@ -447,6 +447,7 @@ module rec Compilation_unit : sig
     content : content;
     expansion : Signature.t option;
     linked : bool;  (** Whether this unit has been linked. *)
+    canonical : Path.Module.t option;
   }
 end =
   Compilation_unit

diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml
@@ -639,6 +639,10 @@ and compilation_unit_t =
       F ("hidden", (fun t -> t.hidden), bool);
       F ("content", (fun t -> t.content), compilation_unit_content);
       F ("expansion", (fun t -> t.expansion), Option signature_t);
+      F
+        ( "canonical",
+          (fun t -> (t.canonical :> Paths.Path.t option)),
+          Option path );
     ]
 
 (** {3 Page} *)

diff --git a/src/xref2/env.ml b/src/xref2/env.ml
@@ -337,7 +337,7 @@ let module_of_unit : Odoc_model.Lang.Compilation_unit.t -> Component.Module.t =
             id = (unit.id :> Odoc_model.Paths.Identifier.Module.t);
             doc = [];
             type_ = ModuleType (Signature s);
-            canonical = None;
+            canonical = unit.canonical;
             hidden = unit.hidden;
           }
       in
@@ -351,7 +351,7 @@ let module_of_unit : Odoc_model.Lang.Compilation_unit.t -> Component.Module.t =
             doc = [];
             type_ =
               ModuleType (Signature { items = []; compiled = true; doc = [] });
-            canonical = None;
+            canonical = unit.canonical;
             hidden = unit.hidden;
           }
       in
@@ -472,7 +472,9 @@ let lookup_by_id (scope : 'a scope) id env : 'a option =
 let lookup_root_module_fallback name t =
   match lookup_root_module name t with
   | Some (Resolved (_, id, m)) ->
-      Some (`Module ((id :> Identifier.Path.Module.t), Component.Delayed.put (fun () -> m)))
+      Some
+        (`Module
+          ((id :> Identifier.Path.Module.t), Component.Delayed.put_val m))
   | Some Forward | None -> None
 
 let s_signature : Component.Element.signature scope =

diff --git a/test/xref2/canonical_unit.t/run.t b/test/xref2/canonical_unit.t/run.t
@@ -5,9 +5,14 @@ The module Test__X is expected to be referenced through Test.X.
 
   $ compile test__x.mli test.ml
 
+Test__x has a 'canonical' field:
+
+  $ odoc_print test__x.odocl | jq -c ".canonical"
+  {"Some":{"`Dot":[{"`Root":"Test"},"X"]}}
+
 The alias Test.X should be marked as canonical:
 
   $ odoc_print test.odocl | jq -c ".content.Module.items | .[] | .Module[1].type_.Alias[0] | select(.)"
-  {"`Resolved":{"`Hidden":{"`Identifier":{"`Root":[{"`RootPage":"test"},"Test__x"]}}}}
+  {"`Resolved":{"`Canonical":[{"`Hidden":{"`Identifier":{"`Root":[{"`RootPage":"test"},"Test__x"]}}},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Test"]},"X"]}}}]}}
   {"`Resolved":{"`Canonical":[{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Test"]},"Test__y"]}},{"`Resolved":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Test"]},"Y"]}}}]}}
   {"`Resolved":{"`Hidden":{"`Identifier":{"`Module":[{"`Root":[{"`RootPage":"test"},"Test"]},"Test__z"]}}}}
diff --git a/test/xref2/lib/common.cppo.ml b/test/xref2/lib/common.cppo.ml
@@ -606,6 +606,7 @@ let my_compilation_unit id s =
     ; content = Module s
     ; expansion = None
     ; linked = false
+    ; canonical = None
 }
 
 let mkenv () =