83 lines
2.8 KiB
OCaml
83 lines
2.8 KiB
OCaml
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 ?(print_error=true) =
|
|
let error i msg = prerr_endline ("Error " ^ string_of_int i ^ ": " ^ msg) in
|
|
function
|
|
| [] -> ()
|
|
| msgs -> if print_error then List.iteri error (List.rev msgs); exit 1
|
|
end
|
|
|
|
module Path = struct
|
|
let of_string str =
|
|
if Sys.file_exists str then
|
|
match Fpath.v str with
|
|
| path -> Ok path
|
|
| exception (Invalid_argument msg) -> Error ("Invalid path " ^ msg)
|
|
else Error (str ^ " not found")
|
|
|
|
let path_exists x = Fpath.to_string x |> Sys.file_exists
|
|
|
|
let conventional_paths =
|
|
let paths =
|
|
try [ ".logarion"; Sys.getenv "HOME" ^ "/.config/logarion"; "/etc/logarion" ]
|
|
with Not_found -> [ ".logarion"; "/etc/logarion" ]
|
|
in
|
|
List.map Fpath.v paths
|
|
|
|
let with_file ?(conventional_paths=conventional_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 mandatory setting"
|
|
|
|
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 of_path path = S.from_path path
|
|
|
|
let (&>) = (&>)
|
|
|
|
let to_record converter = function
|
|
| Ok store -> converter store
|
|
| Error s -> Error s
|
|
|
|
let to_record_or_exit ?(print_error=true) ?(validator=(fun _cfg -> [])) converter store_result =
|
|
match to_record converter store_result with
|
|
| Ok cfg -> Validation.terminate_when_invalid (validator cfg); cfg
|
|
| Error s -> if print_error then prerr_endline s; exit 1
|
|
end
|