Print readable error messages in doc code blocks

When parsing fails inside a `{@ocaml[...]}` block, the catch-all branch
formatted the exception with `Exn.pp`, which for `Lexer.Error` produced
the raw constructor pattern
`Ocamlformat_parser_extended.Lexer.Error(_, _)`. `Lexer.Error` (and most
other compiler-libs exceptions) register a printer via
`Location.register_error_of_exn`, but that table is separate from the
`Printexc` table `Exn.pp` consults, so the printer was never used.

Route the catch-all through `Location.error_of_exn` instead: if a
printer is registered, format its `main` message; otherwise fall back to
`Exn.pp`. This handles `Lexer.Error` and any other registered exception
(e.g. parser internals) without per-variant enumeration.

The .err diff against the previous commit shows the before/after for the
six variants the regression test exercises.

Author: hhugo

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/refs.ahrefs/doc_lexer_errors.mld.err

@@ -1,18 +1,18 @@
 Warning: Invalid documentation comment:
 File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
-invalid code block: Ocamlformat_parser_extended.Lexer.Error(1, _)
+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: Ocamlformat_parser_extended.Lexer.Error(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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+invalid code block: let is a keyword, it cannot be used as label name

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

@@ -1,18 +1,18 @@
 Warning: Invalid documentation comment:
 File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
-invalid code block: Ocamlformat_parser_extended.Lexer.Error(1, _)
+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: Ocamlformat_parser_extended.Lexer.Error(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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+invalid code block: let is a keyword, it cannot be used as label name

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

@@ -1,18 +1,18 @@
 Warning: Invalid documentation comment:
 File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
-invalid code block: Ocamlformat_parser_extended.Lexer.Error(1, _)
+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: Ocamlformat_parser_extended.Lexer.Error(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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+invalid code block: let is a keyword, it cannot be used as label name

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

@@ -1,18 +1,18 @@
 Warning: Invalid documentation comment:
 File "doc_lexer_errors.mld", line 9, character 8 to line 11, character 0:
-invalid code block: Ocamlformat_parser_extended.Lexer.Error(1, _)
+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: Ocamlformat_parser_extended.Lexer.Error(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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+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: Ocamlformat_parser_extended.Lexer.Error(_, _)
+invalid code block: let is a keyword, it cannot be used as label name