jon.recoil.org
this repo has no description
1(* This module contains the token type, emitted by the lexer, and consumed by
2 the comment syntax parser. It also contains two functions that format tokens
3 for error messages. *)
4
5type section_heading = [ `Begin_section_heading of int * string option ]
6type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ]
7type paragraph_style = [ `Left | `Center | `Right ]
8
9type tag =
10 [ `Tag of
11 [ `Author of string
12 | `Deprecated
13 | `Param of string
14 | `Raise of string
15 | `Return
16 | `See of [ `Url | `File | `Document ] * string
17 | `Since of string
18 | `Before of string
19 | `Version of string
20 | `Canonical of string
21 | `Children_order
22 | `Toc_status
23 | `Order_category
24 | `Short_title
25 | `Inline
26 | `Open
27 | `Closed
28 | `Hidden
29 | `Custom of string ] ]
30
31type media = [ `Audio | `Video | `Image ]
32type media_href = [ `Reference of string | `Link of string ]
33
34type media_markup =
35 [ `Simple_media of media_href * media
36 | `Media_with_replacement_text of media_href * media * string ]
37
38let s_of_media kind media =
39 match (kind, media) with
40 | `Simple, `Audio -> "{audio!"
41 | `Simple, `Video -> "{video!"
42 | `Simple, `Image -> "{image!"
43 | `Replaced, `Audio -> "{{audio!"
44 | `Replaced, `Video -> "{{video!"
45 | `Replaced, `Image -> "{{image!"
46
47type code_block_tag =
48 [ `Tag of string Loc.with_location
49 | `Binding of string Loc.with_location * string Loc.with_location ]
50
51type code_block_tags = code_block_tag list
52
53type t =
54 [ (* End of input. *)
55 `End
56 | (* Runs of whitespace. [Blank_line] is any run of whitespace that contains two
57 or more newline characters. [Single_newline] is any run of whitespace that
58 contains exactly one newline character. [Space] is any run of whitespace
59 that contains no newline characters.
60
61 It is an important invariant in the parser that no adjacent whitespace
62 tokens are emitted by the lexer. Otherwise, there would be the need for
63 unbounded lookahead, a (co-?)ambiguity between
64 [Single_newline Single_newline] and [Blank_line], and other problems. *)
65 `Space of string
66 | `Single_newline of string
67 | `Blank_line of string
68 | (* A right curly brace ([}]), i.e. end of markup. *)
69 `Right_brace
70 | `Right_code_delimiter
71 | (* Words are anything that is not whitespace or markup. Markup symbols can be
72 be part of words if escaped.
73
74 Words can contain plus and minus symbols, but those are emitted as [Plus]
75 and [Minus] tokens. The parser combines plus and minus into words, except
76 when they appear first on a line, in which case the tokens are list item
77 bullets. *)
78 `Word of string
79 | `Code_span of string
80 | `Raw_markup of string option * string
81 | `Math_span of string
82 | `Math_block of string
83 | `Begin_style of style
84 | `Begin_paragraph_style of paragraph_style
85 | (* Other inline element markup. *)
86 `Simple_reference of string
87 | `Begin_reference_with_replacement_text of string
88 | `Simple_link of string
89 | `Begin_link_with_replacement_text of string
90 | media_markup
91 | (* Leaf block element markup. *)
92 `Code_block of
93 (string Loc.with_location * code_block_tags) option
94 * string
95 * string Loc.with_location
96 * bool
97 | `Verbatim of string
98 | `Modules of string
99 | (* List markup. *)
100 `Begin_list of [ `Unordered | `Ordered ]
101 | `Begin_list_item of [ `Li | `Dash ]
102 | (* Table markup. *)
103 `Begin_table_light
104 | `Begin_table_heavy
105 | `Begin_table_row
106 | `Begin_table_cell of [ `Header | `Data ]
107 | `Minus
108 | `Plus
109 | `Bar
110 | section_heading
111 | tag ]
112
113let print : [< t ] -> string = function
114 | `Begin_paragraph_style `Left -> "'{L'"
115 | `Begin_paragraph_style `Center -> "'{C'"
116 | `Begin_paragraph_style `Right -> "'{R'"
117 | `Begin_style `Bold -> "'{b'"
118 | `Begin_style `Italic -> "'{i'"
119 | `Begin_style `Emphasis -> "'{e'"
120 | `Begin_style `Superscript -> "'{^'"
121 | `Begin_style `Subscript -> "'{_'"
122 | `Begin_reference_with_replacement_text _ -> "'{{!'"
123 | `Begin_link_with_replacement_text _ -> "'{{:'"
124 | `Begin_list_item `Li -> "'{li ...}'"
125 | `Begin_list_item `Dash -> "'{- ...}'"
126 | `Begin_table_light -> "{t"
127 | `Begin_table_heavy -> "{table"
128 | `Begin_table_row -> "'{tr'"
129 | `Begin_table_cell `Header -> "'{th'"
130 | `Begin_table_cell `Data -> "'{td'"
131 | `Minus -> "'-'"
132 | `Plus -> "'+'"
133 | `Bar -> "'|'"
134 | `Begin_section_heading (level, label) ->
135 let label = match label with None -> "" | Some label -> ":" ^ label in
136 Printf.sprintf "'{%i%s'" level label
137 | `Tag (`Author _) -> "'@author'"
138 | `Tag (`Custom s) -> "'@" ^ s ^ "'"
139 | `Tag `Deprecated -> "'@deprecated'"
140 | `Tag (`Param _) -> "'@param'"
141 | `Tag (`Raise _) -> "'@raise'"
142 | `Tag `Return -> "'@return'"
143 | `Tag `Children_order -> "'@children_order'"
144 | `Tag `Order_category -> "'@order_category'"
145 | `Tag `Toc_status -> "'@toc_status'"
146 | `Tag `Short_title -> "'@short_title'"
147 | `Tag (`See _) -> "'@see'"
148 | `Tag (`Since _) -> "'@since'"
149 | `Tag (`Before _) -> "'@before'"
150 | `Tag (`Version _) -> "'@version'"
151 | `Tag (`Canonical _) -> "'@canonical'"
152 | `Tag `Inline -> "'@inline'"
153 | `Tag `Open -> "'@open'"
154 | `Tag `Closed -> "'@closed'"
155 | `Tag `Hidden -> "'@hidden"
156 | `Raw_markup (None, _) -> "'{%...%}'"
157 | `Raw_markup (Some target, _) -> "'{%" ^ target ^ ":...%}'"
158 | `Simple_media (`Reference _, `Image) -> "{image!...}"
159 | `Simple_media (`Reference _, `Audio) -> "{audio!...}"
160 | `Simple_media (`Reference _, `Video) -> "{video!...}"
161 | `Simple_media (`Link _, `Image) -> "{image:...}"
162 | `Simple_media (`Link _, `Audio) -> "{audio:...}"
163 | `Simple_media (`Link _, `Video) -> "{video:...}"
164 | `Media_with_replacement_text (`Reference _, `Image, _) ->
165 "{{image!...} ...}"
166 | `Media_with_replacement_text (`Reference _, `Audio, _) ->
167 "{{audio!...} ...}"
168 | `Media_with_replacement_text (`Reference _, `Video, _) ->
169 "{{video!...} ...}"
170 | `Media_with_replacement_text (`Link _, `Image, _) -> "{{image:...} ...}"
171 | `Media_with_replacement_text (`Link _, `Audio, _) -> "{{audio:...} ...}"
172 | `Media_with_replacement_text (`Link _, `Video, _) -> "{{video:...} ...}"
173
174(* [`Minus] and [`Plus] are interpreted as if they start list items. Therefore,
175 for error messages based on [Token.describe] to be accurate, formatted
176 [`Minus] and [`Plus] should always be plausibly list item bullets. *)
177let describe : [< t | `Comment ] -> string = function
178 | `Word w -> Printf.sprintf "'%s'" w
179 | `Code_span _ -> "'[...]' (code)"
180 | `Raw_markup _ -> "'{%...%}' (raw markup)"
181 | `Begin_paragraph_style `Left -> "'{L ...}' (left alignment)"
182 | `Begin_paragraph_style `Center -> "'{C ...}' (center alignment)"
183 | `Begin_paragraph_style `Right -> "'{R ...}' (right alignment)"
184 | `Begin_style `Bold -> "'{b ...}' (boldface text)"
185 | `Begin_style `Italic -> "'{i ...}' (italic text)"
186 | `Begin_style `Emphasis -> "'{e ...}' (emphasized text)"
187 | `Begin_style `Superscript -> "'{^...}' (superscript)"
188 | `Begin_style `Subscript -> "'{_...}' (subscript)"
189 | `Math_span _ -> "'{m ...}' (math span)"
190 | `Math_block _ -> "'{math ...}' (math block)"
191 | `Simple_reference _ -> "'{!...}' (cross-reference)"
192 | `Begin_reference_with_replacement_text _ ->
193 "'{{!...} ...}' (cross-reference)"
194 | `Simple_media (`Reference _, `Image) -> "'{image!...}' (image-reference)"
195 | `Simple_media (`Reference _, `Audio) -> "'{audio!...}' (audio-reference)"
196 | `Simple_media (`Reference _, `Video) -> "'{video!...}' (video-reference)"
197 | `Simple_media (`Link _, `Image) -> "'{image:...}' (image-link)"
198 | `Simple_media (`Link _, `Audio) -> "'{audio:...}' (audio-link)"
199 | `Simple_media (`Link _, `Video) -> "'{video:...}' (video-link)"
200 | `Media_with_replacement_text (`Reference _, `Image, _) ->
201 "'{{image!...} ...}' (image-reference)"
202 | `Media_with_replacement_text (`Reference _, `Audio, _) ->
203 "'{{audio!...} ...}' (audio-reference)"
204 | `Media_with_replacement_text (`Reference _, `Video, _) ->
205 "'{{video!...} ...}' (video-reference)"
206 | `Media_with_replacement_text (`Link _, `Image, _) ->
207 "'{{image:...} ...}' (image-link)"
208 | `Media_with_replacement_text (`Link _, `Audio, _) ->
209 "'{{audio:...} ...}' (audio-link)"
210 | `Media_with_replacement_text (`Link _, `Video, _) ->
211 "'{{video:...} ...}' (video-link)"
212 | `Simple_link _ -> "'{:...} (external link)'"
213 | `Begin_link_with_replacement_text _ -> "'{{:...} ...}' (external link)"
214 | `End -> "end of text"
215 | `Space _ -> "whitespace"
216 | `Single_newline _ -> "line break"
217 | `Blank_line _ -> "blank line"
218 | `Right_brace -> "'}'"
219 | `Right_code_delimiter -> "']}'"
220 | `Code_block _ -> "'{[...]}' (code block)"
221 | `Verbatim _ -> "'{v ... v}' (verbatim text)"
222 | `Modules _ -> "'{!modules ...}'"
223 | `Begin_list `Unordered -> "'{ul ...}' (bulleted list)"
224 | `Begin_list `Ordered -> "'{ol ...}' (numbered list)"
225 | `Begin_list_item `Li -> "'{li ...}' (list item)"
226 | `Begin_list_item `Dash -> "'{- ...}' (list item)"
227 | `Begin_table_light -> "'{t ...}' (table)"
228 | `Begin_table_heavy -> "'{table ...}' (table)"
229 | `Begin_table_row -> "'{tr ...}' (table row)"
230 | `Begin_table_cell `Header -> "'{th ... }' (table header cell)"
231 | `Begin_table_cell `Data -> "'{td ... }' (table data cell)"
232 | `Minus -> "'-' (bulleted list item)"
233 | `Plus -> "'+' (numbered list item)"
234 | `Bar -> "'|'"
235 | `Begin_section_heading (level, _) ->
236 Printf.sprintf "'{%i ...}' (section heading)" level
237 | `Tag (`Author _) -> "'@author'"
238 | `Tag `Deprecated -> "'@deprecated'"
239 | `Tag (`Param _) -> "'@param'"
240 | `Tag (`Raise _) -> "'@raise'"
241 | `Tag `Return -> "'@return'"
242 | `Tag (`See _) -> "'@see'"
243 | `Tag (`Since _) -> "'@since'"
244 | `Tag (`Before _) -> "'@before'"
245 | `Tag (`Version _) -> "'@version'"
246 | `Tag (`Canonical _) -> "'@canonical'"
247 | `Tag `Inline -> "'@inline'"
248 | `Tag `Open -> "'@open'"
249 | `Tag `Closed -> "'@closed'"
250 | `Tag `Hidden -> "'@hidden"
251 | `Tag `Children_order -> "'@children_order"
252 | `Tag `Toc_status -> "'@toc_status"
253 | `Tag `Order_category -> "'@order_category"
254 | `Tag `Short_title -> "'@short_title"
255 | `Tag (`Custom s) -> "'@" ^ s ^ "'"
256 | `Comment -> "top-level text"
257
258let describe_element = function
259 | `Reference (`Simple, _, _) -> describe (`Simple_reference "")
260 | `Reference (`With_text, _, _) ->
261 describe (`Begin_reference_with_replacement_text "")
262 | `Link _ -> describe (`Begin_link_with_replacement_text "")
263 | `Heading (level, _, _) -> describe (`Begin_section_heading (level, None))