Add location of invalid docstring in warning messages

CHANGES.md

@@ -7,6 +7,8 @@
   + Preserve the syntax of infix set/get operators (#1528, @gpetiot)
     `String.get` and similar calls used to be automatically rewritten to their corresponding infix form `.()`, that was incorrect when using the `-unsafe` compilation flag. Now the concrete syntax of these calls is preserved.
 
+  + Add location of invalid docstring in warning messages (#1529, @gpetiot)
+
 ### 0.16.0 (2020-11-16)
 
 #### Removed

lib/Docstring.ml

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                              OCamlFormat                               *)
+(*                                                                        *)
+(*            Copyright (c) Facebook, Inc. and its affiliates.            *)
+(*                                                                        *)
+(*      This source code is licensed under the MIT license found in       *)
+(*      the LICENSE file in the root directory of this source tree.       *)
+(*                                                                        *)
+(**************************************************************************)
+
+let parse ~loc text =
+  let location = loc.Location.loc_start in
+  let location =
+    { location with
+      pos_cnum= location.pos_cnum + 3 (* Length of comment opening *) }
+  in
+  match Odoc_parser.parse_comment_raw ~location ~text with
+  | exception _ ->
+      let span = Migrate_ast.Location.to_span loc in
+      Error [Odoc_model.Error.make "comment could not be parsed" span]
+  | {value; warnings= []} -> Ok value
+  | {warnings; _} -> Error warnings
+
+let warn fmt warning =
+  Format.fprintf fmt "Warning: Invalid documentation comment:@,%s\n%!"
+    (Odoc_model.Error.to_string warning)

lib/Docstring.mli

@@ -0,0 +1,17 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                              OCamlFormat                               *)
+(*                                                                        *)
+(*            Copyright (c) Facebook, Inc. and its affiliates.            *)
+(*                                                                        *)
+(*      This source code is licensed under the MIT license found in       *)
+(*      the LICENSE file in the root directory of this source tree.       *)
+(*                                                                        *)
+(**************************************************************************)
+
+val parse :
+     loc:Warnings.loc
+  -> string
+  -> (Odoc_parser.Ast.docs, Odoc_model.Error.t list) Result.t
+
+val warn : Format.formatter -> Odoc_model.Error.t -> unit

lib/Fmt_ast.ml

@@ -335,17 +335,6 @@ let fmt_direction_flag = function
 let fmt_virtual_flag f =
   match f with Virtual -> fmt "@ virtual" | Concrete -> noop
 
-let parse_docstring ~loc text =
-  let location = loc.Location.loc_start in
-  let location =
-    { location with
-      pos_cnum= location.pos_cnum + 3 (* Length of comment opening *) }
-  in
-  match Odoc_parser.parse_comment_raw ~location ~text with
-  | exception _ -> Error ["comment could not be parsed"]
-  | {value; warnings= []} -> Ok value
-  | {warnings; _} -> Error (List.map warnings ~f:Odoc_model.Error.to_string)
-
 let fmt_parsed_docstring c ~loc ?pro ~epi str_cmt parsed =
   assert (not (String.is_empty str_cmt)) ;
   let fmt_parsed parsed =
@@ -364,10 +353,7 @@ let fmt_parsed_docstring c ~loc ?pro ~epi str_cmt parsed =
     | Ok parsed -> fmt_parsed parsed
     | Error msgs ->
         if not c.conf.quiet then
-          List.iter msgs
-            ~f:
-              (Caml.Format.eprintf
-                 "Warning: Invalid documentation comment:@,%s\n%!" ) ;
+          List.iter msgs ~f:(Docstring.warn Stdlib.Format.err_formatter) ;
         fmt_raw str_cmt
   in
   Cmts.fmt c loc
@@ -384,7 +370,7 @@ let fmt_docstring c ?(standalone = false) ?pro ?epi doc =
   list_pn (Option.value ~default:[] doc)
     (fun ~prev:_ ({txt; loc}, floating) ~next ->
       let epi = docstring_epi ~standalone ~next ~epi ~floating in
-      fmt_parsed_docstring c ~loc ?pro ~epi txt (parse_docstring ~loc txt) )
+      fmt_parsed_docstring c ~loc ?pro ~epi txt (Docstring.parse ~loc txt) )
 
 let fmt_docstring_around_item' ?(is_val = false) ?(force_before = false)
     ?(fit = false) c doc1 doc2 =
@@ -408,7 +394,7 @@ let fmt_docstring_around_item' ?(is_val = false) ?(force_before = false)
       let floating_doc, doc =
         doc
         |> List.map ~f:(fun (({txt; loc}, _) as doc) ->
-               (parse_docstring ~loc txt, doc) )
+               (Docstring.parse ~loc txt, doc) )
         |> List.partition_tf ~f:(fun (_, (_, floating)) -> floating)
       in
       let placement =

lib/Migrate_ast.ml

@@ -136,6 +136,8 @@ module Position = struct
   include (val Comparator.make ~compare ~sexp_of_t)
 
   let distance p1 p2 = p2.pos_cnum - p1.pos_cnum
+
+  let to_point x = Odoc_model.Location_.{line= x.pos_lnum; column= column x}
 end
 
 module Location = struct
@@ -195,6 +197,12 @@ module Location = struct
   let smallest loc stack =
     let min a b = if width a < width b then a else b in
     List.reduce_exn (loc :: stack) ~f:min
+
+  let to_span loc =
+    let open Odoc_model.Location_ in
+    { file= loc.loc_start.pos_fname
+    ; start= Position.to_point loc.loc_start
+    ; end_= Position.to_point loc.loc_end }
 end
 
 module Longident = struct

lib/Migrate_ast.mli

@@ -84,6 +84,8 @@ module Location : sig
   val width : t -> int
 
   val is_single_line : t -> int -> bool
+
+  val to_span : t -> Odoc_model.Location_.span
 end
 
 module Traverse : sig

lib/Parse_with_comments.mli

@@ -31,3 +31,4 @@ val parse :
   -> Conf.t
   -> source:string
   -> 'a with_comments
+(** @raise [Warning50] on misplaced documentation comments. *)

test/passing/invalid_docstring.ml.ref

@@ -1,3 +1,4 @@
 Warning: Invalid documentation comment:
+File "invalid_docstring.ml", line 1, characters 0-7:
 comment could not be parsed
 (**{v*)