source: code/trunk/src/confix/config.ml@ 1

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