OCaml: Implement log contexts
This commit is contained in:
parent
a3805ea1bd
commit
c6c92c0a32
8 changed files with 29 additions and 25 deletions
|
|
@ -23,7 +23,7 @@ let interpret (past : Schema.schema) (arguments : string list) : Schema.schema =
|
|||
{
|
||||
past.output with
|
||||
main =
|
||||
"Unknown command: " ^ head ^ "\n" ^ past.meta.help.short;
|
||||
"Unrecognized command: " ^ head ^ "\n" ^ past.meta.help.short;
|
||||
};
|
||||
meta = { past.meta with status = 1 };
|
||||
}
|
||||
|
|
|
|||
|
|
@ -98,5 +98,5 @@ let scan_line (input: char list): token list =
|
|||
|
||||
let scan (char_lists: char lists): token lists =
|
||||
let tokens = rmap (scan_line) char_lists $: [End] in
|
||||
elog $ string_of_tokens tokens;
|
||||
elog ~context:Parsing $ string_of_tokens tokens;
|
||||
tokens
|
||||
|
|
|
|||
|
|
@ -1,14 +1,8 @@
|
|||
(* open Utilities.Aliases *)
|
||||
open Lexer
|
||||
open Utilities.Aliases
|
||||
|
||||
let default_config: Schema.main = Schema.origin.input.configuration.main
|
||||
|
||||
(*
|
||||
TODO: The `elog` calls in this module's functions cause cram tests
|
||||
to fail. Separate logging levels can be implemented to solve this.
|
||||
*)
|
||||
|
||||
let parse_boolean (key: key) (value: string): Schema.default_bool =
|
||||
match value with
|
||||
| "true" -> true
|
||||
|
|
@ -16,7 +10,7 @@ let parse_boolean (key: key) (value: string): Schema.default_bool =
|
|||
| _ -> raise $ Malformed_source
|
||||
(Schema.string_of_key key ^ " must be either true or false")
|
||||
|
||||
let check_sanity (config: Schema.main): Schema.main =
|
||||
let check (config: Schema.main): Schema.main =
|
||||
|
||||
let default = Schema.origin.input.configuration.main in
|
||||
|
||||
|
|
@ -24,20 +18,20 @@ let check_sanity (config: Schema.main): Schema.main =
|
|||
and default to unquoted if a custom su_command is set *)
|
||||
match config.su_command_quoted, config.su_command with
|
||||
| (true|false), su_command when su_command == default.su_command ->
|
||||
elog $ "[c.parser.check_sanity] " ^
|
||||
elog ~context:Parsing $ "[c.parser.check] " ^
|
||||
"Ignoring configuration key su_command_quoted: su_command is unset," ^
|
||||
" and the default su_command needs quoting";
|
||||
{ config with su_command_quoted = default.su_command_quoted }
|
||||
| (true|false), _ -> config
|
||||
| Default, su_command when su_command <> default.su_command ->
|
||||
elog $ "[c.parser.check_sanity] " ^
|
||||
elog ~context:Parsing $ "[c.parser.check] " ^
|
||||
"Setting su_command_quoted to false: su_command is set, but " ^
|
||||
"su_command_quoted isn't. If it needs quoting, please set it to true";
|
||||
{ config with su_command_quoted = false }
|
||||
| Default, _ -> config
|
||||
|
||||
let update config key (value: string): Schema.main =
|
||||
elog $ "[c.parser.update] Matching value '" ^ value ^ "'";
|
||||
elog ~context:Parsing $ "[c.parser.update] Matching value '" ^ value ^ "'";
|
||||
match key with
|
||||
| Schema.SuCommand ->
|
||||
{ config with Schema.su_command = String.split_on_char ' ' value }
|
||||
|
|
@ -45,7 +39,7 @@ let update config key (value: string): Schema.main =
|
|||
{ config with
|
||||
Schema.su_command_quoted = parse_boolean key value }
|
||||
| Unknown ->
|
||||
elog $ "[c.parser.update] Dropped value: unknown key";
|
||||
elog ~context:Parsing $ "[c.parser.update] Dropped value: unknown key";
|
||||
config
|
||||
|
||||
let parse tokens: Schema.main =
|
||||
|
|
@ -53,23 +47,25 @@ let parse tokens: Schema.main =
|
|||
match tokens with
|
||||
| [] -> config
|
||||
| Key key :: tail ->
|
||||
elog $ "[c.parser.parse ] Picked key '" ^
|
||||
elog ~context:Parsing $ "[c.parser.parse] Picked key '" ^
|
||||
Schema.string_of_key key ^ "'";
|
||||
parse_tokens tail config (Some key)
|
||||
| Value value :: tail ->
|
||||
elog $ "[c.parser.parse ] Picked value '" ^ value ^ "'";
|
||||
elog ~context:Parsing $
|
||||
"[c.parser.parse] Picked value '" ^ value ^ "'";
|
||||
(match ready_key with
|
||||
| Some key -> parse_tokens tail (update config key value) None
|
||||
| None -> raise $ Malformed_source "Value lacks preceding key")
|
||||
| Unknown char :: tail ->
|
||||
elog $ "[c.parser.parse ] Dropping unknown token " ^ str_char char;
|
||||
elog ~context:Parsing $
|
||||
"[c.parser.parse] Dropping unknown token " ^ str_char char;
|
||||
parse_tokens tail config ready_key
|
||||
| (Space|Equal|LineBreak|End) :: tail ->
|
||||
parse_tokens tail config ready_key
|
||||
|
||||
in
|
||||
parse_tokens tokens default_config None
|
||||
|> check_sanity
|
||||
|> check
|
||||
|
||||
let apply (origin: Schema.schema) (config: Schema.main): Schema.schema =
|
||||
{ origin with input = {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue