let parse experimental =
let is_digit = function '0' .. '9' -> true | _ -> false in
let digit = repeat (Some 1) None is_digit >>| int_of_string in
let sequence = char '#' *> digit in
let boot = char 'X' *> digit in
let crypto_random = char 'R' *> digit in
let inode = char 'I' *> digit in
let device = char 'V' *> digit in
let microsecond = char 'M' *> digit in
let pid = char 'P' *> digit in
let deliveries = char 'Q' *> digit in
let modern =
(sequence >>| fun x -> `Sequence x)
<|> (boot >>| fun x -> `Boot x)
<|> (crypto_random >>| fun x -> `CryptoRandom x)
<|> (inode >>| fun x -> `Inode x)
<|> (device >>| fun x -> `Device x)
<|> (microsecond >>| fun x -> `Microsecond x)
<|> (pid >>| fun x -> `Pid x)
<|> (deliveries >>| fun x -> `Deliveries x)
in
let modern =
one modern
>>= fun l ->
{ f = fun i s fail succ ->
let rec catch acc = function
| `Sequence x :: r -> catch { acc with sequence = Some x } r
| `Boot x :: r -> catch { acc with boot = Some x } r
| `CryptoRandom x :: r -> catch { acc with crypto_random = Some x } r
| `Inode x :: r -> catch { acc with inode = Some x } r
| `Device x :: r -> catch { acc with device = Some x } r
| `Microsecond x :: r -> catch { acc with microsecond = Some x } r
| `Pid x :: r -> catch { acc with pid = Some x } r
| `Deliveries x :: r -> catch { acc with deliveries = Some x } r
| [] -> acc in
succ i s (catch (make ()) l) }
>>| to_safe
in
let host =
one
( (string (fun x -> x) "\057" >>= fun _ -> return '/')
<|> (string (fun x -> x) "\072" >>= fun _ -> return ':')
<|> (satisfy (function ',' -> false | _ -> true)))
>>| implode
in
let parameters =
one ( repeat None None (function '=' | ':' | ',' -> false | _ -> true)
>>= fun k -> char '='
*> repeat None None (function '=' | ':' | ',' -> false | _ -> true)
>>= fun v -> return (k, v))
>>| fun lst -> List.fold_right (fun (key, value) -> Map.add key value) lst Map.empty
in
digit
>>= fun time -> ( (modern >>= function Some x -> return (Modern x)
| None -> fail Invalid_filename)
<|> (digit <* char '_' >>= fun n -> digit >>| fun m -> Old1 (n, m))
<|> (digit >>| fun x -> Old0 x))
>>= fun id -> host
>>= fun host -> option Map.empty (char ',' *> parameters)
>>= fun parameters -> char ':' *> peek_chr >>= function
| Some '1' -> char ',' *> experimental >>| fun e ->
{ time; id; host; parameters; info = Exp e }
| Some '2' ->
let flag =
(char 'P' >>| fun _ -> Passed)
<|> (char 'R' >>| fun _ -> Replied)
<|> (char 'S' >>| fun _ -> Seen)
<|> (char 'T' >>| fun _ -> Trashed)
<|> (char 'D' >>| fun _ -> Draft)
<|> (char 'F' >>| fun _ -> Flagged)
in
let flags =
fix @@ fun m -> (lift2 (function Some x -> fun r -> x :: r
| None -> fun r -> r)
(option None (flag >>| fun x -> Some x)) m)
<|> return []
in
char ',' *> flags >>| fun l ->
{ time; id; host; parameters; info = Info l }
| _ -> return { time; id; host; parameters; info = Info [] }