let of_stream stream = (*let get_content parse_first parse empty is_ext = let rec loop acc (s, pos) = try let str = Stream.next stream in ( (parse >>= fun r -> loop (r::acc)) ||| (if is_ext then (match Stream.peek stream with | Some next_str -> (* wtf am i writing *) (fun _ -> ((block_modifier >>> return (List.rev acc)) ||| (loop (empty::acc))) (next_str, 0)) | None -> return (List.rev acc)) else return (List.rev acc)) ) (str, 0) with Stream.Failure -> (return (List.rev acc)) (s, pos) in parse_first >>= fun first -> loop [first] in*) let get_content parse_first parse empty extended (s, pos) = let rec loop acc = try let str = Stream.next stream in (match parse (str, 0) with | Parsed (r, _) -> loop (r::acc) | Failed when extended -> (match Stream.peek stream with | Some next_str -> (match (block_modifier (next_str, 0)) with | Parsed _ -> List.rev acc | Failed -> (loop (empty::acc))) | None -> List.rev acc) | Failed -> List.rev acc) with Stream.Failure -> List.rev acc in match parse_first (s, pos) with | Parsed (first, _) -> Parsed (loop [first], (s, pos)) | Failed -> Failed in let get_lines extended (s, pos) = let parse_line = line in let parse_first_line = line in get_content parse_first_line parse_line [] extended (s, pos) in let get_strings extended (s, pos) = let parse_string (s, pos) = match s with | "" -> Failed | _ -> Parsed (s, (s, (String.length s))) in let parse_first_string (s, first) = let s = String.slice ~first s in parse_string (s, first) in get_content parse_first_string parse_string "" extended (s, pos) in let celloptions = let option = (p_char '_' >>> return `Head) ||| (tableoption >>= fun x -> return (`Topt x)) ||| (p_char '\\' >>> p_int >>= fun x -> return (`Colspan x)) ||| (p_char '/' >>> p_int >>= fun x -> return (`Rowspan x)) in let add (celltype, topts, ((colspan, rowspan) as cellspan)) = function | `Head -> (Head, topts, cellspan) | `Topt x -> (celltype, add_tableoption topts x, cellspan) | `Colspan x -> (celltype, topts, (Some x, rowspan)) | `Rowspan x -> (celltype, topts, (colspan, Some x)) in p_plusf option add default_celloptions in let element c prev_level = let bullet = p_many p_whitespace >>> c in bullet >>> p_upto_timesf prev_level (p_many p_whitespace >>> c) (fun l _ -> succ l) 1 >>= fun lvl -> (* if you remove line below, strings started with Strong text will be * parsed as elements of list *) p_plus p_whitespace >>> line >>= fun line -> return (lvl, line) in let get_element c prev_level x = match Stream.peek stream with | Some s -> (element c prev_level >>= fun e -> return (Stream.junk stream; e)) (s, 0) | None -> Failed in let get_elements c = element (p_char c) 0 >>= fun ((f_e_lvl, _) as first_element) -> p_manyf_arg (fun (prev_lvl, elements) -> get_element (p_char c) prev_lvl) (fun (_, acc) (lvl, line) -> lvl, (lvl, line)::acc) (f_e_lvl, [first_element]) >>= fun (_, rev_elements) -> return (List.rev (rev_elements)) in let row peeks = (* FIXME: must be clean!!!1111 *) let peeks = ref peeks in (* suppose you has already parsed first '|' *) let get_cell = (* it's for |foo\nbar| * hate this *) let continue_cell x = let rec loop acc cell_peeks x = match peekn stream (!peeks + cell_peeks) with | None -> Failed | Some s -> (collect (* FIXME *) ~what:all_phrases ~ended_with:(end_of_phrase ||| (* FIXME *) (* check if it works with |(@code@)| *) dont_jump ( p_many p_punct >>> p_char '|' >>> return ())) ~from:0 ~until:( (p_char '|' >>> return true) ||| (p_end >>> return false) ) >>= function | line, true -> return (peeks := !peeks + (succ cell_peeks); List.rev (line::acc)) | line, false -> loop (line::acc) (succ cell_peeks) ) (s, 0) in loop [] 0 x in p_opt default_celloptions ( celloptions >>= fun copts -> p_str ". " >>> return copts) >>= fun copts -> ( (* empty cell *) (p_char '|' >>> return (empty_line, true)) ||| (current_pos >>= fun beg_of_line -> collect ~what:all_phrases (* FIXME *) ~ended_with:(end_of_phrase ||| (* FIXME *) dont_jump (p_many p_punct >>> p_char '|' >>> return ())) ~from:beg_of_line ~until:( (p_char '|' >>> return true) ||| (p_end >>> return false) )) ) >>= function | first_line, true -> return (copts, [first_line]) | first_line, false -> continue_cell >>= fun lines -> return (copts, first_line::lines) in p_many p_whitespace >>> (* skip whitespaces *) p_opt default_tableoptions ( tableoptions_plus >>= fun topts -> p_char '.' >>> p_plus p_whitespace >>> return topts) >>= fun topts -> p_char '|' >>> get_cell >>= fun first_cell -> p_manyf_ends_with get_cell (fun acc x -> x :: acc) [first_cell] p_end >>= fun rev_cells -> return (njunk stream !peeks; (topts, List.rev rev_cells)) in let get_extra_rows = p_seq (fun _ -> match Stream.peek stream with | None -> Failed | Some s -> row 1 (s, 0)) in let get_rows = row 0 >>= fun first_row -> get_extra_rows >>= fun extra_rows -> return (first_row::extra_rows) in let get_block s = ( (* block marked with modifier *) (block_modifier >>= function | `Textblock (bm, opts, extended) -> let lines f = get_lines extended >>= fun r -> return (f r) in let strings f = get_strings extended >>= fun r -> return (f r) in (match bm with | `Header lvl -> lines (fun x -> Header (lvl, (opts, x))) | `Blockquote -> lines (fun x -> Blockquote (opts, x)) | `Footnote n -> lines (fun x -> Footnote (n, (opts, x))) | `Blockcode -> strings (fun x -> Blockcode (opts, x)) | `Pre -> strings (fun x -> Pre (opts, x)) | `Blocknott -> strings (fun x -> Blocknott (opts, x)) | `Paragraph -> lines (fun x -> Paragraph (opts, x))) | `Table topts -> (get_extra_rows >>= function | [] -> fail | rows -> return (Table (topts, rows))) (* only table *) ) ||| ( get_rows >>= fun rows -> return (Table (default_tableoptions, rows)) (* bullist *) ) ||| ( get_elements '*' >>= fun el -> return (Bulllist el) (* numlist *) ) ||| ( get_elements '#' >>= fun el -> return (Numlist el) (* usual text paragraph *) ) ||| ( get_lines false >>= fun lines -> return (Paragraph (default_options, lines)) ) ) (s, 0) >> function | Parsed (r, _) -> r | Failed -> assert false (* FIXME *) in let rec next_block () = try match Stream.next stream with | "" -> next_block () | fstr -> Some (get_block fstr) with Stream.Failure -> None in Stream.from (fun _ -> next_block ())