1:- module(execution_context, [
2 context_variable/3, % +Name:atom, +Type, +Options:list
3 context_variable_value/2, % +Variable, -Value
4 option_or_context_variable/2 % @Option, +Options
5]).12:- use_module(library(dcg/basics)). 13:- use_module(library(option)). 14:- use_module(library(pure_input)). 15 16:- dynamic 17 configuration/2, 18 context_variable_def/3, 19 variable_cache/2. 20 21:- meta_predicate 22 context_variable(, , ), 23 context_variable_value(,), 24 option_or_context_variable(,). 25 26:- multifile 27 context_variable/3. 28 29user:file_search_path(config, '.'). 30user:file_search_path(config, './config'). 31 32:- create_prolog_flag(environment, production, [type(atom)]). 33:- initialization(set_prolog_flag(environment, production), prepare_state). 34:- set_prolog_flag(environment, development). 35 36%%% PUBLIC PREDICATES %%%%%%%%%%%%%%%%%%%%%%%%%%%
Type can be one of the atom, bool, number, string, list, list(atom), list(number).
in case of list types, the list can be specified as a list of atoms or numbers separate by comma (,)
or semicolon, and optionally enclosed into parenthesis or brackets (e.g. [ a, b,c, e],
or (1;2; 3 ; 4), or o, p ; q, r ) will work. Elements in the list are trimmed of left and right spaces.
Options can be one of:
describe(Message) - provides human readable information about the command that is printed when
the CLI help is invoked (for cli options).long(Long) - specifies the long name of the command line parameter prefixed with two dashes. If not provided then the
Long name is assumed to be based on the name with characters ' ', '_', ':' replaced by the dash. Value of the
variable can be either concatenated into argument with '=' character, or separated by space. For example if the long(some_option)
is given then the argument `--some-option=value`, or `--some-option value` will both assign value to context variable of the Name.short(Short) - specifies short variant of the command line argument prefixed by '-'. Value must be provided after the space. For
example if the option short(s) is given then the argument `-s value` will assign 'value' to context variable of the Nameis_flag(Bool) - if Bool is true, then the system recognize the options with out value and `--no-long options, where long` correspnds to the
long(Atom) option value. Variables of type bool are implicitly considered to be flagsenv(EnvName) - specifies the name of the environment variable to check for the value of the context variable. If not provided then the
EnvName name is assumed to be based on the name with characters ' ', '_', ':' replaced by the undescore.default(Value) - Specifies the default values if no other means provides a value. If the Value is of the form context(Variable), then
context variable Variable is evaluated for the default value. Infinite dependency cycles are not resolved, so be carefull here.cli_command(Commands) - Commands is list of CLI commands (see execute_cli/1), for which the variable is intended. This information
is only used to describe usage of the command. Either option short or `long˙, and option `describe˙ must be provided to provide any
help information about the variable. The option cli_command([]) is interpreted as the option for all CLI commands.66context_variable(Name, bool, Options) :- 67 retractall(context_variable_def(Name,_,_)), 68 assert(context_variable_def(Name, bool, [is_flag(true)|Options])), 69 !. 70context_variable(Name, Type, Options) :- 71 retractall(context_variable_def(Name,_,_)), 72 assert(context_variable_def(Name, Type, Options)).
To resolve the contextual variable following steps are executed. The first step that succed will determine the Value
config.env files are looked up in the file search paths defined as
config(config.env). This module resolves config path to the current working directory or into the config directory of the current working
directory. The name variants are provided by the options of the predicate context_variable/2 or derived from the context variable
name.
91context_variable_value(Variable, Value) :-
92 context_variable_def(Variable, Type, Options),
93 once(resolve_context_variable(Variable, ValueAtom, Options)),
94 once(adapt_type(ValueAtom, Type, Value)).context_variable(OptionFunctor, OptionArg).
Options are checked for the module specific or local name of the option.99option_or_context_variable(Option, Options):- 100 option(Option, Options), 101 !. 102 option_or_context_variable( Option, Options):- 103 Option =.. [ ':', _, LocalOption ], 104 option( LocalOption, Options), 105 !. 106option_or_context_variable( Option, _) :- 107 Option =.. [':', Module, LocalOption], 108 LocalOption =.. [ Var, Value], 109 context_variable_value(Module:Var, Value). 110 111%%% PRIVATE PREDICATES %%%%%%%%%%%%%%%%%%%%%%%%% 112 113adapt_type(Value, atom, Value). 114 adapt_type(Value, bool, true) :- 115 downcase_atom(Value, Lower), 116 memberchk(Lower, [true, yes, '1', t, y, ok, positive]), 117 !. 118 adapt_type(_, bool, false). 119 adapt_type(Atom, number, Value) :- 120 atom_number(Atom, Value). 121 adapt_type(Atom, string, Value) :- 122 atom_string(Atom, Value). 123 adapt_type(Atom, list, Value) :- 124 adapt_type(Atom, list(atom), Value). 125 adapt_type(Atom, list(atom), Value) :- 126 atom_codes(Atom, Codes), 127 phrase(value_list_grammar(Value), Codes). 128 adapt_type(Atom, list(number), Value) :- 129 adapt_type(Atom, list(atom), Atoms), 130 maplist(atom_number, Atoms, Value). 131 132 133comment --> 134 "#", 135 string(_), 136 nl. 137 138config([], Variable, Value) --> 139 { 140 atom_codes(VariableName, Variable), 141 atom_codes(ValueName, Value), 142 ( 143 retract(configuration(VariableName,_)), 144 fail 145 ; 146 true 147 ), 148 assertz(configuration(VariableName, ValueName)) 149 }. 150 config(Module, Variable, Value) --> 151 { 152 atom_codes(ModuleName, Module), 153 atom_codes(VariableName, Variable), 154 ( 155 Value == true 156 -> ValueName = true 157 ; atom_codes(ValueName, Value) 158 ), 159 ( 160 retract(configuration(ModuleName:VariableName,_)), 161 fail 162 ; 163 true 164 ), 165 assertz(configuration(ModuleName:VariableName, ValueName)) 166 }. 167 168empty_line --> 169 whites, 170 nl. 171 172env_grammar --> eos. 173env_grammar --> 174 env_line, 175 env_grammar. 176 177env_line --> 178 comment, 179 !. 180 env_line --> 181 empty_line, 182 !. 183 env_line --> 184 module(Module), 185 string_without("=\r\n", Variable), 186 "=", 187 string(Value), 188 whites, 189 nl, 190 config(Module, Variable, Value), 191 !. 192 env_line --> 193 module(Module), 194 string_without("\r\n", Variable), 195 whites, 196 nl, 197 config(Module, Variable, true), 198 !. 199 200default_codes([], _, []) :- !. 201 default_codes([I|In], C, [O|Out]) :- 202 ( 203 member(I, [0' ,0'-, 0'_, 0'.]) 204 -> O = C 205 ; O = I 206 ), 207 default_codes(In, C, Out). 208 209default_name(Module:Variable, Separator, DefaultName) :- 210 atomic_list_concat([Module, Variable], ' ', Default0), 211 atom_codes(Default0, Codes0), 212 atom_codes(Separator, [CodesSep|_]), 213 default_codes(Codes0, CodesSep, Codes1), 214 atom_codes(DefaultName, Codes1). 215 216find_argv([Arg| _], Long, _, true, false) :- 217 atom_concat('--no-', Long, Arg). 218 find_argv([Arg| _], Long, _, true, true) :- 219 atom_concat('--', Long, Arg). 220 find_argv([Arg| _], _, Short, true, true) :- 221 Short \= [], 222 atom_codes( Arg, ArgCodes), 223 ArgCodes \= [ 0'-, 0'- | _ ], 224 ArgCodes = [ 0'- | _ ], 225 atom_codes(Short, [Code|_]), 226 memberchk(Code, ArgCodes). 227 find_argv([Arg| _], Long, _, _, Value) :- 228 atomic_list_concat(['--', Long, '='], ArgPrefix), 229 atom_concat(ArgPrefix, Value, Arg). 230 find_argv([Arg, Value| _], Long, _, false, Value) :- 231 atom_concat('--', Long, Arg). 232 find_argv([Arg, Value| _], _, Short, false, Value) :- 233 Short \= [], 234 atom_concat('-', Shorts, Arg), 235 \+ atom_concat('-', _, Shorts), 236 atom_concat(_, Short, Shorts). 237 find_argv([_| Args], Long, Short, IsFlag, Value) :- 238 find_argv(Args, Long, Short, IsFlag, Value). 239 240load_configurations :- 241 abolish_module_tables(execution_context), 242 retractall(variable_cache(_,_)), 243 retractall(configuration(_,_)), 244 load_configuration(config('config.env')), 245 ( current_prolog_flag(environment, development) 246 -> load_configuration(project('config/config.dev.env')), 247 load_configuration(project('config/config.user.env')) 248 ; true 249 ), 250 !. 251 252load_configuration(File) :- 253 absolute_file_name(File, AbsolutePath), 254 exists_file(AbsolutePath), 255 print_message(informational, format('Configurations loaded from the file ~w', [AbsolutePath])), 256 setup_call_cleanup( 257 open(AbsolutePath, read, Stream, [encoding(utf8)]), 258 phrase_from_stream(env_grammar, Stream), 259 close(Stream)). 260 load_configuration(_). 261 262module(Module) --> 263 string_without("\n\r:=", Module), 264 ":", 265 !. 266 module([]) --> []. 267 268nl --> "\r\n". 269 nl --> "\n". 270 nl --> eos. 271 272resolve_default(Module:_, Value, Options) :- 273 option(default(context(ForwardVariable)), Options), 274 ForwardVariable \= :(_,_), 275 context_variable_value(Module:ForwardVariable, Value). 276 resolve_default(_, Value, Options) :- 277 option(default(context(Module:ForwardVariable)), Options), 278 context_variable_value(Module:ForwardVariable, Value). 279 280 resolve_default(_, Value, Options) :- 281 option(default(Default), Options), 282 Default \= context(_), 283 format(atom(Value), '~w', Default). 284 285 286resolve_command_line(Variable, Value, Options):- 287 current_prolog_flag(os_argv, Argv), 288 option(is_flag(IsFlag), Options, false), 289 option(short(Short), Options, []), 290 default_name(Variable, '-', DefaultLong), 291 option(long(Long), Options, DefaultLong), 292 find_argv(Argv, Long, Short, IsFlag, Value). 293 294resolve_configuration(Variable, Value, _) :- 295 configuration(Variable, Value). 296 resolve_configuration(_, Value, Options) :- 297 option(env(EnvName), Options), 298 configuration(EnvName, Value). 299 300resolve_context_variable(Variable, Value, Options) :- 301 variable_cache(Variable, Value) 302 -> true 303 ; ( 304 resolve_command_line(Variable, Value, Options) 305 ; 306 resolve_environment(Variable, Value, Options) 307 ; 308 resolve_configuration(Variable, Value, Options) 309 ; 310 resolve_default(Variable, Value, Options) 311 ), 312 asserta(variable_cache(Variable, Value)). 313 314resolve_environment(Variable, Value, Options) :- 315 default_name(Variable, '_', DefaultName), 316 option(env(EnvName), Options, DefaultName), 317 getenv(EnvName, Value). 318 319 320value_list_close --> whites, ("]" ; ")" ; []), whites, !. 321 322 323value_list_element(Element) --> 324 whites, 325 string(String), 326 whites, 327 { atom_codes(Element, String)}. 328 329value_list_elements([Element|List]) --> 330 value_list_element(Element), 331 value_list_separator, 332 value_list_elements(List). 333 value_list_elements([Element]) --> 334 value_list_element(Element). 335 336 337value_list_grammar(List) --> 338 value_list_open, 339 value_list_elements(List), 340 value_list_close. 341 value_list_grammar([]) --> 342 value_list_open, 343 value_list_close. 344 345value_list_open --> whites, ("[" ; "(" ; []), !. 346 347value_list_separator --> ",". 348value_list_separator --> ";". 349 350:- initialization(load_configurations).