Resolve asset references

There is no way to reference an asset in the odoc language yet, but we
can already resolve them.

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

src/model/names.ml

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

src/model/names.mli

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

src/model/paths.ml

@@ -935,6 +935,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
@@ -1016,4 +1020,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

@@ -507,6 +507,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
@@ -588,6 +592,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

@@ -290,6 +290,8 @@ module Identifier = struct
   type reference_label = label
 
   type reference_page = page
+
+  type reference_asset = asset_file
 end
 
 module rec Path : sig
@@ -706,6 +708,12 @@ module rec Reference : sig
     | `InstanceVariable of class_signature * InstanceVariableName.t
     | `Label of label_parent * LabelName.t ]
   (** @canonical Odoc_model.Paths.Reference.t *)
+
+  type asset =
+    [ `Resolved of Resolved_reference.asset
+    | `Root of string * [ `TAsset ]
+    | `Asset of page * AssetName.t ]
+  (** @canonical Odoc_model.Paths.Reference.Asset.t *)
 end =
   Reference
 
@@ -859,5 +867,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/xref2/component.ml

@@ -1450,6 +1450,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
@@ -1509,6 +1514,17 @@ module Fmt = struct
         Format.fprintf ppf "%a.%s" model_reference
           (parent :> t)
           (LabelName.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
+    | `Asset (parent, name) ->
+        Format.fprintf ppf "%a.%s" model_reference
+          (parent :> t)
+          (AssetName.to_string name)
 end
 
 module LocalIdents = struct

src/xref2/component.mli

@@ -623,7 +623,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

src/xref2/env.ml

@@ -163,6 +163,7 @@ type t = {
   resolver : resolver option;
   recorder : recorder option;
   fragmentroot : (int * Component.Signature.t) option;
+  parent_page : Identifier.Page.t option;  (** parent page *)
 }
 
 let is_linking env = env.linking
@@ -199,6 +200,7 @@ let empty =
     recorder = None;
     ambiguous_labels = Identifier.Maps.Label.empty;
     fragmentroot = None;
+    parent_page = None;
   }
 
 let add_fragment_root sg env =
@@ -802,6 +804,12 @@ let env_of_unit t ~linking resolver =
     let env = { empty with linking } in
     env |> add_module (t.id :> Identifier.Path.Module.t) dm m.doc
   in
+  let parent_page :> Identifier.Page.t option =
+    match t.id.iv with
+    | `Root (None, _) -> None
+    | `Root (Some parent, _) -> Some parent
+  in
+  let initial_env = { initial_env with parent_page } in
   set_resolver initial_env resolver |> open_units resolver
 
 let open_page page env = add_docs page.Lang.Page.content env
@@ -870,3 +878,5 @@ let verify_lookups env lookups =
   | true, Some r -> r.lookups <- LookupTypeSet.union r.lookups lookups
   | _ -> ());
   result
+
+let parent_page env = env.parent_page

src/xref2/env.mli

@@ -178,3 +178,5 @@ val len : int ref
 val n : int ref
 
 val verify_lookups : t -> LookupTypeSet.t -> bool
+
+val parent_page : t -> Identifier.Page.t option

src/xref2/errors.ml

@@ -9,7 +9,8 @@ module Tools_error = struct
       [ `Module of Cpath.module_ ]
       (* Failed to resolve a module path when applying a fragment item *) ]
 
-  type reference_kind = [ `S | `T | `C | `CT | `Page | `Cons | `Field | `Label ]
+  type reference_kind =
+    [ `S | `T | `C | `CT | `Page | `Cons | `Field | `Label | `Asset ]
 
   type expansion_of_module_error =
     [ `OpaqueModule (* The module does not have an expansion *)
@@ -115,6 +116,7 @@ module Tools_error = struct
       | `Cons -> "constructor"
       | `Field -> "field"
       | `Label -> "label"
+      | `Asset -> "asset"
     in
     Format.pp_print_string fmt k
 
@@ -291,7 +293,8 @@ type what =
   | `Module_type_u_expr of Component.ModuleType.U.expr
   | `Child_module of string
   | `Child_page of string
-  | `Reference of Reference.t ]
+  | `Reference of Reference.t
+  | `Asset_reference of Reference.Asset.t ]
 
 let report ~(what : what) ?tools_error action =
   let action =
@@ -340,6 +343,7 @@ let report ~(what : what) ?tools_error action =
     | `Child_module rf -> r "child module" Astring.String.pp rf
     | `Child_page rf -> r "child page" Astring.String.pp rf
     | `Reference ref -> r "reference" model_reference ref
+    | `Asset_reference ref -> r "asset reference" model_asset_reference ref
   in
   match kind_of_error ~what tools_error with
   | Some (`Root name) -> Lookup_failures.report_root ~name

src/xref2/ref_tools.ml

@@ -812,3 +812,54 @@ let resolve_module_reference env m =
 
 let resolve_reference env m =
   Odoc_model.Error.catch_warnings (fun () -> resolve_reference env m)
+
+let resolve_page_reference env (r : Reference.Page.t) =
+  match r with
+  | `Resolved _ -> failwith "unimplemented"
+  | `Dot (_, name) | `Root (name, _) -> Page.in_env env name
+
+let resolve_asset_reference env (m : Reference.Asset.t) =
+  let has_asset children asset =
+    List.exists
+      (function
+        | Odoc_model.Lang.Page.Asset_child a -> String.equal a asset
+        | _ -> false)
+      children
+  in
+  let rec find_in_page (page : Identifier.Page.t option) asset_name :
+      (Reference.Asset.t, _) result =
+    match page with
+    | Some page -> (
+        match page.Identifier.iv with
+        | `Page (parent, page) -> (
+            match Env.lookup_page (PageName.to_string page) env with
+            | Some { children; name; _ } when has_asset children asset_name ->
+                Ok
+                  (`Resolved
+                    (`Identifier (Identifier.Mk.asset_file (name, asset_name))))
+            | _ ->
+                let parent = (parent :> Identifier.Page.t option) in
+                find_in_page parent asset_name)
+        | `LeafPage (parent, page) -> (
+            match Env.lookup_page (PageName.to_string page) env with
+            | Some { children; name; _ } when has_asset children asset_name ->
+                Ok
+                  (`Resolved
+                    (`Identifier (Identifier.Mk.asset_file (name, asset_name))))
+            | _ ->
+                let parent = (parent :> Identifier.Page.t option) in
+                find_in_page parent asset_name))
+    | None -> Error (`Lookup_by_name (`Asset, asset_name))
+  in
+  match m with
+  | `Resolved _ as r -> Ok r
+  | `Root (name, _) -> (
+      match Env.parent_page env with
+      | None -> Error (`Lookup_by_name (`Asset, name))
+      | Some parent_page -> find_in_page (Some parent_page) name)
+  | `Asset (parent_page, name) ->
+      resolve_page_reference env parent_page >>= fun (_, { name = p; _ }) ->
+      find_in_page (Some p) (AssetName.to_string name)
+
+let resolve_asset_reference env m =
+  Odoc_model.Error.catch_warnings (fun () -> resolve_asset_reference env m)

src/xref2/ref_tools.mli

@@ -13,3 +13,6 @@ val resolve_module_reference :
 
 val resolve_reference :
   Env.t -> t -> Resolved.t ref_result Odoc_model.Error.with_warnings
+
+val resolve_asset_reference :
+  Env.t -> Asset.t -> Asset.t ref_result Odoc_model.Error.with_warnings