diff --git a/CHANGES.md b/CHANGES.md index eced76755..f8952ea16 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +### unreleased + +#### Added + +- Handle the error-blocks syntax (#439, @jonludlam, @gpetiot) + ### 2.3.1 #### Added diff --git a/lib/block.ml b/lib/block.ml index c194236f4..aa972fe4c 100644 --- a/lib/block.ml +++ b/lib/block.ml @@ -114,6 +114,7 @@ type t = { os_type_enabled : bool; set_variables : (string * string) list; unset_variables : string list; + delim : string option; value : value; } @@ -160,19 +161,61 @@ let rec error_padding = function let xs = error_padding xs in x :: xs -let pp_errors ppf t = +let compute_delimiter ~base_delim outputs = + let s = + Format.asprintf "%a" (Format.pp_print_list (Output.pp ~pad:0)) outputs + in + let is_inadequate delim = + Astring.String.is_infix ~affix:("]" ^ delim ^ "}") s + in + let rec loop n = + let delim = + match n with 0 -> base_delim | n -> Format.sprintf "%s_%d" base_delim n + in + if is_inadequate delim then loop (n + 1) else delim + in + loop 0 + +let pp_error ?syntax ?delim ppf outputs = + match syntax with + | Some Syntax.Markdown -> + Fmt.pf ppf "```\n```mdx-error\n%a\n" + Fmt.(list ~sep:(any "\n") Output.pp) + outputs + | Some Syntax.Mli | Some Syntax.Mld -> + let err_delim = compute_delimiter ~base_delim:"err" outputs in + Fmt.pf ppf "]%a[\n{%s@mdx-error[\n%a\n]%s}" + Fmt.(option string) + delim err_delim + Fmt.(list ~sep:(any "\n") Output.pp) + outputs err_delim + | _ -> () + +let has_output t = + match t.value with + | OCaml { errors = []; _ } -> false + | OCaml { errors = _; _ } -> true + | _ -> false + +let pp_value ?syntax ppf t = + let delim = t.delim in match t.value with | OCaml { errors = []; _ } -> () | OCaml { errors; _ } -> let errors = error_padding errors in - Fmt.pf ppf "```mdx-error\n%a\n```\n" - Fmt.(list ~sep:(any "\n") Output.pp) - errors + pp_error ?syntax ?delim ppf errors | _ -> () -let pp_footer ?syntax ppf _ = +let pp_footer ?syntax ppf t = + let delim = + if has_output t then ( + pp_value ?syntax ppf t; + None) + else t.delim + in match syntax with - | Some Syntax.Mli | Some Syntax.Mld -> Fmt.string ppf "]}" + | Some Syntax.Mli | Some Syntax.Mld -> + Fmt.pf ppf "]%a}" Fmt.(option string) delim | Some Syntax.Cram -> Fmt.string ppf "\n" | Some Syntax.Markdown | None -> Fmt.string ppf "```\n" @@ -216,7 +259,9 @@ let pp_header ?syntax ppf t = | [] -> () | labels -> Fmt.pf ppf " %a" (pp_labels ?syntax) labels in - Fmt.pf ppf "{%a%a[" pp_lang_header lang_headers pp_labels other_labels + Fmt.pf ppf "{%a%a%a[" + Fmt.(option string) + t.delim pp_lang_header lang_headers pp_labels other_labels | Some Syntax.Cram -> pp_labels ?syntax ppf t.labels | Some Syntax.Markdown | None -> if t.legacy_labels then @@ -231,8 +276,7 @@ let pp_header ?syntax ppf t = let pp ?syntax ppf b = pp_header ?syntax ppf b; pp_contents ?syntax ppf b; - pp_footer ?syntax ppf b; - pp_errors ppf b + pp_footer ?syntax ppf b let directory t = t.dir let file t = match t.value with Include t -> Some t.file_included | _ -> None @@ -415,7 +459,7 @@ let infer_block ~loc ~config ~header ~contents ~errors = let+ () = check_no_errors ~loc errors in Raw { header }) -let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors = +let mk ~loc ~section ~labels ~legacy_labels ~header ~delim ~contents ~errors = let block_kind = get_label (function Block_kind x -> Some x | _ -> None) labels in @@ -442,6 +486,7 @@ let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors = os_type_enabled; set_variables = config.set_variables; unset_variables = config.unset_variables; + delim; value; } @@ -450,7 +495,7 @@ let mk_include ~loc ~section ~labels = | Some file_inc -> let header = Header.infer_from_file file_inc in mk ~loc ~section ~labels ~legacy_labels:false ~header ~contents:[] - ~errors:[] + ~errors:[] ~delim:None | None -> label_required ~loc ~label:"file" ~kind:"include" let parse_labels ~label_cmt ~legacy_labels = @@ -476,6 +521,7 @@ let from_raw raw = in Util.Result.to_error_list @@ mk ~loc ~section ~header ~contents ~labels ~legacy_labels ~errors + ~delim:None let is_active ?section:s t = let active = diff --git a/lib/block.mli b/lib/block.mli index b2dc62339..b023265df 100644 --- a/lib/block.mli +++ b/lib/block.mli @@ -105,6 +105,7 @@ type t = { (** Whether the current os type complies with the block's version. *) set_variables : (string * string) list; unset_variables : string list; + delim : string option; value : value; } (** The type for supported code blocks. *) @@ -115,6 +116,7 @@ val mk : labels:Label.t list -> legacy_labels:bool -> header:Header.t option -> + delim:string option -> contents:string list -> errors:Output.t list -> (t, [ `Msg of string ]) result diff --git a/lib/mli_parser.ml b/lib/mli_parser.ml index ed0b7e95d..e8a977663 100644 --- a/lib/mli_parser.ml +++ b/lib/mli_parser.ml @@ -3,6 +3,7 @@ module Code_block = struct type t = { metadata : metadata option; + delimiter : string option; content : Location.t; (* Location of the content *) code_block : Location.t; (* Location of the enclosing code block *) } @@ -44,18 +45,19 @@ let extract_code_block_info acc ~(location : Lexing.position) ~docstring = loc_ghost = false; } in - fun location (metadata, { O.Loc.location = span; _ }) -> + fun location + { O.Ast.meta; delimiter; content = { O.Loc.location = span; _ }; _ } -> let metadata = Option.map - (fun (lang, labels) -> - let language_tag = O.Loc.value lang in - let labels = Option.map O.Loc.value labels in + (fun { O.Ast.language; tags } -> + let language_tag = O.Loc.value language in + let labels = Option.map O.Loc.value tags in Code_block.{ language_tag; labels }) - metadata + meta in let content = convert_loc span in let code_block = convert_loc location in - { metadata; content; code_block } + { metadata; delimiter; content; code_block } in (* Fold over the results from odoc-parser, recurse where necessary @@ -146,9 +148,10 @@ let make_block code_block file_contents = let len = loc.loc_end.pos_cnum - start in String.sub file_contents start len in + let delim = code_block.delimiter in let contents = slice code_block.content |> String.split_on_char '\n' in Block.mk ~loc:code_block.code_block ~section:None ~labels ~header - ~contents ~legacy_labels:false ~errors:[] + ~contents ~legacy_labels:false ~errors:[] ~delim (* Given the locations of the code blocks within [file_contents], then slice it up into [Text] and [Block] parts by using the starts and ends of those blocks as diff --git a/test/bin/mdx-test/expect/simple-mld/test-case.mld b/test/bin/mdx-test/expect/simple-mld/test-case.mld index 9952fc996..e3355704a 100644 --- a/test/bin/mdx-test/expect/simple-mld/test-case.mld +++ b/test/bin/mdx-test/expect/simple-mld/test-case.mld @@ -59,4 +59,11 @@ Indentation test: val x : int = 1 ]} - +{delim@ocaml[ + let f = 1 + "2" +]delim[ +{err@mdx-error[ +Line 1, characters 15-18: +Error: This expression has type string but an expression was expected of type + int +]err}]} diff --git a/test/bin/mdx-test/expect/simple-mli/test-case.mli b/test/bin/mdx-test/expect/simple-mli/test-case.mli index f53cb1947..ad197127a 100644 --- a/test/bin/mdx-test/expect/simple-mli/test-case.mli +++ b/test/bin/mdx-test/expect/simple-mli/test-case.mli @@ -49,3 +49,14 @@ val bar : string (** {@ocaml skip[1 + 1 = 3]} *) val baz : string + +(** +{[ + let f = 1 + "2" +][ +{err@mdx-error[ +Line 1, characters 15-18: +Error: This expression has type string but an expression was expected of type + int +]err}]} +*) diff --git a/test/lib/test_block.ml b/test/lib/test_block.ml index 033c02bbc..be45ed866 100644 --- a/test/lib/test_block.ml +++ b/test/lib/test_block.ml @@ -23,7 +23,7 @@ let test_mk = let test_fun () = let actual = Mdx.Block.mk ~loc:Location.none ~section:None ~labels - ~legacy_labels:false ~header ~contents ~errors:[] + ~legacy_labels:false ~header ~contents ~errors:[] ~delim:None in let expected = Result.map_error diff --git a/test/lib/test_dep.ml b/test/lib/test_dep.ml index 4aacc3c2e..c8b371abc 100644 --- a/test/lib/test_dep.ml +++ b/test/lib/test_dep.ml @@ -26,7 +26,7 @@ let test_of_block = | Ok labels -> ( match Mdx.Block.mk ~loc:Location.none ~section:None ~labels ~header:None - ~contents:[] ~legacy_labels:false ~errors:[] + ~contents:[] ~legacy_labels:false ~errors:[] ~delim:None with | Ok block -> block | Error _ -> assert false) diff --git a/vendor/odoc-parser/LICENSE b/vendor/odoc-parser/LICENSE new file mode 100644 index 000000000..039fd7bf3 --- /dev/null +++ b/vendor/odoc-parser/LICENSE @@ -0,0 +1,267 @@ +Copyright (c) 2016 Thomas Refis +Copyright (c) 2014, 2015 Leo White +Copyright (c) 2015 David Sheets + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + + +# Licenses for the support files used by the generated HTML + +## src/html_support_files/highlight.pack.js + +BSD 3-Clause License + +Copyright (c) 2006, Ivan Sagalaev. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +## src/html_support_files/katex.min.js, katex.min.css and fonts/KaTeX_* + +The MIT License (MIT) + +Copyright (c) 2013-2020 Khan Academy and other contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + +## src/html_support_files/fonts/fira-mono-* and fonts/fira-sans-* + +Digitized data copyright (c) 2012-2015, The Mozilla Foundation and Telefonica S.A. + +This Font Software is licensed under the SIL Open Font License, Version 1.1. +This license is copied below, and is also available with a FAQ at: +http://scripts.sil.org/OFL + + +----------------------------------------------------------- +SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 +----------------------------------------------------------- + +PREAMBLE +The goals of the Open Font License (OFL) are to stimulate worldwide +development of collaborative font projects, to support the font creation +efforts of academic and linguistic communities, and to provide a free and +open framework in which fonts may be shared and improved in partnership +with others. + +The OFL allows the licensed fonts to be used, studied, modified and +redistributed freely as long as they are not sold by themselves. The +fonts, including any derivative works, can be bundled, embedded, +redistributed and/or sold with any software provided that any reserved +names are not used by derivative works. The fonts and derivatives, +however, cannot be released under any other type of license. The +requirement for fonts to remain under this license does not apply +to any document created using the fonts or their derivatives. + +DEFINITIONS +"Font Software" refers to the set of files released by the Copyright +Holder(s) under this license and clearly marked as such. This may +include source files, build scripts and documentation. + +"Reserved Font Name" refers to any names specified as such after the +copyright statement(s). + +"Original Version" refers to the collection of Font Software components as +distributed by the Copyright Holder(s). + +"Modified Version" refers to any derivative made by adding to, deleting, +or substituting -- in part or in whole -- any of the components of the +Original Version, by changing formats or by porting the Font Software to a +new environment. + +"Author" refers to any designer, engineer, programmer, technical +writer or other person who contributed to the Font Software. + +PERMISSION & CONDITIONS +Permission is hereby granted, free of charge, to any person obtaining +a copy of the Font Software, to use, study, copy, merge, embed, modify, +redistribute, and sell modified and unmodified copies of the Font +Software, subject to the following conditions: + +1) Neither the Font Software nor any of its individual components, +in Original or Modified Versions, may be sold by itself. + +2) Original or Modified Versions of the Font Software may be bundled, +redistributed and/or sold with any software, provided that each copy +contains the above copyright notice and this license. These can be +included either as stand-alone text files, human-readable headers or +in the appropriate machine-readable metadata fields within text or +binary files as long as those fields can be easily viewed by the user. + +3) No Modified Version of the Font Software may use the Reserved Font +Name(s) unless explicit written permission is granted by the corresponding +Copyright Holder. This restriction only applies to the primary font name as +presented to the users. + +4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font +Software shall not be used to promote, endorse or advertise any +Modified Version, except to acknowledge the contribution(s) of the +Copyright Holder(s) and the Author(s) or with their explicit written +permission. + +5) The Font Software, modified or unmodified, in part or in whole, +must be distributed entirely under this license, and must not be +distributed under any other license. The requirement for fonts to +remain under this license does not apply to any document created +using the Font Software. + +TERMINATION +This license becomes null and void if any of the above conditions are +not met. + +DISCLAIMER +THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT +OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE +COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM +OTHER DEALINGS IN THE FONT SOFTWARE. + +## src/html_support_files/fonts/noticia-* + +Copyright (c) 2011, JM Sole (http://jmsole.cl|info@jmsole.cl), +with Reserved Font Name "Noticia Text". + +This Font Software is licensed under the SIL Open Font License, Version 1.1. +This license is copied below, and is also available with a FAQ at: +http://scripts.sil.org/OFL + + +----------------------------------------------------------- +SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 +----------------------------------------------------------- + +PREAMBLE +The goals of the Open Font License (OFL) are to stimulate worldwide +development of collaborative font projects, to support the font creation +efforts of academic and linguistic communities, and to provide a free and +open framework in which fonts may be shared and improved in partnership +with others. + +The OFL allows the licensed fonts to be used, studied, modified and +redistributed freely as long as they are not sold by themselves. The +fonts, including any derivative works, can be bundled, embedded, +redistributed and/or sold with any software provided that any reserved +names are not used by derivative works. The fonts and derivatives, +however, cannot be released under any other type of license. The +requirement for fonts to remain under this license does not apply +to any document created using the fonts or their derivatives. + +DEFINITIONS +"Font Software" refers to the set of files released by the Copyright +Holder(s) under this license and clearly marked as such. This may +include source files, build scripts and documentation. + +"Reserved Font Name" refers to any names specified as such after the +copyright statement(s). + +"Original Version" refers to the collection of Font Software components as +distributed by the Copyright Holder(s). + +"Modified Version" refers to any derivative made by adding to, deleting, +or substituting -- in part or in whole -- any of the components of the +Original Version, by changing formats or by porting the Font Software to a +new environment. + +"Author" refers to any designer, engineer, programmer, technical +writer or other person who contributed to the Font Software. + +PERMISSION & CONDITIONS +Permission is hereby granted, free of charge, to any person obtaining +a copy of the Font Software, to use, study, copy, merge, embed, modify, +redistribute, and sell modified and unmodified copies of the Font +Software, subject to the following conditions: + +1) Neither the Font Software nor any of its individual components, +in Original or Modified Versions, may be sold by itself. + +2) Original or Modified Versions of the Font Software may be bundled, +redistributed and/or sold with any software, provided that each copy +contains the above copyright notice and this license. These can be +included either as stand-alone text files, human-readable headers or +in the appropriate machine-readable metadata fields within text or +binary files as long as those fields can be easily viewed by the user. + +3) No Modified Version of the Font Software may use the Reserved Font +Name(s) unless explicit written permission is granted by the corresponding +Copyright Holder. This restriction only applies to the primary font name as +presented to the users. + +4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font +Software shall not be used to promote, endorse or advertise any +Modified Version, except to acknowledge the contribution(s) of the +Copyright Holder(s) and the Author(s) or with their explicit written +permission. + +5) The Font Software, modified or unmodified, in part or in whole, +must be distributed entirely under this license, and must not be +distributed under any other license. The requirement for fonts to +remain under this license does not apply to any document created +using the Font Software. + +TERMINATION +This license becomes null and void if any of the above conditions are +not met. + +DISCLAIMER +THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT +OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE +COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM +OTHER DEALINGS IN THE FONT SOFTWARE. diff --git a/vendor/odoc-parser/LICENSE.md b/vendor/odoc-parser/LICENSE.md deleted file mode 100644 index 44754d272..000000000 --- a/vendor/odoc-parser/LICENSE.md +++ /dev/null @@ -1,7 +0,0 @@ -Copyright 2017-2021 the odoc-parser programmers. - -Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - - diff --git a/vendor/odoc-parser/src/ast.ml b/vendor/odoc-parser/src/ast.ml index 863f60c4a..85c38931f 100644 --- a/vendor/odoc-parser/src/ast.ml +++ b/vendor/odoc-parser/src/ast.ml @@ -9,6 +9,7 @@ type 'a with_location = 'a Loc.with_location type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ] +type alignment = [ `Left | `Center | `Right ] type reference_kind = [ `Simple | `With_text ] (** References in doc comments can be of two kinds: [{!simple}] or [{{!ref}With text}]. *) @@ -29,18 +30,33 @@ type inline_element = text. Similarly the [`Link] constructor has the link itself as first parameter and the second is the replacement text. *) -type nestable_block_element = +type 'a cell = 'a with_location list * [ `Header | `Data ] +type 'a row = 'a cell list +type 'a grid = 'a row list +type 'a abstract_table = 'a grid * alignment option list option + +type code_block_meta = { + language : string with_location; + tags : string with_location option; +} + +type code_block = { + meta : code_block_meta option; + delimiter : string option; + content : string with_location; + output : nestable_block_element with_location list option; +} + +and nestable_block_element = [ `Paragraph of inline_element with_location list - | `Code_block of - (string with_location * string with_location option) option - * string with_location - (* [(language tag * metadata option) option * content] *) + | `Code_block of code_block | `Verbatim of string | `Modules of string with_location list | `List of [ `Unordered | `Ordered ] * [ `Light | `Heavy ] * nestable_block_element with_location list list + | `Table of table | `Math_block of string (** @since 2.0.0 *) ] (** Some block elements may be nested within lists or tags, but not all. The [`List] constructor has a parameter of type [\[`Light | `Heavy\]]. @@ -48,8 +64,10 @@ type nestable_block_element = {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#sss:ocamldoc-list}manual}). *) +and table = nestable_block_element abstract_table * [ `Light | `Heavy ] + type internal_tag = - [ `Canonical of string with_location | `Inline | `Open | `Closed ] + [ `Canonical of string with_location | `Inline | `Open | `Closed | `Hidden ] (** Internal tags are used to exercise fine control over the output of odoc. They are never rendered in the output *) diff --git a/vendor/odoc-parser/src/compat.ml b/vendor/odoc-parser/src/compat.ml new file mode 100644 index 000000000..a7b535d18 --- /dev/null +++ b/vendor/odoc-parser/src/compat.ml @@ -0,0 +1,32 @@ +module Option = struct + type 'a t = 'a option = None | Some of 'a + + let is_some = function None -> false | Some _ -> true + let value ~default = function None -> default | Some x -> x + + let join_list l = + let rec loop acc = function + | [] -> Some (List.rev acc) + | Some a :: q -> loop (a :: acc) q + | None :: _ -> None + in + loop [] l +end + +module Char = struct + include Char + + let equal (x : char) y = x = y +end + +module String = struct + include String + + let for_all f str = + let rec aux i = + if i >= String.length str then true + else if f (String.get str i) then aux (i + 1) + else false + in + aux 0 +end diff --git a/vendor/odoc-parser/src/compat.mli b/vendor/odoc-parser/src/compat.mli new file mode 100644 index 000000000..0959145c2 --- /dev/null +++ b/vendor/odoc-parser/src/compat.mli @@ -0,0 +1,26 @@ +(** @since 4.08 *) +module Option : sig + type 'a t = 'a option = None | Some of 'a + + val is_some : 'a option -> bool + (** [is_some o] is [true] if and only if [o] is [Some o]. *) + + val value : default:'a -> 'a option -> 'a + val join_list : 'a option list -> 'a list option +end + +module Char : sig + include module type of Char + + val equal : t -> t -> bool + (** The equal function for chars. + @since 4.03.0 *) +end + +module String : sig + include module type of String + + val for_all : (char -> bool) -> string -> bool + (** [for_all p s] checks if all characters in [s] satisfy the preficate [p]. + @since 4.13.0 *) +end diff --git a/vendor/odoc-parser/src/lexer.mll b/vendor/odoc-parser/src/lexer.mll index d8eac89cf..0cde0b434 100644 --- a/vendor/odoc-parser/src/lexer.mll +++ b/vendor/odoc-parser/src/lexer.mll @@ -31,7 +31,7 @@ type math_kind = Inline | Block let math_constr kind x = - match kind with + match kind with | Inline -> `Math_span x | Block -> `Math_block x @@ -189,8 +189,6 @@ let reference_token start target = | "{{:" -> `Begin_link_with_replacement_text target | _ -> assert false - - let trim_leading_space_or_accept_whitespace input start_offset text = match text.[0] with | ' ' -> String.sub text 1 (String.length text - 1) @@ -219,18 +217,25 @@ let emit_verbatim input start_offset buffer = let t = trim_trailing_blank_lines t in emit input (`Verbatim t) ~start_offset -let emit_code_block ~start_offset input metadata c = - let c = trim_trailing_blank_lines c in +(* The locations have to be treated carefully in this function. We need to ensure that + the []`Code_block] location matches the entirety of the block including the terminator, + and the content location is precicely the location of the text of the code itself. + Note that the location reflects the content _without_ stripping of whitespace, whereas + the value of the content in the tree has whitespace stripped from the beginning, + and trailing empty lines removed. *) +let emit_code_block ~start_offset content_offset input metadata delim terminator c has_results = + let c = Buffer.contents c |> trim_trailing_blank_lines in + let content_location = input.offset_to_location content_offset in let c = with_location_adjustments - (fun _ location c -> - let first_line_offset = location.start.column in + (fun _ _location c -> + let first_line_offset = content_location.column in trim_leading_whitespace ~first_line_offset c) input c in let c = trim_leading_blank_lines c in - let c = with_location_adjustments ~adjust_end_by:"]}" (fun _ -> Loc.at) input c in - emit ~start_offset input (`Code_block (metadata, c)) + let c = with_location_adjustments ~adjust_end_by:terminator ~start_offset:content_offset (fun _ -> Loc.at) input c in + emit ~start_offset input (`Code_block (metadata, delim, c, has_results)) let heading_level input level = if String.length level >= 2 && level.[0] = '0' then begin @@ -239,12 +244,13 @@ let heading_level input level = end; int_of_string level -} - +let buffer_add_lexeme buffer lexbuf = + Buffer.add_string buffer (Lexing.lexeme lexbuf) +} let markup_char = - ['{' '}' '[' ']' '@'] + ['{' '}' '[' ']' '@' '|'] let space_char = [' ' '\t' '\n' '\r'] let bullet_char = @@ -261,18 +267,74 @@ let newline = let reference_start = "{!" | "{{!" | "{:" | "{{:" -let code_block_text = - ([^ ']'] | ']'+ [^ ']' '}'])* ']'* let raw_markup = ([^ '%'] | '%'+ [^ '%' '}'])* '%'* + let raw_markup_target = ([^ ':' '%'] | '%'+ [^ ':' '%' '}'])* '%'* let language_tag_char = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' ] +let delim_char = + ['a'-'z' 'A'-'Z' '0'-'9' '_' ] + +rule reference_paren_content input start ref_offset start_offset depth_paren + buffer = + parse + | '(' + { + buffer_add_lexeme buffer lexbuf ; + reference_paren_content input start ref_offset start_offset + (depth_paren + 1) buffer lexbuf } + | ')' + { + buffer_add_lexeme buffer lexbuf ; + if depth_paren = 0 then + reference_content input start ref_offset buffer lexbuf + else + reference_paren_content input start ref_offset start_offset + (depth_paren - 1) buffer lexbuf } + | eof + { warning + input + ~start_offset + (Parse_error.unclosed_bracket ~bracket:"(") ; + Buffer.contents buffer } + | _ + { + buffer_add_lexeme buffer lexbuf ; + reference_paren_content input start ref_offset start_offset depth_paren + buffer lexbuf } + +and reference_content input start start_offset buffer = parse + | '}' + { + Buffer.contents buffer + } + | '(' + { + buffer_add_lexeme buffer lexbuf ; + reference_paren_content input start start_offset + (Lexing.lexeme_start lexbuf) 0 buffer lexbuf + } + | '"' [^ '"']* '"' + { + buffer_add_lexeme buffer lexbuf ; + reference_content input start start_offset buffer lexbuf + } + | eof + { warning + input + ~start_offset + (Parse_error.unclosed_bracket ~bracket:start) ; + Buffer.contents buffer } + | _ + { + buffer_add_lexeme buffer lexbuf ; + reference_content input start start_offset buffer lexbuf } -rule token input = parse +and token input = parse | horizontal_space* eof { emit input `End } @@ -289,6 +351,9 @@ rule token input = parse | (horizontal_space* (newline horizontal_space*)? as p) '}' { emit input `Right_brace ~adjust_start_by:p } + | '|' + { emit input `Bar } + | word_char (word_char | bullet_char | '@')* | bullet_char (word_char | bullet_char | '@')+ as w { emit input (`Word (unescape_word w)) } @@ -311,13 +376,13 @@ rule token input = parse | "{e" { emit input (`Begin_style `Emphasis) } - + | "{L" { emit input (`Begin_paragraph_style `Left) } - + | "{C" { emit input (`Begin_paragraph_style `Center) } - + | "{R" { emit input (`Begin_paragraph_style `Right) } @@ -326,24 +391,30 @@ rule token input = parse | "{_" { emit input (`Begin_style `Subscript) } - + | "{math" space_char { math Block (Buffer.create 1024) 0 (Lexing.lexeme_start lexbuf) input lexbuf } - + | "{m" horizontal_space { math Inline (Buffer.create 1024) 0 (Lexing.lexeme_start lexbuf) input lexbuf } - + | "{!modules:" ([^ '}']* as modules) '}' { emit input (`Modules modules) } - | (reference_start as start) ([^ '}']* as target) '}' - { emit input (reference_token start target) } + | (reference_start as start) + { + let start_offset = Lexing.lexeme_start lexbuf in + let target = + reference_content input start start_offset (Buffer.create 16) lexbuf + in + let token = (reference_token start target) in + emit ~start_offset input token } | "{[" - { code_block (Lexing.lexeme_start lexbuf) None input lexbuf } + { code_block (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) None (Buffer.create 256) "" input lexbuf } - | (("{@" horizontal_space*) as prefix) (language_tag_char+ as lang_tag_) + | (("{" (delim_char* as delim) "@" horizontal_space*) as prefix) (language_tag_char+ as lang_tag_) { let start_offset = Lexing.lexeme_start lexbuf in let lang_tag = @@ -351,23 +422,23 @@ rule token input = parse in let emit_truncated_code_block () = let empty_content = with_location_adjustments (fun _ -> Loc.at) input "" in - emit ~start_offset input (`Code_block (Some (lang_tag, None), empty_content)) + emit ~start_offset input (`Code_block (Some (lang_tag, None), delim, empty_content, false)) in match code_block_metadata_tail input lexbuf with - | `Ok metadata -> code_block start_offset (Some (lang_tag, metadata)) input lexbuf + | `Ok metadata -> code_block start_offset (Lexing.lexeme_end lexbuf) (Some (lang_tag, metadata)) (Buffer.create 256) delim input lexbuf | `Eof -> warning input ~start_offset Parse_error.truncated_code_block_meta; emit_truncated_code_block () | `Invalid_char c -> warning input ~start_offset (Parse_error.language_tag_invalid_char lang_tag_ c); - code_block start_offset (Some (lang_tag, None)) input lexbuf + code_block start_offset (Lexing.lexeme_end lexbuf) (Some (lang_tag, None)) (Buffer.create 256) delim input lexbuf } | "{@" horizontal_space* '[' { warning input Parse_error.no_language_tag_in_meta; - code_block (Lexing.lexeme_start lexbuf) None input lexbuf + code_block (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) None (Buffer.create 256) "" input lexbuf } | "{v" @@ -398,6 +469,21 @@ rule token input = parse | "{-" { emit input (`Begin_list_item `Dash) } + | "{table" + { emit input (`Begin_table_heavy) } + + | "{t" + { emit input (`Begin_table_light) } + + | "{tr" + { emit input `Begin_table_row } + + | "{th" + { emit input (`Begin_table_cell `Header) } + + | "{td" + { emit input (`Begin_table_cell `Data) } + | '{' (['0'-'9']+ as level) ':' (([^ '}'] # space_char)* as label) { emit input (`Begin_section_heading (heading_level input level, Some label)) } @@ -450,7 +536,11 @@ rule token input = parse | "@closed" { emit input (`Tag `Closed) } + | "@hidden" + { emit input (`Tag `Hidden) } + | "]}" + { emit input `Right_code_delimiter} | '{' { try bad_markup_recovery (Lexing.lexeme_start lexbuf) input lexbuf @@ -502,17 +592,6 @@ rule token input = parse ~in_what:(Token.describe (`Modules ""))); emit input (`Modules modules) } - | (reference_start as start) ([^ '}']* as target) eof - { warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (reference_token start ""))); - emit input (reference_token start target) } - - - and code_span buffer nesting_level start_offset input = parse | ']' { if nesting_level = 0 then @@ -655,11 +734,29 @@ and code_block_metadata_tail input = parse | eof { `Eof } -and code_block start_offset metadata input = parse - | (code_block_text as c) "]}" - { emit_code_block ~start_offset input metadata c } - | (code_block_text as c) eof +and code_block start_offset content_offset metadata prefix delim input = parse + | ("]" (delim_char* as delim') "[") as terminator + { if delim = delim' + then emit_code_block ~start_offset content_offset input metadata delim terminator prefix true + else + (Buffer.add_string prefix terminator; + code_block start_offset content_offset metadata prefix delim input lexbuf) } + | ("]" (delim_char* as delim') "}") as terminator + { + if delim = delim' + then emit_code_block ~start_offset content_offset input metadata delim terminator prefix false + else ( + Buffer.add_string prefix terminator; + code_block start_offset content_offset metadata prefix delim input lexbuf + ) + } + | eof { warning input ~start_offset Parse_error.truncated_code_block; - emit_code_block ~start_offset input metadata c + emit_code_block ~start_offset content_offset input metadata delim "" prefix false + } + | (_ as c) + { + Buffer.add_char prefix c; + code_block start_offset content_offset metadata prefix delim input lexbuf } diff --git a/vendor/odoc-parser/src/loc.ml b/vendor/odoc-parser/src/loc.ml index e3f5a07c7..0316fa270 100644 --- a/vendor/odoc-parser/src/loc.ml +++ b/vendor/odoc-parser/src/loc.ml @@ -22,3 +22,11 @@ let span spans = let nudge_start offset span = { span with start = { span.start with column = span.start.column + offset } } + +let spans_multiple_lines = function + | { + location = + { start = { line = start_line; _ }; end_ = { line = end_line; _ }; _ }; + _; + } -> + end_line > start_line diff --git a/vendor/odoc-parser/src/loc.mli b/vendor/odoc-parser/src/loc.mli index 0afe73554..135ba0358 100644 --- a/vendor/odoc-parser/src/loc.mli +++ b/vendor/odoc-parser/src/loc.mli @@ -39,3 +39,7 @@ val map : ('a -> 'b) -> 'a with_location -> 'b with_location val same : _ with_location -> 'b -> 'b with_location (** [same x y] retuns the value y wrapped in a {!with_location} whose location is that of [x] *) + +val spans_multiple_lines : _ with_location -> bool +(** [spans_multiple_lines x] checks to see whether [x] is located + on a single line or whether it covers more than one. *) diff --git a/vendor/odoc-parser/src/parse_error.ml b/vendor/odoc-parser/src/parse_error.ml index 095061ff4..4ee22c470 100644 --- a/vendor/odoc-parser/src/parse_error.ml +++ b/vendor/odoc-parser/src/parse_error.ml @@ -30,6 +30,11 @@ let not_allowed : Warning.make ?suggestion "%s is not allowed in %s." (capitalize_ascii what) in_what +let unclosed_bracket : + ?suggestion:string -> bracket:string -> Loc.span -> Warning.t = + fun ?suggestion ~bracket -> + Warning.make ?suggestion "Open bracket '%s' is never closed." bracket + let no_leading_whitespace_in_verbatim : Loc.span -> Warning.t = Warning.make "'{v' should be followed by whitespace." diff --git a/vendor/odoc-parser/src/syntax.ml b/vendor/odoc-parser/src/syntax.ml index 347ebf44a..d8ecb87b5 100644 --- a/vendor/odoc-parser/src/syntax.ml +++ b/vendor/odoc-parser/src/syntax.ml @@ -17,6 +17,8 @@ sequence of block elements, so [block_element_list] is the top-level parser. It is also used for list item and tag content. *) +open! Compat + type 'a with_location = 'a Loc.with_location (* {2 Input} *) @@ -36,6 +38,110 @@ let peek input = | Some token -> token | None -> assert false +module Table = struct + module Light_syntax = struct + let valid_align = function + | [ { Loc.value = `Word w; _ } ] -> ( + match String.length w with + | 0 -> `Valid None + | 1 -> ( + match w with + | "-" -> `Valid None + | ":" -> `Valid (Some `Center) + | _ -> `Invalid) + | len -> + if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then + match (String.get w 0, String.get w (len - 1)) with + | ':', ':' -> `Valid (Some `Center) + | ':', '-' -> `Valid (Some `Left) + | '-', ':' -> `Valid (Some `Right) + | '-', '-' -> `Valid None + | _ -> `Invalid + else `Invalid) + | _ -> `Invalid + + let valid_align_row lx = + let rec loop acc = function + | [] -> Some (List.rev acc) + | x :: q -> ( + match valid_align x with + | `Invalid -> None + | `Valid alignment -> loop (alignment :: acc) q) + in + loop [] lx + + let create ~grid ~align : Ast.table = + let cell_to_block (x, k) = + let whole_loc = Loc.span (List.map (fun x -> x.Loc.location) x) in + match x with + | [] -> ([], k) + | _ -> ([ Loc.at whole_loc (`Paragraph x) ], k) + in + let row_to_block = List.map cell_to_block in + let grid_to_block = List.map row_to_block in + ((grid_to_block grid, align), `Light) + + let with_kind kind : 'a with_location list list -> 'a Ast.row = + List.map (fun c -> (c, kind)) + + let from_raw_data grid : Ast.table = + match grid with + | [] -> create ~grid:[] ~align:None + | row1 :: rows2_N -> ( + match valid_align_row row1 with + (* If the first line is the align row, everything else is data. *) + | Some _ as align -> + create ~grid:(List.map (with_kind `Data) rows2_N) ~align + | None -> ( + match rows2_N with + (* Only 1 line, if this is not the align row this is data. *) + | [] -> create ~grid:[ with_kind `Data row1 ] ~align:None + | row2 :: rows3_N -> ( + match valid_align_row row2 with + (* If the second line is the align row, the first one is the + header and the rest is data. *) + | Some _ as align -> + let header = with_kind `Header row1 in + let data = List.map (with_kind `Data) rows3_N in + create ~grid:(header :: data) ~align + (* No align row in the first 2 lines, everything is considered + data. *) + | None -> + create ~grid:(List.map (with_kind `Data) grid) ~align:None + ))) + end + + module Heavy_syntax = struct + let create ~grid : Ast.table = ((grid, None), `Heavy) + let from_grid grid : Ast.table = create ~grid + end +end + +module Reader = struct + let until_rbrace input acc = + let rec consume () = + let next_token = peek input in + match next_token.value with + | `Right_brace -> + junk input; + `End (acc, next_token.location) + | `Space _ | `Single_newline _ | `Blank_line _ -> + junk input; + consume () + | _ -> `Token next_token + in + consume () + + module Infix = struct + let ( >>> ) consume if_token = + match consume with + | `End (ret, loc) -> (ret, loc) + | `Token t -> if_token t + end +end + +open Reader.Infix + (* The last token in the stream is always [`End], and it is never consumed by the parser, so the [None] case is impossible. *) @@ -99,6 +205,9 @@ let rec inline_element : | `Plus -> junk input; Loc.at location (`Word "+") + | `Bar -> + junk input; + Loc.at location (`Word "|") | (`Code_span _ | `Math_span _ | `Raw_markup _) as token -> junk input; Loc.at location token @@ -249,16 +358,19 @@ and delimited_inline_element_list : junk input; let element = Loc.same next_token (`Space ws) in consume_elements ~at_start_of_line:true (element :: acc) + | `Bar as token -> + let acc = inline_element input next_token.location token :: acc in + consume_elements ~at_start_of_line:false acc | (`Minus | `Plus) as bullet -> (if at_start_of_line then - let suggestion = - Printf.sprintf "move %s so it isn't the first thing on the line." - (Token.print bullet) - in - Parse_error.not_allowed ~what:(Token.describe bullet) - ~in_what:(Token.describe parent_markup) - ~suggestion next_token.location - |> add_warning input); + let suggestion = + Printf.sprintf "move %s so it isn't the first thing on the line." + (Token.print bullet) + in + Parse_error.not_allowed ~what:(Token.describe bullet) + ~in_what:(Token.describe parent_markup) + ~suggestion next_token.location + |> add_warning input); let acc = inline_element input next_token.location bullet :: acc in consume_elements ~at_start_of_line:false acc @@ -340,8 +452,8 @@ let paragraph : input -> Ast.nestable_block_element with_location = fun acc -> let next_token = peek input in match next_token.value with - | (`Space _ | `Minus | `Plus | #token_that_always_begins_an_inline_element) - as token -> + | ( `Space _ | `Minus | `Plus | `Bar + | #token_that_always_begins_an_inline_element ) as token -> let element = inline_element input next_token.location token in paragraph_line (element :: acc) | _ -> acc @@ -354,7 +466,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = fun acc -> match npeek 2 input with | { value = `Single_newline ws; location } - :: { value = #token_that_always_begins_an_inline_element; _ } + :: { value = #token_that_always_begins_an_inline_element | `Bar; _ } :: _ -> junk input; let acc = Loc.at location (`Space ws) :: acc in @@ -371,7 +483,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = (* {3 Helper types} *) (* The interpretation of tokens in the block parser depends on where on a line - each token appears. The five possible "locations" are: + each token appears. The six possible "locations" are: - [`At_start_of_line], when only whitespace has been read on the current line. @@ -381,6 +493,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = [-], has been read, and only whitespace has been read since. - [`After_explicit_list_bullet], when a valid explicit bullet, such as [{li], has been read, and only whitespace has been read since. + - [`After_table_cell], when a table cell opening markup ('{th' or '{td') has been read. - [`After_text], when any other valid non-whitespace token has already been read on the current line. @@ -404,6 +517,7 @@ type where_in_line = | `After_tag | `After_shorthand_bullet | `After_explicit_list_bullet + | `After_table_cell | `After_text ] (* The block parsing loop, function [block_element_list], stops when it @@ -426,6 +540,7 @@ type where_in_line = cases for exactly the tokens that might be at the front of the stream after the block parser returns. *) type stops_at_delimiters = [ `End | `Right_brace ] +type code_stop = [ `End | `Right_code_delimiter ] type stopped_implicitly = [ `End @@ -457,6 +572,8 @@ type ('block, 'stops_at_which_tokens) context = | Top_level : (Ast.block_element, stops_at_delimiters) context | In_shorthand_list : (Ast.nestable_block_element, stopped_implicitly) context | In_explicit_list : (Ast.nestable_block_element, stops_at_delimiters) context + | In_table_cell : (Ast.nestable_block_element, stops_at_delimiters) context + | In_code_results : (Ast.nestable_block_element, code_stop) context | In_tag : (Ast.nestable_block_element, Token.t) context (* This is a no-op. It is needed to prove to the type system that nestable block @@ -471,6 +588,8 @@ let accepted_in_all_contexts : | Top_level -> (block :> Ast.block_element) | In_shorthand_list -> block | In_explicit_list -> block + | In_table_cell -> block + | In_code_results -> block | In_tag -> block (* Converts a tag to a series of words. This is used in error recovery, when a @@ -483,6 +602,7 @@ let tag_to_words = function | `Inline -> [ `Word "@inline" ] | `Open -> [ `Word "@open" ] | `Closed -> [ `Word "@closed" ] + | `Hidden -> [ `Word "@hidden" ] | `Param s -> [ `Word "@param"; `Space " "; `Word s ] | `Raise s -> [ `Word "@raise"; `Space " "; `Word s ] | `Return -> [ `Word "@return" ] @@ -499,6 +619,7 @@ let tag_to_words = function - paragraphs, - code blocks, - verbatim text blocks, + - tables, - lists, and - section headings. *) let rec block_element_list : @@ -553,7 +674,15 @@ let rec block_element_list : match peek input with (* Terminators: the two tokens that terminate anything. *) - | ({ value = `End; _ } | { value = `Right_brace; _ }) as next_token -> ( + | { value = `End; _ } as next_token -> ( + match context with + | Top_level -> (List.rev acc, next_token, where_in_line) + | In_shorthand_list -> (List.rev acc, next_token, where_in_line) + | In_explicit_list -> (List.rev acc, next_token, where_in_line) + | In_tag -> (List.rev acc, next_token, where_in_line) + | In_table_cell -> (List.rev acc, next_token, where_in_line) + | In_code_results -> (List.rev acc, next_token, where_in_line)) + | { value = `Right_brace; _ } as next_token -> ( (* This little absurdity is needed to satisfy the type system. Without it, OCaml is unable to prove that [stream_head] has the right type for all possible values of [context]. *) @@ -561,7 +690,17 @@ let rec block_element_list : | Top_level -> (List.rev acc, next_token, where_in_line) | In_shorthand_list -> (List.rev acc, next_token, where_in_line) | In_explicit_list -> (List.rev acc, next_token, where_in_line) - | In_tag -> (List.rev acc, next_token, where_in_line)) + | In_table_cell -> (List.rev acc, next_token, where_in_line) + | In_tag -> (List.rev acc, next_token, where_in_line) + | In_code_results -> + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc) + | { value = `Right_code_delimiter; _ } as next_token -> ( + match context with + | In_code_results -> (List.rev acc, next_token, where_in_line) + | _ -> + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc) (* Whitespace. This can terminate some kinds of block elements. It is also necessary to track it to interpret [`Minus] and [`Plus] correctly, as well as to ensure that all block elements begin on their own line. *) @@ -594,6 +733,32 @@ let rec block_element_list : ~suggestion location |> add_warning input; + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc + (* Table rows ([{tr ...}]) can never appear directly + in block content. They can only appear inside [{table ...}]. *) + | { value = `Begin_table_row as token; location } -> + let suggestion = + Printf.sprintf "move %s into %s." (Token.print token) + (Token.describe `Begin_table_heavy) + in + Parse_error.not_allowed ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion location + |> add_warning input; + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc + (* Table cells ([{th ...}] and [{td ...}]) can never appear directly + in block content. They can only appear inside [{tr ...}]. *) + | { value = `Begin_table_cell _ as token; location } -> + let suggestion = + Printf.sprintf "move %s into %s." (Token.print token) + (Token.describe `Begin_table_row) + in + Parse_error.not_allowed ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion location + |> add_warning input; junk input; consume_block_elements ~parsed_a_tag where_in_line acc (* Tags. These can appear at the top level only. Also, once one tag is seen, @@ -622,10 +787,12 @@ let rec block_element_list : if where_in_line = `At_start_of_line then (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context + | In_table_cell -> recover_when_not_at_top_level context | In_tag -> if where_in_line = `At_start_of_line then (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context + | In_code_results -> recover_when_not_at_top_level context (* If this is the top-level call to [block_element_list], parse the tag. *) | Top_level -> ( @@ -702,12 +869,12 @@ let rec block_element_list : let tag = Loc.at location tag in consume_block_elements ~parsed_a_tag:true where_in_line (tag :: acc) - | (`Inline | `Open | `Closed) as tag -> + | (`Inline | `Open | `Closed | `Hidden) as tag -> let tag = Loc.at location (`Tag tag) in consume_block_elements ~parsed_a_tag:true `After_text (tag :: acc))) - | { value = #token_that_always_begins_an_inline_element; _ } as next_token - -> + | ( { value = #token_that_always_begins_an_inline_element; _ } + | { value = `Bar; _ } ) as next_token -> warn_if_after_tags next_token; warn_if_after_text next_token; @@ -727,8 +894,7 @@ let rec block_element_list : let block = Loc.at location block in let acc = block :: acc in consume_block_elements ~parsed_a_tag `After_text acc - | ( { value = `Code_block (_, { value = s; _ }) as token; location } - | { value = `Math_block s as token; location } ) as next_token -> + | { value = `Math_block s as token; location } as next_token -> warn_if_after_tags next_token; warn_if_after_text next_token; if s = "" then @@ -740,6 +906,53 @@ let rec block_element_list : let block = Loc.at location block in let acc = block :: acc in consume_block_elements ~parsed_a_tag `After_text acc + | { + value = + `Code_block (meta, delim, { value = s; location = v_loc }, has_outputs) + as token; + location; + } as next_token -> + warn_if_after_tags next_token; + warn_if_after_text next_token; + junk input; + let delimiter = if delim = "" then None else Some delim in + let output, location = + if not has_outputs then (None, location) + else + let content, next_token, _where_in_line = + block_element_list In_code_results ~parent_markup:token input + in + junk input; + let locations = + location :: List.map (fun content -> content.Loc.location) content + in + let location = Loc.span locations in + let location = { location with end_ = next_token.location.end_ } in + (Some content, location) + in + + if s = "" then + Parse_error.should_not_be_empty ~what:(Token.describe token) location + |> add_warning input; + + let meta = + match meta with + | None -> None + | Some (language, tags) -> Some { Ast.language; tags } + in + let block = + accepted_in_all_contexts context + (`Code_block + { + Ast.meta; + delimiter; + content = { value = s; location = v_loc }; + output; + }) + in + let block = Loc.at location block in + let acc = block :: acc in + consume_block_elements ~parsed_a_tag `After_text acc | { value = `Modules s as token; location } as next_token -> warn_if_after_tags next_token; warn_if_after_text next_token; @@ -800,6 +1013,25 @@ let rec block_element_list : let block = Loc.at location block in let acc = block :: acc in consume_block_elements ~parsed_a_tag `After_text acc + | { value = (`Begin_table_light | `Begin_table_heavy) as token; location } + as next_token -> + warn_if_after_tags next_token; + warn_if_after_text next_token; + junk input; + let block, brace_location = + let parent_markup = token in + let parent_markup_location = location in + match token with + | `Begin_table_light -> + light_table input ~parent_markup ~parent_markup_location + | `Begin_table_heavy -> + heavy_table input ~parent_markup ~parent_markup_location + in + let location = Loc.span [ location; brace_location ] in + let block = accepted_in_all_contexts context (`Table block) in + let block = Loc.at location block in + let acc = block :: acc in + consume_block_elements ~parsed_a_tag `After_text acc | { value = (`Minus | `Plus) as token; location } as next_token -> ( (match where_in_line with | `After_text | `After_shorthand_bullet -> @@ -855,7 +1087,9 @@ let rec block_element_list : (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context | In_explicit_list -> recover_when_not_at_top_level context + | In_table_cell -> recover_when_not_at_top_level context | In_tag -> recover_when_not_at_top_level context + | In_code_results -> recover_when_not_at_top_level context | Top_level -> if where_in_line <> `At_start_of_line then Parse_error.should_begin_on_its_own_line @@ -914,6 +1148,8 @@ let rec block_element_list : | Top_level -> `At_start_of_line | In_shorthand_list -> `After_shorthand_bullet | In_explicit_list -> `After_explicit_list_bullet + | In_table_cell -> `After_table_cell + | In_code_results -> `After_tag | In_tag -> `After_tag in @@ -1007,25 +1243,25 @@ and explicit_list_items : (* '{li', represented by [`Begin_list_item `Li], must be followed by whitespace. *) (if kind = `Li then - match (peek input).value with - | `Space _ | `Single_newline _ | `Blank_line _ | `Right_brace -> - () - (* The presence of [`Right_brace] above requires some explanation: - - - It is better to be silent about missing whitespace if the next - token is [`Right_brace], because the error about an empty list - item will be generated below, and that error is more important to - the user. - - The [`Right_brace] token also happens to include all whitespace - before it, as a convenience for the rest of the parser. As a - result, not ignoring it could be wrong: there could in fact be - whitespace in the concrete syntax immediately after '{li', just - it is not represented as [`Space], [`Single_newline], or - [`Blank_line]. *) - | _ -> - Parse_error.should_be_followed_by_whitespace next_token.location - ~what:(Token.print token) - |> add_warning input); + match (peek input).value with + | `Space _ | `Single_newline _ | `Blank_line _ | `Right_brace -> + () + (* The presence of [`Right_brace] above requires some explanation: + + - It is better to be silent about missing whitespace if the next + token is [`Right_brace], because the error about an empty list + item will be generated below, and that error is more important to + the user. + - The [`Right_brace] token also happens to include all whitespace + before it, as a convenience for the rest of the parser. As a + result, not ignoring it could be wrong: there could in fact be + whitespace in the concrete syntax immediately after '{li', just + it is not represented as [`Space], [`Single_newline], or + [`Blank_line]. *) + | _ -> + Parse_error.should_be_followed_by_whitespace next_token.location + ~what:(Token.print token) + |> add_warning input); let content, token_after_list_item, _where_in_line = block_element_list In_explicit_list ~parent_markup:token input @@ -1067,6 +1303,139 @@ and explicit_list_items : consume_list_items [] +(* Consumes a sequence of table rows that might start with [`Bar]. + + This function is called immediately after '{t' ([`Begin_table `Light]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and light_table ~parent_markup ~parent_markup_location input = + let rec consume_rows acc ~last_loc = + Reader.until_rbrace input acc >>> fun next_token -> + match next_token.Loc.value with + | `Bar | #token_that_always_begins_an_inline_element -> ( + let next, row, last_loc = + light_table_row ~parent_markup ~last_loc input + in + match next with + | `Continue -> consume_rows (row :: acc) ~last_loc + | `Stop -> (row :: acc, last_loc)) + | other_token -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe other_token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_rows acc ~last_loc + in + let rows, brace_location = consume_rows [] ~last_loc:parent_markup_location in + let grid = List.rev rows in + (Table.Light_syntax.from_raw_data grid, brace_location) + +(* Consumes a table row that might start with [`Bar]. *) +and light_table_row ~parent_markup ~last_loc input = + let rec consume_row acc_row acc_cell acc_space ~new_line ~last_loc = + let push_cells row cell = + match cell with [] -> row | _ -> List.rev cell :: row + in + let return row cell = List.rev (push_cells row cell) in + let next_token = peek input in + match next_token.value with + | `Right_brace -> + junk input; + (`Stop, return acc_row acc_cell, next_token.location) + | `Space _ as token -> + junk input; + let i = Loc.at next_token.location token in + consume_row acc_row acc_cell (i :: acc_space) ~new_line ~last_loc + | `Single_newline _ | `Blank_line _ -> + junk input; + (`Continue, return acc_row acc_cell, last_loc) + | `Bar -> + junk input; + let acc_row = if new_line then [] else List.rev acc_cell :: acc_row in + consume_row acc_row [] [] ~new_line:false ~last_loc + | #token_that_always_begins_an_inline_element as token -> + let i = inline_element input next_token.location token in + if Loc.spans_multiple_lines i then + Parse_error.not_allowed + ~what:(Token.describe (`Single_newline "")) + ~in_what:(Token.describe `Begin_table_light) + i.location + |> add_warning input; + let acc_cell = + if acc_cell = [] then [ i ] else (i :: acc_space) @ acc_cell + in + consume_row acc_row acc_cell [] ~new_line:false + ~last_loc:next_token.location + | other_token -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe other_token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_row acc_row acc_cell acc_space ~new_line ~last_loc + in + consume_row [] [] [] ~new_line:true ~last_loc + +(* Consumes a sequence of table rows (starting with '{tr ...}', which are + represented by [`Begin_table_row] tokens). + + This function is called immediately after '{table' ([`Begin_table `Heavy]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and heavy_table ~parent_markup ~parent_markup_location input = + let rec consume_rows acc ~last_loc = + Reader.until_rbrace input acc >>> fun next_token -> + match next_token.Loc.value with + | `Begin_table_row as token -> + junk input; + let items, last_loc = heavy_table_row ~parent_markup:token input in + consume_rows (List.rev items :: acc) ~last_loc + | token -> + Parse_error.not_allowed next_token.location ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion:"Move outside of {table ...}, or inside {tr ...}" + |> add_warning input; + junk input; + consume_rows acc ~last_loc + in + let rows, brace_location = consume_rows [] ~last_loc:parent_markup_location in + let grid = List.rev rows in + (Table.Heavy_syntax.from_grid grid, brace_location) + +(* Consumes a sequence of table cells (starting with '{th ...}' or '{td ... }', + which are represented by [`Begin_table_cell] tokens). + + This function is called immediately after '{tr' ([`Begin_table_row]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and heavy_table_row ~parent_markup input = + let rec consume_cell_items acc = + Reader.until_rbrace input acc >>> fun next_token -> + match next_token.Loc.value with + | `Begin_table_cell kind as token -> + junk input; + let content, token_after_list_item, _where_in_line = + block_element_list In_table_cell ~parent_markup:token input + in + (match token_after_list_item.value with + | `Right_brace -> junk input + | `End -> + Parse_error.not_allowed token_after_list_item.location + ~what:(Token.describe `End) ~in_what:(Token.describe token) + |> add_warning input); + consume_cell_items ((content, kind) :: acc) + | token -> + Parse_error.not_allowed next_token.location ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion: + "Move outside of {table ...}, or inside {td ...} or {th ...}" + |> add_warning input; + junk input; + consume_cell_items acc + in + consume_cell_items [] + (* {2 Entry point} *) let parse warnings tokens = diff --git a/vendor/odoc-parser/src/token.ml b/vendor/odoc-parser/src/token.ml index 222820f08..83181fe45 100644 --- a/vendor/odoc-parser/src/token.ml +++ b/vendor/odoc-parser/src/token.ml @@ -20,7 +20,8 @@ type tag = | `Canonical of string | `Inline | `Open - | `Closed ] ] + | `Closed + | `Hidden ] ] type t = [ (* End of input. *) @@ -40,6 +41,7 @@ type t = | `Blank_line of string | (* A right curly brace ([}]), i.e. end of markup. *) `Right_brace + | `Right_code_delimiter | (* Words are anything that is not whitespace or markup. Markup symbols can be be part of words if escaped. @@ -63,14 +65,22 @@ type t = | (* Leaf block element markup. *) `Code_block of (string Loc.with_location * string Loc.with_location option) option + * string * string Loc.with_location + * bool | `Verbatim of string | `Modules of string | (* List markup. *) `Begin_list of [ `Unordered | `Ordered ] | `Begin_list_item of [ `Li | `Dash ] + | (* Table markup. *) + `Begin_table_light + | `Begin_table_heavy + | `Begin_table_row + | `Begin_table_cell of [ `Header | `Data ] | `Minus | `Plus + | `Bar | section_heading | tag ] @@ -87,8 +97,14 @@ let print : [< t ] -> string = function | `Begin_link_with_replacement_text _ -> "'{{:'" | `Begin_list_item `Li -> "'{li ...}'" | `Begin_list_item `Dash -> "'{- ...}'" + | `Begin_table_light -> "{t" + | `Begin_table_heavy -> "{table" + | `Begin_table_row -> "'{tr'" + | `Begin_table_cell `Header -> "'{th'" + | `Begin_table_cell `Data -> "'{td'" | `Minus -> "'-'" | `Plus -> "'+'" + | `Bar -> "'|'" | `Begin_section_heading (level, label) -> let label = match label with None -> "" | Some label -> ":" ^ label in Printf.sprintf "'{%i%s'" level label @@ -105,6 +121,7 @@ let print : [< t ] -> string = function | `Tag `Inline -> "'@inline'" | `Tag `Open -> "'@open'" | `Tag `Closed -> "'@closed'" + | `Tag `Hidden -> "'@hidden" | `Raw_markup (None, _) -> "'{%...%}'" | `Raw_markup (Some target, _) -> "'{%" ^ target ^ ":...%}'" @@ -135,6 +152,7 @@ let describe : [< t | `Comment ] -> string = function | `Single_newline _ -> "line break" | `Blank_line _ -> "blank line" | `Right_brace -> "'}'" + | `Right_code_delimiter -> "']}'" | `Code_block _ -> "'{[...]}' (code block)" | `Verbatim _ -> "'{v ... v}' (verbatim text)" | `Modules _ -> "'{!modules ...}'" @@ -142,8 +160,14 @@ let describe : [< t | `Comment ] -> string = function | `Begin_list `Ordered -> "'{ol ...}' (numbered list)" | `Begin_list_item `Li -> "'{li ...}' (list item)" | `Begin_list_item `Dash -> "'{- ...}' (list item)" + | `Begin_table_light -> "'{t ...}' (table)" + | `Begin_table_heavy -> "'{table ...}' (table)" + | `Begin_table_row -> "'{tr ...}' (table row)" + | `Begin_table_cell `Header -> "'{th ... }' (table header cell)" + | `Begin_table_cell `Data -> "'{td ... }' (table data cell)" | `Minus -> "'-' (bulleted list item)" | `Plus -> "'+' (numbered list item)" + | `Bar -> "'|'" | `Begin_section_heading (level, _) -> Printf.sprintf "'{%i ...}' (section heading)" level | `Tag (`Author _) -> "'@author'" @@ -159,6 +183,7 @@ let describe : [< t | `Comment ] -> string = function | `Tag `Inline -> "'@inline'" | `Tag `Open -> "'@open'" | `Tag `Closed -> "'@closed'" + | `Tag `Hidden -> "'@hidden" | `Comment -> "top-level text" let describe_element = function diff --git a/vendor/update-odoc-parser.sh b/vendor/update-odoc-parser.sh index 9a1a19ea0..e99b26bc5 100755 --- a/vendor/update-odoc-parser.sh +++ b/vendor/update-odoc-parser.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=ebfd3b9489e44187da2c67d79a32b6fc1e92bda4 +version=5ac1ffc67ce1b96f5a990fa4902a157a5cdb42d0 set -e -o pipefail @@ -12,15 +12,15 @@ mkdir -p odoc-parser/src ( cd $TMP - git clone https://github.com/ocaml-doc/odoc-parser.git - cd odoc-parser - git checkout $version + git clone https://github.com/ocaml/odoc.git + cd odoc + git -c advice.detachedHead=false checkout $version ) -SRC=$TMP/odoc-parser +SRC=$TMP/odoc -cp -v $SRC/src/*.{ml,mli,mll} odoc-parser/src -cp -v $SRC/LICENSE.md odoc-parser/ +cp -v $SRC/src/parser/*.{ml,mli,mll} odoc-parser/src +cp -v $SRC/LICENSE odoc-parser/ git checkout odoc-parser/src/dune git add -A .