Skip to content

Commit 2ca8c07

Browse files
JulowJulow
authored
Merge pull request #1171 from panglesd/odoc3-asset-references
Parse and resolve asset references
2 parents 4c03cf3 + 58fdf9c commit 2ca8c07

File tree

22 files changed

+138
-15
lines changed

22 files changed

+138
-15
lines changed

‎CHANGES.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@
2525
number of occurrences of each entry of the index in the json output
2626
(@panglesd, #1076).
2727
- Added a `compile-asset` command (@EmileTrotignon, @panglesd, #1170)
28+
- Allow referencing assets (@panglesd, #1171)
2829

2930
### Changed
3031

‎src/document/comment.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,7 @@ module Reference = struct
7676
| `Root (n, _) -> n
7777
| `Dot (p, f) -> render_unresolved (p :> t) ^ "." ^ f
7878
| `Page_path p -> render_path p
79+
| `Asset_path p -> render_path p
7980
| `Module_path p -> render_path p
8081
| `Any_path p -> render_path p
8182
| `Module (p, f) ->

‎src/document/url.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -190,6 +190,7 @@ module Path = struct
190190
| { iv = `AssetFile (parent, name); _ } ->
191191
let parent = from_identifier (parent :> any) in
192192
let kind = `File in
193+
let name = AssetName.to_string name in
193194
mk ~parent kind name
194195

195196
let from_identifier p =

‎src/model/names.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -159,3 +159,4 @@ module LabelName = SimpleName
159159
module PageName = SimpleName
160160
module DefName = SimpleName
161161
module LocalName = SimpleName
162+
module AssetName = SimpleName

‎src/model/names.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -100,3 +100,5 @@ module PageName : SimpleName
100100
module DefName : SimpleName
101101

102102
module LocalName : SimpleName
103+
104+
module AssetName : SimpleName

‎src/model/paths.ml

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ module Identifier = struct
6161
| `SourceLocationMod x -> name_aux (x :> t)
6262
| `SourceLocationInternal (x, anchor) ->
6363
name_aux (x :> t) ^ "#" ^ LocalName.to_string anchor
64-
| `AssetFile (_, name) -> name
64+
| `AssetFile (_, name) -> AssetName.to_string name
6565

6666
let rec is_hidden : t -> bool =
6767
fun x ->
@@ -143,7 +143,8 @@ module Identifier = struct
143143
LocalName.to_string name :: full_name_aux (parent :> t)
144144
| `SourceLocationMod name -> full_name_aux (name :> t)
145145
| `SourcePage (parent, name) -> name :: full_name_aux (parent :> t)
146-
| `AssetFile (parent, name) -> name :: full_name_aux (parent :> t)
146+
| `AssetFile (parent, name) ->
147+
AssetName.to_string name :: full_name_aux (parent :> t)
147148

148149
let fullname : [< t_pv ] id -> string list =
149150
fun n -> List.rev @@ full_name_aux (n :> t)
@@ -497,8 +498,8 @@ module Identifier = struct
497498
[> `LeafPage of ContainerPage.t option * PageName.t ] id =
498499
mk_parent_opt PageName.to_string "lp" (fun (p, n) -> `LeafPage (p, n))
499500

500-
let asset_file : Page.t * string -> AssetFile.t =
501-
mk_parent (fun k -> k) "asset" (fun (p, n) -> `AssetFile (p, n))
501+
let asset_file : Page.t * AssetName.t -> AssetFile.t =
502+
mk_parent AssetName.to_string "asset" (fun (p, n) -> `AssetFile (p, n))
502503

503504
let source_page (container_page, path) =
504505
let rec source_dir dir =
@@ -1090,6 +1091,10 @@ module Reference = struct
10901091
module Page = struct
10911092
type t = Paths_types.Resolved_reference.page
10921093
end
1094+
1095+
module Asset = struct
1096+
type t = Paths_types.Resolved_reference.asset
1097+
end
10931098
end
10941099

10951100
type t = Paths_types.Reference.any

‎src/model/paths.mli

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,7 @@ module Identifier : sig
253253

254254
val source_page : ContainerPage.t * string list -> SourcePage.t
255255

256-
val asset_file : Page.t * string -> AssetFile.t
256+
val asset_file : Page.t * AssetName.t -> AssetFile.t
257257

258258
val root :
259259
ContainerPage.t option * ModuleName.t ->
@@ -551,6 +551,10 @@ module rec Reference : sig
551551
type t = Paths_types.Resolved_reference.page
552552
end
553553

554+
module Asset : sig
555+
type t = Paths_types.Resolved_reference.asset
556+
end
557+
554558
type t = Paths_types.Resolved_reference.any
555559

556560
val identifier : t -> Identifier.t

‎src/model/paths_types.ml

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ module Identifier = struct
3232
type source_page = source_page_pv id
3333
(** @canonical Odoc_model.Paths.Identifier.SourcePage.t *)
3434

35-
type asset_file_pv = [ `AssetFile of page * string ]
35+
type asset_file_pv = [ `AssetFile of page * AssetName.t ]
3636
(** The second argument is the filename.
3737
3838
@canonical Odoc_model.Paths.Identifier.AssetFile.t_pv *)
@@ -575,6 +575,7 @@ module rec Reference : sig
575575
| `TInstanceVariable
576576
| `TLabel
577577
| `TPage
578+
| `TAsset
578579
| `TChildPage
579580
| `TChildModule
580581
| `TUnknown ]
@@ -651,6 +652,8 @@ module rec Reference : sig
651652
| `Type of signature * TypeName.t ]
652653
(** @canonical Odoc_model.Paths.Reference.LabelParent.t *)
653654

655+
type asset = [ `Asset_path of hierarchy ]
656+
654657
type module_ =
655658
[ `Resolved of Resolved_reference.module_
656659
| `Root of string * [ `TModule | `TUnknown ]
@@ -769,6 +772,7 @@ module rec Reference : sig
769772
| `Dot of label_parent * string
770773
| `Page_path of hierarchy
771774
| `Module_path of hierarchy
775+
| `Asset_path of hierarchy
772776
| `Any_path of hierarchy
773777
| `Module of signature * ModuleName.t
774778
| `ModuleType of signature * ModuleTypeName.t
@@ -929,6 +933,9 @@ and Resolved_reference : sig
929933
type page = [ `Identifier of Identifier.reference_page ]
930934
(** @canonical Odoc_model.Paths.Reference.Resolved.Page.t *)
931935

936+
type asset = [ `Identifier of Identifier.asset_file ]
937+
(** @canonical Odoc_model.Paths.Reference.Resolved.Asset.t *)
938+
932939
type any =
933940
[ `Identifier of Identifier.any
934941
| `Alias of Resolved_path.module_ * module_

‎src/model/reference.ml

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ let match_extra_odoc_reference_kind (_location as loc) s :
9090
Some `TLabel
9191
| "module-type" -> Some `TModuleType
9292
| "page" -> Some `TPage
93+
| "asset" -> Some `TAsset
9394
| "value" ->
9495
d loc "value" "val";
9596
Some `TValue
@@ -352,12 +353,24 @@ let parse whole_reference_location s :
352353
)
353354
in
354355

356+
let label_parent_path { identifier; location; _ } kind next_token tokens =
357+
let path () = path [ identifier ] next_token tokens in
358+
match kind with
359+
| `TUnknown -> `Any_path (path ())
360+
| `TModule -> `Module_path (path ())
361+
| `TPage -> `Page_path (path ())
362+
| _ ->
363+
expected ~expect_paths:true [ "module"; "page" ] location
364+
|> Error.raise_exception
365+
in
366+
355367
let any_path { identifier; location; _ } kind next_token tokens =
356368
let path () = path [ identifier ] next_token tokens in
357369
match kind with
358370
| `TUnknown -> `Any_path (path ())
359371
| `TModule -> `Module_path (path ())
360372
| `TPage -> `Page_path (path ())
373+
| `TAsset -> `Asset_path (path ())
361374
| _ ->
362375
expected ~expect_paths:true [ "module"; "page" ] location
363376
|> Error.raise_exception
@@ -379,7 +392,7 @@ let parse whole_reference_location s :
379392
location
380393
|> Error.raise_exception)
381394
| next_token :: tokens when ends_in_slash next_token ->
382-
any_path token kind next_token tokens
395+
label_parent_path token kind next_token tokens
383396
| next_token :: tokens -> (
384397
match kind with
385398
| `TUnknown -> `Dot (label_parent next_token tokens, identifier)
@@ -499,6 +512,21 @@ let parse whole_reference_location s :
499512
in
500513
(* Prefixed pages are not differentiated. *)
501514
`Page_path (path [ identifier ] next_token tokens)
515+
| `TAsset ->
516+
let () =
517+
match next_token.kind with
518+
| `End_in_slash -> ()
519+
| `None | `Prefixed _ ->
520+
let suggestion =
521+
Printf.sprintf "Reference assets as '<parent_path>/%s'."
522+
identifier
523+
in
524+
not_allowed ~what:"Asset label"
525+
~in_what:"on the right side of a dot" ~suggestion location
526+
|> Error.raise_exception
527+
in
528+
(* Prefixed assets are not differentiated. *)
529+
`Asset_path (path [ identifier ] next_token tokens)
502530
| `TPathComponent -> assert false)
503531
in
504532

‎src/model/root.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,7 @@ let to_string t =
9494
| `AssetFile (parent, name) ->
9595
Format.fprintf fmt "%a::%s" pp
9696
(parent :> Paths.Identifier.OdocId.t)
97-
name
97+
(Names.AssetName.to_string name)
9898
in
9999

100100
Format.asprintf "%a" pp t.id

‎src/model_desc/paths_desc.ml

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,8 @@ module Names = struct
3636

3737
let pagename = To_string PageName.to_string
3838

39+
let assetname = To_string AssetName.to_string
40+
3941
let parametername = To_string ModuleName.to_string
4042

4143
let defname = To_string DefName.to_string
@@ -77,7 +79,10 @@ module General_paths = struct
7779
((parent :> id_t option), name),
7880
Pair (Option identifier, Names.pagename) )
7981
| `AssetFile (parent, name) ->
80-
C ("`AssetFile", ((parent :> id_t), name), Pair (identifier, string))
82+
C
83+
( "`AssetFile",
84+
((parent :> id_t), name),
85+
Pair (identifier, Names.assetname) )
8186
| `Root (parent, name) ->
8287
C
8388
( "`Root",
@@ -197,6 +202,7 @@ module General_paths = struct
197202
| `TModule -> C0 "`TModule"
198203
| `TModuleType -> C0 "`TModuleType"
199204
| `TPage -> C0 "`TPage"
205+
| `TAsset -> C0 "`TAsset"
200206
| `TType -> C0 "`TType"
201207
| `TUnknown -> C0 "`TUnknown"
202208
| `TValue -> C0 "`TValue"
@@ -300,6 +306,7 @@ module General_paths = struct
300306
| `Root (x1, x2) -> C ("`Root", (x1, x2), Pair (string, reference_tag))
301307
| `Dot (x1, x2) -> C ("`Dot", ((x1 :> r), x2), Pair (reference, string))
302308
| `Page_path x -> C ("`Page_path", x, hierarchy_reference)
309+
| `Asset_path x -> C ("`Asset_path", x, hierarchy_reference)
303310
| `Module_path x -> C ("`Module_path", x, hierarchy_reference)
304311
| `Any_path x -> C ("`Any_path", x, hierarchy_reference)
305312
| `Module (x1, x2) ->

‎src/odoc/asset.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@ let compile ~parent_id ~name ~output_dir =
22
let open Odoc_model in
33
let parent_id = Compile.mk_id parent_id in
44
let id =
5-
Paths.Identifier.Mk.asset_file ((parent_id :> Paths.Identifier.Page.t), name)
5+
Paths.Identifier.Mk.asset_file
6+
((parent_id :> Paths.Identifier.Page.t), Names.AssetName.make_std name)
67
in
78
let directory =
89
Compile.path_of_id output_dir parent_id

‎src/odoc/html_page.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,10 @@ let asset_documents parent_id children asset_paths =
5858
Error.raise_warning (Error.filename_only "asset is missing." name);
5959
None
6060
| Some path ->
61-
let asset_id = Paths.Identifier.Mk.asset_file (parent_id, name) in
61+
let asset_id =
62+
Paths.Identifier.Mk.asset_file
63+
(parent_id, Names.AssetName.make_std name)
64+
in
6265
let url = Odoc_document.Url.Path.from_identifier asset_id in
6366
Some (Odoc_document.Types.Document.Asset { url; src = path }))
6467
paired_or_missing

‎src/odoc/resolver.ml

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -447,6 +447,13 @@ let lookup_path ~possible_unit_names ~named_roots ~hierarchy (tag, path) :
447447
|> List.find_map find_in_hierarchy
448448
|> option_to_result
449449

450+
let lookup_asset_by_path ~pages ~hierarchy path =
451+
let possible_unit_names name = [ "asset-" ^ name ^ ".odoc" ] in
452+
match lookup_path ~possible_unit_names ~named_roots:pages ~hierarchy path with
453+
| Ok (Odoc_file.Asset_content asset) -> Ok asset
454+
| Ok _ -> Error `Not_found (* TODO: Report is not an asset. *)
455+
| Error _ as e -> e
456+
450457
let lookup_page_by_path ~pages ~hierarchy path =
451458
let possible_unit_names name = [ "page-" ^ name ^ ".odoc" ] in
452459
match lookup_path ~possible_unit_names ~named_roots:pages ~hierarchy path with
@@ -472,6 +479,10 @@ let lookup_page ap ~pages ~hierarchy = function
472479
| `Path p -> lookup_page_by_path ~pages ~hierarchy p
473480
| `Name n -> lookup_page_by_name ap n
474481

482+
let lookup_asset ~pages ~hierarchy = function
483+
| `Path p -> lookup_asset_by_path ~pages ~hierarchy p
484+
| `Name _ -> failwith "TODO"
485+
475486
type t = {
476487
important_digests : bool;
477488
ap : Accessible_paths.t;
@@ -566,8 +577,11 @@ let build_compile_env_for_unit
566577
let lookup_unit =
567578
lookup_unit ~important_digests ~imports_map ap ~libs:None ~hierarchy:None
568579
and lookup_page _ = Error `Not_found
580+
and lookup_asset _ = Error `Not_found
569581
and lookup_impl = lookup_impl ap in
570-
let resolver = { Env.open_units; lookup_unit; lookup_page; lookup_impl } in
582+
let resolver =
583+
{ Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
584+
in
571585
Env.env_of_unit m ~linking:false resolver
572586

573587
(** [important_digests] and [imports_map] only apply to modules. *)
@@ -589,8 +603,9 @@ let build ?(imports_map = StringMap.empty) ?hierarchy_roots
589603
let lookup_unit =
590604
lookup_unit ~important_digests ~imports_map ap ~libs ~hierarchy
591605
and lookup_page = lookup_page ap ~pages ~hierarchy
606+
and lookup_asset = lookup_asset ~pages ~hierarchy
592607
and lookup_impl = lookup_impl ap in
593-
{ Env.open_units; lookup_unit; lookup_page; lookup_impl }
608+
{ Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
594609

595610
let build_compile_env_for_impl t i =
596611
let imports_map =

‎src/search/json_index/json_search.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ let rec of_id x =
3939
match x.iv with
4040
| `Root (_, name) -> [ ret "Root" (ModuleName.to_string name) ]
4141
| `Page (_, name) -> [ ret "Page" (PageName.to_string name) ]
42+
| `AssetFile (_, name) -> [ ret "Asset" (AssetName.to_string name) ]
4243
| `LeafPage (_, name) -> [ ret "Page" (PageName.to_string name) ]
4344
| `Module (parent, name) ->
4445
ret "Module" (ModuleName.to_string name) :: of_id (parent :> t)
@@ -76,7 +77,7 @@ let rec of_id x =
7677
| `Label (parent, name) ->
7778
ret "Label" (LabelName.to_string name) :: of_id (parent :> t)
7879
| `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
79-
| `SourceLocationInternal _ | `AssetFile _ ->
80+
| `SourceLocationInternal _ ->
8081
[ `Null ]
8182
(* TODO *)
8283

‎src/xref2/component.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -744,7 +744,9 @@ module Fmt = struct
744744
| `SourceLocationMod p ->
745745
Format.fprintf ppf "%a#" (model_identifier c) (p :> id)
746746
| `AssetFile (p, name) ->
747-
Format.fprintf ppf "%a/%s" (model_identifier c) (p :> id) name
747+
Format.fprintf ppf "%a/%s" (model_identifier c)
748+
(p :> id)
749+
(AssetName.to_string name)
748750

749751
let rec signature : config -> Format.formatter -> Signature.t -> unit =
750752
fun c ppf sg ->
@@ -1676,6 +1678,7 @@ module Fmt = struct
16761678
| `Dot (parent, str) ->
16771679
Format.fprintf ppf "%a.%s" (model_reference c) (parent :> t) str
16781680
| `Page_path p -> model_reference_hierarchy c ppf p
1681+
| `Asset_path p -> model_reference_hierarchy c ppf p
16791682
| `Module_path p -> model_reference_hierarchy c ppf p
16801683
| `Any_path p -> model_reference_hierarchy c ppf p
16811684
| `Module (parent, name) ->

‎src/xref2/env.ml

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ type resolver = {
1414
open_units : string list;
1515
lookup_unit : path_query -> (lookup_unit_result, lookup_error) result;
1616
lookup_page : path_query -> (Lang.Page.t, lookup_error) result;
17+
lookup_asset : path_query -> (Lang.Asset.t, lookup_error) result;
1718
lookup_impl : string -> Lang.Implementation.t option;
1819
}
1920

@@ -431,6 +432,11 @@ let lookup_page query env =
431432
| None -> Error `Not_found
432433
| Some r -> r.lookup_page query
433434

435+
let lookup_asset query env =
436+
match env.resolver with
437+
| None -> Error `Not_found
438+
| Some r -> r.lookup_asset query
439+
434440
let lookup_unit query env =
435441
match env.resolver with
436442
| None -> Error `Not_found
@@ -442,6 +448,9 @@ let lookup_impl name env =
442448
let lookup_page_by_name n env = lookup_page (`Name n) env
443449
let lookup_page_by_path p env = lookup_page (`Path p) env
444450

451+
let lookup_asset_by_name p env = lookup_asset (`Name p) env
452+
let lookup_asset_by_path p env = lookup_asset (`Path p) env
453+
445454
let lookup_unit_by_path p env =
446455
match lookup_unit (`Path p) env with
447456
| Ok (Found u) ->

0 commit comments

Comments
 (0)