struct
type parsing_buffer = {
mutable unfinished_line : string option;
lines : string Queue.t;
mutable parsed_lines : int;
filename : string option;
}
let parsing_buffer ?filename () =
{unfinished_line = None;
lines = Queue.create ();
parsed_lines = 0;
filename}
let feed_line p s =
Queue.enqueue p.lines s
let feed_string p s =
let lines = String.split s ~on:'\n' in
let rec faux = function
| [] -> assert false
| [ "" ] -> ()
| [ s ] ->
p.unfinished_line <- Some s;
| h :: t ->
Queue.enqueue p.lines h;
faux t
in
match p.unfinished_line, lines with
| _, [] -> assert false
| _, [""] -> ()
| None, l -> faux l
| Some s, h :: t ->
p.unfinished_line <- None;
faux ((s ^ h) :: t)
let queued_lines p = Queue.length p.lines
let next_line p =
let l = Queue.dequeue p.lines in
if l <> None then (
p.parsed_lines <- p.parsed_lines + 1;
);
l
exception No_next_line
let next_line_exn p =
match next_line p with
| Some s -> s
| None -> raise No_next_line
let current_position p =
Pos.make ?file:p.filename ~line:p.parsed_lines ()
let is_empty p =
Queue.is_empty p.lines && p.unfinished_line = None
let contents p = Queue.to_list p.lines, p.unfinished_line
let empty p = (Queue.clear p.lines; p.unfinished_line <- None)
let lines () =
let buf = parsing_buffer () in
make ~name:"lines"
~feed:(feed_string buf)
~next:(function
| true -> (match next_line buf with
| Some line -> `output line
| None -> (match contents buf with
| [], None -> `end_of_stream
| [], Some unfinished_line ->
(empty buf; `output unfinished_line)
| _ -> assert false
)
)
| false -> (match next_line buf with
| None -> `not_ready
| Some line -> `output line
)
)
()
let make ?name ?filename ~next ~on_error () =
let lo_parser = parsing_buffer ?filename () in
make ?name ()
~feed:(feed_string lo_parser)
~next:(fun stopped ->
match next lo_parser with
| `output (Ok r) -> `output (Ok r)
| `output (Error r) -> `output (Error (on_error (`next r)))
| `not_ready ->
if stopped then (
if is_empty lo_parser then
`end_of_stream
else
let l,o = contents lo_parser in
`output
(Error
(on_error
(`incomplete_input (current_position lo_parser, l, o))))
) else
`not_ready)
let make_merge_error =
make
~on_error:(function
| `next e -> e
| `incomplete_input e -> `incomplete_input e)
end