new configuration functions

This commit is contained in:
Stavros Polymenis 2016-12-08 23:30:49 +00:00
parent 85be47ef7a
commit d09dc39c03
2 changed files with 35 additions and 5 deletions

View File

@ -1,18 +1,32 @@
module Configuration = struct
type t = {
repository : string;
title : string;
owner : string;
email : string;
}
let default = {
repository = Sys.getenv "HOME" ^ "/ymd";
title = "Logarion journal";
owner = "";
email = "";
}
let of_filename fn =
let result = Toml.Parser.from_filename fn in
match result with
| `Error (str, loc) -> { title = ""; owner = ""; email = "" }
| `Ok tbl ->
let str_of key_name = match TomlLenses.(get tbl (key "general" |-- table |-- key key_name |-- string)) with
Some v -> v | None -> "" in
{ title = str_of "title"; owner = str_of "owner"; email = str_of "email" }
| `Error (str, loc) -> default
| `Ok toml ->
let open Logarion_toml in
let str = Logarion_toml.str toml "general" in
let str_opt = Logarion_toml.str_opt toml "general" in
{
repository = str "repository" default.repository;
title = str "title" default.title;
owner = str "owner" default.owner;
email = str "email" default.email;
}
end
let load_file f =

16
src/logarion_toml.ml Normal file
View File

@ -0,0 +1,16 @@
open TomlLenses
let int toml table_name key_name default =
match get toml (key table_name |-- table |-- key key_name |-- int) with
Some i -> i | None -> default
let float toml table_name key_name default =
match get toml (key table_name |-- table |-- key key_name |-- float) with
Some f -> f | None -> default
let str_opt toml table_name key_name =
get toml (key table_name |-- table |-- key key_name |-- string)
let str toml table_name key_name default =
match str_opt toml table_name key_name with
Some s -> s | None -> default