Skip to content

Commit

Permalink
Medias: allow re-resolving asset references
Browse files Browse the repository at this point in the history
  • Loading branch information
panglesd committed Aug 19, 2024
1 parent b0f3ada commit 01109c6
Show file tree
Hide file tree
Showing 3 changed files with 8 additions and 10 deletions.
2 changes: 1 addition & 1 deletion src/xref2/link.ml
Original file line number Diff line number Diff line change
Expand Up @@ -295,7 +295,7 @@ and comment_nestable_block_element env parent ~loc:_
`Modules refs
| `Media (`Reference r, m, content) as orig -> (
match Ref_tools.resolve_asset_reference env r |> Error.raise_warnings with
| Ok (x, _) -> `Media (`Reference (`Resolved x), m, content)
| Ok x -> `Media (`Reference (`Resolved x), m, content)
| Error e ->
Errors.report
~what:(`Reference (r :> Paths.Reference.t))
Expand Down
14 changes: 6 additions & 8 deletions src/xref2/ref_tools.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ 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 asset_lookup_result = Resolved.Asset.t

type type_lookup_result =
[ `T of datatype_lookup_result
Expand Down Expand Up @@ -237,7 +237,7 @@ module Path = struct

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)
Ok (`Identifier p.name)

let module_in_env env p : module_lookup_result ref_result =
Env.lookup_unit_by_path p env |> handle_lookup_error p >>= fun m ->
Expand Down Expand Up @@ -637,7 +637,7 @@ module Asset = struct

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)
| Ok p -> Ok (`Identifier p.Odoc_model.Lang.Asset.name)
| Error `Not_found -> Error (`Lookup_by_name (`Page (* TODO *), name))
end

Expand Down Expand Up @@ -832,9 +832,7 @@ let resolved3 (r, _, _) = resolved1 r
and resolved2 (r, _) = resolved1 r

let resolve_asset_reference env (r : Reference.Asset.t) : Asset.t ref_result =
match r with
| `Resolved _r -> failwith "What's going on!?"
| `Asset_path p -> Path.asset_in_env env p
match r with `Resolved r -> Ok r | `Asset_path p -> Path.asset_in_env env p

let resolved_type_lookup = function
| `T (r, _) -> resolved1 r
Expand Down Expand Up @@ -959,7 +957,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) -> Asset.in_env env name >>= resolved2
| `Root (name, `TAsset) -> Asset.in_env env name >>= resolved1
| `Dot (parent, name) -> resolve_reference_dot env parent name
| `Root (name, `TConstructor) -> CS.in_env env name >>= resolved1
| `Constructor (parent, name) ->
Expand Down Expand Up @@ -990,7 +988,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 a -> Path.asset_in_env env a >>= resolved2
| `Asset_path a -> Path.asset_in_env env a >>= resolved1
| `Module_path p ->
Path.module_in_env env p
>>= module_lookup_to_signature_lookup env
Expand Down
2 changes: 1 addition & 1 deletion src/xref2/ref_tools.mli
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ open Odoc_model.Paths.Reference
type module_lookup_result =
Resolved.Module.t * Cpath.Resolved.module_ * Component.Module.t

type asset_lookup_result = Resolved.Asset.t * Odoc_model.Lang.Asset.t
type asset_lookup_result = Resolved.Asset.t

type 'a ref_result =
('a, Errors.Tools_error.reference_lookup_error) Result.result
Expand Down

0 comments on commit 01109c6

Please sign in to comment.