diff --git a/src/document/comment.ml b/src/document/comment.ml index 73362632c6..c3e2a551f8 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -59,7 +59,7 @@ module Reference = struct render_resolved (r :> t) ^ "." ^ InstanceVariableName.to_string s | `Label (_, s) -> LabelName.to_string s - let render_page_path (tag, cs) = + let render_path (tag, cs) = let tag = match tag with | `TRelativePath -> "./" @@ -74,7 +74,9 @@ module Reference = struct | `Resolved r -> render_resolved r | `Root (n, _) -> n | `Dot (p, f) -> render_unresolved (p :> t) ^ "." ^ f - | `Page_path p -> render_page_path p + | `Page_path p -> render_path p + | `Module_path p -> render_path p + | `Any_path p -> render_path p | `Module (p, f) -> render_unresolved (p :> t) ^ "." ^ ModuleName.to_string f | `ModuleType (p, f) -> diff --git a/src/model/paths.ml b/src/model/paths.ml index b48e3eadf3..4646c00d98 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -1083,7 +1083,7 @@ module Reference = struct type t = Paths_types.Reference.any type tag_any = Paths_types.Reference.tag_any - type tag_page_path = Paths_types.Reference.tag_page_path + type tag_path = Paths_types.Reference.tag_path module Signature = struct type t = Paths_types.Reference.signature @@ -1165,7 +1165,7 @@ module Reference = struct type t = Paths_types.Reference.page end - module PagePath = struct - type t = Paths_types.Reference.page_path + module Path = struct + type t = Paths_types.Reference.path end end diff --git a/src/model/paths.mli b/src/model/paths.mli index 231f11a021..c46ca893ef 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -633,12 +633,12 @@ module rec Reference : sig type t = Paths_types.Reference.page end - module PagePath : sig - type t = Paths_types.Reference.page_path + module Path : sig + type t = Paths_types.Reference.path end type t = Paths_types.Reference.any type tag_any = Paths_types.Reference.tag_any - type tag_page_path = Paths_types.Reference.tag_page_path + type tag_path = Paths_types.Reference.tag_path end diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 742d2e8c66..9e3062ec8b 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -553,7 +553,7 @@ module rec Reference : sig type tag_only_child_module = [ `TChildModule ] - type tag_page_path = + type tag_path = [ `TRelativePath (* {!identifier/} *) | `TAbsolutePath (* {!/identifier} *) | `TCurrentPackage (* {!//identifier} *) ] @@ -597,14 +597,14 @@ module rec Reference : sig | `TChildPage | `TChildModule ] - type page_path = tag_page_path * string list - (** @canonical Odoc_model.Paths.Reference.PagePath.t *) + type path = tag_path * string list + (** @canonical Odoc_model.Paths.Reference.Path.t *) type signature = [ `Resolved of Resolved_reference.signature | `Root of string * tag_signature | `Dot of label_parent * string - | `Page_path of page_path + | `Module_path of path | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t ] (** @canonical Odoc_model.Paths.Reference.Signature.t *) @@ -629,6 +629,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.field_parent | `Root of string * tag_parent | `Dot of label_parent * string + | `Module_path of path | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Type of signature * TypeName.t ] @@ -638,7 +639,9 @@ module rec Reference : sig [ `Resolved of Resolved_reference.label_parent | `Root of string * tag_label_parent | `Dot of label_parent * string - | `Page_path of page_path + | `Page_path of path + | `Module_path of path + | `Any_path of path | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Class of signature * ClassName.t @@ -650,6 +653,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.module_ | `Root of string * [ `TModule | `TUnknown ] | `Dot of label_parent * string + | `Module_path of path | `Module of signature * ModuleName.t ] (** @canonical Odoc_model.Paths.Reference.Module.t *) @@ -754,14 +758,16 @@ module rec Reference : sig [ `Resolved of Resolved_reference.page | `Root of string * [ `TPage | `TUnknown ] | `Dot of label_parent * string - | `Page_path of page_path ] + | `Page_path of path ] (** @canonical Odoc_model.Paths.Reference.Page.t *) type any = [ `Resolved of Resolved_reference.any | `Root of string * tag_any | `Dot of label_parent * string - | `Page_path of page_path + | `Page_path of path + | `Module_path of path + | `Any_path of path | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Type of signature * TypeName.t diff --git a/src/model/reference.ml b/src/model/reference.ml index 5c18247032..b924922976 100644 --- a/src/model/reference.ml +++ b/src/model/reference.ml @@ -81,7 +81,7 @@ let match_extra_odoc_reference_kind (_location as loc) s : Some `TValue | _ -> None -type reference_kind = [ Paths.Reference.tag_any | `TRelativePath ] +type reference_kind = [ Paths.Reference.tag_any | `TPathComponent ] (* Ideally, [tokenize] would call this on every reference kind annotation during tokenization, when generating the token list. However, that constrains the @@ -104,7 +104,7 @@ let match_reference_kind location s : reference_kind = match result with | Some kind -> kind | None -> unknown_reference_qualifier s location |> Error.raise_exception) - | `End_in_slash -> `TRelativePath + | `End_in_slash -> `TPathComponent type token = { kind : [ `None | `Prefixed of string | `End_in_slash ]; @@ -221,7 +221,7 @@ let parse whole_reference_location s : Paths.Reference.t Error.with_errors_and_warnings = let open Paths.Reference in let open Names in - let rec page_path components next_token tokens : PagePath.t = + let rec path components next_token tokens : Path.t = match (next_token.kind, tokens) with | `End_in_slash, [] when next_token.identifier = "" -> (* {!/identifier} *) @@ -237,19 +237,16 @@ let parse whole_reference_location s : (* {!identifier'/identifier} *) (`TRelativePath, next_token.identifier :: components) | `End_in_slash, next_token' :: tokens' -> - (* {!page_path/identifier} *) - page_path (next_token.identifier :: components) next_token' tokens' + (* {!path/identifier} *) + path (next_token.identifier :: components) next_token' tokens' | (`None | `Prefixed _), _ -> (* This is not really expected *) expected ~expect_paths:true [] next_token.location |> Error.raise_exception in - let dot_or_slash (type parent) (dot : _ -> _ -> parent) identifier next_token - tokens : [ `Page_path of PagePath.t | `Dot of parent * string ] = - match next_token.kind with - | `End_in_slash -> `Page_path (page_path [ identifier ] next_token tokens) - | _ -> `Dot (dot next_token tokens, identifier) + let ends_in_slash next_token = + match next_token.kind with `End_in_slash -> true | _ -> false in let rec signature { kind; identifier; location } tokens : Signature.t = @@ -259,21 +256,28 @@ let parse whole_reference_location s : match kind with | (`TUnknown | `TModule | `TModuleType) as kind -> `Root (identifier, kind) - | `TRelativePath -> `Page_path (`TRelativePath, [ identifier ]) + | `TPathComponent -> `Module_path (`TRelativePath, [ identifier ]) | _ -> expected ~expect_paths:true [ "module"; "module-type" ] location |> Error.raise_exception) + | next_token :: tokens when ends_in_slash next_token -> ( + match kind with + | `TUnknown | `TModule -> + `Module_path (path [ identifier ] next_token tokens) + | _ -> + expected ~expect_paths:true [ "module" ] location + |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> - (dot_or_slash parent identifier next_token tokens :> Signature.t) + `Dot ((parent next_token tokens :> LabelParent.t), identifier) | `TModule -> `Module (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> `ModuleType (signature next_token tokens, ModuleTypeName.make_std identifier) - | `TRelativePath -> - `Page_path (page_path [ identifier ] next_token tokens) + | `TPathComponent -> + `Module_path (path [ identifier ] next_token tokens) | _ -> expected ~expect_paths:true [ "module"; "module-type" ] location |> Error.raise_exception) @@ -287,6 +291,13 @@ let parse whole_reference_location s : | _ -> expected [ "module"; "module-type"; "type" ] location |> Error.raise_exception) + | next_token :: tokens when ends_in_slash next_token -> ( + match kind with + | `TUnknown | `TModule -> + `Module_path (path [ identifier ] next_token tokens) + | _ -> + expected ~expect_paths:true [ "module" ] location + |> Error.raise_exception) | next_token :: tokens -> ( match kind with | `TUnknown -> @@ -326,7 +337,19 @@ let parse whole_reference_location s : ) in - let rec label_parent { kind; identifier; location } tokens : LabelParent.t = + let any_page { identifier; location; _ } kind next_token tokens = + let path () = path [ identifier ] next_token tokens in + match kind with + | `TUnknown -> `Any_path (path ()) + | `TModule -> `Module_path (path ()) + | `TPage -> `Page_path (path ()) + | _ -> + expected ~expect_paths:true [ "module"; "page" ] location + |> Error.raise_exception + in + + let rec label_parent ({ kind; identifier; location } as token) tokens : + LabelParent.t = let kind = match_reference_kind location kind in match tokens with | [] -> ( @@ -334,17 +357,17 @@ let parse whole_reference_location s : | ( `TUnknown | `TModule | `TModuleType | `TType | `TClass | `TClassType | `TPage ) as kind -> `Root (identifier, kind) - | `TRelativePath -> `Page_path (`TRelativePath, [ identifier ]) + | `TPathComponent -> `Page_path (`TRelativePath, [ identifier ]) | _ -> expected ~expect_paths:true [ "module"; "module-type"; "type"; "class"; "class-type"; "page" ] location |> Error.raise_exception) + | next_token :: tokens when ends_in_slash next_token -> + any_page token kind next_token tokens | next_token :: tokens -> ( match kind with - | `TUnknown -> - (dot_or_slash label_parent identifier next_token tokens - :> LabelParent.t) + | `TUnknown -> `Dot (label_parent next_token tokens, identifier) | `TModule -> `Module (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> @@ -357,8 +380,7 @@ let parse whole_reference_location s : | `TClassType -> `ClassType (signature next_token tokens, ClassTypeName.make_std identifier) - | `TRelativePath -> - `Page_path (page_path [ identifier ] next_token tokens) + | `TPathComponent -> `Page_path (path [ identifier ] next_token tokens) | _ -> expected ~expect_paths:true [ "module"; "module-type"; "type"; "class"; "class-type" ] @@ -366,7 +388,8 @@ let parse whole_reference_location s : |> Error.raise_exception) in - let start_from_last_component { kind; identifier; location } old_kind tokens = + let start_from_last_component ({ kind; identifier; location } as token) + old_kind tokens = let new_kind = match_reference_kind location kind in let kind = match old_kind with @@ -394,12 +417,12 @@ let parse whole_reference_location s : | [] -> ( match kind with | #Paths.Reference.tag_any as kind -> `Root (identifier, kind) - | `TRelativePath -> `Page_path (`TRelativePath, [ identifier ])) + | `TPathComponent -> `Page_path (`TRelativePath, [ identifier ])) + | next_token :: tokens when ends_in_slash next_token -> + any_page token kind next_token tokens | next_token :: tokens -> ( match kind with - | `TUnknown -> - (dot_or_slash label_parent identifier next_token tokens - :> Paths.Reference.t) + | `TUnknown -> `Dot (label_parent next_token tokens, identifier) | `TModule -> `Module (signature next_token tokens, ModuleName.make_std identifier) | `TModuleType -> @@ -460,9 +483,8 @@ let parse whole_reference_location s : |> Error.raise_exception in (* Prefixed pages are not differentiated. *) - `Page_path (page_path [ identifier ] next_token tokens) - | `TRelativePath -> - `Page_path (page_path [ identifier ] next_token tokens)) + `Page_path (path [ identifier ] next_token tokens) + | `TPathComponent -> `Page_path (path [ identifier ] next_token tokens)) in let old_kind, s, location = diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml index 1b4253264a..4a1be6b29c 100644 --- a/src/model_desc/paths_desc.ml +++ b/src/model_desc/paths_desc.ml @@ -283,7 +283,7 @@ module General_paths = struct | `SubstitutedT c -> C ("`SubstitutedT", (c :> rp), resolved_path) | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path)) - and page_path_reference : Paths.Reference.PagePath.t t = + and path_reference : Paths.Reference.Path.t t = let tag_page_path = Variant (function @@ -299,7 +299,9 @@ module General_paths = struct | `Resolved x -> C ("`Resolved", x, resolved_reference) | `Root (x1, x2) -> C ("`Root", (x1, x2), Pair (string, reference_tag)) | `Dot (x1, x2) -> C ("`Dot", ((x1 :> r), x2), Pair (reference, string)) - | `Page_path x -> C ("`Page_path", x, page_path_reference) + | `Page_path x -> C ("`Page_path", x, path_reference) + | `Module_path x -> C ("`Module_path", x, path_reference) + | `Any_path x -> C ("`Any_path", x, path_reference) | `Module (x1, x2) -> C ("`Module", ((x1 :> r), x2), Pair (reference, Names.modulename)) | `ModuleType (x1, x2) -> diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 937a5adc58..45bf39a676 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -1655,8 +1655,7 @@ module Fmt = struct (parent :> t) (LabelName.to_string name) - and model_reference_page_path _c ppf - ((tag, components) : Reference.PagePath.t) = + and model_reference_path _c ppf ((tag, components) : Reference.Path.t) = (match tag with | `TRelativePath -> fpf ppf "./" | `TAbsolutePath -> fpf ppf "/" @@ -1671,7 +1670,9 @@ module Fmt = struct | `Root (name, _) -> Format.fprintf ppf "unresolvedroot(%s)" name | `Dot (parent, str) -> Format.fprintf ppf "%a.%s" (model_reference c) (parent :> t) str - | `Page_path p -> model_reference_page_path c ppf p + | `Page_path p -> model_reference_path c ppf p + | `Module_path p -> model_reference_path c ppf p + | `Any_path p -> model_reference_path c ppf p | `Module (parent, name) -> Format.fprintf ppf "%a.%s" (model_reference c) (parent :> t) diff --git a/src/xref2/errors.ml b/src/xref2/errors.ml index 27efc8d570..021bb94e8d 100644 --- a/src/xref2/errors.ml +++ b/src/xref2/errors.ml @@ -10,7 +10,17 @@ module Tools_error = struct (* Failed to resolve a module path when applying a fragment item *) ] type reference_kind = - [ `S | `T | `C | `CT | `Page | `Cons | `Field | `Label | `Page_path ] + [ `S + | `T + | `C + | `CT + | `Page + | `Cons + | `Field + | `Label + | `Page_path + | `Module_path + | `Any_path ] type expansion_of_module_error = [ `OpaqueModule (* The module does not have an expansion *) @@ -126,7 +136,9 @@ module Tools_error = struct | `Cons -> "constructor" | `Field -> "field" | `Label -> "label" - | `Page_path -> "page path" + | `Page_path -> "path to a page" + | `Module_path -> "path to a module" + | `Any_path -> "path" in Format.pp_print_string fmt k diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 48c803b20e..c51172565a 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -25,11 +25,13 @@ type type_lookup_result = | `C of class_lookup_result | `CT of class_type_lookup_result ] -type page_path_lookup_result = - [ `S of signature_lookup_result | `P of page_lookup_result ] +type any_path_lookup_result = + [ `P of page_lookup_result | `S of signature_lookup_result ] type label_parent_lookup_result = - [ type_lookup_result | page_path_lookup_result ] + [ type_lookup_result + | `P of page_lookup_result + | `S of signature_lookup_result ] type fragment_type_parent_lookup_result = [ `S of signature_lookup_result | `T of datatype_lookup_result ] @@ -162,10 +164,6 @@ let module_type_lookup_to_signature_lookup env (ref, cp, m) = >>= Tools.assert_not_functor >>= fun sg -> Ok ((ref :> Resolved.Signature.t), `ModuleType cp, sg) -let page_path_lookup_to_signature_lookup = function - | `S r -> Ok r - | `P _ as r -> wrong_kind_error [ `S ] r - let type_lookup_to_class_signature_lookup = let resolved p' cs = Ok ((p' :> Resolved.ClassSignature.t), cs) in fun env -> function @@ -179,12 +177,18 @@ let type_lookup_to_class_signature_lookup = |> of_option ~error:(`Parent (`Parent_type `OpaqueClass)) >>= resolved p' -module Page_path = struct - type t = page_path_lookup_result +module Path = struct + let page_in_env _env _page_path : page_lookup_result ref_result = + (* Not implemented *) + Error (`Wrong_kind ([ `Page ], `Page_path)) + + let module_in_env _env _page_path : module_lookup_result ref_result = + (* Not implemented *) + Error (`Wrong_kind ([ `S ], `Module_path)) - let in_env _env _page_path : t ref_result = + let any_in_env _env _page_path : any_path_lookup_result ref_result = (* Not implemented *) - Error (`Wrong_kind ([ `S; `Page ], `Page_path)) + Error (`Wrong_kind ([ `S; `Page ], `Any_path)) end module M = struct @@ -666,9 +670,12 @@ let rec resolve_label_parent_reference env (r : LabelParent.t) = | `Root (name, `TChildModule) -> resolve_signature_reference env (`Root (name, `TModule)) >>= fun s -> Ok (`S s) - | `Page_path page_path -> - Page_path.in_env env page_path >>= fun r -> - Ok (r :> label_parent_lookup_result) + | `Page_path p -> Path.page_in_env env p >>= fun r -> Ok (`P r) + | `Module_path p -> + Path.module_in_env env p >>= module_lookup_to_signature_lookup env + >>= fun r -> Ok (`S r) + | `Any_path p -> + Path.any_in_env env p >>= fun r -> Ok (r :> label_parent_lookup_result) and resolve_fragment_type_parent_reference (env : Env.t) (r : FragmentTypeParent.t) : (fragment_type_parent_lookup_result, _) result @@ -690,6 +697,9 @@ and resolve_fragment_type_parent_reference (env : Env.t) resolve_label_parent_reference env parent >>= signature_lookup_result_of_label_parent >>= fun p -> DT.in_signature env p name + | `Module_path p -> + Path.module_in_env env p >>= module_lookup_to_signature_lookup env + >>= fun r -> Ok (`S r) and resolve_signature_reference : Env.t -> Signature.t -> signature_lookup_result ref_result = @@ -734,8 +744,8 @@ and resolve_signature_reference : (MT.of_component env mt (`ModuleType (parent_cp, name)) (`ModuleType (parent, name)))) - | `Page_path page_path -> - Page_path.in_env env page_path >>= page_path_lookup_to_signature_lookup + | `Module_path p -> + Path.module_in_env env p >>= module_lookup_to_signature_lookup env in resolve env' @@ -751,6 +761,7 @@ and resolve_module_reference env (r : Module.t) : M.t ref_result = resolve_signature_reference env parent >>= fun p -> M.in_signature env p (ModuleName.to_string name) | `Root (name, _) -> M.in_env env name + | `Module_path p -> Path.module_in_env env p let resolve_class_signature_reference env (r : ClassSignature.t) = (* Casting from ClassSignature to LabelParent. @@ -919,8 +930,12 @@ let resolve_reference : _ -> Reference.t -> _ = | `InstanceVariable (parent, name) -> resolve_class_signature_reference env parent >>= fun p -> MV.in_class_signature env p name >>= resolved1 - | `Page_path page_path -> - Page_path.in_env env page_path >>= resolved_page_path_lookup + | `Page_path p -> Path.page_in_env env p >>= resolved2 + | `Module_path p -> + Path.module_in_env env p + >>= module_lookup_to_signature_lookup env + >>= resolved + | `Any_path p -> Path.any_in_env env p >>= resolved_page_path_lookup let resolve_module_reference env m = Odoc_model.Error.catch_warnings (fun () -> resolve_module_reference env m) diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml index c54780dc66..357b573409 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -2700,108 +2700,108 @@ let%expect_test _ = let abs = test "{!/foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TAbsolutePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] let abs_label_parent_page = test "{!/foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let abs_label_parent_module = test "{!/foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] (* References to current package root *) let root_to_page = test "{!//foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TCurrentPackage",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},[]]}]}],"warnings":[]} |}] let root_to_module = test "{!//foo/Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TCurrentPackage",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] let root_label_parent_page = test "{!//foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let root_label_parent_module = test "{!//foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] (* Relative paths *) let relative = test "{!foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] let relative = test "{!foo/bar/baz}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","bar","baz"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar","baz"]]},[]]}]}],"warnings":[]} |}] let relative_module = test "{!foo/Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] let relative_label_parent_page = test "{!foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let relative_label_parent_module = test "{!foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let dot_relative = test "{!./bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["bar"]]},[]]}]}],"warnings":[]} |}] let dot_relative_module = test "{!./Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["Bar"]]},[]]}]}],"warnings":[]} |}] let dot_relative_label_parent_page = test "{!./bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TRelativePath",["bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let dot_relative_label_parent_module = test "{!./Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Page_path":["`TRelativePath",["Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] (* Prefix *) let abs_label_parent_page_prefix = test "{!/foo/bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let abs_label_parent_module_prefix = test "{!/foo/Bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let root_label_parent_page_prefix = test "{!//foo/bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let root_label_parent_module_prefix = test "{!//foo/Bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let relative_tag_after_slash = test "{!foo/page-bar}"; @@ -2811,7 +2811,12 @@ let%expect_test _ = let relative_tag_after_slash = test "{!foo/module-Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Page_path":["`TRelativePath",["foo"]]},"Bar"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Module_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + + let relative_tag_after_slash_label_parent = + test "{!page_path/page-pagename.section-sectionname}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TRelativePath",["page_path","pagename"]]},"sectionname"]},[]]}]}],"warnings":[]} |}] (* Errors *) @@ -2845,36 +2850,41 @@ let%expect_test _ = [%expect {| {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in on the right side of a dot.\nSuggestion: Reference pages as '/bar'."]} |}] + let err_unsupported_kind = + test "{!foo/type-bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'page-', a path, an unqualified reference."]} |}] + (* Old kind compatibility *) let oldkind_abs_page = test "{!section:/foo.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TAbsolutePath",["foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo"]]},"label"]},[]]}]}],"warnings":[]} |}] let oldkind_abs_module = test "{!section:/Foo.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TAbsolutePath",["Foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["Foo"]]},"label"]},[]]}]}],"warnings":[]} |}] let oldkind_relative_page = test "{!section:foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let oldkind_relative_module = test "{!section:foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let oldkind_root_page = test "{!section://foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] let oldkind_root_module = test "{!section://foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] end in ()