<html><head>
<link rel="stylesheet" href="style.css" type="text/css">
<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
<link rel="Start" href="index.html">
<link title="Index of types" rel=Appendix href="index_types.html">
<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
<link title="Index of values" rel=Appendix href="index_values.html">
<link title="Index of modules" rel=Appendix href="index_modules.html">
<link title="Textile" rel="Chapter" href="Textile.html">
<link title="Textile_parser" rel="Chapter" href="Textile_parser.html">
<link title="Textile_html" rel="Chapter" href="Textile_html.html"><title>Textile_parser</title>
</head>
<body>
<code class="code"><span class="comment">(* This file is part of textile-ocaml.<br>
*<br>
* textile-ocaml is free software: you can redistribute it and/or modify<br>
* it under the terms of the GNU General Public License as published by<br>
* the Free Software Foundation, either version 3 of the License, or<br>
* (at your option) any later version.<br>
*<br>
* textile-ocaml is distributed in the hope that it will be useful,<br>
* but WITHOUT ANY WARRANTY; without even the implied warranty of<br>
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the<br>
* GNU General Public License for more details.<br>
*<br>
* You should have received a copy of the GNU General Public License<br>
* along with textile-ocaml. If not, see <http://www.gnu.org/licenses/>.<br>
*<br>
* Copyright 2011 Alexander Markov *)</span><br>
<br>
<span class="keyword">open</span> <span class="constructor">ExtString</span><br>
<span class="keyword">open</span> <span class="constructor">Textile</span><br>
<span class="keyword">open</span> <span class="constructor">Textile_parsercomb</span><br>
<br>
<span class="keyword">let</span> (>>) f g = g f<br>
<span class="keyword">let</span> ($) a b = <span class="keyword">fun</span> x <span class="keywordsign">-></span> a (b x)<br>
<br>
<br>
<span class="comment">(* some defaults *)</span><br>
<br>
<span class="keyword">let</span> default_options = ([], <span class="constructor">None</span>, (0, 0))<br>
<span class="keyword">let</span> default_tableoptions = (default_options, <span class="constructor">None</span>)<br>
<span class="keyword">let</span> default_celloptions = (<span class="constructor">Data</span>, default_tableoptions, (<span class="constructor">None</span>, <span class="constructor">None</span>))<br>
<span class="keyword">let</span> empty_line = []<br>
<br>
<br>
<span class="comment">(* various helpers *)</span><br>
<br>
<span class="keyword">let</span> num_of_char c = (int_of_char c) - 48<br>
<br>
<span class="comment">(* junks n elements of the stream *)</span><br>
<span class="keyword">let</span> <span class="keyword">rec</span> njunk stream n =<br>
<span class="keyword">if</span> n > 0<br>
<span class="keyword">then</span> <span class="keyword">begin</span> <span class="constructor">Stream</span>.junk stream; njunk stream (n-1) <span class="keyword">end</span><br>
<br>
<span class="comment">(* returns n'th element of the stream (from zero) *)</span><br>
<span class="keyword">let</span> <span class="keyword">rec</span> peekn stream n =<br>
<span class="keyword">let</span> l = <span class="constructor">Stream</span>.npeek (n+1) stream <span class="keyword">in</span><br>
<span class="keyword">try</span> <span class="constructor">Some</span> (<span class="constructor">List</span>.nth l n)<br>
<span class="keyword">with</span> <span class="constructor">Failure</span> _ <span class="keywordsign">|</span> <span class="constructor">ExtList</span>.<span class="constructor">List</span>.<span class="constructor">Invalid_index</span> _ <span class="keywordsign">-></span> <span class="comment">(* ExtLib, goddamn *)</span><br>
<span class="constructor">None</span><br>
<br>
<br>
<span class="comment">(* let's parse *)</span><br>
<br>
<span class="keyword">let</span> p_string_not_empty = <span class="keyword">function</span> <span class="string">""</span> <span class="keywordsign">-></span> fail <span class="keywordsign">|</span> s <span class="keywordsign">-></span> return s<br>
<span class="keyword">let</span> whitespace = <span class="keyword">function</span> <span class="string">' '</span> <span class="keywordsign">|</span> <span class="string">'\t'</span> <span class="keywordsign">-></span> <span class="keyword">true</span> <span class="keywordsign">|</span> _ <span class="keywordsign">-></span> <span class="keyword">false</span><br>
<span class="keyword">let</span> punct = <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="string">'!'</span> <span class="keywordsign">|</span> <span class="string">'"'</span> <span class="keywordsign">|</span> <span class="string">'$'</span> <span class="keywordsign">|</span> <span class="string">'%'</span> <span class="keywordsign">|</span> <span class="string">'&'</span> <span class="keywordsign">|</span> <span class="string">'\''</span> <span class="keywordsign">|</span> <span class="string">'('</span> <span class="keywordsign">|</span> <span class="string">')'</span> <span class="keywordsign">|</span> <span class="string">'*'</span> <span class="keywordsign">|</span> <span class="string">'+'</span> <span class="keywordsign">|</span> <span class="string">','</span> <span class="keywordsign">|</span> <span class="string">'-'</span> <span class="keywordsign">|</span> <span class="string">'.'</span> <span class="keywordsign">|</span> <span class="string">':'</span> <span class="keywordsign">|</span> <span class="string">';'</span> <span class="keywordsign">|</span> <span class="string">'<'</span> <span class="keywordsign">|</span> <span class="string">'='</span> <span class="keywordsign">|</span> <span class="string">'>'</span> <span class="keywordsign">|</span> <span class="string">'?'</span> <span class="keywordsign">-></span> <span class="keyword">true</span> <span class="keywordsign">|</span> _ <span class="keywordsign">-></span> <span class="keyword">false</span><br>
<span class="comment">(*(c >= '!' && c < '#') || (c > '#' && c <= '.') || (c >= ':' && c <= '?')*)</span><br>
<span class="keyword">let</span> p_whitespace = p_pred whitespace<br>
<span class="keyword">let</span> p_not_whitespace = p_pred (<span class="keyword">fun</span> c <span class="keywordsign">-></span> not (whitespace c))<br>
<span class="keyword">let</span> p_punct = p_pred punct<br>
<br>
<span class="comment">(* checks previous char; doesn't jump *)</span><br>
<span class="keyword">let</span> check_prev p (s, pos) =<br>
<span class="keyword">let</span> prev_pos = pos - 1 <span class="keyword">in</span><br>
(p >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span> <span class="keyword">fun</span> _ <span class="keywordsign">-></span> <span class="constructor">Parsed</span> (r, (s, pos))) (s, prev_pos)<br>
<br>
<span class="comment">(* checks current char; doesn't jump *)</span><br>
<span class="keyword">let</span> check_current p (s, pos) =<br>
(p >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span> <span class="keyword">fun</span> _ <span class="keywordsign">-></span> <span class="constructor">Parsed</span> (r, (s, pos))) (s, pos)<br>
<br>
<span class="comment">(* parses all kinds of declarations include (classname#id1#id2) *)</span><br>
<span class="keyword">let</span> class_and_ids =<br>
<span class="comment">(* ((())) must be for padding, not for class (( or something else *)</span><br>
p_char <span class="string">'('</span> >>><br>
p_until (p_pred ((<>) <span class="string">'('</span>)) (p_char <span class="string">')'</span>) >>=<br>
<span class="keyword">fun</span> (s, _) <span class="keywordsign">-></span><br>
<span class="keyword">match</span> <span class="constructor">String</span>.nsplit s <span class="string">"#"</span> <span class="keyword">with</span><br>
<span class="keywordsign">|</span> [] <span class="keywordsign">-></span> fail<br>
<span class="keywordsign">|</span> <span class="string">""</span> :: ids <span class="keywordsign">-></span><br>
return (<span class="constructor">List</span>.map (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Id</span> x) ids)<br>
<span class="keywordsign">|</span> classname :: ids <span class="keywordsign">-></span><br>
return ((<span class="constructor">Class</span> classname) :: (<span class="constructor">List</span>.map (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Id</span> x) ids))<br>
<span class="keyword">let</span> style = p_char <span class="string">'{'</span> >>> p_str_until (p_char <span class="string">'}'</span>) >>= p_string_not_empty<br>
<span class="keyword">let</span> language = p_char <span class="string">'['</span> >>> p_str_until (p_char <span class="string">']'</span>) >>= p_string_not_empty<br>
<br>
<span class="keyword">let</span> attr_decl =<br>
class_and_ids |||<br>
(style >>= <span class="keyword">fun</span> s <span class="keywordsign">-></span> return [<span class="constructor">Style</span> s]) |||<br>
(language >>= <span class="keyword">fun</span> s <span class="keywordsign">-></span> return [<span class="constructor">Language</span> s])<br>
<br>
<span class="comment">(*let attrs =<br>
p_manyf attr (fun acc x -> x::acc) [] in*)</span><br>
<br>
<span class="comment">(* this is for correct parsing strings like _(hi)_ *)</span><br>
<span class="keyword">let</span> try_attrs f =<br>
(p_seq attr_decl >>= (return $ <span class="constructor">List</span>.flatten) >>= f) |||<br>
<span class="comment">(*(p_plusf attr (fun acc x -> x::acc) [] >>= f) |||*)</span><br>
(f [])<br>
<br>
<span class="keyword">let</span> img_float =<br>
(p_char <span class="string">'<'</span> >>> return <span class="constructor">Float_left</span>) |||<br>
(p_char <span class="string">'>'</span> >>> return <span class="constructor">Float_right</span>)<br>
<br>
<span class="comment">(* attributes + floating *)</span><br>
<span class="keyword">let</span> img_opts =<br>
<span class="keyword">let</span> add_opt (attrs, float_opt) = <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Attr</span> a <span class="keywordsign">-></span> (a @ attrs, float_opt)<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Img_float</span> f <span class="keywordsign">-></span> (attrs, <span class="constructor">Some</span> f) <span class="keyword">in</span><br>
p_manyf<br>
((attr_decl >>= <span class="keyword">fun</span> a <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Attr</span> a)) ||| (img_float >>= <span class="keyword">fun</span> f <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Img_float</span> f)))<br>
add_opt<br>
([], <span class="constructor">None</span>)<br>
<br>
<span class="comment">(* matches typical beginning of phrase: beginning of line or whitespace *)</span><br>
<span class="keyword">let</span> begin_of_phrase begin_of_line follow =<br>
<span class="comment">(* why so unobvious solution? We can write it in that way:<br>
* begin_of_phrase begin_of_line =<br>
* p_pos begin_of_line ||| p_whitespace || p_punct<br>
* but it willn't parse strings like (@code@) because it will detect<br>
* the begin of line, then found '(' which is not a modifier and all<br>
* parser fails. *)</span><br>
(p_pos begin_of_line >>> follow) |||<br>
(<br>
((p_whitespace) |||<br>
(p_pred (<span class="keyword">function</span> <span class="string">'('</span> <span class="keywordsign">|</span> <span class="string">'\''</span> <span class="keywordsign">|</span> <span class="string">'"'</span> <span class="keywordsign">-></span> <span class="keyword">true</span> <span class="keywordsign">|</span> _ <span class="keywordsign">-></span> <span class="keyword">false</span>))) >>> follow<br>
)<br>
<br>
<span class="comment">(* matches typical end of phrase: end of line, whitespace, punctuation<br>
* doesn't jump *)</span><br>
<span class="keyword">let</span> end_of_phrase =<br>
dont_jump<br>
(p_end |||<br>
(p_whitespace >>> return ()) |||<br>
(p_many p_punct >>> (p_end ||| (p_whitespace >>> return ()))))<br>
<br>
<span class="comment">(* The Great Function which collects CData and more interesting<br>
* phrases into line *)</span><br>
<span class="comment">(* it fails if [until] not reached *)</span><br>
<span class="keyword">let</span> collect_phrases_with phrase until (s, begin_of_line) =<br>
<span class="keyword">let</span> <span class="keyword">rec</span> loop acc beg (s, pos) =<br>
<span class="keyword">let</span> go_on () = loop acc beg (s, succ pos) <span class="keyword">in</span><br>
<span class="keyword">match</span> phrase (s, pos) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> ((phrase_r, last_cdata_pos), (s, next_p)) <span class="keywordsign">-></span><br>
<span class="keyword">let</span> acc_values =<br>
<span class="comment">(* do we have some cdata to save which was<br>
* before we found a phrase? *)</span><br>
<span class="keyword">if</span> last_cdata_pos <= beg<br>
<span class="keyword">then</span><br>
[phrase_r]<br>
<span class="keyword">else</span><br>
<span class="keyword">let</span> prev_cdata =<br>
<span class="constructor">CData</span> (<span class="constructor">String</span>.slice ~first:beg ~last:last_cdata_pos s) <span class="keyword">in</span><br>
[prev_cdata; phrase_r] <span class="keyword">in</span><br>
loop (<span class="constructor">List</span>.rev_append acc_values acc) next_p (s, next_p)<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span><br>
(<span class="keyword">match</span> until (s, pos) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> (until_r, (s, new_pos)) <span class="keywordsign">-></span><br>
<span class="keyword">if</span> pos = begin_of_line<br>
<span class="keyword">then</span> go_on ()<br>
<span class="keyword">else</span><br>
<span class="keyword">let</span> acc =<br>
<span class="comment">(* do we have some cdata to save which was<br>
* before we found a termination combinator? *)</span><br>
<span class="keyword">if</span> beg = pos<br>
<span class="keyword">then</span> acc<br>
<span class="keyword">else</span><br>
<span class="keyword">let</span> last_cdata =<br>
<span class="constructor">CData</span> (<span class="constructor">String</span>.slice ~first:beg ~last:pos s) <span class="keyword">in</span><br>
last_cdata::acc <span class="keyword">in</span><br>
<span class="constructor">Parsed</span> ((<span class="constructor">List</span>.rev acc, until_r), (s, new_pos))<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span><br>
<span class="keyword">if</span> pos >= <span class="constructor">String</span>.length s<br>
<span class="keyword">then</span><br>
<span class="comment">(* we have passed the whole string<br>
* and haven't catch a termination combinator *)</span><br>
<span class="constructor">Failed</span><br>
<span class="keyword">else</span> go_on ()) <span class="keyword">in</span><br>
loop [] begin_of_line (s, begin_of_line)<br>
<br>
<span class="keyword">let</span> phrase_surrounding end_of_phrase beg_of_line phrase =<br>
<span class="comment">(* phrases are usually surrounded with whitespaces, punctuation,<br>
* begining/ending of line —<br>
* every case described in begin_of_phrase *)</span><br>
(<br>
begin_of_phrase beg_of_line (<br>
current_pos >>= <span class="keyword">fun</span> last_cdata_pos <span class="keywordsign">-></span><br>
phrase end_of_phrase >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span><br>
return (r, last_cdata_pos))<br>
)<br>
|||<br>
<span class="comment">(* but phrases can also be surrounded with square brackets *)</span><br>
(<br>
<span class="comment">(* XXX: this makes code about 4x faster *)</span><br>
<span class="comment">(*current_pos >>= fun last_cdata_pos -><br>
p_char '[' >>><br>
phrases last_cdata_pos (p_char ']' >>> return ())*)</span><br>
p_char <span class="string">'['</span> >>><br>
current_pos >>= <span class="keyword">fun</span> _pos <span class="keywordsign">-></span><br>
phrase (p_char <span class="string">']'</span> >>> return ()) >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span><br>
return (r, (_pos-1))<br>
)<br>
<br>
<span class="comment">(* separetely from other stuff — references *)</span><br>
<span class="keyword">let</span> reference beg_of_line =<br>
(p_pos beg_of_line |||<br>
(p_not_whitespace >>> current_pos)) >>= <span class="keyword">fun</span> bracket <span class="keywordsign">-></span><br>
p_unsign_int >>= <span class="keyword">fun</span> i <span class="keywordsign">-></span><br>
p_char <span class="string">']'</span> >>> end_of_phrase >>><br>
return ((<span class="constructor">Reference</span> i), bracket-1)<br>
<br>
</code><table><tr><td></td><td><span class="comment">(** high level function which made for collecting phrases
@param what phrases to parse; everything else is CData
@param ended_with what can be at the end of phrase
@param from where to start
@param until end when this parser matched *)</span></td></tr></table><code class="code"><br>
<span class="keyword">let</span> collect ~what ~ended_with ~from ~until =<br>
collect_phrases_with<br>
((phrase_surrounding<br>
ended_with<br>
from<br>
what) ||| reference from)<br>
until<br>
<br>
<span class="comment">(* Hyprlinks can't contain another hyperlinks.<br>
* Therefore, there are two functions for parsing phrases —<br>
* one without hyperlinks... *)</span><br>
<span class="keyword">let</span> <span class="keyword">rec</span> phrases_except_hyperlinks end_of_phrase =<br>
<span class="comment">(* opened modifier should not be before whitespace *)</span><br>
<span class="keyword">let</span> opened_modifier m =<br>
m >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span> check_current p_not_whitespace >>> return r <span class="keyword">in</span><br>
<span class="comment">(* and closed modifier also should not be after whitespace *)</span><br>
<span class="keyword">let</span> closed_modifier m =<br>
check_prev p_not_whitespace >>> m >>> end_of_phrase <span class="keyword">in</span><br>
<span class="comment">(* there are general definition of simple phrases *)</span><br>
<span class="keyword">let</span> sp modifier =<br>
opened_modifier modifier >>= <span class="keyword">fun</span> (f, cm) <span class="keywordsign">-></span><br>
try_attrs (<span class="keyword">fun</span> a <span class="keywordsign">-></span><br>
current_pos >>= <span class="keyword">fun</span> from <span class="keywordsign">-></span><br>
<span class="comment">(* FIXME *)</span><br>
<span class="keyword">let</span> until = closed_modifier cm <span class="keyword">in</span><br>
collect<br>
~what:all_phrases<br>
~ended_with:(end_of_phrase ||| (dont_jump until >>> return ()))<br>
~from<br>
~until >>= <span class="keyword">fun</span> (line, _) <span class="keywordsign">-></span><br>
return (f (a, line))) <span class="keyword">in</span><br>
<span class="comment">(* remember that __ and ** must be first than _ and * *)</span><br>
<span class="comment">(* simple_phrase (p_str "__") (fun x -> Italic x) |||<br>
simple_phrase (p_char '_') (fun x -> Emphasis x) |||<br>
simple_phrase (p_str "**") (fun x -> Bold x) |||<br>
simple_phrase (p_char '*') (fun x -> Strong x) |||<br>
simple_phrase (p_str "??") (fun x -> Citation x) |||<br>
simple_phrase (p_char '-') (fun x -> Deleted x) |||<br>
simple_phrase (p_char '+') (fun x -> Inserted x) |||<br>
simple_phrase (p_char '^') (fun x -> Superscript x) |||<br>
simple_phrase (p_char '~') (fun x -> Subscript x) |||<br>
simple_phrase (p_char '%') (fun x -> Span x) |||<br>
simple_phrase (p_char '@') (fun x -> Code x) |||*)</span><br>
sp (p_str <span class="string">"__"</span> >>> return ((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Italic</span> x), p_str <span class="string">"__"</span>)) |||<br>
sp (p_str <span class="string">"**"</span> >>> return ((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Bold</span> x), p_str <span class="string">"**"</span>)) |||<br>
sp (p_pred2 (<span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="string">'_'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Emphasis</span> x), p_char <span class="string">'_'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'*'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Strong</span> x), p_char <span class="string">'*'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'-'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Deleted</span> x), p_char <span class="string">'-'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'+'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Inserted</span> x), p_char <span class="string">'+'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'^'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Superscript</span> x), p_char <span class="string">'^'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'~'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Subscript</span> x), p_char <span class="string">'~'</span>))<br>
<span class="keywordsign">|</span> <span class="string">'%'</span> <span class="keywordsign">-></span> <span class="constructor">Some</span> (((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Span</span> x), p_char <span class="string">'%'</span>))<br>
<span class="keywordsign">|</span> _ <span class="keywordsign">-></span> <span class="constructor">None</span>)) |||<br>
sp (p_str <span class="string">"??"</span> >>> return ((<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Citation</span> x), p_str <span class="string">"??"</span>)) |||<br>
<span class="comment">(* and there are not too simple phrases *)</span><br>
<span class="comment">(* code *)</span><br>
(<br>
opened_modifier (p_char <span class="string">'@'</span>) >>><br>
try_attrs (<span class="keyword">fun</span> a <span class="keywordsign">-></span><br>
p_str_until (closed_modifier (p_char <span class="string">'@'</span>)) >>= <span class="keyword">fun</span> s <span class="keywordsign">-></span><br>
return (<span class="constructor">Code</span> (a, s)))<br>
) |||<br>
<span class="comment">(* notextile *)</span><br>
(<br>
opened_modifier (p_str <span class="string">"=="</span>) >>><br>
p_str_until (closed_modifier (p_str <span class="string">"=="</span>)) >>= <span class="keyword">fun</span> s <span class="keywordsign">-></span><br>
return (<span class="constructor">Notextile</span> s)<br>
) |||<br>
<span class="comment">(* image *)</span><br>
(<br>
<span class="comment">(* ...:http://komar.bitcheese.net *)</span><br>
<span class="keyword">let</span> link_opt =<br>
(p_char <span class="string">':'</span> >>><br>
p_until (p_not_whitespace) end_of_phrase >>= <span class="keyword">fun</span> (url, _) <span class="keywordsign">-></span><br>
return (<span class="constructor">Some</span> url)) |||<br>
(end_of_phrase >>> return <span class="constructor">None</span>) <span class="keyword">in</span><br>
<span class="comment">(* ...(title)! *)</span><br>
<span class="keyword">let</span> end_with_title =<br>
p_char <span class="string">'('</span> >>><br>
p_str_until (p_str <span class="string">")!"</span>) >>= <span class="keyword">fun</span> title <span class="keywordsign">-></span><br>
link_opt >>= <span class="keyword">fun</span> link_opt <span class="keywordsign">-></span><br>
return (title, link_opt) <span class="keyword">in</span><br>
<span class="comment">(* ...! *)</span><br>
<span class="keyword">let</span> end_with_no_title =<br>
p_char <span class="string">'!'</span> >>><br>
link_opt <span class="keyword">in</span><br>
<br>
p_char <span class="string">'!'</span> >>><br>
img_opts >>= <span class="keyword">fun</span> (attrs, float) <span class="keywordsign">-></span><br>
p_until p_not_whitespace (<br>
(end_with_title >>= <span class="keyword">fun</span> (title, link_opt) <span class="keywordsign">-></span> return (<span class="constructor">Some</span> title, link_opt)) |||<br>
(end_with_no_title >>= <span class="keyword">fun</span> link_opt <span class="keywordsign">-></span> return (<span class="constructor">None</span>, link_opt))<br>
) >>= <span class="keyword">fun</span> (src, (title_opt, link_opt)) <span class="keywordsign">-></span><br>
<br>
<span class="keyword">let</span> r =<br>
<span class="keyword">let</span> image = <span class="constructor">Image</span> (attrs, float, src, title_opt) <span class="keyword">in</span><br>
<span class="keyword">match</span> link_opt <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Some</span> url <span class="keywordsign">-></span> <span class="constructor">Link</span> (([], [image]), <span class="constructor">None</span>, url)<br>
<span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> image <span class="keyword">in</span><br>
return r<br>
) ||| (<br>
<span class="comment">(* acronym *)</span><br>
p_until<br>
(p_pred (<span class="keyword">fun</span> c <span class="keywordsign">-></span> c >= <span class="string">'A'</span> <span class="keywordsign">&&</span> c <= <span class="string">'Z'</span>))<br>
(p_char <span class="string">'('</span>) >>= <span class="keyword">fun</span> (acr, _) <span class="keywordsign">-></span><br>
p_string_not_empty acr >>><br>
p_str_until (p_char <span class="string">')'</span> >>> end_of_phrase) >>= <span class="keyword">fun</span> desc <span class="keywordsign">-></span><br>
<span class="comment">(*p_str_until (closed_modifier (p_char ')')) >>= fun desc ->*)</span><br>
return (<span class="constructor">Acronym</span> (acr, desc))<br>
)<br>
<br>
<span class="comment">(* ... and one with them. *)</span><br>
<span class="keyword">and</span> all_phrases end_of_phrase =<br>
(phrases_except_hyperlinks end_of_phrase) |||<br>
<span class="comment">(* hyperlink *)</span><br>
(<br>
<span class="comment">(* ...:http://komar.bitcheese.net *)</span><br>
<span class="keyword">let</span> url =<br>
p_char <span class="string">':'</span> >>><br>
p_until (p_not_whitespace) end_of_phrase >>= <span class="keyword">fun</span> (url, _) <span class="keywordsign">-></span> return url <span class="keyword">in</span><br>
<span class="comment">(* ...(title)'' *)</span><br>
<span class="keyword">let</span> end_with_title =<br>
p_char <span class="string">'('</span> >>><br>
<span class="comment">(*p_str_until (check_prev p_not_whitespace >>> p_str ")\"") >>= fun title ->*)</span><br>
p_str_until (p_str <span class="string">")\""</span>) >>= <span class="keyword">fun</span> title <span class="keywordsign">-></span><br>
url >>= <span class="keyword">fun</span> url <span class="keywordsign">-></span><br>
return (title, url) <span class="keyword">in</span><br>
<span class="comment">(* ...'' *)</span><br>
<span class="keyword">let</span> end_with_no_title =<br>
<span class="comment">(*check_prev p_not_whitespace >>>*)</span><br>
p_char <span class="string">'"'</span> >>> url <span class="keyword">in</span><br>
<br>
p_char <span class="string">'"'</span> >>><br>
<span class="comment">(* XXX: hm *)</span><br>
check_current p_not_whitespace >>><br>
try_attrs (<span class="keyword">fun</span> a <span class="keywordsign">-></span><br>
current_pos >>= <span class="keyword">fun</span> from <span class="keywordsign">-></span><br>
collect<br>
~what:phrases_except_hyperlinks<br>
~ended_with:(end_of_phrase ||| dont_jump ((end_with_title >>> return ()) ||| (end_with_no_title >>> return ())))<br>
~from<br>
~until:(<br>
(end_with_title >>= <span class="keyword">fun</span> (title, url) <span class="keywordsign">-></span> return (<span class="constructor">Some</span> title, url)) |||<br>
(end_with_no_title >>= <span class="keyword">fun</span> url <span class="keywordsign">-></span> return (<span class="constructor">None</span>, url))<br>
) >>= <span class="keyword">fun</span> (line, (title_opt, url)) <span class="keywordsign">-></span><br>
<br>
<span class="keyword">let</span> r = <span class="constructor">Link</span> ((a, line), title_opt, url) <span class="keyword">in</span><br>
return r)<br>
)<br>
<br>
<span class="keyword">let</span> line (s, pos) =<br>
(collect<br>
~what:all_phrases<br>
~ended_with:end_of_phrase<br>
~from:pos<br>
~until:p_end >>= <span class="keyword">fun</span> (line, _) <span class="keywordsign">-></span><br>
return line) (s, pos)<br>
<br>
<span class="keyword">let</span> line_of_string s =<br>
<span class="keyword">match</span> line (s, 0) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> (r, _) <span class="keywordsign">-></span> r<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span> empty_line<br>
<br>
<span class="keyword">let</span> align =<br>
(p_str <span class="string">"<>"</span> >>> return <span class="constructor">Justify</span>) ||| <span class="comment">(* must be first *)</span><br>
(p_char <span class="string">'<'</span> >>> return <span class="constructor">Left</span>) |||<br>
(p_char <span class="string">'='</span> >>> return <span class="constructor">Center</span>) |||<br>
(p_char <span class="string">'>'</span> >>> return <span class="constructor">Right</span>)<br>
<br>
<span class="keyword">let</span> option =<br>
(attr_decl >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Attr</span> x)) |||<br>
(align >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Align</span> x)) |||<br>
(p_char <span class="string">'('</span> >>> return <span class="keywordsign">`</span><span class="constructor">Left_padding</span>) |||<br>
(p_char <span class="string">')'</span> >>> return <span class="keywordsign">`</span><span class="constructor">Right_padding</span>)<br>
<br>
<span class="comment">(* should we fix it? *)</span><br>
<span class="keyword">let</span> add_option (attrs, talign, (lp, rp)) = <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Attr</span> a <span class="keywordsign">-></span> (a @ attrs, talign, (lp, rp))<br>
<span class="comment">(* may be we need to add warning or something else<br>
* when align is already set *)</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Align</span> a <span class="keywordsign">-></span> (attrs, <span class="constructor">Some</span> a, (lp, rp))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Left_padding</span> <span class="keywordsign">-></span> (attrs, talign, (succ lp, rp))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Right_padding</span> <span class="keywordsign">-></span> (attrs, talign, (lp, succ rp))<br>
<br>
<span class="keyword">let</span> options =<br>
p_manyf option add_option default_options<br>
<br>
<span class="keyword">let</span> valign =<br>
(p_char <span class="string">'^'</span> >>> return <span class="constructor">Top</span> ) |||<br>
(p_char <span class="string">'-'</span> >>> return <span class="constructor">Middle</span>) |||<br>
(p_char <span class="string">'~'</span> >>> return <span class="constructor">Bottom</span>)<br>
<br>
<span class="keyword">let</span> tableoption =<br>
(option >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Option</span> x)) |||<br>
(valign >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Valign</span> x))<br>
<span class="keyword">let</span> add_tableoption (opts, valign) = <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Valign</span> x <span class="keywordsign">-></span> (opts, <span class="constructor">Some</span> x)<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Option</span> x <span class="keywordsign">-></span> (add_option opts x, valign)<br>
<span class="keyword">let</span> tableoptions =<br>
p_manyf tableoption add_tableoption default_tableoptions<br>
<span class="keyword">let</span> tableoptions_plus =<br>
p_plusf tableoption add_tableoption default_tableoptions<br>
<br>
<span class="keyword">let</span> block_type =<br>
(p_char <span class="string">'h'</span> >>><br>
p_pred (<span class="keyword">fun</span> c <span class="keywordsign">-></span> c >= <span class="string">'1'</span> <span class="keywordsign">&&</span> c <= <span class="string">'6'</span>) >>= <span class="keyword">fun</span> c <span class="keywordsign">-></span><br>
return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> (<span class="keywordsign">`</span><span class="constructor">Header</span> (num_of_char c)))) |||<br>
(p_str <span class="string">"bq"</span> >>> return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> <span class="keywordsign">`</span><span class="constructor">Blockquote</span>)) |||<br>
(p_str <span class="string">"fn"</span> >>> p_unsign_int >>= <span class="keyword">fun</span> i <span class="keywordsign">-></span><br>
return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> (<span class="keywordsign">`</span><span class="constructor">Footnote</span> i))) |||<br>
(p_str <span class="string">"bc"</span> >>> return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> <span class="keywordsign">`</span><span class="constructor">Blockcode</span>)) |||<br>
(p_str <span class="string">"pre"</span> >>> return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> <span class="keywordsign">`</span><span class="constructor">Pre</span>)) |||<br>
(p_str <span class="string">"notextile"</span> >>> return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> <span class="keywordsign">`</span><span class="constructor">Blocknott</span>)) |||<br>
(p_char <span class="string">'p'</span> >>> return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> <span class="keywordsign">`</span><span class="constructor">Paragraph</span>)) |||<br>
(p_str <span class="string">"table"</span> >>> return <span class="keywordsign">`</span><span class="constructor">Table</span>)<br>
<br>
<span class="keyword">let</span> block_modifier =<br>
p_many p_whitespace >>> <span class="comment">(* skip whitespaces *)</span><br>
block_type >>= <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Table</span> <span class="keywordsign">-></span><br>
tableoptions >>= <span class="keyword">fun</span> topts <span class="keywordsign">-></span><br>
p_opt () (p_char <span class="string">'.'</span> >>> return ()) >>><br>
p_many p_whitespace >>><br>
p_end >>><br>
return (<span class="keywordsign">`</span><span class="constructor">Table</span> topts)<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Textblock</span> bm <span class="keywordsign">-></span><br>
options >>= <span class="keyword">fun</span> opts <span class="keywordsign">-></span><br>
p_char <span class="string">'.'</span> >>><br>
((p_char <span class="string">'.'</span> >>> return <span class="keyword">true</span>) ||| (return <span class="keyword">false</span>)) >>= <span class="keyword">fun</span> extended <span class="keywordsign">-></span><br>
p_char <span class="string">' '</span> >>><br>
<span class="comment">(* FIXME *)</span><br>
<span class="comment">(*line >>= fun line ->*)</span><br>
<span class="comment">(*dont_jump p_somechar >>>*)</span><br>
return (<span class="keywordsign">`</span><span class="constructor">Textblock</span> (bm, opts, extended))<br>
<br>
<span class="keyword">let</span> of_stream stream =<br>
<br>
<span class="comment">(*let get_content parse_first parse empty is_ext =<br>
let rec loop acc (s, pos) =<br>
try<br>
let str = Stream.next stream in<br>
(<br>
(parse >>= fun r -><br>
loop (r::acc)) |||<br>
(if is_ext<br>
then<br>
(match Stream.peek stream with<br>
| Some next_str -><br>
(* wtf am i writing *)<br>
(fun _ -><br>
((block_modifier >>> return (List.rev acc)) |||<br>
(loop (empty::acc))) (next_str, 0))<br>
| None -> return (List.rev acc))<br>
else return (List.rev acc))<br>
) (str, 0)<br>
with Stream.Failure -> (return (List.rev acc)) (s, pos) in<br>
parse_first >>= fun first -><br>
loop [first] in*)</span><br>
<br>
<span class="keyword">let</span> get_content parse_first parse empty extended (s, pos) =<br>
<span class="keyword">let</span> <span class="keyword">rec</span> loop acc =<br>
<span class="keyword">try</span><br>
<span class="keyword">let</span> str = <span class="constructor">Stream</span>.next stream <span class="keyword">in</span><br>
(<span class="keyword">match</span> parse (str, 0) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> (r, _) <span class="keywordsign">-></span> loop (r::acc)<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keyword">when</span> extended <span class="keywordsign">-></span><br>
(<span class="keyword">match</span> <span class="constructor">Stream</span>.peek stream <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Some</span> next_str <span class="keywordsign">-></span><br>
(<span class="keyword">match</span> (block_modifier (next_str, 0)) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> _ <span class="keywordsign">-></span> <span class="constructor">List</span>.rev acc<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span> (loop (empty::acc)))<br>
<span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> <span class="constructor">List</span>.rev acc)<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span> <span class="constructor">List</span>.rev acc)<br>
<span class="keyword">with</span> <span class="constructor">Stream</span>.<span class="constructor">Failure</span> <span class="keywordsign">-></span> <span class="constructor">List</span>.rev acc <span class="keyword">in</span><br>
<span class="keyword">match</span> parse_first (s, pos) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> (first, _) <span class="keywordsign">-></span> <span class="constructor">Parsed</span> (loop [first], (s, pos))<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span> <span class="constructor">Failed</span> <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_lines extended (s, pos) =<br>
<span class="keyword">let</span> parse_line = line <span class="keyword">in</span><br>
<span class="keyword">let</span> parse_first_line = line <span class="keyword">in</span><br>
get_content parse_first_line parse_line [] extended (s, pos) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_strings extended (s, pos) =<br>
<span class="keyword">let</span> parse_string (s, pos) =<br>
<span class="keyword">match</span> s <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="string">""</span> <span class="keywordsign">-></span> <span class="constructor">Failed</span><br>
<span class="keywordsign">|</span> _ <span class="keywordsign">-></span> <span class="constructor">Parsed</span> (s, (s, (<span class="constructor">String</span>.length s))) <span class="keyword">in</span><br>
<span class="keyword">let</span> parse_first_string (s, first) =<br>
<span class="keyword">let</span> s = <span class="constructor">String</span>.slice ~first s <span class="keyword">in</span><br>
parse_string (s, first) <span class="keyword">in</span><br>
get_content parse_first_string parse_string <span class="string">""</span> extended (s, pos) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> celloptions =<br>
<span class="keyword">let</span> option =<br>
(p_char <span class="string">'_'</span> >>> return <span class="keywordsign">`</span><span class="constructor">Head</span>) |||<br>
(tableoption >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Topt</span> x)) |||<br>
(p_char <span class="string">'\\'</span> >>> p_int >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Colspan</span> x)) |||<br>
(p_char <span class="string">'/'</span> >>> p_int >>= <span class="keyword">fun</span> x <span class="keywordsign">-></span> return (<span class="keywordsign">`</span><span class="constructor">Rowspan</span> x)) <span class="keyword">in</span><br>
<span class="keyword">let</span> add (celltype, topts, ((colspan, rowspan) <span class="keyword">as</span> cellspan)) = <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Head</span> <span class="keywordsign">-></span> (<span class="constructor">Head</span>, topts, cellspan)<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Topt</span> x <span class="keywordsign">-></span> (celltype, add_tableoption topts x, cellspan)<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Colspan</span> x <span class="keywordsign">-></span> (celltype, topts, (<span class="constructor">Some</span> x, rowspan))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Rowspan</span> x <span class="keywordsign">-></span> (celltype, topts, (colspan, <span class="constructor">Some</span> x)) <span class="keyword">in</span><br>
p_plusf option add default_celloptions <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> element c prev_level =<br>
<span class="keyword">let</span> bullet = p_many p_whitespace >>> c <span class="keyword">in</span><br>
bullet >>><br>
p_upto_timesf prev_level<br>
(p_many p_whitespace >>> c)<br>
(<span class="keyword">fun</span> l _ <span class="keywordsign">-></span> succ l) 1 >>= <span class="keyword">fun</span> lvl <span class="keywordsign">-></span><br>
<span class="comment">(* if you remove line below, strings started with Strong text will be<br>
* parsed as elements of list *)</span><br>
p_plus p_whitespace >>><br>
line >>= <span class="keyword">fun</span> line <span class="keywordsign">-></span><br>
return (lvl, line) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_element c prev_level x =<br>
<span class="keyword">match</span> <span class="constructor">Stream</span>.peek stream <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">Some</span> s <span class="keywordsign">-></span><br>
(element c prev_level >>= <span class="keyword">fun</span> e <span class="keywordsign">-></span><br>
return (<span class="constructor">Stream</span>.junk stream; e)) (s, 0)<br>
<span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> <span class="constructor">Failed</span> <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_elements c =<br>
element (p_char c) 0 >>= <span class="keyword">fun</span> ((f_e_lvl, _) <span class="keyword">as</span> first_element) <span class="keywordsign">-></span><br>
p_manyf_arg<br>
(<span class="keyword">fun</span> (prev_lvl, elements) <span class="keywordsign">-></span> get_element (p_char c) prev_lvl)<br>
(<span class="keyword">fun</span> (_, acc) (lvl, line) <span class="keywordsign">-></span> lvl, (lvl, line)::acc)<br>
(f_e_lvl, [first_element]) >>= <span class="keyword">fun</span> (_, rev_elements) <span class="keywordsign">-></span><br>
return (<span class="constructor">List</span>.rev (rev_elements)) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> row peeks =<br>
<span class="comment">(* FIXME: must be clean!!!1111 *)</span><br>
<span class="keyword">let</span> peeks = ref peeks <span class="keyword">in</span><br>
<span class="comment">(* suppose you has already parsed first '|' *)</span><br>
<span class="keyword">let</span> get_cell =<br>
<span class="comment">(* it's for |foo\nbar|<br>
* hate this *)</span><br>
<span class="keyword">let</span> continue_cell x =<br>
<span class="keyword">let</span> <span class="keyword">rec</span> loop acc cell_peeks x =<br>
<span class="keyword">match</span> peekn stream (!peeks + cell_peeks) <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> <span class="constructor">Failed</span><br>
<span class="keywordsign">|</span> <span class="constructor">Some</span> s <span class="keywordsign">-></span><br>
(collect<br>
<span class="comment">(* FIXME *)</span><br>
~what:all_phrases<br>
~ended_with:(end_of_phrase |||<br>
<span class="comment">(* FIXME *)</span><br>
<span class="comment">(* check if it works with |(@code@)| *)</span><br>
dont_jump (<br>
p_many p_punct >>><br>
p_char <span class="string">'|'</span> >>> return ()))<br>
~from:0<br>
~until:(<br>
(p_char <span class="string">'|'</span> >>> return <span class="keyword">true</span>) |||<br>
(p_end >>> return <span class="keyword">false</span>)<br>
) >>= <span class="keyword">function</span><br>
<span class="keywordsign">|</span> line, <span class="keyword">true</span> <span class="keywordsign">-></span><br>
return (peeks := !peeks + (succ cell_peeks); <span class="constructor">List</span>.rev (line::acc))<br>
<span class="keywordsign">|</span> line, <span class="keyword">false</span> <span class="keywordsign">-></span><br>
loop (line::acc) (succ cell_peeks)<br>
) (s, 0) <span class="keyword">in</span><br>
loop [] 0 x <span class="keyword">in</span><br>
<br>
p_opt default_celloptions (<br>
celloptions >>= <span class="keyword">fun</span> copts <span class="keywordsign">-></span><br>
p_str <span class="string">". "</span> >>><br>
return copts) >>= <span class="keyword">fun</span> copts <span class="keywordsign">-></span><br>
(<br>
<span class="comment">(* empty cell *)</span><br>
(p_char <span class="string">'|'</span> >>> return (empty_line, <span class="keyword">true</span>)) |||<br>
(current_pos >>= <span class="keyword">fun</span> beg_of_line <span class="keywordsign">-></span><br>
collect<br>
~what:all_phrases<br>
<span class="comment">(* FIXME *)</span><br>
~ended_with:(end_of_phrase |||<br>
<span class="comment">(* FIXME *)</span><br>
dont_jump (p_many p_punct >>> p_char <span class="string">'|'</span> >>> return ()))<br>
~from:beg_of_line<br>
~until:(<br>
(p_char <span class="string">'|'</span> >>> return <span class="keyword">true</span>) |||<br>
(p_end >>> return <span class="keyword">false</span>)<br>
))<br>
) >>= <span class="keyword">function</span><br>
<span class="keywordsign">|</span> first_line, <span class="keyword">true</span> <span class="keywordsign">-></span> return (copts, [first_line])<br>
<span class="keywordsign">|</span> first_line, <span class="keyword">false</span> <span class="keywordsign">-></span> continue_cell >>= <span class="keyword">fun</span> lines <span class="keywordsign">-></span><br>
return (copts, first_line::lines) <span class="keyword">in</span><br>
<br>
p_many p_whitespace >>> <span class="comment">(* skip whitespaces *)</span><br>
p_opt default_tableoptions (<br>
tableoptions_plus >>= <span class="keyword">fun</span> topts <span class="keywordsign">-></span><br>
p_char <span class="string">'.'</span> >>><br>
p_plus p_whitespace >>><br>
return topts) >>= <span class="keyword">fun</span> topts <span class="keywordsign">-></span><br>
p_char <span class="string">'|'</span> >>><br>
get_cell >>= <span class="keyword">fun</span> first_cell <span class="keywordsign">-></span><br>
p_manyf_ends_with<br>
get_cell<br>
(<span class="keyword">fun</span> acc x <span class="keywordsign">-></span> x :: acc)<br>
[first_cell]<br>
p_end >>= <span class="keyword">fun</span> rev_cells <span class="keywordsign">-></span><br>
return (njunk stream !peeks; (topts, <span class="constructor">List</span>.rev rev_cells)) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_extra_rows =<br>
p_seq<br>
(<span class="keyword">fun</span> _ <span class="keywordsign">-></span><br>
<span class="keyword">match</span> <span class="constructor">Stream</span>.peek stream <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> <span class="constructor">Failed</span><br>
<span class="keywordsign">|</span> <span class="constructor">Some</span> s <span class="keywordsign">-></span> row 1 (s, 0)) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_rows =<br>
row 0 >>= <span class="keyword">fun</span> first_row <span class="keywordsign">-></span><br>
get_extra_rows >>= <span class="keyword">fun</span> extra_rows <span class="keywordsign">-></span><br>
return (first_row::extra_rows) <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> get_block s =<br>
(<br>
<span class="comment">(* block marked with modifier *)</span><br>
(block_modifier >>= <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Textblock</span> (bm, opts, extended) <span class="keywordsign">-></span><br>
<span class="keyword">let</span> lines f = get_lines extended >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span> return (f r) <span class="keyword">in</span><br>
<span class="keyword">let</span> strings f = get_strings extended >>= <span class="keyword">fun</span> r <span class="keywordsign">-></span> return (f r) <span class="keyword">in</span><br>
(<span class="keyword">match</span> bm <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Header</span> lvl <span class="keywordsign">-></span> lines (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Header</span> (lvl, (opts, x)))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Blockquote</span> <span class="keywordsign">-></span> lines (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Blockquote</span> (opts, x))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Footnote</span> n <span class="keywordsign">-></span> lines (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Footnote</span> (n, (opts, x)))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Blockcode</span> <span class="keywordsign">-></span> strings (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Blockcode</span> (opts, x))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Pre</span> <span class="keywordsign">-></span> strings (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Pre</span> (opts, x))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Blocknott</span> <span class="keywordsign">-></span> strings (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Blocknott</span> (opts, x))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Paragraph</span> <span class="keywordsign">-></span> lines (<span class="keyword">fun</span> x <span class="keywordsign">-></span> <span class="constructor">Paragraph</span> (opts, x)))<br>
<span class="keywordsign">|</span> <span class="keywordsign">`</span><span class="constructor">Table</span> topts <span class="keywordsign">-></span><br>
(get_extra_rows >>= <span class="keyword">function</span><br>
<span class="keywordsign">|</span> [] <span class="keywordsign">-></span> fail<br>
<span class="keywordsign">|</span> rows <span class="keywordsign">-></span> return (<span class="constructor">Table</span> (topts, rows)))<br>
<span class="comment">(* only table *)</span><br>
) ||| (<br>
get_rows >>= <span class="keyword">fun</span> rows <span class="keywordsign">-></span><br>
return (<span class="constructor">Table</span> (default_tableoptions, rows))<br>
<span class="comment">(* bullist *)</span><br>
) ||| (<br>
get_elements <span class="string">'*'</span> >>= <span class="keyword">fun</span> el <span class="keywordsign">-></span> return (<span class="constructor">Bulllist</span> el)<br>
<span class="comment">(* numlist *)</span><br>
) ||| (<br>
get_elements <span class="string">'#'</span> >>= <span class="keyword">fun</span> el <span class="keywordsign">-></span> return (<span class="constructor">Numlist</span> el)<br>
<span class="comment">(* usual text paragraph *)</span><br>
) ||| (<br>
get_lines <span class="keyword">false</span> >>= <span class="keyword">fun</span> lines <span class="keywordsign">-></span><br>
return (<span class="constructor">Paragraph</span> (default_options, lines))<br>
)<br>
) (s, 0) >> <span class="keyword">function</span><br>
<span class="keywordsign">|</span> <span class="constructor">Parsed</span> (r, _) <span class="keywordsign">-></span> r<br>
<span class="keywordsign">|</span> <span class="constructor">Failed</span> <span class="keywordsign">-></span> <span class="keyword">assert</span> <span class="keyword">false</span> <span class="comment">(* FIXME *)</span> <span class="keyword">in</span><br>
<br>
<span class="keyword">let</span> <span class="keyword">rec</span> next_block () =<br>
<span class="keyword">try</span><br>
<span class="keyword">match</span> <span class="constructor">Stream</span>.next stream <span class="keyword">with</span><br>
<span class="keywordsign">|</span> <span class="string">""</span> <span class="keywordsign">-></span> next_block ()<br>
<span class="keywordsign">|</span> fstr <span class="keywordsign">-></span> <span class="constructor">Some</span> (get_block fstr)<br>
<span class="keyword">with</span> <span class="constructor">Stream</span>.<span class="constructor">Failure</span> <span class="keywordsign">-></span> <span class="constructor">None</span> <span class="keyword">in</span><br>
<br>
<span class="constructor">Stream</span>.from (<span class="keyword">fun</span> _ <span class="keywordsign">-></span> next_block ())<br>
<br>
</code></body></html>
