Print readable error messages in doc code blocks

CHANGES.md

@@ -8,6 +8,10 @@ profile. This started with version 0.26.0.
 
 ### Fixed
 
+- Print readable messages for errors raised when parsing OCaml code blocks
+  in documentation comments, instead of the raw exception representation
+  `Ocamlformat_parser_extended.Lexer.Error(_, _)` (#PR, @hhugo)
+
 - Fix instability on long `if-then-else` with `if-then-else=fit-or-vertical`
   (#2797, @MisterDA)
 

lib/Fmt_ast.ml

@@ -5155,7 +5155,14 @@ let fmt_code ~debug =
         Error (`Msg (Format.asprintf "not expecting: %s" x))
     | exception Syntaxerr.Error (Other _) when warn ->
         Error (`Msg (Format.asprintf "invalid toplevel or OCaml syntax"))
-    | exception e when warn -> Error (`Msg (Format.asprintf "%a" Exn.pp e))
+    | exception e when warn ->
+        let msg =
+          match Location.error_of_exn e with
+          | Some (`Ok report) ->
+              Format.asprintf "%a" Format_doc.Doc.format report.main.txt
+          | _ -> Format.asprintf "%a" Exn.pp e
+        in
+        Error (`Msg msg)
     | exception _ -> Error (`Msg "")
   in
   fmt_code

lib/dune

@@ -23,6 +23,8 @@
    -open
    Ocamlformat_parser_extended
    -open
+   Ocamlformat_parser_shims
+   -open
    Ocamlformat_stdlib
    -open
    Ocamlformat_format))
@@ -35,6 +37,7 @@
   ocamlformat_ocaml_common
   ocamlformat_odoc_parser
   ocamlformat_parser_extended
+  ocamlformat_parser_shims
   ocamlformat_parser_standard
   ocamlformat_stdlib
   ocp-indent.lib

test/passing/gen/dune.inc

@@ -1694,6 +1694,24 @@
  (package ocamlformat)
  (action (diff doc_comments_padding.ml.err doc_comments_padding.ml.stderr)))
 
+(rule
+ (deps .ocamlformat)
+ (package ocamlformat)
+ (action
+  (with-stdout-to doc_lexer_errors.mld.stdout
+   (with-stderr-to doc_lexer_errors.mld.stderr
+     (run %{bin:ocamlformat} --name doc_lexer_errors.mld --margin-check --parse-toplevel-phrases %{dep:../tests/doc_lexer_errors.mld})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff doc_lexer_errors.mld.ref doc_lexer_errors.mld.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff doc_lexer_errors.mld.err doc_lexer_errors.mld.stderr)))
+
 (rule
  (deps .ocamlformat)
  (package ocamlformat)

test/passing/refs.ahrefs/doc_lexer_errors.mld.err

@@ -0,0 +1,18 @@
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
+invalid code block: Illegal empty character literal ''
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 15, character 8 to line 17, character 0:
+invalid code block: String literal not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 21, character 8 to line 23, character 0:
+invalid code block: Comment not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 27, character 8 to line 29, character 0:
+invalid code block: Invalid literal 0xz
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 33, character 8 to line 35, character 0:
+invalid code block: Foo cannot be used as label name, it must start with a lowercase letter
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 39, character 8 to line 41, character 0:
+invalid code block: let is a keyword, it cannot be used as label name

test/passing/refs.ahrefs/doc_lexer_errors.mld.ref

@@ -0,0 +1,41 @@
+Regression test for readable lexer error messages in OCaml code blocks.
+
+Each block below triggers a different Lexer.Error variant; without the fix, all
+of them would report the cryptic "invalid code block:
+Ocamlformat_parser_extended.Lexer.Error" form.
+
+Empty character literal:
+
+{@ocaml[
+  let _ = ''
+]}
+
+Unterminated string:
+
+{@ocaml[
+  let _ = "abc
+]}
+
+Unterminated comment:
+
+{@ocaml[
+  let _ = (* abc
+]}
+
+Invalid literal:
+
+{@ocaml[
+  let _ = 0xz
+]}
+
+Capitalized label:
+
+{@ocaml[
+  let _ = f ~Foo:1
+]}
+
+Keyword used as label:
+
+{@ocaml[
+  let _ = f ~let:1
+]}

test/passing/refs.default/doc_lexer_errors.mld.err

@@ -0,0 +1,18 @@
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
+invalid code block: Illegal empty character literal ''
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 15, character 8 to line 17, character 0:
+invalid code block: String literal not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 21, character 8 to line 23, character 0:
+invalid code block: Comment not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 27, character 8 to line 29, character 0:
+invalid code block: Invalid literal 0xz
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 33, character 8 to line 35, character 0:
+invalid code block: Foo cannot be used as label name, it must start with a lowercase letter
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 39, character 8 to line 41, character 0:
+invalid code block: let is a keyword, it cannot be used as label name

test/passing/refs.default/doc_lexer_errors.mld.ref

@@ -0,0 +1,41 @@
+Regression test for readable lexer error messages in OCaml code blocks.
+
+Each block below triggers a different Lexer.Error variant; without the fix, all
+of them would report the cryptic "invalid code block:
+Ocamlformat_parser_extended.Lexer.Error" form.
+
+Empty character literal:
+
+{@ocaml[
+  let _ = ''
+]}
+
+Unterminated string:
+
+{@ocaml[
+  let _ = "abc
+]}
+
+Unterminated comment:
+
+{@ocaml[
+  let _ = (* abc
+]}
+
+Invalid literal:
+
+{@ocaml[
+  let _ = 0xz
+]}
+
+Capitalized label:
+
+{@ocaml[
+  let _ = f ~Foo:1
+]}
+
+Keyword used as label:
+
+{@ocaml[
+  let _ = f ~let:1
+]}

test/passing/refs.janestreet/doc_lexer_errors.mld.err

@@ -0,0 +1,18 @@
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
+invalid code block: Illegal empty character literal ''
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 15, character 8 to line 17, character 0:
+invalid code block: String literal not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 21, character 8 to line 23, character 0:
+invalid code block: Comment not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 27, character 8 to line 29, character 0:
+invalid code block: Invalid literal 0xz
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 33, character 8 to line 35, character 0:
+invalid code block: Foo cannot be used as label name, it must start with a lowercase letter
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 39, character 8 to line 41, character 0:
+invalid code block: let is a keyword, it cannot be used as label name

test/passing/refs.janestreet/doc_lexer_errors.mld.ref

@@ -0,0 +1,41 @@
+Regression test for readable lexer error messages in OCaml code blocks.
+
+Each block below triggers a different Lexer.Error variant; without the
+fix, all of them would report the cryptic
+"invalid code block: Ocamlformat_parser_extended.Lexer.Error" form.
+
+Empty character literal:
+
+{@ocaml[
+  let _ = ''
+]}
+
+Unterminated string:
+
+{@ocaml[
+  let _ = "abc
+]}
+
+Unterminated comment:
+
+{@ocaml[
+  let _ = (* abc
+]}
+
+Invalid literal:
+
+{@ocaml[
+  let _ = 0xz
+]}
+
+Capitalized label:
+
+{@ocaml[
+  let _ = f ~Foo:1
+]}
+
+Keyword used as label:
+
+{@ocaml[
+  let _ = f ~let:1
+]}

test/passing/refs.ocamlformat/doc_lexer_errors.mld.err

@@ -0,0 +1,18 @@
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
+invalid code block: Illegal empty character literal ''
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 15, character 8 to line 17, character 0:
+invalid code block: String literal not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 21, character 8 to line 23, character 0:
+invalid code block: Comment not terminated
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 27, character 8 to line 29, character 0:
+invalid code block: Invalid literal 0xz
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 33, character 8 to line 35, character 0:
+invalid code block: Foo cannot be used as label name, it must start with a lowercase letter
+Warning: Invalid documentation comment:
+File "doc_lexer_errors.mld", line 39, character 8 to line 41, character 0:
+invalid code block: let is a keyword, it cannot be used as label name

test/passing/refs.ocamlformat/doc_lexer_errors.mld.ref

@@ -0,0 +1,41 @@
+Regression test for readable lexer error messages in OCaml code blocks.
+
+Each block below triggers a different Lexer.Error variant; without the fix, all
+of them would report the cryptic "invalid code block:
+Ocamlformat_parser_extended.Lexer.Error" form.
+
+Empty character literal:
+
+{@ocaml[
+  let _ = ''
+]}
+
+Unterminated string:
+
+{@ocaml[
+  let _ = "abc
+]}
+
+Unterminated comment:
+
+{@ocaml[
+  let _ = (* abc
+]}
+
+Invalid literal:
+
+{@ocaml[
+  let _ = 0xz
+]}
+
+Capitalized label:
+
+{@ocaml[
+  let _ = f ~Foo:1
+]}
+
+Keyword used as label:
+
+{@ocaml[
+  let _ = f ~let:1
+]}

test/passing/tests/doc_lexer_errors.mld

@@ -0,0 +1,41 @@
+Regression test for readable lexer error messages in OCaml code blocks.
+
+Each block below triggers a different Lexer.Error variant; without the
+fix, all of them would report the cryptic
+"invalid code block: Ocamlformat_parser_extended.Lexer.Error" form.
+
+Empty character literal:
+
+{@ocaml[
+  let _ = ''
+]}
+
+Unterminated string:
+
+{@ocaml[
+  let _ = "abc
+]}
+
+Unterminated comment:
+
+{@ocaml[
+  let _ = (* abc
+]}
+
+Invalid literal:
+
+{@ocaml[
+  let _ = 0xz
+]}
+
+Capitalized label:
+
+{@ocaml[
+  let _ = f ~Foo:1
+]}
+
+Keyword used as label:
+
+{@ocaml[
+  let _ = f ~let:1
+]}

test/passing/tests/doc_lexer_errors.mld.opts

@@ -0,0 +1 @@
+--parse-toplevel-phrases