Resolve references to assets

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

Author: panglesd

src/odoc/resolver.ml

@@ -447,6 +447,13 @@ let lookup_path ~possible_unit_names ~named_roots ~hierarchy (tag, path) :
       |> List.find_map find_in_hierarchy
       |> option_to_result
 
+let lookup_asset_by_path ~pages ~hierarchy path =
+  let possible_unit_names name = [ "asset-" ^ name ^ ".odoc" ] in
+  match lookup_path ~possible_unit_names ~named_roots:pages ~hierarchy path with
+  | Ok (Odoc_file.Asset_content asset) -> Ok asset
+  | Ok _ -> Error `Not_found (* TODO: Report is not an asset. *)
+  | Error _ as e -> e
+
 let lookup_page_by_path ~pages ~hierarchy path =
   let possible_unit_names name = [ "page-" ^ name ^ ".odoc" ] in
   match lookup_path ~possible_unit_names ~named_roots:pages ~hierarchy path with
@@ -472,6 +479,10 @@ let lookup_page ap ~pages ~hierarchy = function
   | `Path p -> lookup_page_by_path ~pages ~hierarchy p
   | `Name n -> lookup_page_by_name ap n
 
+let lookup_asset ~pages ~hierarchy = function
+  | `Path p -> lookup_asset_by_path ~pages ~hierarchy p
+  | `Name _ -> failwith "TODO"
+
 type t = {
   important_digests : bool;
   ap : Accessible_paths.t;
@@ -566,8 +577,11 @@ let build_compile_env_for_unit
   let lookup_unit =
     lookup_unit ~important_digests ~imports_map ap ~libs:None ~hierarchy:None
   and lookup_page _ = Error `Not_found
+  and lookup_asset _ = Error `Not_found
   and lookup_impl = lookup_impl ap in
-  let resolver = { Env.open_units; lookup_unit; lookup_page; lookup_impl } in
+  let resolver =
+    { Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
+  in
   Env.env_of_unit m ~linking:false resolver
 
 (** [important_digests] and [imports_map] only apply to modules. *)
@@ -589,8 +603,9 @@ let build ?(imports_map = StringMap.empty) ?hierarchy_roots
   let lookup_unit =
     lookup_unit ~important_digests ~imports_map ap ~libs ~hierarchy
   and lookup_page = lookup_page ap ~pages ~hierarchy
+  and lookup_asset = lookup_asset ~pages ~hierarchy
   and lookup_impl = lookup_impl ap in
-  { Env.open_units; lookup_unit; lookup_page; lookup_impl }
+  { Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
 
 let build_compile_env_for_impl t i =
   let imports_map =

src/search/json_index/json_search.ml

@@ -39,6 +39,7 @@ let rec of_id x =
   match x.iv with
   | `Root (_, name) -> [ ret "Root" (ModuleName.to_string name) ]
   | `Page (_, name) -> [ ret "Page" (PageName.to_string name) ]
+  | `AssetFile (_, name) -> [ ret "Asset" (AssetName.to_string name) ]
   | `LeafPage (_, name) -> [ ret "Page" (PageName.to_string name) ]
   | `Module (parent, name) ->
       ret "Module" (ModuleName.to_string name) :: of_id (parent :> t)
@@ -76,7 +77,7 @@ let rec of_id x =
   | `Label (parent, name) ->
       ret "Label" (LabelName.to_string name) :: of_id (parent :> t)
   | `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
-  | `SourceLocationInternal _ | `AssetFile _ ->
+  | `SourceLocationInternal _ ->
       [ `Null ]
 (* TODO *)
 

src/xref2/env.ml

@@ -14,6 +14,7 @@ type resolver = {
   open_units : string list;
   lookup_unit : path_query -> (lookup_unit_result, lookup_error) result;
   lookup_page : path_query -> (Lang.Page.t, lookup_error) result;
+  lookup_asset : path_query -> (Lang.Asset.t, lookup_error) result;
   lookup_impl : string -> Lang.Implementation.t option;
 }
 
@@ -431,6 +432,11 @@ let lookup_page query env =
   | None -> Error `Not_found
   | Some r -> r.lookup_page query
 
+let lookup_asset query env =
+  match env.resolver with
+  | None -> Error `Not_found
+  | Some r -> r.lookup_asset query
+
 let lookup_unit query env =
   match env.resolver with
   | None -> Error `Not_found
@@ -442,6 +448,9 @@ let lookup_impl name env =
 let lookup_page_by_name n env = lookup_page (`Name n) env
 let lookup_page_by_path p env = lookup_page (`Path p) env
 
+let lookup_asset_by_name p env = lookup_asset (`Name p) env
+let lookup_asset_by_path p env = lookup_asset (`Path p) env
+
 let lookup_unit_by_path p env =
   match lookup_unit (`Path p) env with
   | Ok (Found u) ->

src/xref2/env.mli

@@ -14,6 +14,7 @@ type resolver = {
   open_units : string list;
   lookup_unit : path_query -> (lookup_unit_result, lookup_error) result;
   lookup_page : path_query -> (Lang.Page.t, lookup_error) result;
+  lookup_asset : path_query -> (Lang.Asset.t, lookup_error) result;
   lookup_impl : string -> Lang.Implementation.t option;
 }
 
@@ -95,6 +96,11 @@ val lookup_page_by_name : string -> t -> (Lang.Page.t, lookup_error) result
 val lookup_page_by_path :
   Reference.Hierarchy.t -> t -> (Lang.Page.t, lookup_error) result
 
+val lookup_asset_by_path :
+  Reference.Hierarchy.t -> t -> (Lang.Asset.t, lookup_error) result
+
+val lookup_asset_by_name : string -> t -> (Lang.Asset.t, lookup_error) result
+
 val lookup_impl : string -> t -> Lang.Implementation.t option
 
 val lookup_unit_by_path :

src/xref2/ref_tools.ml

@@ -21,6 +21,8 @@ type class_type_lookup_result = Resolved.ClassType.t * Component.ClassType.t
 
 type page_lookup_result = Resolved.Page.t * Odoc_model.Lang.Page.t
 
+type asset_lookup_result = Resolved.Asset.t * Odoc_model.Lang.Asset.t
+
 type type_lookup_result =
   [ `T of datatype_lookup_result
   | `C of class_lookup_result
@@ -233,6 +235,10 @@ module Path = struct
     Env.lookup_page_by_path p env |> handle_lookup_error p >>= fun p ->
     Ok (`Identifier p.name, p)
 
+  let asset_in_env env p : asset_lookup_result ref_result =
+    Env.lookup_asset_by_path p env |> handle_lookup_error p >>= fun p ->
+    Ok (`Identifier p.name, p)
+
   let module_in_env env p : module_lookup_result ref_result =
     Env.lookup_unit_by_path p env |> handle_lookup_error p >>= fun m ->
     Ok (M.of_element env m)
@@ -626,6 +632,15 @@ module Page = struct
   let of_element _env (`Page (id, page)) : t = (`Identifier id, page)
 end
 
+module Asset = struct
+  type t = asset_lookup_result
+
+  let in_env env name : t ref_result =
+    match Env.lookup_asset_by_name name env with
+    | Ok p -> Ok (`Identifier p.Odoc_model.Lang.Asset.name, p)
+    | Error `Not_found -> Error (`Lookup_by_name (`Page (* TODO *), name))
+end
+
 module LP = struct
   (** Label parent *)
 
@@ -939,7 +954,7 @@ let resolve_reference : _ -> Reference.t -> _ =
         resolve_label_parent_reference env parent >>= fun p ->
         L.in_label_parent env p name >>= resolved_with_text
     | `Root (name, (`TPage | `TChildPage)) -> Page.in_env env name >>= resolved2
-    | `Root (name, `TAsset) -> Error (`Find_by_name (`Asset_path, name))
+    | `Root (name, `TAsset) -> Asset.in_env env name >>= resolved2
     | `Dot (parent, name) -> resolve_reference_dot env parent name
     | `Root (name, `TConstructor) -> CS.in_env env name >>= resolved1
     | `Constructor (parent, name) ->
@@ -970,7 +985,7 @@ let resolve_reference : _ -> Reference.t -> _ =
         resolve_class_signature_reference env parent >>= fun p ->
         MV.in_class_signature env p name >>= resolved1
     | `Page_path p -> Path.page_in_env env p >>= resolved2
-    | `Asset_path (tag, p) -> Error (`Path_error (`Not_found, tag, p))
+    | `Asset_path a -> Path.asset_in_env env a >>= resolved2
     | `Module_path p ->
         Path.module_in_env env p
         >>= module_lookup_to_signature_lookup env

test/xref2/path_references.t/doc/foo.mld

@@ -10,3 +10,7 @@
 {!//subdir/dup} {!/pkg/subdir/dup} {!subdir/dup}
 {1 Module Test}
 {!//Test} {!/libname/Test} {!./Test} {!Test}
+
+{1 Asset}
+
+{!//asset-"img.png"} {!./asset-"img.png"} {!/pkg/asset-"img.png"}

test/xref2/path_references.t/run.t

@@ -6,6 +6,7 @@
   $ odoc compile --output-dir h --parent-id pkg/doc/subdir doc/subdir/bar.mld
   $ odoc compile --output-dir h --parent-id pkg/doc/subdir doc/subdir/dup.mld
   $ odoc compile --output-dir h --parent-id pkg/lib/libname test.cmt
+  $ odoc compile-asset --output-dir h --parent-id pkg/doc --name img.png
 
   $ odoc link -P pkg:h/pkg/doc -L libname:h/pkg/lib/libname h/pkg/doc/subdir/page-dup.odoc
   $ odoc link -P pkg:h/pkg/doc -L libname:h/pkg/lib/libname h/pkg/doc/subdir/page-bar.odoc
@@ -67,6 +68,10 @@ Helper that extracts references in a compact way. Headings help to interpret the
   {"`Reference":[{"`Resolved":{"`Identifier":{"`Root":[{"Some":{"`Page":[{"Some":{"`Page":[{"Some":{"`Page":["None","pkg"]}},"lib"]}},"libname"]}},"Test"]}}},[]]}
   {"`Reference":[{"`Any_path":["`TRelativePath",["Test"]]},[]]}
   {"`Reference":[{"`Root":["Test","`TUnknown"]},[]]}
+  ["Asset"]
+  {"`Reference":[{"`Resolved":{"`Identifier":{"`AssetFile":[{"`Page":[{"Some":{"`Page":["None","pkg"]}},"doc"]},"img.png"]}}},[]]}
+  {"`Reference":[{"`Resolved":{"`Identifier":{"`AssetFile":[{"`Page":[{"Some":{"`Page":["None","pkg"]}},"doc"]},"img.png"]}}},[]]}
+  {"`Reference":[{"`Resolved":{"`Identifier":{"`AssetFile":[{"`Page":[{"Some":{"`Page":["None","pkg"]}},"doc"]},"img.png"]}}},[]]}
 
   $ odoc_print ./h/pkg/doc/subdir/page-bar.odocl | jq_references
   ["Title","for","subdir/bar"]