This commit is contained in:
swrup 2026-02-09 00:36:59 +01:00
parent d0297beb07
commit 7a5b91e69c

View file

@ -21,10 +21,10 @@ let fail fmt =
let is_eol = function '\n' | '\r' -> true | _ -> false
let is_whitespace = function ' ' | '\t' -> true | _ -> false
let whitespace = skip_while is_whitespace
let blanks = skip_while is_whitespace
module Parse_data = struct
type line =
type t =
| Blank
| Comment of string
| Header of string
@ -37,23 +37,17 @@ module Parse_data = struct
in
take_while1 ident_char >>| String.lowercase_ascii
let take_till_end_of_line =
take_till is_eol >>= fun s -> return s <* end_of_line
let blank = whitespace <* end_of_line >>| fun () -> Blank
let comment =
whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
Comment s
let line = take_till is_eol <* end_of_line
let blank = blanks <* end_of_line >>| fun () -> Blank
let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
let item_value =
let unquoted_value =
take_while1 (fun c -> not (is_whitespace c || is_eol c))
take_while1 (fun c -> not (is_whitespace c || is_eol c)) <* end_of_line
in
let quoted_value =
char '"' *> take_till is_eol >>= fun s ->
char '"' *> take_till is_eol <* end_of_line >>= fun s ->
match String.ends_with ~suffix:"\"" s with
| false -> fail "invalid quoted value"
| true ->
@ -66,8 +60,7 @@ module Parse_data = struct
lift2
(fun key value -> Item { key; value })
id
(whitespace *> char '=' *> whitespace *> item_value)
<* end_of_line
(blanks *> char '=' *> blanks *> item_value)
let config = many (choice [ blank; comment; header; item ]) <* end_of_input
@ -98,10 +91,10 @@ module Pp_debug = struct
| false -> pf ppf "%s = %s" key value
| true -> pf ppf "%s = \"%s\"" key value
let pp_line ppf line =
let pp_line ppf v =
let open Fmt in
let open Parse_data in
match line with
match v with
| Blank -> Fmt.nop ppf ()
| Comment s -> pf ppf "#%s" s
| Header s -> pf ppf "[%s]" s
@ -119,7 +112,6 @@ module Pp_debug = struct
let open Fmt in
pf ppf "%a" (list ~sep:(any "\n") pp_section) l
end
[@@ocaml.warning "-32"]
module Parse_duration = struct
type duration_element = {
@ -134,9 +126,9 @@ module Parse_duration = struct
| Some i -> return i
let duration_element =
let number = whitespace *> integer in
let number = blanks *> integer in
let dunit =
whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
>>= function
| "year" | "years" -> return `Year
| "week" | "weeks" -> return `Week