struct
open Result.Monad_infix
let explode_key_value loc s =
try
let by_space =
String.split_on_chars s ~on:[' '; '\n'; '\t'; '\r']
|> List.filter ~f:((<>) "") in
Ok (List.map by_space (fun s ->
begin match String.split ~on:'=' s with
| [ key; value ] -> (key, value)
| anyother -> raise Not_found
end))
with
Not_found -> Error (`cannot_parse_key_values (loc, s))
let rec next ~tags p =
let open Lines.Buffer in
let assoc_find ~missing l v =
match List.Assoc.find l v with | Some v -> Ok v | None -> Error missing in
let assoc_find_map ~missing ~wrong ~f l v =
match List.Assoc.find l v with
| Some v -> (try Ok (f v) with e -> Error wrong)
| None -> Error missing in
match (next_line p :> string option) with
| Some "" ->
if tags.Tags.allow_empty_lines
then `output (Error (`empty_line (current_position p)))
else next ~tags p
| Some l when tags.Tags.sharp_comments && String.is_prefix l ~prefix:"#" ->
`output (Ok (`comment String.(sub l ~pos:1 ~len:(length l - 1))))
| Some l when String.is_prefix l ~prefix:"fixedStep" ->
let output_m =
explode_key_value (current_position p)
String.(chop_prefix_exn l ~prefix:"fixedStep")
>>= fun assoc ->
assoc_find assoc "chrom"
~missing:(`missing_chrom_value (current_position p, l))
>>= fun chrom ->
assoc_find_map assoc "start"
~missing:(`missing_start_value (current_position p, l))
~f:Int.of_string ~wrong:(`wrong_start_value (current_position p, l))
>>= fun start ->
assoc_find_map assoc "step"
~missing:(`missing_step_value (current_position p, l))
~f:Int.of_string ~wrong:(`wrong_step_value (current_position p, l))
>>= fun step ->
begin match List.Assoc.find assoc "span" with
| None ->
Ok (`fixed_step_state_change (chrom, start, step, None))
| Some span ->
begin match Option.try_with (fun () -> Int.of_string span) with
| Some i ->
Ok (`fixed_step_state_change (chrom, start, step, Some i))
| None -> Error (`wrong_span_value (current_position p, span))
end
end
in
`output output_m
| Some l when String.is_prefix l ~prefix:"variableStep" ->
let output_m =
explode_key_value (current_position p)
String.(chop_prefix_exn l ~prefix:"variableStep")
>>= fun assoc ->
assoc_find assoc "chrom"
~missing:(`missing_chrom_value (current_position p, l))
>>= fun chrom ->
begin match List.Assoc.find assoc "span" with
| None -> Ok (`variable_step_state_change (chrom, None))
| Some span ->
begin match Option.try_with (fun () -> Int.of_string span) with
| Some i -> Ok (`variable_step_state_change (chrom, Some i))
| None -> Error (`wrong_span_value (current_position p, span))
end
end
in
`output output_m
| Some l ->
let by_space =
String.split_on_chars l ~on:[' '; '\n'; '\t'; '\r']
|> List.filter ~f:((<>) "") in
begin match by_space with
| [ one_value ] ->
(try `output (Ok (`fixed_step_value Float.(of_string one_value)))
with e -> `output (Error (`wrong_fixed_step_value (current_position p, l))))
| [ fst_val; snd_val] ->
(try `output (Ok (`variable_step_value (Int.of_string fst_val,
Float.of_string snd_val)))
with e -> `output (Error (`wrong_variable_step_value (current_position p, l))))
| [ chr; b; e; v; ] ->
(try `output (Ok (`bed_graph_value (chr,
Int.of_string b,
Int.of_string e,
Float.of_string v)))
with e -> `output (Error (`wrong_bed_graph_value (current_position p, l))))
| l ->
`output (Error (`unrecognizable_line (current_position p, l)))
end
| None ->
`not_ready
let string_to_item ?filename ?(tags=Tags.default) () =
let name = sprintf "wig_parser:%s" Option.(value ~default:"<>" filename) in
let next = next ~tags in
Lines.Transform.make_merge_error ~name ?filename ~next ()
let item_to_string ?(tags=Tags.default) () =
let to_string = function
| `comment c -> if tags.Tags.sharp_comments then sprintf "#%s\n" c else ""
| `variable_step_state_change (chrom, span) ->
sprintf "variableStep chrom=%s%s\n" chrom
Option.(value_map ~default:"" span ~f:(sprintf " span=%d"))
| `variable_step_value (pos, v) -> sprintf "%d %g\n" pos v
| `fixed_step_state_change (chrom, start, step, span) ->
sprintf "fixedStep chrom=%s start=%d step=%d%s\n" chrom start step
Option.(value_map ~default:"" span ~f:(sprintf " span=%d"))
| `fixed_step_value v -> sprintf "%g\n" v
| `bed_graph_value (chrom, start, stop, v) ->
sprintf "%s %d %d %g\n" chrom start stop v in
Biocaml_transform.of_function ~name:"wig_to_string" to_string
let item_to_bed_graph () =
let queue = Queue.create () in
let current_state = ref None in
Biocaml_transform.make ~name:"wig_to_variable_step" ()
~feed:(function
| `comment _ -> ()
| `bed_graph_value already_done ->
Queue.enqueue queue (`output (Ok already_done))
| `variable_step_state_change (chrom, span) ->
current_state := Some (`variable (chrom, span))
| `variable_step_value (pos, v) ->
begin match !current_state with
| Some (`variable (chrom, span)) ->
let stop = pos + Option.(value ~default:1 span) - 1 in
Queue.enqueue queue (`output (Ok (chrom, pos, stop, v)))
| other ->
Queue.enqueue queue (`output (Error (`not_in_variable_step_state)))
end
| `fixed_step_state_change (chrom, start, step, span) ->
current_state := Some (`fixed (chrom, start, step , span, 0))
| `fixed_step_value v ->
begin match !current_state with
| Some (`fixed (chrom, start, step, span, current)) ->
let pos = start + (step * current) in
let stop = pos + Option.(value ~default:1 span) - 1 in
Queue.enqueue queue (`output (Ok (chrom, pos, stop, v)));
current_state := Some (`fixed (chrom, start, step , span, current + 1))
| other ->
Queue.enqueue queue (`output (Error (`not_in_fixed_step_state)))
end)
~next:(fun stopped ->
match Queue.dequeue queue with
| None -> if stopped then `end_of_stream else `not_ready
| Some v -> v)
end