hop-2012/server/config.ml

83 lines
2.5 KiB
OCaml

(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
(* This file is part of Hop. *)
(* Hop is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License as published by the *)
(* Free Software Foundation, either version 3 of the License, or (at your *)
(* option) any later version. *)
(* Hop is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* General Public License for more details. *)
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see <http://www.gnu.org/licenses/>. *)
open Hof
let config = ref (Json.Rec ["config-file", Json.Str "hop.config"])
let get key =
try Some (Json.lookup_str key !config) with Not_found -> None
let get' key default_value =
try (Json.lookup_str key !config) with Not_found -> default_value
let get_str key default_value =
match get key with
| Some (Json.Str s) -> s
| _ -> default_value
let get_num key default_value =
match get key with
| Some (Json.Num n) -> n
| _ -> default_value
let get_int key default_value =
match get key with
| Some (Json.Num n) -> int_of_float n
| _ -> default_value
let get_bool key default_value =
match get key with
| Some v -> Json.truish v
| _ -> default_value
let conditional key default_value f =
if get_bool key default_value
then f () else Lwt.return ()
let set k v =
config := Json.update_str k v !config
let init () =
let argv = Sys.argv in
let argc = Array.length argv in
let rec loop index current_key =
if index >= argc
then ()
else
(let opt = argv.(index) in
if Util.starts_with opt "--"
then loop (index + 1) (String.sub opt 2 (String.length opt - 2))
else
let v = (try Json.of_string opt with _ -> Json.Str opt) in
ignore (Log.info "Setting command-line parameter" [Sexp.str current_key; Sexpjson.sexp_of_json v]);
set current_key v;
loop (index + 1) current_key)
in
loop 1 "";
(match get "config-file" with
| Some (Json.Str config_filename) ->
ignore (Log.info "Reading configuration file" [Sexp.str config_filename]);
let file_config = try Json.load config_filename with Sys_error _ -> Json.Rec [] in
config := Json.merge_right file_config !config
| _ ->
ignore (Log.info "No configuration file" []);
());
if Json.truish_some (get "dump-config")
then print_endline (Json.pretty_string !config)
else ()