swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2026-02-09 00:36:59 +01:00
parent d0297beb07
commit 7a5b91e69c
1 changed files with 12 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

32
src/parse_config.ml
View file

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