Source locations are now identifiers

src/document/generator.ml

@@ -49,11 +49,10 @@ let path_to_id path =
 
 let source_anchor locs =
   match locs with
-  | Some { Odoc_model.Lang.Locations.anchor = Some anchor; source_parent } ->
-      Some (Url.Anchor.source_file_from_identifier source_parent ~anchor)
-  | Some { Odoc_model.Lang.Locations.anchor = None; source_parent } ->
-      let path = Url.Path.source_file_from_identifier source_parent in
-      Some (Url.from_path path)
+  | Some id ->
+      Url.Anchor.from_identifier
+        (id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t)
+      |> Result.to_option
   | _ -> None
 
 let attach_expansion ?(status = `Default) (eq, o, e) page text =
@@ -242,7 +241,7 @@ module Make (Syntax : SYNTAX) = struct
       string ->
       Source_page.t
   end = struct
-    let path id = Url.Path.source_file_from_identifier id
+    let path id = Url.Path.from_identifier id
     let url id = Url.from_path (path id)
 
     let info_of_info url = function
@@ -1792,7 +1791,7 @@ module Make (Syntax : SYNTAX) = struct
           | `SourceDir (parent, _) ->
               let mmap = add parent (add_dir dir) mmap in
               dir_ancestors_add parent mmap
-          | `SourceRoot _ -> mmap
+          | `Page _ -> mmap
         in
         let file_ancestors_add ({ iv = `SourcePage (parent, _); _ } as file)
             mmap =
@@ -1804,11 +1803,11 @@ module Make (Syntax : SYNTAX) = struct
           M.empty dir_pages
       in
       let page_of_dir (dir : SourceDir.t) (dir_children, file_children) =
-        let url = Url.Path.source_dir_from_identifier dir in
+        let url = Url.Path.from_identifier dir in
         let block ?(attr = []) desc = Block.{ attr; desc } in
         let inline ?(attr = []) desc = Inline.[ { attr; desc } ] in
         let header =
-          let title = inline (Text (SourceDir.name dir)) in
+          let title = inline (Text (name dir)) in
           Item.Heading
             Heading.{ label = None; level = 0; title; source_anchor = None }
         in
@@ -1822,18 +1821,14 @@ module Make (Syntax : SYNTAX) = struct
         in
         let li_of_child child =
           match child with
-          | { iv = `SourceRoot _; _ } ->
-              assert false (* No [`SourceRoot] is child of a [`SourceDir] *)
+          | { iv = `Page _; _ } ->
+              assert false (* No [`Page] is child of a [`SourceDir] *)
           | { iv = `SourceDir (_, name); _ } ->
-              let url =
-                child |> Url.Path.source_dir_from_identifier |> Url.from_path
-              in
+              let url = child |> Url.Path.from_identifier |> Url.from_path in
               (name, url)
         in
         let li_of_file_child ({ iv = `SourcePage (_, name); _ } as child) =
-          let url =
-            child |> Url.Path.source_file_from_identifier |> Url.from_path
-          in
+          let url = child |> Url.Path.from_identifier |> Url.from_path in
           (name, url)
         in
         let items =

src/document/url.ml

@@ -82,11 +82,14 @@ end
 let ( >>= ) x f = match x with Ok x -> f x | Error _ as e -> e
 
 module Path = struct
-  type source_pv =
+  type nonsrc_pv =
     [ Identifier.Page.t_pv
     | Identifier.Signature.t_pv
     | Identifier.ClassSignature.t_pv ]
 
+  type source_pv =
+    [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ]
+
   and source = source_pv Odoc_model.Paths.Identifier.id
 
   type kind =
@@ -174,25 +177,16 @@ module Path = struct
         let name = ClassTypeName.to_string name in
         mk ~parent kind name
     | { iv = `Result p; _ } -> from_identifier (p :> source)
+    | { iv = `SourceDir (parent, name); _ }
+    | { iv = `SourcePage (parent, name); _ } ->
+        let parent = from_identifier (parent :> source) in
+        let kind = `Page in
+        mk ~parent kind name
 
   let from_identifier p =
     from_identifier
       (p : [< source_pv ] Odoc_model.Paths.Identifier.id :> source)
 
-  let rec source_dir_from_identifier id =
-    match id.Odoc_model.Paths.Identifier.iv with
-    | `SourceRoot container -> from_identifier (container :> source)
-    | `SourceDir (parent, name) ->
-        let parent = source_dir_from_identifier parent in
-        let kind = `Page in
-        mk ~parent kind name
-
-  let source_file_from_identifier id =
-    let (`SourcePage (parent, name)) = id.Odoc_model.Paths.Identifier.iv in
-    let parent = source_dir_from_identifier parent in
-    let kind = `SourcePage in
-    mk ~parent kind name
-
   let to_list url =
     let rec loop acc { parent; name; kind } =
       match parent with
@@ -369,16 +363,20 @@ module Anchor = struct
            happen, [`Type] may not happen either but just in case, use the
            grand-parent. *)
         match parent with
-        | { iv = #Path.source_pv; _ } as parent ->
-            mk ~kind:`Section parent str_name
         | { iv = `CoreType _; _ } ->
             Error (Unexpected_anchor "core_type label parent")
-        | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name)
-
-  let source_file_from_identifier id ~anchor =
-    let kind = `SourceAnchor in
-    let page = Path.source_file_from_identifier id in
-    { page; anchor; kind }
+        | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name
+        | { iv = #Path.nonsrc_pv; _ } as p ->
+            mk ~kind:`Section (p :> Path.source) str_name)
+    | { iv = `SourceLocation (parent, loc); _ } ->
+        let page = Path.from_identifier (parent :> Path.source) in
+        Ok { page; kind = `SourceAnchor; anchor = DefName.to_string loc }
+    | { iv = `SourceLocationMod parent; _ } ->
+        let page = Path.from_identifier (parent :> Path.source) in
+        Ok { page; kind = `SourceAnchor; anchor = "" }
+    | { iv = `SourcePage (p, _name); _ } | { iv = `SourceDir (p, _name); _ } ->
+        let page = Path.from_identifier (p :> Path.source) in
+        Ok { page; kind = `Page; anchor = "" }
 
   let polymorphic_variant ~type_ident elt =
     let name_of_type_constr te =

src/document/url.mli

@@ -29,22 +29,18 @@ module Path : sig
 
   type t = { kind : kind; parent : t option; name : string }
 
-  type source_pv =
+  type nonsrc_pv =
     [ Identifier.Page.t_pv
     | Identifier.Signature.t_pv
     | Identifier.ClassSignature.t_pv ]
 
+  type source_pv =
+    [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ]
+
   and source = source_pv Odoc_model.Paths.Identifier.id
 
   val from_identifier : [< source_pv ] Odoc_model.Paths.Identifier.id -> t
 
-  val source_dir_from_identifier : Odoc_model.Paths.Identifier.SourceDir.t -> t
-  (** A path to a source dir. *)
-
-  val source_file_from_identifier :
-    Odoc_model.Paths.Identifier.SourcePage.t -> t
-  (** A path to a source file. *)
-
   val to_list : t -> (kind * string) list
 
   val of_list : (kind * string) list -> t option
@@ -93,9 +89,6 @@ module Anchor : sig
 
   val from_identifier : Identifier.t -> (t, Error.t) result
 
-  val source_file_from_identifier :
-    Odoc_model.Paths.Identifier.SourcePage.t -> anchor:string -> t
-
   val polymorphic_variant :
     type_ident:Identifier.t ->
     Odoc_model.Lang.TypeExpr.Polymorphic_variant.element ->

src/loader/lookup_def.ml

@@ -11,10 +11,10 @@ type t = Shape.t
 
 (** Project an identifier into a shape. *)
 let rec shape_of_id lookup_shape :
-    [< Identifier.t_pv ] Identifier.id -> Shape.t option =
+    [< Identifier.NonSrc.t_pv ] Identifier.id -> Shape.t option =
   let proj parent kind name =
     let item = Shape.Item.make name kind in
-    match shape_of_id lookup_shape (parent :> Identifier.t) with
+    match shape_of_id lookup_shape (parent :> Identifier.NonSrc.t) with
     | Some shape -> Some (Shape.proj shape item)
     | None -> None
   in
@@ -29,7 +29,7 @@ let rec shape_of_id lookup_shape :
         (* Apply the functor to an empty signature. This doesn't seem to cause
            any problem, as the shape would stop resolve on an item inside the
            result of the function, which is what we want. *)
-        shape_of_id lookup_shape (parent :> Identifier.t) >>= fun parent ->
+        shape_of_id lookup_shape (parent :> Identifier.NonSrc.t) >>= fun parent ->
         Some (Shape.app parent ~arg:(Shape.str Shape.Item.Map.empty))
     | `ModuleType (parent, name) ->
         proj parent Kind.Module_type (ModuleTypeName.to_string name)
@@ -69,8 +69,10 @@ let lookup_def lookup_unit id =
       Uid.unpack_uid (Uid.of_shape_uid uid) >>= fun (unit_name, id) ->
       lookup_unit unit_name >>= fun (unit, _) ->
       unit.Lang.Compilation_unit.source_info >>= fun sources ->
-      let anchor = id >>= fun id -> Some (Uid.anchor_of_id id) in
-      Some { Lang.Locations.source_parent = sources.id; anchor }
+      let anchor_opt = id >>= fun id -> Some (Uid.anchor_of_id id) in
+      match anchor_opt with
+      | Some anchor -> Some (Paths.Identifier.Mk.source_location (sources.id,Odoc_model.Names.DefName.make_std anchor))
+      | None -> Some (Paths.Identifier.Mk.source_location_mod sources.id)
 
 let of_cmt (cmt : Cmt_format.cmt_infos) = cmt.cmt_impl_shape
 

src/loader/lookup_def.mli

@@ -4,8 +4,8 @@ type t
 
 val lookup_def :
   (string -> (Lang.Compilation_unit.t * t) option) ->
-  Identifier.t ->
-  Lang.Locations.t option
+  Identifier.NonSrc.t ->
+  Identifier.SourceLocation.t option
 (** Returns the root module containing the definition of the given identifier
     and the corresponding anchor. *)
 

src/model/lang.ml

@@ -16,16 +16,7 @@
 
 open Paths
 
-module Locations = struct
-  type t = {
-    source_parent : Identifier.SourcePage.t;
-        (** Correspond to where the source code is stored. Might be different
-            from the root component of the identifier inside expansions. *)
-    anchor : string option;
-        (** Location of the definition in the implementation file. *)
-  }
-end
-
+(** {3 Modules} *)
 module Source_info = struct
   type anchor = { anchor : string }
 
@@ -40,17 +31,15 @@ module Source_info = struct
   type t = { id : Identifier.SourcePage.t; infos : infos }
 end
 
-(** {3 Modules} *)
-
 module rec Module : sig
   type decl =
     | Alias of (Path.Module.t * ModuleType.simple_expansion option)
     | ModuleType of ModuleType.expr
 
   type t = {
     id : Identifier.Module.t;
-    locs : Locations.t option;
-        (** Locations might not be set when the module is artificially constructed from a functor argument. *)
+    locs : Identifier.SourceLocation.t option;
+        (** Identifier.SourceLocation might not be set when the module is artificially constructed from a functor argument. *)
     doc : Comment.docs;
     type_ : decl;
     canonical : Path.Module.t option;
@@ -127,7 +116,7 @@ and ModuleType : sig
 
   type t = {
     id : Identifier.ModuleType.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
         (** Can be [None] for module types created by a type substitution. *)
     doc : Comment.docs;
     canonical : Path.ModuleType.t option;
@@ -268,7 +257,7 @@ and TypeDecl : sig
 
   type t = {
     id : Identifier.Type.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
     doc : Comment.docs;
     canonical : Path.Type.t option;
     equation : Equation.t;
@@ -283,7 +272,7 @@ and Extension : sig
   module Constructor : sig
     type t = {
       id : Identifier.Extension.t;
-      locs : Locations.t option;
+      locs : Identifier.SourceLocation.t option;
       doc : Comment.docs;
       args : TypeDecl.Constructor.argument;
       res : TypeExpr.t option;
@@ -305,7 +294,7 @@ end =
 and Exception : sig
   type t = {
     id : Identifier.Exception.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
     doc : Comment.docs;
     args : TypeDecl.Constructor.argument;
     res : TypeExpr.t option;
@@ -320,7 +309,7 @@ and Value : sig
 
   type t = {
     id : Identifier.Value.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
     value : value;
     doc : Comment.docs;
     type_ : TypeExpr.t;
@@ -337,7 +326,7 @@ and Class : sig
 
   type t = {
     id : Identifier.Class.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
     doc : Comment.docs;
     virtual_ : bool;
     params : TypeDecl.param list;
@@ -356,7 +345,7 @@ and ClassType : sig
 
   type t = {
     id : Identifier.ClassType.t;
-    locs : Locations.t option;
+    locs : Identifier.SourceLocation.t option;
     doc : Comment.docs;
     virtual_ : bool;
     params : TypeDecl.param list;

src/model/names.ml

@@ -141,3 +141,4 @@ module MethodName = SimpleName
 module InstanceVariableName = SimpleName
 module LabelName = SimpleName
 module PageName = SimpleName
+module DefName = SimpleName

src/model/names.mli

@@ -95,3 +95,5 @@ module InstanceVariableName : SimpleName
 module LabelName : SimpleName
 
 module PageName : SimpleName
+
+module DefName : SimpleName