Allow prefixed page reference

Julow · Jun 7, 2024 · dd61bc5 · dd61bc5
1 parent f6b9daa
commit dd61bc5
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 8 deletions.
diff --git a/src/model/reference.ml b/src/model/reference.ml
@@ -445,13 +445,20 @@ 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 '<parent_path>/%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 (page_path identifier next_token tokens)
         | `TRelativePath -> `Page_path (page_path identifier next_token tokens))
   in
 

diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml
@@ -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 '<parent_path>/bar'."]} |}]
 
     let inner_parent_something_in_something =
       test "{!foo.bar.field-baz}";
@@ -2806,7 +2806,7 @@ let%expect_test _ =
     let relative_tag_after_slash =
       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":[{"`Reference":[{"`Page_path":{"`Slash":[{"`Root":["foo","`TRelativePath"]},"bar"]}},[]]}]}],"warnings":[]} |}]
 
     let relative_tag_after_slash =
       test "{!foo/module-Bar}";
@@ -2840,6 +2840,11 @@ let%expect_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 '<parent_path>/bar'."]} |}]
+
     (* Old kind compatibility *)
 
     let oldkind_abs_page =