1/* Part of SWI-Prolog 2 3 Author: Marcus Uneson 4 E-mail: marcus.uneson@ling.lu.se 5 WWW: http://person.sol.lu.se/MarcusUneson/ 6 Copyright (c) 2011-2015, Marcus Uneson 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(optparse, 36 [ opt_parse/5, %+OptsSpec, +CLArgs, -Opts, -PositionalArgs,-ParseOptions 37 opt_parse/4, %+OptsSpec, +CLArgs, -Opts, -PositionalArgs, 38 opt_arguments/3, %+OptsSpec, -Opts, -PositionalArgs 39 opt_help/2 %+OptsSpec, -Help 40 ]). 41 42:- autoload(library(apply),[maplist/3]). 43:- autoload(library(debug),[assertion/1]). 44:- autoload(library(error),[must_be/2]). 45:- autoload(library(lists),[member/2,max_list/2,reverse/2,append/3]). 46:- autoload(library(option),[merge_options/3,option/3]). 47 48 49:- set_prolog_flag(double_quotes, codes). 50%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% EXPORTS 51 52/** <module> command line parsing 53 54This module helps in building a command-line interface to an 55application. In particular, it provides functions that take an option 56specification and a list of atoms, probably given to the program on the 57command line, and return a parsed representation (a list of the 58customary Key(Val) by default; or optionally, a list of Func(Key, Val) 59terms in the style of current_prolog_flag/2). It can also synthesize a 60simple help text from the options specification. 61 62The terminology in the following is partly borrowed from python, see 63http://docs.python.org/library/optparse.html#terminology . Very briefly, 64_arguments_ is what you provide on the command line and for many prologs 65show up as a list of atoms =|Args|= in =|current_prolog_flag(argv, 66Args)|=. For a typical prolog incantation, they can be divided into 67 68 * _|runtime arguments|_, which controls the prolog runtime; 69 conventionally, they are ended by '--'; 70 * _options_, which are key-value pairs (with a boolean value 71 possibly implicit) intended to control your program in one way 72 or another; and 73 * _|positional arguments|_, which is what remains after 74 all runtime arguments and options have been removed (with 75 implicit arguments -- true/false for booleans -- filled in). 76 77Positional arguments are in particular used for mandatory arguments 78without which your program won't work and for which there are no 79sensible defaults (e.g,, input file names). Options, by contrast, offer 80flexibility by letting you change a default setting. Options are 81optional not only by etymology: this library has no notion of mandatory 82or required options (see the python docs for other rationales than 83laziness). 84 85The command-line arguments enter your program as a list of atoms, but 86the programs perhaps expects booleans, integers, floats or even prolog 87terms. You tell the parser so by providing an _|options specification|_. 88This is just a list of individual option specifications. One of those, 89in turn, is a list of ground prolog terms in the customary Name(Value) 90format. The following terms are recognized (any others raise error). 91 92 * opt(Key) 93 Key is what the option later will be accessed by, just like for 94 current_prolog_flag(Key, Value). This term is mandatory (an error is 95 thrown if missing). 96 97 * shortflags(ListOfFlags) 98 ListOfFlags denotes any single-dashed, single letter args specifying the 99 current option (=|-s , -K|=, etc). Uppercase letters must be quoted. 100 Usually ListOfFlags will be a singleton list, but sometimes aliased flags 101 may be convenient. 102 103 * longflags(ListOfFlags) 104 ListOfFlags denotes any double-dashed arguments specifying 105 the current option (=|--verbose, --no-debug|=, etc). They are 106 basically a more readable alternative to short flags, except 107 108 1. long flags can be specified as =|--flag value|= or 109 =|--flag=value|= (but not as =|--flagvalue|=); short flags as 110 =|-f val|= or =|-fval|= (but not =|-f=val|=) 111 2. boolean long flags can be specified as =|--bool-flag|= 112 or =|--bool-flag=true|= or =|--bool-flag true|=; and they can be 113 negated as =|--no-bool-flag|= or =|--bool-flag=false|= or 114 =|--bool-flag false|=. 115 116 Except that shortflags must be single characters, the 117 distinction between long and short is in calling convention, not 118 in namespaces. Thus, if you have shortflags([v]), you can use it 119 as =|-v2|= or =|-v 2|= or =|--v=2|= or =|--v 2|= (but not 120 =|-v=2|= or =|--v2|=). 121 122 Shortflags and longflags both default to =|[]|=. It can be useful to 123 have flagless options -- see example below. 124 125 * meta(Meta) 126 Meta is optional and only relevant for the synthesized usage message 127 and is the name (an atom) of the metasyntactic variable (possibly) 128 appearing in it together with type and default value (e.g, 129 =|x:integer=3|=, =|interest:float=0.11|=). It may be useful to 130 have named variables (=|x|=, =|interest|=) in case you wish to 131 mention them again in the help text. If not given the =|Meta:|= 132 part is suppressed -- see example below. 133 134 * type(Type) 135 Type is one of =|boolean, atom, integer, float, term|=. 136 The corresponding argument will be parsed appropriately. This 137 term is optional; if not given, defaults to =|term|=. 138 139 * default(Default) 140 Default value. This term is optional; if not given, or if given the 141 special value '_', an uninstantiated variable is created (and any 142 type declaration is ignored). 143 144 * help(Help) 145 Help is (usually) an atom of text describing the option in the 146 help text. This term is optional (but obviously strongly recommended 147 for all options which have flags). 148 149 Long lines are subject to basic word wrapping -- split on white 150 space, reindent, rejoin. However, you can get more control by 151 supplying the line breaking yourself: rather than a single line of 152 text, you can provide a list of lines (as atoms). If you do, they 153 will be joined with the appropriate indent but otherwise left 154 untouched (see the option =mode= in the example below). 155 156Absence of mandatory option specs or the presence of more than one for a 157particular option throws an error, as do unknown or incompatible types. 158 159As a concrete example from a fictive application, suppose we want the 160following options to be read from the command line (long flag(s), short 161flag(s), meta:type=default, help) 162 163== 164--mode -m atom=SCAN data gathering mode, 165 one of 166 SCAN: do this 167 READ: do that 168 MAKE: make numbers 169 WAIT: do nothing 170--rebuild-cache -r boolean=true rebuild cache in 171 each iteration 172--heisenberg-threshold -t,-h float=0.1 heisenberg threshold 173--depths, --iters -i,-d K:integer=3 stop after K 174 iterations 175--distances term=[1,2,3,5] initial prolog term 176--output-file -o FILE:atom=_ write output to FILE 177--label -l atom=REPORT report label 178--verbosity -v V:integer=2 verbosity level, 179 1 <= V <= 3 180== 181 182We may also have some configuration parameters which we currently think 183not needs to be controlled from the command line, say 184path('/some/file/path'). 185 186This interface is described by the following options specification 187(order between the specifications of a particular option is irrelevant). 188 189== 190ExampleOptsSpec = 191 [ [opt(mode ), type(atom), default('SCAN'), 192 shortflags([m]), longflags(['mode'] ), 193 help([ 'data gathering mode, one of' 194 , ' SCAN: do this' 195 , ' READ: do that' 196 , ' MAKE: fabricate some numbers' 197 , ' WAIT: don''t do anything'])] 198 199 , [opt(cache), type(boolean), default(true), 200 shortflags([r]), longflags(['rebuild-cache']), 201 help('rebuild cache in each iteration')] 202 203 , [opt(threshold), type(float), default(0.1), 204 shortflags([t,h]), longflags(['heisenberg-threshold']), 205 help('heisenberg threshold')] 206 207 , [opt(depth), meta('K'), type(integer), default(3), 208 shortflags([i,d]),longflags([depths,iters]), 209 help('stop after K iterations')] 210 211 , [opt(distances), default([1,2,3,5]), 212 longflags([distances]), 213 help('initial prolog term')] 214 215 , [opt(outfile), meta('FILE'), type(atom), 216 shortflags([o]), longflags(['output-file']), 217 help('write output to FILE')] 218 219 , [opt(label), type(atom), default('REPORT'), 220 shortflags([l]), longflags([label]), 221 help('report label')] 222 223 , [opt(verbose), meta('V'), type(integer), default(2), 224 shortflags([v]), longflags([verbosity]), 225 help('verbosity level, 1 <= V <= 3')] 226 227 , [opt(path), default('/some/file/path/')] 228 ]. 229== 230 231The help text above was accessed by =|opt_help(ExamplesOptsSpec, 232HelpText)|=. The options appear in the same order as in the OptsSpec. 233 234Given =|ExampleOptsSpec|=, a command line (somewhat syntactically 235inconsistent, in order to demonstrate different calling conventions) may 236look as follows 237 238== 239ExampleArgs = [ '-d5' 240 , '--heisenberg-threshold', '0.14' 241 , '--distances=[1,1,2,3,5,8]' 242 , '--iters', '7' 243 , '-ooutput.txt' 244 , '--rebuild-cache', 'true' 245 , 'input.txt' 246 , '--verbosity=2' 247 ]. 248== 249 250opt_parse(ExampleOptsSpec, ExampleArgs, Opts, PositionalArgs) would then 251succeed with 252 253== 254Opts = [ mode('SCAN') 255 , label('REPORT') 256 , path('/some/file/path') 257 , threshold(0.14) 258 , distances([1,1,2,3,5,8]) 259 , depth(7) 260 , outfile('output.txt') 261 , cache(true) 262 , verbose(2) 263 ], 264PositionalArgs = ['input.txt']. 265== 266 267Note that path('/some/file/path') showing up in Opts has a default value 268(of the implicit type 'term'), but no corresponding flags in OptsSpec. 269Thus it can't be set from the command line. The rest of your program 270doesn't need to know that, of course. This provides an alternative to 271the common practice of asserting such hard-coded parameters under a 272single predicate (for instance setting(path, '/some/file/path')), with 273the advantage that you may seamlessly upgrade them to command-line 274options, should you one day find this a good idea. Just add an 275appropriate flag or two and a line of help text. Similarly, suppressing 276an option in a cluttered interface amounts to commenting out the flags. 277 278opt_parse/5 allows more control through an additional argument list as 279shown in the example below. 280 281== 282?- opt_parse(ExampleOptsSpec, ExampleArgs, Opts, PositionalArgs, 283 [ output_functor(appl_config) 284 ]). 285 286Opts = [ appl_config(verbose, 2), 287 , appl_config(label, 'REPORT') 288 ... 289 ] 290== 291 292This representation may be preferable with the empty-flag configuration 293parameter style above (perhaps with asserting appl_config/2). 294 295## Notes and tips {#optparse-notes} 296 297 * In the example we were mostly explicit about the types. Since the 298 default is =|term|=, which subsumes =|integer, float, atom|=, it 299 may be possible to get away cheaper (e.g., by only giving booleans). 300 However, it is recommended practice to always specify types: 301 parsing becomes more reliable and error messages will be easier to interpret. 302 303 304 * Note that =|-sbar|= is taken to mean =|-s bar|=, not =|-s -b -a -r|=, 305 that is, there is no clustering of flags. 306 307 * =|-s=foo|= is disallowed. The rationale is that although some 308 command-line parsers will silently interpret this as =|-s =foo|=, this is very 309 seldom what you want. To have an option argument start with '=' (very 310 un-recommended), say so explicitly. 311 312 * The example specifies the option =|depth|= twice: once as 313 =|-d5|= and once as =|--iters 7|=. The default when encountering duplicated 314 flags is to =|keeplast|= (this behaviour can be controlled, by ParseOption 315 duplicated_flags). 316 317 * The order of the options returned by the parsing functions is the same as 318 given on the command 319 line, with non-overridden defaults prepended and duplicates removed 320 as in previous item. You should not rely on this, however. 321 322 * Unknown flags (not appearing in OptsSpec) will throw errors. This 323 is usually a Good Thing. Sometimes, however, you may wish to pass 324 along flags to an external program (say, one called by shell/2), and 325 it means duplicated effort and a maintenance headache to have to 326 specify all possible flags for the external program explicitly (if 327 it even can be done). On the other hand, simply taking all unknown 328 flags as valid makes error checking much less efficient and 329 identification of positional arguments uncertain. A better solution 330 is to collect all arguments intended for passing along to an 331 indirectly called program as a single argument, probably as an atom 332 (if you don't need to inspect them first) or as a prolog term (if 333 you do). 334 335@author Marcus Uneson 336@version 0.20 (2011-04-27) 337@tbd: validation? e.g, numbers; file path existence; one-out-of-a-set-of-atoms 338*/ 339 340:- predicate_options(opt_parse/5, 5, 341 [ allow_empty_flag_spec(boolean), 342 duplicated_flags(oneof([keepfirst,keeplast,keepall])), 343 output_functor(atom), 344 suppress_empty_meta(boolean) 345 ]). 346 347:- multifile 348 error:has_type/2, 349 parse_type/3. 350 351%% opt_arguments(+OptsSpec, -Opts, -PositionalArgs) is det 352% 353% Extract commandline options according to a specification. 354% Convenience predicate, assuming that command-line arguments can be 355% accessed by current_prolog_flag/2 (as in swi-prolog). For other 356% access mechanisms and/or more control, get the args and pass them 357% as a list of atoms to opt_parse/4 or opt_parse/5 instead. 358% 359% Opts is a list of parsed options in the form Key(Value). Dashed 360% args not in OptsSpec are not permitted and will raise error (see 361% tip on how to pass unknown flags in the module description). 362% PositionalArgs are the remaining non-dashed args after each flag 363% has taken its argument (filling in =true= or =false= for booleans). 364% There are no restrictions on non-dashed arguments and they may go 365% anywhere (although it is good practice to put them last). Any 366% leading arguments for the runtime (up to and including '--') are 367% discarded. 368 369opt_arguments(OptsSpec, Opts, PositionalArgs) :- 370 current_prolog_flag(argv, Argv), 371 opt_parse(OptsSpec, Argv, Opts, PositionalArgs). 372 373%% opt_parse(+OptsSpec, +ApplArgs, -Opts, -PositionalArgs) is det 374% 375% Equivalent to opt_parse(OptsSpec, ApplArgs, Opts, PositionalArgs, []). 376 377 378opt_parse(OptsSpec, ApplArgs, Opts, PositionalArgs) :- 379 opt_parse(OptsSpec, ApplArgs, Opts, PositionalArgs, []). 380 381%% opt_parse(+OptsSpec, +ApplArgs, -Opts, -PositionalArgs, +ParseOptions) is det 382% 383% Parse the arguments Args (as list of atoms) according to OptsSpec. 384% Any runtime arguments (typically terminated by '--') are assumed to 385% be removed already. 386% 387% Opts is a list of parsed options in the form Key(Value), or (with 388% the option functor(Func) given) in the form Func(Key, Value). 389% Dashed args not in OptsSpec are not permitted and will raise error 390% (see tip on how to pass unknown flags in the module description). 391% PositionalArgs are the remaining non-dashed args after each flag 392% has taken its argument (filling in =true= or =false= for booleans). 393% There are no restrictions on non-dashed arguments and they may go 394% anywhere (although it is good practice to put them last). 395% ParseOptions are 396% 397% * output_functor(Func) 398% Set the functor Func of the returned options Func(Key,Value). 399% Default is the special value 'OPTION' (upper-case), which makes 400% the returned options have form Key(Value). 401% 402% * duplicated_flags(Keep) 403% Controls how to handle options given more than once on the commad line. 404% Keep is one of =|keepfirst, keeplast, keepall|= with the obvious meaning. 405% Default is =|keeplast|=. 406% 407% * allow_empty_flag_spec(Bool) 408% If true (default), a flag specification is not required (it is allowed 409% that both shortflags and longflags be either [] or absent). 410% Flagless options cannot be manipulated from the command line 411% and will not show up in the generated help. This is useful when you 412% have (also) general configuration parameters in 413% your OptsSpec, especially if you think they one day might need to be 414% controlled externally. See example in the module overview. 415% allow_empty_flag_spec(false) gives the more customary behaviour of 416% raising error on empty flags. 417 418 419opt_parse(OptsSpec, ApplArgs, Opts, PositionalArgs, ParseOptions) :- 420 opt_parse_(OptsSpec, ApplArgs, Opts, PositionalArgs, ParseOptions). 421 422 423%% opt_help(+OptsSpec, -Help:atom) is det 424% 425% True when Help is a help string synthesized from OptsSpec. 426 427opt_help(OptsSpec, Help) :- 428 opt_help(OptsSpec, Help, []). 429 430% semi-arbitrary default format settings go here; 431% if someone needs more control one day, opt_help/3 could be exported 432opt_help(OptsSpec, Help, HelpOptions0) :- 433 Defaults = [ line_width(80) 434 , min_help_width(40) 435 , break_long_flags(false) 436 , suppress_empty_meta(true) 437 ], 438 merge_options(HelpOptions0, Defaults, HelpOptions), 439 opt_help_(OptsSpec, Help, HelpOptions). 440 441 442%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OPT_PARSE 443 444opt_parse_(OptsSpec0, Args0, Opts, PositionalArgs, ParseOptions) :- 445 must_be(list(atom), Args0), 446 447 check_opts_spec(OptsSpec0, ParseOptions, OptsSpec), 448 449 maplist(atom_codes, Args0, Args1), 450 parse_options(OptsSpec, Args1, Args2, PositionalArgs), 451 add_default_opts(OptsSpec, Args2, Args3), 452 453 option(duplicated_flags(Keep), ParseOptions, keeplast), 454 remove_duplicates(Keep, Args3, Args4), 455 456 option(output_functor(Func), ParseOptions, 'OPTION'), 457 refunctor_opts(Func, Args4, Opts). %}}} 458 459 460 461%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MAKE HELP 462opt_help_(OptsSpec0, Help, HelpOptions) :- 463 check_opts_spec(OptsSpec0, HelpOptions, OptsSpec1), 464 include_in_help(OptsSpec1, OptsSpec2), 465 format_help_fields(OptsSpec2, OptsSpec3), 466 col_widths(OptsSpec3, [shortflags, metatypedef], CWs), 467 long_flag_col_width(OptsSpec3, LongestFlagWidth), 468 maplist(format_opt(LongestFlagWidth, CWs, HelpOptions), OptsSpec3, Lines), 469 atomic_list_concat(Lines, Help). 470 471include_in_help([], []). 472include_in_help([OptSpec|OptsSpec], Result) :- 473 ( flags(OptSpec, [_|_]) 474 -> Result = [OptSpec|Rest] 475 ; Result = Rest 476 ), 477 include_in_help(OptsSpec, Rest). 478 479format_help_fields(OptsSpec0, OptsSpec) :- 480 maplist(embellish_flag(short), OptsSpec0, OptsSpec1), 481 maplist(embellish_flag(long), OptsSpec1, OptsSpec2), 482 maplist(merge_meta_type_def, OptsSpec2, OptsSpec). 483 484merge_meta_type_def(OptSpecIn, [metatypedef(MTD)|OptSpecIn]) :- 485 memberchk(meta(Meta), OptSpecIn), 486 memberchk(type(Type), OptSpecIn), 487 memberchk(default(Def), OptSpecIn), 488 atom_length(Meta, N), 489 ( N > 0 490 -> format(atom(MTD), '~w:~w=~w', [Meta, Type, Def]) 491 ; format(atom(MTD), '~w=~w', [Type, Def]) 492 ). 493embellish_flag(short, OptSpecIn, OptSpecOut) :- 494 memberchk(shortflags(FlagsIn), OptSpecIn), 495 maplist(atom_concat('-'), FlagsIn, FlagsOut0), 496 atomic_list_concat(FlagsOut0, ',', FlagsOut), 497 merge_options([shortflags(FlagsOut)], OptSpecIn, OptSpecOut). 498embellish_flag(long, OptSpecIn, OptSpecOut) :- 499 memberchk(longflags(FlagsIn), OptSpecIn), 500 maplist(atom_concat('--'), FlagsIn, FlagsOut), 501 merge_options([longflags(FlagsOut)], OptSpecIn, OptSpecOut). 502 503col_widths(OptsSpec, Functors, ColWidths) :- 504 maplist(col_width(OptsSpec), Functors, ColWidths). 505col_width(OptsSpec, Functor, ColWidth) :- 506 findall(N, 507 ( member(OptSpec, OptsSpec), 508 M =.. [Functor, Arg], 509 member(M, OptSpec), 510 format(atom(Atom), '~w', [Arg]), 511 atom_length(Atom, N0), 512 N is N0 + 2 %separate cols with two spaces 513 ), 514 Ns), 515 max_list([0|Ns], ColWidth). 516 517long_flag_col_width(OptsSpec, ColWidth) :- 518 findall(FlagLength, 519 ( member(OptSpec, OptsSpec), 520 memberchk(longflags(LFlags), OptSpec), 521 member(LFlag, LFlags), 522 atom_length(LFlag, FlagLength) 523 ), 524 FlagLengths), 525 max_list([0|FlagLengths], ColWidth). 526 527 528format_opt(LongestFlagWidth, [SFlagsCW, MTDCW], HelpOptions, Opt, Line) :- 529 memberchk(shortflags(SFlags), Opt), 530 531 memberchk(longflags(LFlags0), Opt), 532 group_length(LongestFlagWidth, LFlags0, LFlags1), 533 LFlagsCW is LongestFlagWidth + 2, %separate with comma and space 534 option(break_long_flags(BLF), HelpOptions, true), 535 ( 536 -> maplist(atomic_list_concat_(',\n'), LFlags1, LFlags2) 537 ; maplist(atomic_list_concat_(', '), LFlags1, LFlags2) 538 ), 539 atomic_list_concat(LFlags2, ',\n', LFlags), 540 541 memberchk(metatypedef(MetaTypeDef), Opt), 542 543 memberchk(help(Help), Opt), 544 HelpIndent is LFlagsCW + SFlagsCW + MTDCW + 2, 545 option(line_width(LW), HelpOptions, 80), 546 option(min_help_width(MHW), HelpOptions, 40), 547 HelpWidth is max(MHW, LW - HelpIndent), 548 ( atom(Help) 549 -> line_breaks(Help, HelpWidth, HelpIndent, BrokenHelp) 550 ; assertion(is_list_of_atoms(Help)) 551 -> indent_lines(Help, HelpIndent, BrokenHelp) 552 ), 553 format(atom(Line), '~w~t~*+~w~t~*+~w~t~*+~w~n', 554 [LFlags, LFlagsCW, SFlags, SFlagsCW, MetaTypeDef, MTDCW, BrokenHelp]). 555 556 557line_breaks(TextLine, LineLength, Indent, TextLines) :- 558 atomic_list_concat(Words, ' ', TextLine), 559 group_length(LineLength, Words, Groups0), 560 maplist(atomic_list_concat_(' '), Groups0, Groups), 561 indent_lines(Groups, Indent, TextLines). 562 563indent_lines(Lines, Indent, TextLines) :- 564 format(atom(Separator), '~n~*|', [Indent]), 565 atomic_list_concat(Lines, Separator, TextLines). 566 567atomic_list_concat_(Separator, List, Atom) :- 568 atomic_list_concat(List, Separator, Atom). 569 570%group_length(10, 571% [here, are, some, words, you, see], 572% [[here are], [some words], [you see]]) %each group >= 10F 573group_length(LineLength, Words, Groups) :- 574 group_length_(Words, LineLength, LineLength, [], [], Groups). 575 576group_length_([], _, _, ThisLine, GroupsAcc, Groups) :- 577 maplist(reverse, [ThisLine|GroupsAcc], GroupsAcc1), 578 reverse(GroupsAcc1, Groups). 579group_length_([Word|Words], LineLength, Remains, ThisLine, Groups, GroupsAcc) :- 580 atom_length(Word, K), 581 ( (Remains >= K; ThisLine = []) %Word fits on ThisLine, or too long too fit 582 -> Remains1 is Remains - K - 1, %even on a new line 583 group_length_(Words, LineLength, Remains1, [Word|ThisLine], Groups, GroupsAcc) 584 585 %Word doesn't fit on ThisLine (non-empty) 586 ; group_length_([Word|Words], LineLength, LineLength, [], [ThisLine|Groups], GroupsAcc) 587 ). 588 589 590%}}} 591 592 593%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OPTSSPEC DEFAULTS 594 595 596add_default_defaults(OptsSpec0, OptsSpec, Options) :- 597 option(suppress_empty_meta(SEM), Options, true), 598 maplist(default_defaults(SEM), OptsSpec0, OptsSpec). 599 600default_defaults(SuppressEmptyMeta, OptSpec0, OptSpec) :- 601 ( 602 -> Meta = '' 603 ; memberchk(type(Type), OptSpec0) 604 -> meta_placeholder(Type, Meta) 605 ; Meta = 'T' 606 ), 607 608 Defaults = [ help('') 609 , type(term) 610 , shortflags([]) 611 , longflags([]) 612 , default('_') 613 , meta(Meta) 614 ], 615 merge_options(OptSpec0, Defaults, OptSpec). 616 %merge_options(+New, +Old, -Merged) 617 618 619meta_placeholder(boolean, 'B'). 620meta_placeholder(atom, 'A'). 621meta_placeholder(float, 'F'). 622meta_placeholder(integer, 'I'). 623meta_placeholder(term, 'T'). 624 625 626 627%}}} 628 629 630%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OPTSSPEC VALIDATION 631 632%this is a bit paranoid, but OTOH efficiency is no issue 633check_opts_spec(OptsSpec0, Options, OptsSpec) :- 634 validate_opts_spec(OptsSpec0, Options), 635 add_default_defaults(OptsSpec0, OptsSpec, Options), 636 validate_opts_spec(OptsSpec, Options). 637 638validate_opts_spec(OptsSpec, ParseOptions) :- 639 \+ invalidate_opts_spec(OptsSpec, ParseOptions). 640 641invalidate_opts_spec(OptsSpec, _ParseOptions) :- 642 %invalid if not ground -- must go first for \+ to be sound 643 ( \+ ground(OptsSpec) 644 -> throw(error(instantiation_error, 645 context(validate_opts_spec/1, 'option spec must be ground'))) 646 647 %invalid if conflicting flags 648 ; ( member(O1, OptsSpec), flags(O1, Flags1), member(F, Flags1), 649 member(O2, OptsSpec), flags(O2, Flags2), member(F, Flags2), 650 O1 \= O2) 651 -> throw(error(domain_error(unique_atom, F), 652 context(validate_opts_spec/1, 'ambiguous flag'))) 653 654 %invalid if unknown opt spec 655 ; ( member(OptSpec, OptsSpec), 656 member(Spec, OptSpec), 657 functor(Spec, F, _), 658 \+ member(F, [opt, shortflags, longflags, type, help, default, meta]) ) 659 -> throw(error(domain_error(opt_spec, F), 660 context(validate_opts_spec/1, 'unknown opt spec'))) 661 662 %invalid if mandatory option spec opt(ID) is not unique in the entire Spec 663 ; ( member(O1, OptsSpec), member(opt(Name), O1), 664 member(O2, OptsSpec), member(opt(Name), O2), 665 O1 \= O2) 666 -> throw(error(domain_error(unique_atom, Name), 667 context(validate_opts_spec/1, 'ambiguous id'))) 668 ). 669 670invalidate_opts_spec(OptsSpec, _ParseOptions) :- 671 member(OptSpec, OptsSpec), 672 \+ member(opt(_Name), OptSpec), 673 %invalid if mandatory option spec opt(ID) is absent 674 throw(error(domain_error(unique_atom, OptSpec), 675 context(validate_opts_spec/1, 'opt(id) missing'))). 676 677invalidate_opts_spec(OptsSpec, ParseOptions) :- 678 member(OptSpec, OptsSpec), %if we got here, OptSpec has a single unique Name 679 member(opt(Name), OptSpec), 680 681 option(allow_empty_flag_spec(AllowEmpty), ParseOptions, true), 682 683 %invalid if allow_empty_flag_spec(false) and no flag is given 684 ( (\+ , \+ flags(OptSpec, [_|_])) 685 -> format(atom(Msg), 'no flag specified for option ''~w''', [Name]), 686 throw(error(domain_error(unique_atom, _), 687 context(validate_opts_spec/1, Msg))) 688 689 %invalid if any short flag is not actually single-letter 690 ; ( memberchk(shortflags(Flags), OptSpec), 691 member(F, Flags), 692 atom_length(F, L), 693 L > 1) 694 -> format(atom(Msg), 'option ''~w'': flag too long to be short', [Name]), 695 throw(error(domain_error(short_flag, F), 696 context(validate_opts_spec/1, Msg))) 697 698 %invalid if any option spec is given more than once 699 ; duplicate_optspec(OptSpec, 700 [type,opt,default,help,shortflags,longflags,meta]) 701 -> format(atom(Msg), 'duplicate spec in option ''~w''', [Name]), 702 throw(error(domain_error(unique_functor, _), 703 context(validate_opts_spec/1, Msg))) 704 705 %invalid if unknown type 706 ; ( memberchk(type(Type), OptSpec), 707 Type \== term, 708 \+ clause(error:has_type(Type,_), _) 709 ) 710 -> format(atom(Msg), 'unknown type ''~w'' in option ''~w''', [Type, Name]), 711 throw(error(type_error(flag_value, Type), 712 context(validate_opts_spec/1, Msg))) 713 714 %invalid if type does not match default 715 %note1: reverse logic: we are trying to _in_validate OptSpec 716 717 %note2: 'term' approves of any syntactically valid prolog term, since 718 %if syntactically invalid, OptsSpec wouldn't have parsed 719 720 %note3: the special placeholder '_' creates a new variable, so no typecheck 721 ; (memberchk(type(Type), OptSpec), 722 Type \= term, 723 memberchk(default(Default), OptSpec), 724 Default \= '_' 725 -> \+ must_be(Type, Default)) 726 727 %invalidation failed, i.e., optspec is OK 728 ; fail 729 ). 730 731duplicate_optspec(_, []) :- !, fail. 732duplicate_optspec(OptSpec, [Func|Funcs]) :- 733 functor(F, Func, 1), 734 findall(F, member(F, OptSpec), Xs), 735 (Xs = [_,_|_] 736 -> true 737 ; duplicate_optspec(OptSpec, Funcs) 738 ). 739 740 741%}}} 742 743 744%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PARSE OPTIONS 745% NOTE: 746% -sbar could be interpreted in two ways: as short for -s bar, and 747% as short ('clustered') for -s -b -a -r. Here, the former interpretation 748% is chosen. 749% Cf http://perldoc.perl.org/Getopt/Long.html (no clustering by default) 750 751 752parse_options(OptsSpec, Args0, Options, PosArgs) :- 753 append(Args0, [""], Args1), 754 parse_args_(Args1, OptsSpec, Args2), 755 partition_args_(Args2, Options, PosArgs). 756 757%{{{ PARSE ARGS 758 759 760%if arg is boolean flag given as --no-my-arg, expand to my-arg, false, re-call 761parse_args_([Arg,Arg2|Args], OptsSpec, [opt(KID, false)|Result]) :- 762 flag_name_long_neg(Dashed, NonDashed, Arg, []), 763 flag_id_type(OptsSpec, NonDashed, KID, boolean), 764 !, 765 parse_args_([Dashed, "false", Arg2|Args], OptsSpec, Result). 766 767%if arg is ordinary boolean flag, fill in implicit true if arg absent; re-call 768parse_args_([Arg,Arg2|Args], OptsSpec, Result) :- 769 flag_name(K, Arg, []), 770 flag_id_type(OptsSpec, K, _KID, boolean), 771 \+ member(Arg2, ["true", "false"]), 772 !, 773 parse_args_([Arg, "true", Arg2 | Args], OptsSpec, Result). 774 775% separate short or long flag run together with its value and parse 776parse_args_([Arg|Args], OptsSpec, [opt(KID, Val)|Result]) :- 777 flag_name_value(Arg1, Arg2, Arg, []), 778 \+ short_flag_w_equals(Arg1, Arg2), 779 flag_name(K, Arg1, []), 780 !, 781 parse_option(OptsSpec, K, Arg2, opt(KID, Val)), 782 parse_args_(Args, OptsSpec, Result). 783 784%from here, unparsed args have form 785% PosArg1,Flag1,Val1,PosArg2,PosArg3,Flag2,Val2, PosArg4... 786%i.e., positional args may go anywhere except between FlagN and ValueN 787%(of course, good programming style says they should go last, but it is poor 788%programming style to assume that) 789 790parse_args_([Arg1,Arg2|Args], OptsSpec, [opt(KID, Val)|Result]) :- 791 flag_name(K, Arg1, []), 792 !, 793 parse_option(OptsSpec, K, Arg2, opt(KID, Val)), 794 parse_args_(Args, OptsSpec, Result). 795 796parse_args_([Arg1,Arg2|Args], OptsSpec, [pos(At)|Result]) :- 797 \+ flag_name(_, Arg1, []), 798 !, 799 atom_codes(At, Arg1), 800 parse_args_([Arg2|Args], OptsSpec, Result). 801 802parse_args_([""], _, []) :- !. %placeholder, but useful for error messages 803parse_args_([], _, []) :- !. 804 805short_flag_w_equals([0'-,_C], [0'=|_]) :- 806 throw(error(syntax_error('disallowed: <shortflag>=<value>'),_)). 807 808 809 810flag_id_type(OptsSpec, FlagCodes, ID, Type) :- 811 atom_codes(Flag, FlagCodes), 812 member(OptSpec, OptsSpec), 813 flags(OptSpec, Flags), 814 member(Flag, Flags), 815 member(type(Type), OptSpec), 816 member(opt(ID), OptSpec). 817 818%{{{ FLAG DCG 819 820%DCG non-terminals: 821% flag_name(NonDashed) %c, flag-name, x 822% flag_name_short(Dashed, NonDashed) %c, x 823% flag_name_long(Dashed, NonDashed) %flag-name 824% flag_name_long_neg(Dashed, NonDashed) %no-flag-name 825% flag_value(Val) %non-empty string 826% flag_value0(Val) %any string, also empty 827% flag_name_value(Dashed, Val) %pair of flag_name, flag_value 828 829 830flag_name(NonDashed) --> flag_name_long(_, NonDashed). 831flag_name(NonDashed) --> flag_name_short(_, NonDashed). 832flag_name(NonDashed) --> flag_name_long_neg(_, NonDashed). 833 834flag_name_long_neg([0'-,0'-|Cs], Cs) --> "--no-", name_long(Cs). 835flag_name_long([0'-,0'-|Cs], Cs) --> "--", name_long(Cs). 836flag_name_short([0'-|C], C) --> "-", name_1st(C). 837 838flag_value([C|Cs]) --> [C], flag_value0(Cs). 839flag_value0([]) --> []. 840flag_value0([C|Cs]) --> [C], flag_value0(Cs). 841flag_name_value(Dashed, Val) --> flag_name_long(Dashed, _), "=", flag_value0(Val). 842flag_name_value(Dashed, Val) --> flag_name_short(Dashed, _), flag_value(Val). 843 844name_long([C|Cs]) --> name_1st([C]), name_rest(Cs). 845name_1st([C]) --> [C], {name_1st(C)}. 846name_rest([]) --> []. 847name_rest([C|Cs]) --> [C], {name_char(C)}, name_rest(Cs). 848name_1st(C) :- char_type(C, alpha). 849name_char(C) :- char_type(C, alpha). 850name_char( 0'_ ). 851name_char( 0'- ). %}}} 852 853 854%{{{ PARSE OPTION 855parse_option(OptsSpec, Arg1, Arg2, opt(KID, Val)) :- 856 ( flag_id_type(OptsSpec, Arg1, KID, Type) 857 -> parse_val(Arg1, Type, Arg2, Val) 858 ; format(atom(Msg), '~s', [Arg1]), 859 opt_help(OptsSpec, Help), %unknown flag: dump usage on stderr 860 nl(user_error), 861 write(user_error, Help), 862 throw(error(domain_error(flag_value, Msg),context(_, 'unknown flag'))) 863 ). 864 865 866parse_val(Opt, Type, Cs, Val) :- 867 catch( 868 parse_loc(Type, Cs, Val), 869 E, 870 ( format('~nERROR: flag ''~s'': expected atom parsable as ~w, found ''~s'' ~n', 871 [Opt, Type, Cs]), 872 throw(E)) 873 ). 874 875%parse_loc(+Type, +ListOfCodes, -Result). 876parse_loc(Type, _LOC, _) :- 877 var(Type), !, throw(error(instantiation_error, _)). 878parse_loc(_Type, LOC, _) :- 879 var(LOC), !, throw(error(instantiation_error, _)). 880parse_loc(boolean, Cs, true) :- atom_codes(true, Cs), !. 881parse_loc(boolean, Cs, false) :- atom_codes(false, Cs), !. 882parse_loc(atom, Cs, Result) :- atom_codes(Result, Cs), !. 883parse_loc(integer, Cs, Result) :- 884 number_codes(Result, Cs), 885 integer(Result), 886 887 !. 888parse_loc(float, Cs, Result) :- 889 number_codes(Result, Cs), 890 float(Result), 891 892 !. 893parse_loc(term, Cs, Result) :- 894 atom_codes(A, Cs), 895 term_to_atom(Result, A), 896 897 !. 898parse_loc(Type, Cs, Result) :- 899 parse_type(Type, Cs, Result), 900 !. 901parse_loc(Type, _Cs, _) :- %could not parse Cs as Type 902 throw(error(type_error(flag_value, Type), _)), 903 !. %}}} 904%}}} 905 906%% parse_type(+Type, +Codes:list(code), -Result) is semidet. 907% 908% Hook to parse option text Codes to an object of type Type. 909 910partition_args_([], [], []). 911partition_args_([opt(K,V)|Rest], [opt(K,V)|RestOpts], RestPos) :- 912 !, 913 partition_args_(Rest, RestOpts, RestPos). 914partition_args_([pos(Arg)|Rest], RestOpts, [Arg|RestPos]) :- 915 !, 916 partition_args_(Rest, RestOpts, RestPos). 917 918 919 920 921%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ADD DEFAULTS 922 923add_default_opts([], Opts, Opts). 924add_default_opts([OptSpec|OptsSpec], OptsIn, Result) :- 925 memberchk(opt(OptName), OptSpec), 926 ( memberchk(opt(OptName, _Val), OptsIn) 927 -> Result = OptsOut %value given on cl, ignore default 928 929 ; %value not given on cl: 930 memberchk(default('_'), OptSpec) % no default in OptsSpec (or 'VAR'): 931 -> Result = [opt(OptName, _) | OptsOut] % create uninstantiated variable 932 ; 933 memberchk(default(Def), OptSpec), % default given in OptsSpec 934% memberchk(type(Type), OptSpec), % already typechecked 935% assertion(must_be(Type, Def)), 936 Result = [opt(OptName, Def) | OptsOut] 937 ), 938 add_default_opts(OptsSpec, OptsIn, OptsOut). 939 940 941 942%}}} 943 944 945%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% REMOVE DUPLICATES 946remove_duplicates(_, [], []) :- !. 947remove_duplicates(keeplast, [opt(OptName, Val) | Opts], Result) :- 948 !, 949 ( memberchk(opt(OptName, _), Opts) 950 -> Result = RestOpts 951 ; Result = [opt(OptName, Val) | RestOpts] 952 ), 953 remove_duplicates(keeplast, Opts, RestOpts). 954 955remove_duplicates(keepfirst, OptsIn, OptsOut) :- 956 !, 957 reverse(OptsIn, OptsInRev), 958 remove_duplicates(keeplast, OptsInRev, OptsOutRev), 959 reverse(OptsOutRev, OptsOut). 960 961remove_duplicates(keepall, OptsIn, OptsIn) :- !. 962remove_duplicates(K, [_|_], _) :- 963 !, 964 throw(error(domain_error(keep_flag, K), _)). %}}} 965 966 967%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% REFUNCTOR 968refunctor_opts(Fnct, OptsIn, OptsOut) :- 969 maplist(refunctor_opt(Fnct), OptsIn, OptsOut). 970 971refunctor_opt('OPTION', opt(OptName, OptVal), Result) :- 972 !, 973 Result =.. [OptName, OptVal]. 974 975refunctor_opt(F, opt(OptName, OptVal), Result) :- 976 Result =.. [F, OptName, OptVal]. %}}} 977 978 979%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ACCESSORS 980 981flags(OptSpec, Flags) :- memberchk(shortflags(Flags), OptSpec). 982flags(OptSpec, Flags) :- memberchk(longflags(Flags), OptSpec). %}}} 983 984%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% UTILS 985is_list_of_atoms([]). 986is_list_of_atoms([X|Xs]) :- atom(X), is_list_of_atoms(Xs). 987%}}}