Introduce resolving of asset referencing

Reference can now be toward assets.
When resolving them, look up the assets of the current page, and if
not found, recurse in the parent page.

Signed-off-by: Paul-Elliot <peada@free.fr>

Author: panglesd

src/document/comment.ml

@@ -88,6 +88,7 @@ module Reference = struct
     | `InstanceVariable (p, f) ->
         render_unresolved (p :> t) ^ "." ^ InstanceVariableName.to_string f
     | `Label (p, f) -> render_unresolved (p :> t) ^ "." ^ LabelName.to_string f
+    | `Asset (p, f) -> render_unresolved (p :> t) ^ "." ^ AssetName.to_string f
 
   (* This is the entry point. *)
   let to_ir : ?text:Inline.t -> Reference.t -> Inline.t =

src/model/names.ml

@@ -138,3 +138,4 @@ module LabelName = SimpleName
 module PageName = SimpleName
 module DefName = SimpleName
 module LocalName = SimpleName
+module AssetName = SimpleName

src/model/names.mli

@@ -101,3 +101,5 @@ module PageName : SimpleName
 module DefName : SimpleName
 
 module LocalName : SimpleName
+
+module AssetName : SimpleName

src/model/paths.ml

@@ -1058,6 +1058,10 @@ module Reference = struct
     module Page = struct
       type t = Paths_types.Resolved_reference.page
     end
+
+    module Asset = struct
+      type t = Paths_types.Resolved_reference.asset
+    end
   end
 
   type t = Paths_types.Reference.any
@@ -1143,4 +1147,8 @@ module Reference = struct
   module Page = struct
     type t = Paths_types.Reference.page
   end
+
+  module Asset = struct
+    type t = Paths_types.Reference.asset
+  end
 end

src/model/paths.mli

@@ -546,6 +546,10 @@ module rec Reference : sig
       type t = Paths_types.Resolved_reference.page
     end
 
+    module Asset : sig
+      type t = Paths_types.Resolved_reference.asset
+    end
+
     type t = Paths_types.Resolved_reference.any
 
     val identifier : t -> Identifier.t
@@ -631,6 +635,10 @@ module rec Reference : sig
     type t = Paths_types.Reference.page
   end
 
+  module Asset : sig
+    type t = Paths_types.Reference.asset
+  end
+
   type t = Paths_types.Reference.any
 
   type tag_any = Paths_types.Reference.tag_any

src/model/paths_types.ml

@@ -310,6 +310,8 @@ module Identifier = struct
   type reference_label = label
 
   type reference_page = page
+
+  type reference_asset = asset_file
 end
 
 module rec Path : sig
@@ -548,6 +550,7 @@ module rec Reference : sig
     | `TInstanceVariable
     | `TLabel
     | `TPage
+    | `TAsset
     | `TChildPage
     | `TChildModule
     | `TUnknown ]
@@ -742,8 +745,16 @@ module rec Reference : sig
     | `ClassType of signature * ClassTypeName.t
     | `Method of class_signature * MethodName.t
     | `InstanceVariable of class_signature * InstanceVariableName.t
-    | `Label of label_parent * LabelName.t ]
+    | `Label of label_parent * LabelName.t
+    | `Asset of page * AssetName.t ]
   (** @canonical Odoc_model.Paths.Reference.t *)
+
+  type asset =
+    [ `Resolved of Resolved_reference.asset
+    | `Root of string * [ `TAsset ]
+    | `Dot of label_parent * string
+    | `Asset of page * AssetName.t ]
+  (** @canonical Odoc_model.Paths.Reference.Asset.t *)
 end =
   Reference
 
@@ -908,5 +919,8 @@ and Resolved_reference : sig
     | `InstanceVariable of class_signature * InstanceVariableName.t
     | `Label of label_parent * LabelName.t ]
   (** @canonical Odoc_model.Paths.Reference.Resolved.t *)
+
+  type asset = [ `Identifier of Identifier.reference_asset ]
+  (** @canonical Odoc_model.Paths.Reference.Resolved.Asset.t *)
 end =
   Resolved_reference

src/model/reference.ml

@@ -76,6 +76,7 @@ let match_extra_odoc_reference_kind (_location as loc) s :
       Some `TLabel
   | Some "module-type" -> Some `TModuleType
   | Some "page" -> Some `TPage
+  | Some "asset" -> Some `TAsset
   | Some "value" ->
       d loc "value" "val";
       Some `TValue
@@ -298,6 +299,26 @@ let parse whole_reference_location s :
             |> Error.raise_exception)
   in
 
+  let page (kind, identifier, location) tokens : Page.t =
+    let kind = match_reference_kind location kind in
+    match tokens with
+    | [] -> (
+        match kind with
+        | (`TUnknown | `TPage) as kind -> `Root (identifier, kind)
+        | _ -> expected [ "page" ] location |> Error.raise_exception)
+    | next_token :: tokens -> (
+        match kind with
+        | `TUnknown -> `Dot (label_parent next_token tokens, identifier)
+        | _ ->
+            let suggestion =
+              Printf.sprintf "'page-%s' should be first." identifier
+            in
+            not_allowed ~what:"Page label"
+              ~in_what:"the last component of a reference path" ~suggestion
+              location
+            |> Error.raise_exception)
+  in
+
   let start_from_last_component (kind, identifier, location) old_kind tokens =
     let new_kind = match_reference_kind location kind in
     let kind =
@@ -363,6 +384,8 @@ let parse whole_reference_location s :
         | `TLabel ->
             `Label
               (label_parent next_token tokens, LabelName.make_std identifier)
+        | `TAsset ->
+            `Asset (page next_token tokens, AssetName.make_std identifier)
         | `TChildPage | `TChildModule ->
             let suggestion =
               Printf.sprintf "'child-%s' should be first." identifier

src/model_desc/paths_desc.ml

@@ -34,6 +34,8 @@ module Names = struct
 
   let labelname = To_string LabelName.to_string
 
+  let assetname = To_string AssetName.to_string
+
   let pagename = To_string PageName.to_string
 
   let parametername = To_string ModuleName.to_string
@@ -200,6 +202,7 @@ module General_paths = struct
       | `TType -> C0 "`TType"
       | `TUnknown -> C0 "`TUnknown"
       | `TValue -> C0 "`TValue"
+      | `TAsset -> C0 "`TValue"
       | `TChildPage -> C0 "`TChildPage"
       | `TChildModule -> C0 "`TChildModule")
 
@@ -329,7 +332,9 @@ module General_paths = struct
               ((x1 :> r), x2),
               Pair (reference, Names.instancevariablename) )
       | `Label (x1, x2) ->
-          C ("`Label", ((x1 :> r), x2), Pair (reference, Names.labelname)))
+          C ("`Label", ((x1 :> r), x2), Pair (reference, Names.labelname))
+      | `Asset (x1, x2) ->
+          C ("`Asset", ((x1 :> r), x2), Pair (reference, Names.assetname)))
 
   and resolved_reference : rr t =
     Variant

src/xref2/component.ml

@@ -1499,6 +1499,11 @@ module Fmt = struct
           (parent :> t)
           (LabelName.to_string name)
 
+  and model_resolved_asset_reference ppf
+      (`Identifier id : Odoc_model.Paths.Reference.Resolved.Asset.t) =
+    Format.fprintf ppf "%a" model_identifier
+      (id :> Odoc_model.Paths.Identifier.t)
+
   and model_reference ppf (r : Odoc_model.Paths.Reference.t) =
     let open Odoc_model.Paths.Reference in
     match r with
@@ -1562,6 +1567,23 @@ module Fmt = struct
         Format.fprintf ppf "%a.%s" model_reference
           (parent :> t)
           (LabelName.to_string name)
+    | `Asset (parent, name) ->
+        Format.fprintf ppf "%a.%s" model_reference
+          (parent :> t)
+          (AssetName.to_string name)
+
+  and model_asset_reference ppf (r : Odoc_model.Paths.Reference.Asset.t) =
+    let open Odoc_model.Paths.Reference in
+    match r with
+    | `Resolved r' ->
+        Format.fprintf ppf "r(%a)" model_resolved_asset_reference r'
+    | `Root (name, _) -> Format.fprintf ppf "unresolvedroot(%s)" name
+    | `Dot (parent, str) ->
+        Format.fprintf ppf "%a.%s" model_reference (parent :> t) str
+    | `Asset (parent, name) ->
+        Format.fprintf ppf "%a.%s" model_reference
+          (parent :> t)
+          (AssetName.to_string name)
 end
 
 module LocalIdents = struct

src/xref2/component.mli

@@ -636,7 +636,13 @@ module Fmt : sig
   val model_resolved_reference :
     Format.formatter -> Odoc_model.Paths.Reference.Resolved.t -> unit
 
+  val model_resolved_asset_reference :
+    Format.formatter -> Odoc_model.Paths.Reference.Resolved.Asset.t -> unit
+
   val model_reference : Format.formatter -> Odoc_model.Paths.Reference.t -> unit
+
+  val model_asset_reference :
+    Format.formatter -> Odoc_model.Paths.Reference.Asset.t -> unit
 end
 
 module Of_Lang : sig