software-archive/logarion-2016
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Introduce Confix, a discrete library for application configuration

Browse Source 
- Patch Template.ml to use Confix
- Add result binding operator
- Patch template and webserver to use Confix
- Wrote Config.to_record for applying positive result to converter
- Remove truncated file
This commit is contained in:
Stavros Polymenis 2017-10-08 18:28:53 +01:00
parent 04dc9a9a22
commit d56fb93d58
11 changed files with 147 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
src/confix/config.ml Normal file
View File

@ -0,0 +1,71 @@
module Validation = struct
let empty = []
let (&>) report = function None -> report | Some msg -> msg :: report
let (&&>) report = function [] -> report | msgs -> msgs @ report
let check ok msg = if ok then None else Some msg
let file_exists ?(msg=(fun s -> (s ^ " is not a file"))) ?(parent_dir=Fpath.v ".") file =
let str = Fpath.(to_string (parent_dir // file)) in
check (Sys.file_exists str) (msg str)
let is_directory ?(msg=(fun s -> (s ^ " is not a directory"))) dir =
let str = Fpath.to_string dir in
check (Sys.file_exists str && Sys.is_directory str) (msg str)
let files_exist ?(msg=(fun s -> (s ^ " is not a file"))) ?(parent_dir=Fpath.v ".") files =
let f report file = report &> file_exists ~msg ~parent_dir file in
List.fold_left f empty files
let terminate_when_invalid =
let error i msg = prerr_endline ("Error " ^ string_of_int i ^ ": " ^ msg) in
function
| [] -> ()
| msgs -> List.iteri error (List.rev msgs); exit 1
end
module Path = struct
let path_exists x = Fpath.to_string x |> Sys.file_exists
let conventional_paths =
let paths =
try [ "."; Sys.getenv "HOME" ^ "/.config"; "/etc" ]
with Not_found -> [ "."; "/etc" ]
in
List.map Fpath.v paths
let with_file ?(convetional_paths) config_file =
let (//) = Fpath.(//) in
let basepath = Fpath.v config_file in
let existing dir = path_exists (dir // basepath) in
try Ok (List.find existing conventional_paths // basepath)
with Not_found -> Error (config_file ^ " not found in: " ^ String.concat ", " (List.map Fpath.to_string conventional_paths))
end
let with_default default = function Some x -> x | None -> default
let with_default_paths default =
function Some ss -> List.map Fpath.v ss | None -> default
let mandatory = function Some x -> x | None -> failwith "undefined"
let (&>) a b = match a with Ok x -> b x | Error e -> Error e
module type Store = sig
type t
val from_path : Fpath.t -> (t, string) result
end
module Make (S : Store) = struct
include S
let config filename = match Path.with_file filename with
| Ok filepath -> S.from_path filepath
| Error s -> Error s
let (&>) = (&>)
let to_record converter = function
| Ok store -> converter store
| Error s -> Error s
end

23
src/confix/confixToml.ml Normal file
View File

@ -0,0 +1,23 @@
type t = TomlTypes.table
let from_path path =
match Toml.Parser.from_filename (Fpath.to_string path) with
| `Error (str, loc) -> Error str
| `Ok toml -> Ok toml
open TomlLenses
let (/) a b = (key a |-- table |-- key b)
let (//) a b = (key a |-- table |-- key b |-- table)
let int toml path = get toml (path |-- int)
let float toml path = get toml (path |-- float)
let string toml path = get toml (path |-- string)
let strings toml path = get toml (path |-- array |-- strings)
let path toml path = match string toml path with Some s -> Some (Fpath.v s) | None -> None
let paths toml path = match strings toml path with
Some ss -> Some (List.map Fpath.v ss) | None -> None

7
src/confix/jbuild Normal file
View File

@ -0,0 +1,7 @@
(jbuild_version 1)
(library
((name confix)
(public_name logarion.confix)
(libraries (fpath toml))
))

5
src/converters/template.ml
View File

@ -21,9 +21,8 @@ module Configuration = struct
item = None;
}
let of_toml_file toml =
let open Logarion.Config in
let path_tpl = path_opt toml "templates" in
let of_toml toml =
let path_tpl k = Confix.ConfixToml.(path toml ("templates" / k)) in
{
dir = path_tpl "dir";
header = path_tpl "header";

42
src/core/archive.ml
View File

@ -10,33 +10,29 @@ module Configuration = struct
id : Id.t;
}
let default ?(id=(Id.generate ())) () = {
repository = Lpath.repo_of_string (Sys.getcwd ());
title = "Logarion journal";
owner = "";
email = "";
id;
}
let of_config config =
let open Confix in
let open Confix.Config in
let str k = ConfixToml.(string config ("general" / k)) in
try
begin
Ok {
repository = (try Lpath.repo_of_string (str "repository" |> mandatory)
with
| Invalid_argument s -> failwith ("Invalid repository: " ^ s)
| Failure s -> failwith s);
title = str "title" |> with_default "";
owner = str "owner" |> with_default "";
email = str "email" |> with_default "";
id = match Id.of_string (str "uuid" |> mandatory) with Some id -> id | None -> failwith "Invalid UUID in file";
}
end
with Failure str -> Error str
let of_toml_file filename =
let result = Toml.Parser.from_filename (Lpath.string_of_config filename) in
match result with
| `Error (str, loc) -> Error str
| `Ok toml ->
let str = Config.str toml "general" in
let default = default () in
let default_repo = default.repository |> Lpath.string_of_repo in
Ok {
repository = (try Lpath.repo_of_string (str "repository" default_repo) with Invalid_argument s -> failwith ("Invalid repository value: " ^ s));
title = str "title" default.title;
owner = str "owner" default.owner;
email = str "email" default.email;
id = match Id.of_string (str "uuid" "") with Some id -> id | None -> failwith "Invalid UUID in config file";
}
let validity config =
let repo = Lpath.fpath_of_repo config.repository in
let open Config.Validation in
let open Confix.Config.Validation in
empty
&> is_directory repo
end

67
src/core/config.ml
View File

@ -1,67 +0,0 @@
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
let strs_opt toml table_name key_name =
get toml (key table_name |-- table |-- key key_name |-- array |-- strings)
let strs toml table_name key_name default =
match strs_opt toml table_name key_name with
Some ss -> ss | None -> default
let path_opt toml table_name key_name =
match str_opt toml table_name key_name with
Some s -> Some (Fpath.v s) | None -> None
let path toml table_name key_name default =
match str_opt toml table_name key_name with
Some s -> Fpath.v s | None -> default
let paths_opt toml table_name key_name =
match strs_opt toml table_name key_name with
Some ss -> Some (List.map Fpath.v ss) | None -> None
let paths toml table_name key_name default =
match strs_opt toml table_name key_name with
Some ss -> List.map Fpath.v ss | None -> default
module Validation = struct
let empty = []
let (&>) report = function None -> report | Some msg -> msg :: report
let (&&>) report = function [] -> report | msgs -> msgs @ report
let check ok msg = if ok then None else Some msg
let file_exists ?(msg=(fun s -> (s ^ " is not a file"))) ?(parent_dir=Fpath.v ".") file =
let str = Fpath.(to_string (parent_dir // file)) in
check (Sys.file_exists str) (msg str)
let is_directory ?(msg=(fun s -> (s ^ " is not a directory"))) dir =
let str = Fpath.to_string dir in
check (Sys.file_exists str && Sys.is_directory str) (msg str)
let files_exist ?(msg=(fun s -> (s ^ " is not a file"))) ?(parent_dir=Fpath.v ".") files =
let f report file = report &> file_exists ~msg ~parent_dir file in
List.fold_left f empty files
let terminate_when_invalid =
let error i msg = prerr_endline ("Error " ^ string_of_int i ^ ": " ^ msg) in
function
| [] -> ()
| msgs -> List.iteri error (List.rev msgs); exit 1
end

2
src/core/jbuild
View File

@ -3,5 +3,5 @@
(library
((name logarion)
(public_name logarion)
(libraries (batteries toml omd fpath ptime lwt uuidm uri re))
(libraries (batteries confix omd fpath ptime lwt uuidm uri re))
))

14
src/core/lpath.ml
View File

@ -5,24 +5,10 @@ type config_t = Config of t
let extension = ".ymd"
let path_exists x = to_string x |> Sys.file_exists
let config_of_string s = Config (of_string s |> function Ok p -> p | _ -> invalid_arg "Config")
let fpath_of_config = function Config c -> c
let string_of_config c = fpath_of_config c |> to_string
let config_paths =
let paths =
try [ "."; Sys.getenv "HOME" ^ "/.config/logarion/"; "/etc/logarion/" ]
with Not_found -> [ "."; "/etc/logarion/" ] in
List.map v paths
let from_config_paths config_file =
let basepath = v config_file in
let existing dir = path_exists (dir // basepath) in
try Ok (Config (List.find existing config_paths // basepath))
with Not_found -> Error (config_file ^ " not found in: " ^ String.concat ", " (List.map to_string config_paths))
let fpath_of_repo = function Repo p -> p
let string_of_repo r = fpath_of_repo r |> to_string
let repo_of_string s = Repo (v s)

4
src/jbuild
View File

@ -4,10 +4,10 @@
((name logarion_cli)
(public_name logarion_cli)
(modules logarion_cli)
(libraries (logarion logarion.file lwt.unix re.str cmdliner))))
(libraries (logarion logarion.confix logarion.file lwt.unix re.str cmdliner))))
(executable
((name logarion_webserver)
(public_name logarion_webserver)
(modules logarion_webserver)
(libraries (logarion logarion.converters lwt.unix opium uri re.str tyxml))))
(libraries (logarion logarion.confix logarion.converters lwt.unix opium uri re.str tyxml))))

10
src/logarion_cli.ml
View File

@ -4,11 +4,11 @@ module C = Archive.Configuration
module Lpath = Logarion.Lpath
let conf () =
let result = match Lpath.from_config_paths "logarion.toml" with
| Ok filepath -> C.of_toml_file filepath
| Error str -> Error str
in
match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
let module Config = Confix.Config.Make (Confix.ConfixToml) in
let archive_res = Config.config "logarion.toml" |> Config.to_record C.of_config in
match archive_res with
| Ok config -> config
| Error str -> prerr_endline str; exit 1
let init =
let f force =

43
src/logarion_webserver.ml
View File

@ -18,22 +18,20 @@ module Configuration = struct
template = Template.Configuration.default_paths;
}
let of_toml_file fn =
let result = Toml.Parser.from_filename (Lpath.string_of_config fn) in
match result with
| `Error (str, loc) -> Error str
| `Ok toml ->
let default_url = Uri.to_string default.url in
let open Logarion.Config in
Ok {
url = str toml "general" "url" default_url |> Uri.of_string;
static = path toml "general" "static_dir" default.static;
styles = paths toml "general" "stylesheets" default.styles;
template = Template.Configuration.of_toml_file toml
}
let of_toml toml =
let open Confix.Config in
let open Confix.ConfixToml in
try
Ok {
url = string toml ("general" / "url" ) |> mandatory |> Uri.of_string;
static = path toml ("general" / "static_dir" ) |> mandatory;
styles = paths toml ("general" / "stylesheets") |> mandatory;
template = Template.Configuration.of_toml toml;
}
with Failure str -> Error str
let validity config =
let open Logarion.Config.Validation in
let open Confix.Config.Validation in
empty
&> is_directory config.static
&&> files_exist ~parent_dir:config.static config.styles
@ -57,24 +55,17 @@ let () =
let module L = Logarion in
Random.self_init();
let module Config = Confix.Config.Make (Confix.ConfixToml) in
let config =
let result = match Lpath.from_config_paths "logarion.toml" with
| Ok filepath -> L.Archive.Configuration.of_toml_file filepath
| Error s -> Error s
in
match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
match Config.(config "logarion.toml" &> L.Archive.Configuration.of_config)
with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
in
let web_config =
let result = match Lpath.from_config_paths "web.toml" with
| Ok filepath -> Configuration.of_toml_file filepath
| Error s -> Error s
in
match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
match Config.(config "web.toml" &> Configuration.of_toml)
with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
in
Logarion.Config.Validation.terminate_when_invalid (Configuration.validity web_config);
Logarion.Config.Validation.terminate_when_invalid (L.Archive.Configuration.validity config);
let module L = Logarion.Archive.Make(File) in
let store = File.store config.repository in
let lgrn = L.{ config; store; } in