215:- flag_define/2
flag_define/5
flag_define/7
flag_set/2
flag_set/3
flag_unsafe_set/2
flag_get/2
flags_reset/0
flags_reset/1
flags_save/1
flags_load/1
flag_groups/1
flag_group_chk/1
flag_help/0
flags_print/0
defined_flag/7
module(flags, [,
247:-
'$defined_flag$'/7
'$store_flag_value$'/2
dynamic([, ]).
248:-
meta_predicate(flag_define(+, +, +, ?, ?, ?,
:)).
249:-
meta_predicate(flag_define(+,
:)).
250:-
meta_predicate(validate(+, :, ?,
+)).
253flag_define(
FlagName,
InputOptions)
:-
254 strip_module(
InputOptions,
Module,
UserOptions),
255 Defaults = [
flag_group(general),
flag_type(nonvar),
default_value(true),
description(
FlagName),
access(read_write),
handler(true)],
256 append(
UserOptions,
Defaults,
Options),
257 memberchk(flag_group(
FlagGroup),
Options),
259 memberchk(default_value(
DefaultValue),
Options),
260 memberchk(description(
Description),
Options),
263 flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler).
265flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description)
:-
266 flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description, read_write, true).
268flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
MHandler)
:-
269 strip_module(
MHandler,
Module,
Handler),
275 (
\+ atom(
FlagName)
->
276 throw(error(type_error(atom,
FlagName), message(
'Flag name needs to be an atom.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
277 ; \+ atom(
FlagGroup)
->
278 throw(error(type_error(atom,
FlagGroup), message(
'Flag group needs to be an atom.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
279 ; \+ flag_type(
FlagType)
->
280 throw(error(domain_error(flag_type,
FlagType), message(
'Unknown flag type.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Module:Handler))))
281 ; \+ validate_type(
FlagType)
->
282 throw(error(evaluation_error(type_validation), message(
'Validation of flag type failed, check custom domain.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
283 ; '$defined_flag$'(
FlagName,
_FlagGroup,
_FlagType,
_DefaultValue,
_Description,
_Access,
_Handler)
->
284 throw(error(permission_error(create, flag,
FlagName), message(
'Re-defining a flag is not allowed.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
285 ; \+ memberchk(
Access, [read_write, read_only, hidden, hidden_read_only]),
286 throw(error(domain_error(access,
Access), message(
'Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
288 throw(error(type_error(callable,
Handler), message(
'Flag handler needs to be callable.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler))))
290 validate(
FlagType,
Module:Handler,
DefaultValue,
FlagName),
291 assertz(
'$defined_flag$'(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Module:Handler)),
292 assertz(
'$store_flag_value$'(
FlagName,
DefaultValue)),
296 call(
Module:Handler, stored,
DefaultValue)
299flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler)
:-
300 throw(error(instantiation_error, message(
'Flag name, group, type, access and handler need to be instantiated.', flag_define(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler)))).
302flag_groups(
FlagGroups)
:-
303 all(
FlagGroup, (
'$defined_flag$'(
_FlagName,
FlagGroup,
_FlagType,
_DefaultValue,
_Description,
Access,
_Handler),
Access \== hidden,
Access \== hidden_read_only),
FlagGroups).
305flag_group_chk(
FlagGroup)
:-
307 '$defined_flag$'(
_FlagName,
FlagGroup,
_FlagType,
_DefaultValue,
_Description,
_Access,
_Handler),
'$defined_flag$'.
323flags_type_definition(in_interval(
Type,
Interval), in_interval(
Type,
Interval), in_interval(
Type,
Interval)).
324flags_type_definition(integer_in_interval(
Interval), in_interval(integer,
Interval), in_interval(integer,
Interval)).
328flags_type_definition(float_in_interval(
Interval), in_interval(float,
Interval), in_interval(float,
Interval)).
332flags_type_definition(number_in_interval(
Interval), in_interval(number,
Interval), in_interval(number,
Interval)).
343in_domain(
Domain,
Value)
:-
347in_interval(
Type,
Interval)
:-
350 in_interval_conj(
Type,
Interval).
351in_interval(
Type,
Interval)
:-
352 in_interval_single(
Type,
Interval).
354in_interval_conj(
_Type, []).
355in_interval_conj(
Type, [
Interval|Rest])
:-
356 in_interval_single(
Type,
Interval),
357 in_interval_conj(
Type,
Rest).
359in_interval_single(
Type, ([
Min], [
Max]))
:-
360 in_interval_single,
call(
Type,
Min),
364in_interval_single(
Type, ([
Min],
Max))
:-
365 in_interval_single,
call(
Type,
Min),
366 type_or_inf(
Type,
Max),
369in_interval_single(
Type, (
Min, [
Max]))
:-
370 in_interval_single,
type_or_inf(
Type,
Min),
374in_interval_single(
Type, (
Min,
Max))
:-
375 type_or_inf(
Type,
Min),
376 type_or_inf(
Type,
Max),
380type_or_inf(
Type,
Value)
:-
383type_or_inf(
Type,
Value)
:-
386type_or_inf(
Type,
Value)
:- call(
Type,
Value).
388in_interval(
Type, [
Interval|_Rest],
Value)
:-
389 in_interval(
Type,
Interval,
Value),
in_interval.
390in_interval(
Type, [
_Interval|Rest],
Value)
:-
391 in_interval(
Type,
Rest,
Value).
393in_interval(
Type, ([
Min], [
Max]),
Value)
:-
394 in_interval,
call(
Type,
Value),
398in_interval(
Type, ([
Min],
Max),
Value)
:-
399 in_interval,
call(
Type,
Value),
403in_interval(
Type, (
Min, [
Max]),
Value)
:-
404 in_interval,
call(
Type,
Value),
408in_interval(
Type, (
Min,
Max),
Value)
:-
417validate(
FlagType,
Handler,
Value,
FlagName)
:-
418 strip_module(
Handler,
_Module, true),
420 (
call(
FlagValidator,
Value)
->
423 throw(error(validation_error(
FlagType,
Value), message(
'Validation of value fails.', validate(
FlagType,
Value,
FlagName))))
425validate(
FlagType,
Handler,
Value,
FlagName)
:-
427 ((
call(
Handler, validating,
Value), (
call(
FlagValidator,
Value)
; call(
Handler, validate,
Value)))
->
428 call(
Handler, validated,
Value)
430 throw(error(validation_error(
FlagType,
Value), message(
'Validation of value fails.', validate(
FlagType,
Handler,
Value,
FlagName))))
433flag_set(
FlagName,
FlagValue)
:-
434 flag_set(
FlagName,
_OldValue,
FlagValue).
435flag_set(
FlagName,
OldValue,
FlagValue)
:-
437 '$defined_flag$'(
FlagName,
_FlagGroup,
FlagType,
_DefaultValue,
_Description,
Access,
Module:Handler),
'$defined_flag$',
438 (
Access \== read_only,
Access \== hidden_read_only
->
439 validate(
FlagType,
Module:Handler,
FlagValue,
FlagName),
440 retract(
'$store_flag_value$'(
FlagName,
OldValue)),
441 assertz(
'$store_flag_value$'(
FlagName,
FlagValue)),
445 call(
Module:Handler, stored,
FlagValue)
448 throw(error(permission_error(set, flag,
FlagName), message(
'Setting the flag value is not allowed.',flag_set(
FlagName,
OldValue,
FlagValue))))
450flag_set(
FlagName,
OldValue,
FlagValue)
:-
451 throw(error(existence_error(flag,
FlagName), message(
'The flag is not defined.', flag_set(
FlagName,
OldValue,
FlagValue)))).
453flag_unsafe_set(
FlagName,
FlagValue)
:-
454 retract(
'$store_flag_value$'(
FlagName,
_)),
455 assertz(
'$store_flag_value$'(
FlagName,
FlagValue)).
457flag_get(
FlagName,
FlagValue)
:-
458 \+ '$store_flag_value$'(
FlagName,
_),
459 throw(error(existence_error(flag,
FlagName), message(
'The flag is not defined.', flag_get(
FlagName,
FlagValue)))).
460flag_get(
FlagName,
FlagValue)
:-
461 '$store_flag_value$'(
FlagName,
FlagValue).
463'$store_flag_value$'
:-
465 '$defined_flag$'(
FlagName,
_FlagGroup,
_FlagType,
DefaultValue,
_Description,
_Access,
Module:Handler),
466 assertz(
'$store_flag_value$'(
FlagName,
DefaultValue)),
470 call(
Module:Handler, stored,
DefaultValue)
475flags_reset(
FlagGroup)
:-
476 '$defined_flag$'(
FlagName,
FlagGroup,
_FlagType,
DefaultValue,
_Description,
_Access,
Module:Handler),
477 retractall(
'$store_flag_value$'(
FlagName,
_)),
478 assertz(
'$store_flag_value$'(
FlagName,
DefaultValue)),
482 call(
Module:Handler, stored,
DefaultValue)
487flags_save(
FileName)
:-
489 catch((
'$store_flag_value$'(
FlagName,
Value),
490 write_canonical(
'$store_flag_value$'(
FlagName,
Value)),
492 Exception, clean_and_throw(told,
Exception)),
494flags_save(
_FileName)
:-
497flags_load(
FileName)
:-
499 catch((read(
'$store_flag_value$'(
FlagName,
Value)),
500 flag_set(
FlagName,
Value)),
501 Exception, clean_and_throw(seen,
Exception)),
503flags_load(
_FileName)
:-
506clean_and_throw(
Action,
Exception)
:-
511 format(
'This is a short tutorial for the flags library.~nExported predicates:~n'),
512 format(
' flag_define/5 : defines a new flag without a handler~n'),
513 format(
' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description)~n'),
514 format(
' flag_define/6 : defines a new flag with a handler~n'),
515 format(
' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Handler)~n'),
516 format(
' FlagName : the name of the flag~n'),
517 format(
' FlagGroup : the name of the flag group~n'),
518 format(
' FlagType : the type of the flag available types are:~n'),
520 format(
' DefaultValue : the default value for the flag~n'),
521 format(
' Description : a flag description~n'),
522 format(
' Handler : a handler~n'),
524 format(
' flag_groups/1 : returns all the flag groups in a list~n'),
525 format(
' flag_group_chk/1 : checks if a group exists~n'),
526 format(
' flag_set/2 : sets the value of a flag~n'),
527 format(
' flag_get/2 : gets the value of a flag~n'),
528 format(
' flag_store/2 : sets the value of a flag ignoring all tests and handlers~n'),
529 format(
' flag_reset/0 : resets all flags to their default value~n'),
530 format(
' flag_reset/1 : resets all flags of a group to their default value~n'),
531 format(
' flag_help/0 : this screen~n'),
532 format(
' flags_print/0 : shows the current flags/values~n').
535 format(
' ~w~n', [
FlagType]),
540 format(
' Handler important notes:~n'),
541 format(
' Conjuction: external_handler(validating, Value):-...~n'),
542 format(
' Disjunction: external_handler(validate, Value):-...~n'),
543 format(
' After: external_handler(validated, Value):-...~n'),
544 format(
' After set: external_handler(stored, Value):-...~n'),
545 format(
' this is implemented as (validating,(original;validated))~n'),
546 format(
' validating|original|validate|result~n'),
547 format(
' true | true | true | true~n'),
548 format(
' true | true | fail | true~n'),
549 format(
' true | fail | true | true~n'),
550 format(
' true | fail | fail | fail~n'),
551 format(
' fail | true | true | fail~n'),
552 format(
' fail | true | fail | fail~n'),
553 format(
' fail | fail | true | fail~n'),
554 format(
' fail | fail | fail | fail~n'),
555 format(
' Default behaviour is validating->true, validate->fail~n'),
556 format(
' To completly replace original set validate->true~n'),
557 format(
' To add new values to original set validating->true~n'),
558 format(
' To remove values from original set validate->fail~n'),
559 format(
' Example definition with a handler:~n'),
560 format(
' flag_define(myflag, mygroup, in_interval(integer, [(-5, 5),([15],[25])]), 0, description, my_handler).~n'),
561 format(
' my_handler(validate, Value):-Value is 10.~n'),
562 format(
' my_handler(validating, Value).~n'),
563 format(
' my_handler(validated, Value).~n'),
564 format(
' my_handler(stored, Value).~n'),
565 format(
' This has defined a flag that accepts integers (-5,5)v[15,25].~n'),
566 format(
' The handler adds the value 10 in those.~n').
570 forall(member(
Group,
Groups), flags_print(
Group)).
572 format(
' ~w:~n~w~38+ ~w~19+ ~w~10+ ~w~10+~n', [
Group,
'Description',
'Domain',
'Flag',
'Value']),
574flags_print(
FlagGroup)
:-
575 '$defined_flag$'(
FlagName,
FlagGroup,
FlagType,
_DefaultValue,
Description,
Access,
_Handler),
576 Access \== '$defined_flag$',
Access \== '$defined_flag$',
577 flag_get(
FlagName,
Value),
578 format(
'~w~38+ ~w~19+ ~w~10+ ~q~10+~n', [
Description,
FlagType,
FlagName,
Value]),
582defined_flag(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler)
:-
583 '$defined_flag$'(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler),
584 Access \== '$defined_flag$',
Access \== '$defined_flag$'.
585defined_flag(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler)
:-
587 '$defined_flag$'(
FlagName,
FlagGroup,
FlagType,
DefaultValue,
Description,
Access,
Handler).
590
catch( : Goal,+ Exception,+ Action)
yap_flag( ?Param, ?Value)
flags_type_definition(TypeName, TypeHandler, TypeValidator)
append(? List1,? List2,? List3)
member(?Element, ?Set) is true when Set is a list, and Element occurs in it
memberchk(+ Element, + Set)