1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3/* 4Nan.Validation 1.2 5Validation Operations 6nan_validation.pl 7 8This file is part of 9Nan.Common 1.2 10Common Operations 11<http://julio.diegidio.name/Projects/Prolog/Download/Nan.Common-0.1.zip> 12 13Copyright 2012 J.P. Di Egidio 14All rights reserved. 15<http://julio.diegidio.name/Projects/Prolog/Nan.Common> 16 17Nan.Common is free software: you can redistribute it and/or modify 18it under the terms of the GNU General Public License as published by the 19Free Software Foundation, either version 3 of the License, or (at your 20option) any later version. 21 22Nan.Common is distributed in the hope that it will be useful, but 23WITHOUT ANY WARRANTY; without even the implied warranty of 24MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 25General Public License for more details. 26 27You should have received a copy of the GNU General Public License along 28with Nan.Common. If not, see <http://www.gnu.org/licenses/>. 29 30As a special exception, if you link this library with other files, 31compiled with a Free Software compiler, to produce an executable, this 32library does not by itself cause the resulting executable to be covered 33by the GNU General Public License. This exception does not however 34invalidate any other reasons why the executable file might be covered by 35the GNU General Public License. 36 37Authors: 38J.P. Di Egidio - JDE - mailto:julio@diegidio.name 39 40History: 411.2.2012-11-11/JDE - Common: minor fixes to the docs and interface. 421.0.2012-11-10/JDE - Validation: created version 1.0. 43 44Written and tested in: 45SWI-Prolog 6.2.0 - <http://www.swi-prolog.org> 46*/ 47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 48%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76:- module(nan_validation, 77[ %%% INTERFACE: test_* 78 test_type/2, % +Type, @Term 79 test_domain/3, % +Type, :Constraint, @Term 80 %%% INTERFACE: validate_* 81 validate_type/3, % +Type, @Term, +Message 82 validate_type/4, % +Type, @Term, :Caller, +Message 83 validate_domain/4, % +Type, :Constraint, @Term, +Message 84 validate_domain/5, % +Type, :Constraint, @Term, :Caller, +Message 85 validate_condition/3, % :Condition, +Error, +Message 86 validate_condition/4, % :Condition, +Error, :Caller, +Message 87 %%% INTERFACE: *_exception 88 type_exception/4, % +Type, @Term, +Message, -Exception 89 type_exception/5, % +Type, @Term, :Caller, +Message, -Exception 90 domain_exception/5, % +Type, :Constraint, @Term, +Message, -Exception 91 domain_exception/6, % +Type, :Constraint, @Term, :Caller, +Message, -Exception 92 custom_exception/3, % +Error, +Message, -Exception 93 custom_exception/4, % +Error, :Caller, +Message, -Exception 94 %%% INTERFACE: *_error 95 type_error/3, % +Type, @Term, -Error 96 domain_error/4, % +Type, :Constraint, @Term, -Error 97 %%% INTERFACE: current_caller 98 current_caller/1 % -Caller 99]). 100 101:- use_module(library(error), []). 102 103:- meta_predicate 104 %%% INTERFACE: test_* 105 test_domain(, , ), 106 %%% INTERFACE: validate_* 107 validate_type(, , , ), 108 validate_domain(, , , ), 109 validate_domain(, , , , ), 110 validate_condition(, , ), 111 validate_condition(, , , ), 112 %%% INTERFACE: *_exception 113 type_exception(, , , , ), 114 domain_exception(, , , , ), 115 domain_exception(, , , , , ), 116 custom_exception(, , , ), 117 %%% INTERFACE: *_error 118 domain_error(, , , ). 119 120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 121%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 122 123%%% META-IMPLEMENTATION: 124 125expand_term_(Head, TermIn, TermOut) :- 126 callable(TermIn), 127 !, 128 expand_callable_(Head, TermIn, TermOut). 129expand_term_(_, Term, Term). 130 131expand_callable_(Head, GoalIn, GoalOut) :-
132 functor(GoalIn, throw_no_direct_call_, 0), 133 !, 134 expand_get_caller_(Head, Caller), 135 GoalOut = ( 136 Error = context_error(no_direct_call, Head), 137 Message = 'For term rewriting only.', 138 Exception = error(Error, context(Caller, Message)), 139 throw(Exception) 140 )
140. 141expand_callable_(Head, GoalIn, GoalOut) :-
142 functor(GoalIn, validate_type, 3), 143 !, 144 expand_get_caller_(Head, Caller), 145 GoalIn = validate_type(Type, Term, Message), 146 GoalOut = validate_type(Type, Term, Caller, Message)
146. 147% 148expand_callable_(Head, GoalIn, GoalOut) :-
149 functor(GoalIn, validate_domain, 4), 150 !, 151 expand_get_caller_(Head, Caller), 152 GoalIn = validate_domain(Type, Constraint, Term, Message), 153 GoalOut = validate_domain(Type, Constraint, Term, Caller, Message)
153. 154% 155expand_callable_(Head, GoalIn, GoalOut) :-
156 functor(GoalIn, validate_condition, 3), 157 !, 158 expand_get_caller_(Head, Caller), 159 GoalIn = validate_condition(Condition, Error, Message), 160 GoalOut = validate_condition(Condition, Error, Caller, Message)
160. 161% 162expand_callable_(Head, GoalIn, GoalOut) :-
163 functor(GoalIn, type_exception, 4), 164 !, 165 expand_get_caller_(Head, Caller), 166 GoalIn = type_exception(Type, Term, Message, Exception), 167 GoalOut = type_exception(Type, Term, Caller, Message, Exception)
167. 168% 169expand_callable_(Head, GoalIn, GoalOut) :-
170 functor(GoalIn, domain_exception, 5), 171 !, 172 expand_get_caller_(Head, Caller), 173 GoalIn = domain_exception(Type, Constraint, Term, Message, Exception), 174 GoalOut = domain_exception( 175 Type, Constraint, Term, Caller, Message, Exception 176 )
176. 177% 178expand_callable_(Head, GoalIn, GoalOut) :-
179 functor(GoalIn, custom_exception, 3), 180 !, 181 expand_get_caller_(Head, Caller), 182 GoalIn = custom_exception(Error, Message, Exception), 183 GoalOut = custom_exception(Error, Caller, Message, Exception)
183. 184% 185expand_callable_(Head, GoalIn, GoalOut) :-
186 functor(GoalIn, current_caller, 1), 187 GoalIn = current_caller(CallerVar), 188 var(CallerVar), 189 !, 190 expand_get_caller_(Head, Caller), 191 GoalOut = (CallerVar = Caller)
191. 192% 193expand_callable_(Head, GoalIn, GoalOut) :- 194 GoalIn =.. [GName| GArgsIn], 195 expand_callable__loop(Head, GArgsIn, GArgsOut), 196 GoalOut =.. [GName| GArgsOut]. 197 198expand_callable__loop(Head, [GAIn| GArgsIn], [GAOut| GArgsOut]) :- 199 !, 200 expand_term_(Head, GAIn, GAOut), 201 expand_callable__loop(Head, GArgsIn, GArgsOut). 202expand_callable__loop(_, [], []). 203 204expand_get_caller_(Head, Caller) :- 205 context_module(Module), 206 functor(Head, Name, Arity), 207 Caller = Module:Name/Arity. 208 209%%% system:term_expansion(+TermIn, -TermOut) is det. 210 211:- multifile 212 system:term_expansion/2. 213 214systemterm_expansion((Head :- BodyIn), (Head :- BodyOut)) :- 215 nan_validation:expand_term_(Head, BodyIn, BodyOut). 216 217%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 219 220%%% INTERFACE: test_*
Supports all types documented in must_be/2 plus those listed here:
predicate | atom/nonneg |
formatted | text-list or text |
formal_error | callable |
term_order | oneof([=, <, >]) |
pair(KeyType-ValueType) | KeyType-ValueType |
or([Type1, ..., TypeN]) | Type1 or ... or TypeN |
var(SubType) | var or SubType |
m_var(SubType) | atom:var or atom:SubType |
m_predicate | atom:predicate or predicate |
m_callable | atom:callable or callable |
s_callable(Struct:struct) | callable and has_struct(Struct, Term) (*) |
struct | callable with "_terminals_" atom or var:SubType (*) |
type | callable and clause(error:has_type(Term, _)) |
(*) The implicit predicate has_struct/2 tests functor equality of
non-"terminal" sub-terms of Struct to the corresponding sub-terms of
Term. For "terminal" sub-terms of Struct, specifically meaning any
encountered (sub-)terms of Struct that are of type var:SubType,
has_struct/2 tests that the corresponding (sub-)term of Term satisfies
SubType. (Variable names in "terminals" of Struct are ignored but
useful for self-documentation.)
260test_type(Type, Term) :-
261 validate_arg_type_(Type),
262 test_type_(Type, Term).
Supports the types documented in test_type/2.
279test_domain(Type, Constraint, Term) :- 280 validate_arg_type_(Type), 281 validate_arg_constraint_(Constraint), 282 test_domain_(Type, Constraint, Term). 283 284%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 285%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 286 287%%% INTERFACE: validate_*
error(type_error(Type, Term), context(Caller, Message)).
Supports the types documented in test_type/2.
NOTE: The variant validate_type/3 is translated to validate_type/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
319validate_type(_, _, _) :- 320 throw_no_direct_call_. 321 322validate_type(Type, Term, Caller, Message) :- 323 validate_arg_type_(Type), 324 validate_arg_caller_(Caller), 325 validate_arg_message_(Message), 326 validate_type_(Type, Term, Caller, Message).
error(Error, context(Caller, Message)),
where Error is type_error(Type, Term) or
domain_error(constr(Type, Constraint), Term),
depending on the case.
Supports the types documented in test_type/2.
NOTE: The variant validate_domain/4 is translated to validate_domain/5 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
365validate_domain(_, _, _, _) :- 366 throw_no_direct_call_. 367 368validate_domain(Type, Constraint, Term, Caller, Message) :- 369 validate_arg_type_(Type), 370 validate_arg_constraint_(Constraint), 371 validate_arg_caller_(Caller), 372 validate_arg_message_(Message), 373 validate_domain_(Type, Constraint, Term, Caller, Message).
error(Error, context(Caller, Message)).
NOTE: The variant validate_condition/3 is translated to validate_condition/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
403validate_condition(_, _, _) :- 404 throw_no_direct_call_. 405 406validate_condition(Condition, Error, Caller, Message) :- 407 validate_arg_condition_(Condition), 408 validate_arg_error_(Error), 409 validate_arg_caller_(Caller), 410 validate_arg_message_(Message), 411 validate_condition_(Condition, Error, Caller, Message). 412 413%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 414%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 415 416%%% INTERFACE: *_exception
error(type_error(Type, Term), context(Caller, Message)).
Supports the types documented in test_type/2.
NOTE: The variant type_exception/4 is translated to type_exception/5 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
450type_exception(_, _, _, _) :- 451 throw_no_direct_call_. 452 453type_exception(Type, Term, Caller, Message, Exception) :- 454 validate_arg_type_(Type), 455 validate_arg_caller_(Caller), 456 validate_arg_message_(Message), 457 type_exception_(Type, Term, Caller, Message, Exception).
error(Error, context(Caller, Message)),
where Error is
domain_error(constr(Type, Constraint), Term).
Supports the types documented in test_type/2.
NOTE: The variant domain_exception/5 is translated to domain_exception/6 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
496domain_exception(_, _, _, _, _) :- 497 throw_no_direct_call_. 498 499domain_exception(Type, Constraint, Term, Caller, Message, Exception) :- 500 validate_arg_type_(Type), 501 validate_arg_constraint_(Constraint), 502 validate_arg_caller_(Caller), 503 validate_arg_message_(Message), 504 domain_exception_(Type, Constraint, Term, Caller, Message, Exception).
error(Error, context(Caller, Message)).
NOTE: The variant custom_exception/3 is translated to custom_exception/4 via term rewriting, with Caller set to the (qualified) predicate indicator of the predicate containing the call.
533custom_exception(_, _, _) :- 534 throw_no_direct_call_. 535 536custom_exception(Error, Caller, Message, Exception) :- 537 validate_arg_error_(Error), 538 validate_arg_caller_(Caller), 539 validate_arg_message_(Message), 540 custom_exception_(Error, Caller, Message, Exception). 541 542%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 543%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 544 545%%% INTERFACE: *_error
type_error(Type, Term).
Supports the types documented in test_type/2.
563type_error(Type, Term, Error) :-
564 validate_arg_type_(Type),
565 type_error_(Type, Term, Error).
domain_error(constr(Type, Constraint), Term).
Supports the types documented in test_type/2.
585domain_error(Type, Constraint, Term, Error) :- 586 validate_arg_type_(Type), 587 validate_arg_constraint_(Constraint), 588 domain_error_(Type, Constraint, Term, Error). 589 590%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 591%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 592 593%%% INTERFACE: current_caller
NOTE: An invocation to this predicate is translated via term rewriting as shown in the following example:
For a predicate =my_mod:my_pred/1= such as: == my_pred(X) :- ..., current_caller(Caller), ... == The translation would be: == my_pred(X) :- ..., Caller = my_mod:my_pred/1, ... ==
619current_caller(_) :- 620 throw_no_direct_call_. 621 622%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 623%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 624 625%%% IMPLEMENTATION: 626 627%%% error:has_type(+Type, @Term) is semidet. 628 629:- multifile 630 error:has_type/2. 631 632errorhas_type(predicate, Term) :- % predicate 633 nonvar(Term), 634 Term = Name/Arity, 635 atom(Name), 636 error:has_type(nonneg, Arity). 637errorhas_type(formatted, Term) :- % formatted 638 nonvar(Term), 639 ( Term = Format-Args 640 -> error:has_type(list, Args) 641 ; Term = Format 642 ), 643 error:has_type(text, Format). 644errorhas_type(formal_error, Term) :- % formal_error 645 callable(Term). 646errorhas_type(term_order, Term) :- % term_order 647 error:has_type(oneof([=, <, >]), Term). 648errorhas_type(pair(KeyType-ValueType), Term) :- % pair(KeyType-ValueType) 649 nonvar(Term), 650 Term = Key-Value, 651 error:has_type(KeyType, Key), 652 error:has_type(ValueType, Value). 653errorhas_type(or(Types), Term) :- % or([Type1, ..., TypeN]) 654 error:has_type(list, Types), 655 is_type_or_(Types, Term). 656errorhas_type(var(SubType), Term) :- % var(SubType) 657 ( var(Term) 658 -> true 659 ; error:has_type(SubType, Term) 660 ). 661errorhas_type(m_var(SubType), Term) :- % m_var(SubType) 662 stripped_module_(Term, SubTerm), 663 ( var(SubTerm) 664 -> true 665 ; error:has_type(SubType, SubTerm) 666 ). 667errorhas_type(m_predicate, Term) :- % m_predicate 668 stripped_module_(Term, PredInd), 669 error:has_type(predicate, PredInd). 670errorhas_type(m_callable, Term) :- % m_callable 671 stripped_module_(Term, Callable), 672 callable(Callable). 673errorhas_type(s_callable(Struct), Term) :- % s_callable(Struct) 674 has_struct_(Struct, Term). 675errorhas_type(struct, Term) :- % struct 676 is_struct_(Term). 677errorhas_type(type, Term) :- % type 678 callable(Term), 679 \+ \+ once(clause(error:has_type(Term, _), _)). 680 681is_type_or_([Type| Types], Term) :- 682 ( error:has_type(Type, Term) 683 -> true 684 ; is_type_or_(Types, Term) 685 ). 686 687stripped_module_(Term, SubTerm) :- 688 nonvar(Term), 689 ( Term = Module:SubTerm 690 -> atom(Module) 691 ; Term = SubTerm 692 ). 693 694is_struct_(Term) :- 695 callable(Term), 696 is_struct__case(Term). 697 698is_struct__case(Term) :- 699 atom(Term), 700 !. 701is_struct__case(Term) :- 702 Term = Var:VType, 703 var(Var), 704 !, 705 error:has_type(type, VType). 706is_struct__case(Term) :- 707 Term =.. [_| SubTerms], 708 is_struct__loop(SubTerms). 709 710is_struct__loop([Term| Terms]) :- 711 is_struct_(Term), 712 is_struct__loop(Terms). 713is_struct__loop([]). 714 715has_struct_(Struct, Term) :- 716 callable(Struct), 717 has_struct__case(Struct, Term). 718 719has_struct__case(Struct, Term) :- 720 atom(Struct), 721 !, 722 Term == Struct. 723has_struct__case(Struct, Term) :- 724 Struct = Var:VType, 725 var(Var), 726 !, 727 error:has_type(VType, Term). 728has_struct__case(Struct, Term) :- 729 compound(Term), 730 functor(Struct, Name, Arity), 731 functor(Term, Name, Arity), 732 Struct =.. [Name| SubStructs], 733 Term =.. [Name| SubTerms], 734 has_struct__loop(SubStructs, SubTerms). 735 736has_struct__loop([Struct| Structs], [Term| Terms]) :- 737 has_struct_(Struct, Term), 738 has_struct__loop(Structs, Terms). 739has_struct__loop([], []).
748validate_arg_type_(Type) :- 749 validate_type_(type, Type, _, _). 750 751validate_arg_constraint_(Constraint) :- 752 validate_type_(m_callable, Constraint, _, _). 753 754validate_arg_condition_(Condition) :- 755 validate_type_(m_callable, Condition, _, _). 756 757validate_arg_error_(Error) :- 758 validate_type_(formal_error, Error, _, _). 759 760validate_arg_caller_(Caller) :- 761 validate_type_(m_var(predicate), Caller, _, _). 762 763validate_arg_message_(Message) :- 764 validate_type_(var(formatted), Message, _, _).
769test_type_(Type, Term) :- 770 error:has_type(Type, Term). 771 772test_domain_(Type, Constraint, Term) :- 773 error:has_type(Type, Term), 774 call(Constraint, Term).
780validate_type_(Type, Term, Caller, Message) :- 781 validate_( 782 error:has_type(Type, Term), 783 type_exception_(Type, Term, Caller, Message) 784 ). 785 786validate_domain_(Type, Constraint, Term, Caller, Message) :- 787 validate_type_(Type, Term, Caller, Message), 788 validate_( 789 call(Constraint, Term), 790 domain_exception_(Type, Constraint, Term, Caller, Message) 791 ). 792 793validate_condition_(Condition, Error, Caller, Message) :- 794 validate_( 795 call(Condition), 796 custom_exception_(Error, Caller, Message) 797 ).
801validate_(Validate, _) :- 802 call(Validate), 803 !. 804validate_(_, CreateEx) :- 805 call(CreateEx, Exception), 806 throw(Exception).
812type_exception_(Type, Term, Caller, Message, Exception) :- 813 type_error_(Type, Term, Error), 814 custom_exception_(Error, Caller, Message, Exception). 815 816domain_exception_(Type, Constraint, Term, Caller, Message, Exception) :- 817 domain_error_(Type, Constraint, Term, Error), 818 custom_exception_(Error, Caller, Message, Exception). 819 820custom_exception_(Error, Caller, Message, Exception) :- 821 Exception = error(Error, context(Caller, Message)).
826type_error_(Type, Term, Error) :- 827 Error = type_error(Type, Term). 828 829domain_error_(Type, Constraint, Term, Error) :- 830 Domain = constr(Type, Constraint), 831 Error = domain_error(Domain, Term). 832 833%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 834%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Nan.Validation 1.2: Validation Operations
Nan.Validation 1.2: Validation Operations (nan_validation)
This module is part of Nan.Common 1.2: Common Operations (nan_common) http://julio.diegidio.name/Projects/Prolog/Nan.Common
This module provides common operations for testing and validation of term types, domains and custom conditions, and for the construction of exception and error terms.
This module abstracts and extends the type testing and validation system provided by library(error). In particular, this module extends to the types that are documented in test_type/2.
NOTE: The type testing and validation system is extensible: specifically, has_type/2 is a
multifile(anddynamic) predicate. See library(error) for details.J.P. Di EgidioJ.P. Di Egidio