diff --git a/CHANGES.md b/CHANGES.md index eb124df261..4f37b64803 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,7 +13,7 @@ - OCaml 5.2.0 compatibility (@Octachron, #1094, #1112) - New driver package (@jonludlam, #1121) - Fix a big gap between the preamble and the content of a page (@EmileTrotignon, #1147) -- Path-references to hierarchical pages and modules (@Julow, #1151) +- Path-references to hierarchical pages and modules (@Julow, #1142, #1151) Absolute (`{!/foo}`), relative (`{!./foo}`) and package-local (`{!//foo}`) are added. - Add a marshalled search index consumable by sherlodoc (@EmileTrotignon, @panglesd, #1084) diff --git a/src/document/comment.ml b/src/document/comment.ml index de04499fd6..93a30c6652 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -61,12 +61,24 @@ module Reference = struct render_resolved (r :> t) ^ "." ^ InstanceVariableName.to_string s | `Label (_, s) -> LabelName.to_string s + let render_path (tag, cs) = + let tag = + match tag with + | `TRelativePath -> "./" + | `TAbsolutePath -> "/" + | `TCurrentPackage -> "//" + in + tag ^ String.concat "/" cs + let rec render_unresolved : Reference.t -> string = let open Reference in function | `Resolved r -> render_resolved r | `Root (n, _) -> n | `Dot (p, f) -> render_unresolved (p :> t) ^ "." ^ f + | `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 8abdf4bd7b..f2a055d63f 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -1092,6 +1092,7 @@ module Reference = struct type t = Paths_types.Reference.any type tag_any = Paths_types.Reference.tag_any + type tag_hierarchy = Paths_types.Reference.tag_hierarchy module Signature = struct type t = Paths_types.Reference.signature @@ -1172,4 +1173,8 @@ module Reference = struct module Page = struct type t = Paths_types.Reference.page end + + module Hierarchy = struct + type t = Paths_types.Reference.hierarchy + end end diff --git a/src/model/paths.mli b/src/model/paths.mli index 98596a8f55..adf5d8296a 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -637,7 +637,12 @@ module rec Reference : sig type t = Paths_types.Reference.page end + module Hierarchy : sig + type t = Paths_types.Reference.hierarchy + end + type t = Paths_types.Reference.any type tag_any = Paths_types.Reference.tag_any + type tag_hierarchy = Paths_types.Reference.tag_hierarchy end diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 1d1da12431..e5daaf17bb 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -553,6 +553,12 @@ module rec Reference : sig type tag_only_child_module = [ `TChildModule ] + type tag_hierarchy = + [ `TRelativePath (** {!identifier/} *) + | `TAbsolutePath (** {!/identifier} *) + | `TCurrentPackage (** {!//identifier} *) ] + (** @canonical Odoc_model.Paths.Reference.tag_hierarchy *) + type tag_any = [ `TModule | `TModuleType @@ -572,6 +578,7 @@ module rec Reference : sig | `TChildPage | `TChildModule | `TUnknown ] + (** @canonical Odoc_model.Paths.Reference.tag_any *) type tag_signature = [ `TUnknown | `TModule | `TModuleType ] @@ -592,10 +599,14 @@ module rec Reference : sig | `TChildPage | `TChildModule ] + type hierarchy = tag_hierarchy * string list + (** @canonical Odoc_model.Paths.Reference.Hierarchy.t *) + type signature = [ `Resolved of Resolved_reference.signature | `Root of string * tag_signature | `Dot of label_parent * string + | `Module_path of hierarchy | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t ] (** @canonical Odoc_model.Paths.Reference.Signature.t *) @@ -620,6 +631,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.field_parent | `Root of string * tag_parent | `Dot of label_parent * string + | `Module_path of hierarchy | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Type of signature * TypeName.t ] @@ -629,6 +641,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 hierarchy + | `Module_path of hierarchy + | `Any_path of hierarchy | `Module of signature * ModuleName.t | `ModuleType of signature * ModuleTypeName.t | `Class of signature * ClassName.t @@ -640,6 +655,7 @@ module rec Reference : sig [ `Resolved of Resolved_reference.module_ | `Root of string * [ `TModule | `TUnknown ] | `Dot of label_parent * string + | `Module_path of hierarchy | `Module of signature * ModuleName.t ] (** @canonical Odoc_model.Paths.Reference.Module.t *) @@ -743,13 +759,17 @@ module rec Reference : sig type page = [ `Resolved of Resolved_reference.page | `Root of string * [ `TPage | `TUnknown ] - | `Dot of label_parent * string ] + | `Dot of label_parent * string + | `Page_path of hierarchy ] (** @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 hierarchy + | `Module_path of hierarchy + | `Any_path of hierarchy | `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 20c2f47913..9108c9cd47 100644 --- a/src/model/reference.ml +++ b/src/model/reference.ml @@ -1,5 +1,9 @@ -let expected_err : string -> Location_.span -> Error.t = - Error.make "Expected %s." +let expected_err : + (Format.formatter -> 'a -> unit) -> 'a -> Location_.span -> Error.t = + fun pp_a a -> Error.make "Expected %a." pp_a a + +let expected_err_str : string -> Location_.span -> Error.t = + expected_err Format.pp_print_string let unknown_reference_qualifier : string -> Location_.span -> Error.t = Error.make "Unknown reference qualifier '%s'." @@ -26,12 +30,22 @@ let not_allowed : (Astring.String.Ascii.capitalize what) in_what +(** Format a list in a human readable way: [A, B, or C]. *) +let pp_hum_comma_separated pp_a ppf lst = + let rec loop hd = function + | [] -> Format.fprintf ppf "or %a" pp_a hd + | hd' :: tl' -> + Format.fprintf ppf "%a, " pp_a hd; + loop hd' tl' + in + match lst with [] -> () | [ a ] -> pp_a ppf a | hd :: tl -> loop hd tl + let deprecated_reference_kind location kind replacement = deprecated_reference_kind kind replacement location |> Error.raise_warning (* http://caml.inria.fr/pub/docs/manual-ocaml/ocamldoc.html#sec359. *) let match_ocamldoc_reference_kind (_location as loc) s : - Paths.Reference.tag_any option = + [> Paths.Reference.tag_any ] option = let d = deprecated_reference_kind in match s with | "module" -> Some `TModule @@ -59,7 +73,7 @@ let match_ocamldoc_reference_kind (_location as loc) s : | _ -> None let match_extra_odoc_reference_kind (_location as loc) s : - Paths.Reference.tag_any option = + [> Paths.Reference.tag_any ] option = let d = deprecated_reference_kind in match s with | "class-type" -> Some `TClassType @@ -81,6 +95,8 @@ let match_extra_odoc_reference_kind (_location as loc) s : Some `TValue | _ -> None +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 phantom tag type to be the same for all tokens in the list (because lists are @@ -90,21 +106,22 @@ let match_extra_odoc_reference_kind (_location as loc) s : A secondary reason to delay parsing, and store strings in the token list, is that we need the strings for user-friendly error reporting. *) -let match_reference_kind location s : Paths.Reference.tag_any = +let match_reference_kind location s : reference_kind = match s with - | None -> `TUnknown - | Some s -> ( + | `None -> `TUnknown + | `Prefixed s | `Old_prefix s -> ( let result = match match_ocamldoc_reference_kind location s with - | Some kind -> Some kind + | Some _ as kind -> kind | None -> match_extra_odoc_reference_kind location s in match result with | Some kind -> kind | None -> unknown_reference_qualifier s location |> Error.raise_exception) + | `End_in_slash -> `TPathComponent type token = { - kind : string option; + kind : [ `None | `Prefixed of string | `End_in_slash ]; identifier : string; location : Location_.span; } @@ -118,14 +135,18 @@ let tokenize location s : token list = match s.[index] with | exception Invalid_argument _ -> let identifier, location = identifier_ended started_at index in - { kind = None; identifier; location } :: tokens + { kind = `None; identifier; location } :: tokens | '-' when open_parenthesis_count = 0 -> let identifier, location = identifier_ended started_at index in scan_kind identifier location index (index - 1) tokens | '.' when open_parenthesis_count = 0 -> let identifier, location = identifier_ended started_at index in scan_identifier index 0 (index - 1) - ({ kind = None; identifier; location } :: tokens) + ({ kind = `None; identifier; location } :: tokens) + | '/' when open_parenthesis_count = 0 -> + let identifier, location = identifier_ended started_at index in + scan_path index (index - 1) + ({ kind = `None; identifier; location } :: tokens) | ')' -> scan_identifier started_at (open_parenthesis_count + 1) @@ -170,34 +191,80 @@ let tokenize location s : token list = let kind, location = kind_ended identifier_location started_at index in scan_identifier index 0 (index - 1) ({ kind; identifier; location } :: tokens) + | '/' -> + let kind, location = kind_ended identifier_location started_at index in + scan_path index (index - 1) ({ kind; identifier; location } :: tokens) | _ -> scan_kind identifier identifier_location started_at (index - 1) tokens and kind_ended identifier_location started_at index = let offset = index + 1 in let length = started_at - offset in - let kind = Some (String.sub s offset length) in + let kind = `Prefixed (String.sub s offset length) in let location = Location_.in_string s ~offset ~length location in let location = Location_.span [ location; identifier_location ] in (kind, location) + and scan_path started_at index tokens = + (* The parsing rules are different for [/]-separated components. [-"".()] are + no longer meaningful. *) + match s.[index] with + | exception Invalid_argument _ -> path_ended started_at index :: tokens + | '/' -> scan_path index (index - 1) (path_ended started_at index :: tokens) + | _ -> scan_path started_at (index - 1) tokens + and path_ended started_at index = + let offset = index + 1 in + let length = started_at - offset in + let identifier = String.sub s offset length in + let location = Location_.in_string s ~offset ~length location in + { kind = `End_in_slash; identifier; location } in scan_identifier (String.length s) 0 (String.length s - 1) [] |> List.rev -let expected allowed location = - let unqualified = "or an unqualified reference" in - let allowed = - match allowed with - | [ one ] -> Printf.sprintf "'%s-' %s" one unqualified - | _ -> - String.concat ", " - (List.map (Printf.sprintf "'%s-'") allowed @ [ unqualified ]) +let expected ?(expect_paths = false) allowed location = + let unqualified = [ "an unqualified reference" ] in + let unqualified = + if expect_paths then "a path" :: unqualified else unqualified in - expected_err allowed location + let allowed = List.map (Printf.sprintf "'%s-'") allowed @ unqualified in + expected_err (pp_hum_comma_separated Format.pp_print_string) allowed location +(* Parse references that do not contain a [/]. Raises errors and warnings. *) 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 path components next_token tokens : Hierarchy.t = + match (next_token, tokens) with + | { kind = `End_in_slash; identifier; _ }, [] -> ( + match identifier with + | "" -> + (* {!/identifier} *) + (`TAbsolutePath, components) + | "." -> + (* {!./identifier} *) + (`TRelativePath, components) + | c -> + (* {!identifier'/identifier} *) + (`TRelativePath, c :: components)) + | ( { kind = `End_in_slash; identifier = ""; _ }, + [ { kind = `End_in_slash; identifier = ""; _ } ] ) -> + (* {!//identifier} *) + (`TCurrentPackage, components) + | { kind = `End_in_slash; identifier; location }, next_token' :: tokens' -> + if identifier = "" then + should_not_be_empty ~what:"Identifier in path reference" location + |> Error.raise_exception; + (* {!path/identifier} *) + path (identifier :: components) next_token' tokens' + | { kind = `None | `Prefixed _; _ }, _ -> + (* Cannot be outputed by the lexer. *) + assert false + in + + 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 = let kind = match_reference_kind location kind in match tokens with @@ -205,8 +272,16 @@ let parse whole_reference_location s : match kind with | (`TUnknown | `TModule | `TModuleType) as kind -> `Root (identifier, kind) + | `TPathComponent -> assert false | _ -> - expected [ "module"; "module-type" ] location + 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 @@ -217,8 +292,9 @@ let parse whole_reference_location s : | `TModuleType -> `ModuleType (signature next_token tokens, ModuleTypeName.make_std identifier) + | `TPathComponent -> assert false | _ -> - expected [ "module"; "module-type" ] location + expected ~expect_paths:true [ "module"; "module-type" ] location |> Error.raise_exception) and parent { kind; identifier; location } tokens : FragmentTypeParent.t = let kind = match_reference_kind location kind in @@ -230,6 +306,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 -> @@ -269,7 +352,19 @@ let parse whole_reference_location s : ) in - let rec label_parent { kind; identifier; location } tokens : LabelParent.t = + let any_path { 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 | [] -> ( @@ -277,11 +372,14 @@ let parse whole_reference_location s : | ( `TUnknown | `TModule | `TModuleType | `TType | `TClass | `TClassType | `TPage ) as kind -> `Root (identifier, kind) + | `TPathComponent -> assert false | _ -> - expected + 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_path token kind next_token tokens | next_token :: tokens -> ( match kind with | `TUnknown -> `Dot (label_parent next_token tokens, identifier) @@ -297,28 +395,32 @@ let parse whole_reference_location s : | `TClassType -> `ClassType (signature next_token tokens, ClassTypeName.make_std identifier) + | `TPathComponent -> assert false | _ -> - expected + expected ~expect_paths:true [ "module"; "module-type"; "type"; "class"; "class-type" ] location |> 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 | None -> new_kind | Some (old_kind_string, old_kind_location) -> ( let old_kind = - match_reference_kind old_kind_location (Some old_kind_string) + match_reference_kind old_kind_location (`Old_prefix old_kind_string) in match new_kind with | `TUnknown -> old_kind | _ -> (if old_kind <> new_kind then let new_kind_string = - match kind with Some s -> s | None -> "" + match kind with + | `None | `End_in_slash -> "" + | `Prefixed s -> s in reference_kinds_do_not_match old_kind_string new_kind_string whole_reference_location @@ -327,7 +429,12 @@ let parse whole_reference_location s : in match tokens with - | [] -> `Root (identifier, kind) + | [] -> ( + match kind with + | #Paths.Reference.tag_any as kind -> `Root (identifier, kind) + | `TPathComponent -> assert false) + | next_token :: tokens when ends_in_slash next_token -> + any_path token kind next_token tokens | next_token :: tokens -> ( match kind with | `TUnknown -> `Dot (label_parent next_token tokens, identifier) @@ -378,13 +485,21 @@ let parse whole_reference_location s : location |> Error.raise_exception | `TPage -> - let suggestion = - Printf.sprintf "'page-%s' should be first." identifier + let () = + match next_token.kind with + | `End_in_slash -> () + | `None | `Prefixed _ -> + let suggestion = + Printf.sprintf "Reference pages as '/%s'." + identifier + in + not_allowed ~what:"Page label" + ~in_what:"on the right side of a dot" ~suggestion location + |> Error.raise_exception in - not_allowed ~what:"Page label" - ~in_what:"the last component of a reference path" ~suggestion - location - |> Error.raise_exception) + (* Prefixed pages are not differentiated. *) + `Page_path (path [ identifier ] next_token tokens) + | `TPathComponent -> assert false) in let old_kind, s, location = @@ -442,7 +557,7 @@ let read_path_longident location s = Error.catch_warnings (fun () -> match loop s (String.length s - 1) with | Some r -> Result.Ok (r :> path) - | None -> Result.Error (expected_err "a valid path" location)) + | None -> Result.Error (expected_err_str "a valid path" location)) let read_mod_longident location lid = Error.catch_warnings (fun () -> @@ -453,4 +568,6 @@ let read_mod_longident location lid = | (`Root (_, (`TUnknown | `TModule)) | `Dot (_, _) | `Module (_, _)) as r -> Result.Ok r - | _ -> Result.Error (expected_err "a reference to a module" location))) + | _ -> + Result.Error (expected_err_str "a reference to a module" location) + )) diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml index 91d3608639..f3133305e9 100644 --- a/src/model_desc/paths_desc.ml +++ b/src/model_desc/paths_desc.ml @@ -283,12 +283,25 @@ module General_paths = struct | `SubstitutedT c -> C ("`SubstitutedT", (c :> rp), resolved_path) | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path)) + and hierarchy_reference : Paths.Reference.Hierarchy.t t = + let tag_page_path = + Variant + (function + | `TRelativePath -> C0 "`TRelativePath" + | `TAbsolutePath -> C0 "`TAbsolutePath" + | `TCurrentPackage -> C0 "`TCurrentPackage") + in + Pair (tag_page_path, List string) + and reference : r t = Variant (function | `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, hierarchy_reference) + | `Module_path x -> C ("`Module_path", x, hierarchy_reference) + | `Any_path x -> C ("`Any_path", x, hierarchy_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 760a9a1cf8..3cf34e0a81 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -585,6 +585,7 @@ module Fmt = struct type path = Odoc_model.Paths.Path.t type rpath = Odoc_model.Paths.Path.Resolved.t open Odoc_model.Names + open Odoc_model.Paths let fpf = Format.fprintf @@ -1659,13 +1660,25 @@ module Fmt = struct (parent :> t) (LabelName.to_string name) - and model_reference c ppf (r : Odoc_model.Paths.Reference.t) = - let open Odoc_model.Paths.Reference in + and model_reference_hierarchy _c ppf + ((tag, components) : Reference.Hierarchy.t) = + (match tag with + | `TRelativePath -> fpf ppf "./" + | `TAbsolutePath -> fpf ppf "/" + | `TCurrentPackage -> fpf ppf "//"); + let pp_sep ppf () = fpf ppf "/" in + Format.pp_print_list ~pp_sep Format.pp_print_string ppf components + + and model_reference c ppf (r : Reference.t) = + let open Reference in match r with | `Resolved r' -> Format.fprintf ppf "r(%a)" (model_resolved_reference c) r' | `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_hierarchy c ppf p + | `Module_path p -> model_reference_hierarchy c ppf p + | `Any_path p -> model_reference_hierarchy 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 a471778c12..021bb94e8d 100644 --- a/src/xref2/errors.ml +++ b/src/xref2/errors.ml @@ -9,7 +9,18 @@ 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 + | `Page_path + | `Module_path + | `Any_path ] type expansion_of_module_error = [ `OpaqueModule (* The module does not have an expansion *) @@ -125,6 +136,9 @@ module Tools_error = struct | `Cons -> "constructor" | `Field -> "field" | `Label -> "label" + | `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 c0a066da1a..49406b1f08 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -25,10 +25,13 @@ type type_lookup_result = | `C of class_lookup_result | `CT of class_type_lookup_result ] +type any_path_lookup_result = + [ `P of page_lookup_result | `S of signature_lookup_result ] + type label_parent_lookup_result = - [ `S of signature_lookup_result - | type_lookup_result - | `P of page_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 ] @@ -175,6 +178,20 @@ let type_lookup_to_class_signature_lookup = |> of_option ~error:(`Parent (`Parent_type `OpaqueClass)) >>= resolved p' +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 any_in_env _env _page_path : any_path_lookup_result ref_result = + (* Not implemented *) + Error (`Wrong_kind ([ `S; `Page ], `Any_path)) +end + module M = struct (** Module *) @@ -635,7 +652,7 @@ module LP = struct Ok (`CT ct) end -let rec resolve_label_parent_reference env r = +let rec resolve_label_parent_reference env (r : LabelParent.t) = let label_parent_res_of_type_res : type_lookup_result -> _ = fun r -> Ok (r :> label_parent_lookup_result) in @@ -670,6 +687,12 @@ let rec resolve_label_parent_reference env r = | `Root (name, `TChildModule) -> resolve_signature_reference env (`Root (name, `TModule)) >>= fun s -> Ok (`S s) + | `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 @@ -691,6 +714,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 = @@ -735,6 +761,8 @@ and resolve_signature_reference : (MT.of_component env mt (`ModuleType (parent_cp, name)) (`ModuleType (parent, name)))) + | `Module_path p -> + Path.module_in_env env p >>= module_lookup_to_signature_lookup env in resolve env' @@ -750,6 +778,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. @@ -773,6 +802,10 @@ let resolved_type_lookup = function | `C (r, _) -> resolved1 r | `CT (r, _) -> resolved1 r +let resolved_page_path_lookup = function + | `S (r, _, _) -> resolved1 r + | `P (r, _) -> resolved1 r + let resolve_reference_dot_sg env ~parent_path ~parent_ref ~parent_sg name = let parent_path = Tools.reresolve_parent env parent_path in let parent_sg = Tools.prefix_signature (parent_path, parent_sg) in @@ -829,7 +862,7 @@ let resolve_reference_dot env parent name = | `P _ as page -> resolve_reference_dot_page env page name (** Warnings may be generated with [Error.implicit_warning] *) -let resolve_reference = +let resolve_reference : _ -> Reference.t -> _ = let resolved = resolved3 in fun env r -> match r with @@ -916,6 +949,12 @@ let resolve_reference = | `InstanceVariable (parent, name) -> 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 + | `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 d9bafb990a..b3dcd83878 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -1243,49 +1243,49 @@ let%expect_test _ = test "{!constructor-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_exception = test "{!exception-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_extension = test "{!extension-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_field = test "{!field-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_section = test "{!section-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_instance_variable = test "{!instance-variable-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_method = test "{!method-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_val = test "{!val-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_something_nested = test "{!foo.bar.baz}"; @@ -1327,55 +1327,55 @@ let%expect_test _ = test "{!foo.page-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_constructor_nested = test "{!Foo.constructor-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_exception_nested = test "{!Foo.exception-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_extension_nested = test "{!Foo.extension-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_field_nested = test "{!foo.field-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_section_nested = test "{!foo.section-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_instance_variable_nested = test "{!foo.instance-variable-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_method_nested = test "{!foo.method-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_val_nested = test "{!Foo.val-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let module_in_empty = test "{!.module-Foo}"; @@ -1405,73 +1405,73 @@ let%expect_test _ = test "{!class-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_class_type = test "{!class-type-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_constructor = test "{!constructor-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_exception = test "{!exception-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_extension = test "{!extension-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_field = test "{!field-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_section = test "{!section-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_instance_variable = test "{!instance-variable-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_method = test "{!method-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_page = test "{!page-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_type = test "{!type-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_val = test "{!val-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_something_nested = test "{!Foo.Bar.module-Baz}"; @@ -1495,73 +1495,73 @@ let%expect_test _ = test "{!Foo.class-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_class_type_nested = test "{!Foo.class-type-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_constructor_nested = test "{!Foo.constructor-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_exception_nested = test "{!Foo.exception-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_extension_nested = test "{!Foo.extension-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_field_nested = test "{!foo.field-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_section_nested = test "{!foo.section-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_instance_variable_nested = test "{!foo.instance-variable-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_method_nested = test "{!foo.method-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_page_nested = test "{!foo.page-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_type_nested = test "{!Foo.type-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_val_nested = test "{!Foo.val-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_type_in_something = test "{!Foo.module-type-Bar}"; @@ -1585,13 +1585,13 @@ let%expect_test _ = test "{!class-foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_type_in_page = test "{!page-foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let type_in_something = test "{!Foo.type-bar}"; @@ -1615,13 +1615,13 @@ let%expect_test _ = test "{!class-foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let type_in_page = test "{!page-foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let constructor_in_empty = test "{!.constructor-Foo}"; @@ -2011,13 +2011,13 @@ let%expect_test _ = test "{!class-foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let exception_in_page = test "{!page-foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let extension_in_something = test "{!Foo.extension-Bar}"; @@ -2035,13 +2035,13 @@ let%expect_test _ = test "{!class-foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let extension_in_page = test "{!page-foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let val_in_something = test "{!Foo.val-bar}"; @@ -2059,13 +2059,13 @@ let%expect_test _ = test "{!class-foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let val_in_page = test "{!page-foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_in_something = test "{!Foo.class-bar}"; @@ -2083,13 +2083,13 @@ let%expect_test _ = test "{!class-foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_in_page = test "{!page-foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_type_in_something = test "{!Foo.class-type-bar}"; @@ -2107,13 +2107,13 @@ let%expect_test _ = test "{!class-foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_type_in_page = test "{!page-foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let method_in_empty = test "{!.method-foo}"; @@ -2353,7 +2353,7 @@ let%expect_test _ = test "{!foo.page-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in the last component of a reference path.\nSuggestion: 'page-bar' should be first."]} |}] + {"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 inner_parent_something_in_something = test "{!foo.bar.field-baz}"; @@ -2389,7 +2389,7 @@ let%expect_test _ = test "{!class-foo.module-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_module_type_in_module = test "{!module-Foo.module-type-Bar.field-baz}"; @@ -2401,7 +2401,7 @@ let%expect_test _ = test "{!class-foo.module-type-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_type_in_module = test "{!module-Foo.type-bar.field-baz}"; @@ -2413,7 +2413,7 @@ let%expect_test _ = test "{!class-foo.type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_class_in_module = test "{!module-Foo.class-bar.field-baz}"; @@ -2461,7 +2461,7 @@ let%expect_test _ = test "{!class-foo.module-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_module_type_in_module = test "{!module-Foo.module-type-Bar.baz}"; @@ -2473,7 +2473,7 @@ let%expect_test _ = test "{!class-foo.module-type-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_type_in_module = test "{!module-Foo.type-bar.baz}"; @@ -2485,7 +2485,7 @@ let%expect_test _ = test "{!class-foo.type-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_class_in_module = test "{!module-Foo.class-bar.baz}"; @@ -2497,7 +2497,7 @@ let%expect_test _ = test "{!class-foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_class_type_in_module = test "{!module-Foo.class-bar.baz}"; @@ -2509,13 +2509,13 @@ let%expect_test _ = test "{!class-foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_page_in_something = test "{!foo.page-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let inner_class_signature_something_in_something = test "{!foo.bar.method-baz}"; @@ -2539,7 +2539,7 @@ let%expect_test _ = test "{!class-foo.class-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_class_signature_class_type_in_module = test "{!module-Foo.class-type-bar.method-baz}"; @@ -2551,7 +2551,7 @@ let%expect_test _ = test "{!class-foo.class-type-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_signature_something_in_something = test "{!foo.bar.type-baz}"; @@ -2575,7 +2575,7 @@ let%expect_test _ = test "{!class-foo.module-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_signature_module_type_in_module = test "{!module-Foo.module-type-Bar.type-baz}"; @@ -2587,7 +2587,7 @@ let%expect_test _ = test "{!class-foo.module-type-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_datatype_something_in_something = test "{!foo.bar.constructor-Baz}"; @@ -2611,7 +2611,7 @@ let%expect_test _ = test "{!class-foo.type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let kind_conflict = test "{!val:type-foo}"; @@ -2692,3 +2692,224 @@ let%expect_test _ = {"value":[{"`Paragraph":[{"`Code_span":"\"\"foo\""}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nUnmatched quotation!"]} |}] end in () + +let%expect_test _ = + let module Reference_path = struct + (* Absolute references *) + + let abs = + test "{!/foo/bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + + let abs_label_parent_page = + test "{!/foo/bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + (* References to current package root *) + + let root_to_page = + test "{!//foo/bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + + let root_to_module = + test "{!//foo/Bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + + let root_label_parent_page = + test "{!//foo/bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + (* Relative paths *) + + let relative = + test "{!foo/bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + + let relative = + test "{!foo/bar/baz}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar","baz"]]},[]]}]}],"warnings":[]} |}] + + let relative_module = + test "{!foo/Bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + + let relative_label_parent_page = + test "{!foo/bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let dot_relative = + test "{!./bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["bar"]]},[]]}]}],"warnings":[]} |}] + + let dot_relative_module = + test "{!./Bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["Bar"]]},[]]}]}],"warnings":[]} |}] + + let dot_relative_label_parent_page = + test "{!./bar.label}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let dot_relative_label_parent_module = + test "{!./Bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let abs_label_parent_module_prefix = + test "{!/foo/Bar.section-label}"; + [%expect + {| {"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":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let root_label_parent_module_prefix = + test "{!//foo/Bar.section-label}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let relative_tag_after_slash = + test "{!foo/page-bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + + let relative_tag_after_slash = + test "{!foo/module-Bar}"; + [%expect + {| {"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 *) + + let err_abs_only = + test "{!/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nIdentifier in reference should not be empty."]} |}] + + let err_relative_only = + test "{!foo/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + + let err_root_only = + test "{!//}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + + let err_relative_empty = + test "{!foo/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + + let err_dot_relative_empty = + test "{!./}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"./"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + + let err_page_prefix_after_dot = + test "{!foo.page-bar}"; + [%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, or an unqualified reference."]} |}] + + let err_relative_empty_component = + test "{!foo//bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo//bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in path reference should not be empty."]} |}] + + let err_current_package_empty_component = + test "{!///bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"///bar"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in path reference should not be empty."]} |}] + + let err_last_empty_component = + test "{!foo/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + + let err_first_empty_component = + test "{!/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nIdentifier in reference should not be empty."]} |}] + + let err_current_package_empty_component = + test "{!//}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + + (* Old kind compatibility *) + + let oldkind_abs_page = + test "{!section:/foo.label}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let oldkind_abs_module = + test "{!section:/Foo.label}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["Foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let oldkind_relative_page = + test "{!section:foo/bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + + let oldkind_root_page = + test "{!section://foo/bar.label}"; + [%expect + {| {"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":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + end in + ()