1:- encoding(utf8).
    2:- module(
    3  conf,
    4  [
    5    cli_argument/2,   % +Key, -Value
    6    cli_argument/3,   % +Key, +Default, -Value
    7    cli_arguments/1,  % -Conf
    8    cli_arguments/2,  % +FlagMap, -Conf
    9    cli_arguments/3,  % +Argv, +FlagMap, -Conf
   10    conf_json/1,      % -Conf
   11    conf_json/2,      % +Key, -Value
   12    data_directory/1, % -Directory
   13    data_file/1,      % -AbsolutePath
   14    data_file/2       % +RelativePath, -AbsolutePath
   15  ]
   16).

Configuration support

This module is typically used in the following way:

:- initialization
   conf_json(Conf),
   configure_your_application(Conf).

or

:- initialization
   conf_json('my-application', Conf),
   configure_your_application(Conf).

The configuration file location can be supplied from the command line by using the following flag. If no location is supplied, the default configuration file location is used, i.e., `~/conf.json'.

--conf=$(FILE)

*/

   47:- use_module(library(apply)).   48:- use_module(library(error)).   49:- use_module(library(lists)).   50:- use_module(library(uuid)).   51
   52:- use_module(library(dcg)).   53:- use_module(library(dict)).   54:- use_module(library(file_ext)).   55:- use_module(library(json_ext)).
 cli_argument(+Key:atom, -Value:term) is semidet
   63cli_argument(Key, Value) :-
   64  cli_arguments(Conf),
   65  dict_get(Key, Conf, Value).
 cli_argument(+Key:atom, +Default:term, -Value:term) is det
   71cli_argument(Key, Default, Value) :-
   72  cli_arguments(Conf),
   73  dict_get(Key, Conf, Default, Value).
 cli_arguments(-Conf:dict) is det
 cli_arguments(+FlagMap:list(pair(atom,atom)), -Conf:dict) is det
 cli_arguments(+Argv:list(atom), +FlagMap:list(pair(atom,atom)), -Conf:dict) is det
   81cli_arguments(Conf) :-
   82  current_prolog_flag(argv, Argv),
   83  cli_arguments(Argv, [], Conf).
   84
   85cli_arguments(FlagMap, Conf) :-
   86  current_prolog_flag(argv, Argv),
   87  cli_arguments(Argv, FlagMap, Conf).
   88
   89cli_arguments(Argv, FlagMap, Conf) :-
   90  maplist(cli_argument_(FlagMap), Argv, Pairs1),
   91  keysort(Pairs1, Pairs2),
   92  group_pairs_by_key(Pairs2, GroupedPairs1),
   93  maplist(remove_singleton_value_, GroupedPairs1, GroupedPairs2),
   94  dict_pairs(Conf, GroupedPairs2).
   95
   96remove_singleton_value_(Key-[Value], Key-Value) :- !.
   97remove_singleton_value_(Pair, Pair).
   98
   99cli_argument_(Map, Flag, Arg) :-
  100  atom_phrase(cli_flag_(Map, Arg), Flag), !.
  101cli_argument_(_, Arg, positional-Arg).
  102
  103cli_flag_(Map, Key-Value) -->
  104  (   "--"
  105  ->  '...'(Codes),
  106      "=",
  107      {atom_codes(Key, Codes)}
  108  ;   "-"
  109  ->  '...'(Codes),
  110      "=",
  111      {
  112        atom_codes(Short, Codes),
  113        memberchk(Short-Key, Map)
  114      }
  115  ), !,
  116  remainder_as_atom(Value).
  117cli_flag_(Map, Key-true) -->
  118  (   "--"
  119  ->  remainder_as_atom(Key)
  120  ;   "-"
  121  ->  remainder_as_atom(Short),
  122      {memberchk(Short-Key, Map)}
  123  ).
 conf_json(-Conf:dict) is semidet
Read a dictionary with configuration information from a file whose FILE name is supplied as a command-line argument of the form `--conf=FILE`.
throws
- existence_error/1 if no configuration file exists.
  135conf_json(Conf) :-
  136  conf_file(File), !,
  137  json_load(File, Conf).
  138conf_json(_) :-
  139  throw(error(existence_error(conf_file),conf_json/1)).
  140
  141conf_file(File) :-
  142  conf_file_spec(Spec),
  143  expand_file_name(Spec, Files),
  144  member(File, Files),
  145  access_file(File, read), !.
  146
  147% Specified in a command-line argument.
  148conf_file_spec(Spec) :-
  149  cli_argument(conf, Spec), !.
  150% Present in the directory from which the program was started.
  151conf_file_spec('conf.json').
  152% Present in the home directory of the current user.
  153conf_file_spec('~/conf.json').
 conf_json(+Key:atom, -Value:atom) is semidet
Like conf_json/1, but only returns that part of the configuration that resides underneath the given Key.
throws
- existence_error/1 if no configuration files exists.
- existence_error/2 if Key does not occur in the configuration file.
  166conf_json(Key, Value) :-
  167  conf_json(Conf),
  168  dict_get(Key, Conf, Value), !.
  169conf_json(Key, _) :-
  170  existence_error(conf_key, Key).
 data_directory(-Directory:atom) is semidet
  176data_directory(Dir) :-
  177  conf_json('data-directory', Dir), !.
  178data_directory(_) :-
  179  existence_error(config, data_directory).
 data_file(-AbsolutePath:atom) is multi
  185data_file(File) :-
  186  uuid(Local),
  187  data_file(Local, File).
 data_file(+RelativePath:atom, -AbsolutePath:atom) is det
  193data_file(RelativePath, AbsolutePath) :-
  194  data_directory(Dir),
  195  absolute_file_name(RelativePath, AbsolutePath, [relative_to(Dir)]),
  196  create_file_directory(AbsolutePath).
  197
  198
  199
  200
  201
  202% MESSAGES %
  203
  204:- multifile
  205    prolog:error_message//1.  206
  207prolog:error_message(cannot_find_cli_argument(Key)) -->
  208  ['Cannot find CLI argument ‘--~a="VALUE"’.'-[Key]].
  209prolog:error_message(cannot_find_configuration(Key)) -->
  210  ["Cannot find the configuration section for ‘~a’."-[Key]]