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:- use_module(library(debug),[assertion/1]). 44:- autoload(library(error),[must_be/2, current_type/3]). 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) ; string(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%! add_default_defaults(+OptSpecIn, -OptSpec, +Options) is det. 594% 595% Add defaults to the user speficified options. 596 597add_default_defaults(OptsSpec0, OptsSpec, Options) :- 598 option(suppress_empty_meta(SEM), Options, true), 599 maplist(default_defaults(SEM), OptsSpec0, OptsSpec). 600 601default_defaults(SuppressEmptyMeta, OptSpec0, OptSpec) :- 602 ( 603 -> Meta = '' 604 ; memberchk(type(Type), OptSpec0) 605 -> meta_placeholder(Type, Meta) 606 ; Meta = 'T' 607 ), 608 609 Defaults = [ help(''), 610 type(term), 611 shortflags([]), 612 longflags([]), 613 default('_'), 614 meta(Meta) 615 ], 616 merge_options(OptSpec0, Defaults, OptSpec). 617 618meta_placeholder(boolean, 'B'). 619meta_placeholder(atom, 'A'). 620meta_placeholder(float, 'F'). 621meta_placeholder(integer, 'I'). 622meta_placeholder(term, 'T'). 623 624 625%! check_opts_spec(+OptSpecIn, +Options, -OptSpec) 626% 627% Verify and possibly fix the user option specification. 628 629check_opts_spec(OptsSpec0, Options, OptsSpec) :- 630 validate_opts_spec(OptsSpec0, Options), 631 add_default_defaults(OptsSpec0, OptsSpec, Options), 632 validate_opts_spec(OptsSpec, Options). 633 634validate_opts_spec(OptsSpec, ParseOptions) :- 635 \+ invalidate_opts_spec(OptsSpec, ParseOptions). 636 637invalidate_opts_spec(OptsSpec, _ParseOptions) :- 638 %invalid if not ground -- must go first for \+ to be sound 639 ( \+ ground(OptsSpec) 640 -> throw(error(instantiation_error, 641 context(validate_opts_spec/1, 'option spec must be ground'))) 642 643 %invalid if conflicting flags 644 ; member(O1, OptsSpec), flags(O1, Flags1), member(F, Flags1), 645 member(O2, OptsSpec), flags(O2, Flags2), member(F, Flags2), 646 O1 \= O2 647 -> throw(error(domain_error(unique_atom, F), 648 context(validate_opts_spec/1, 'ambiguous flag'))) 649 650 %invalid if unknown opt spec 651 ; member(OptSpec, OptsSpec), 652 member(Spec, OptSpec), 653 functor(Spec, F, _), 654 \+ member(F, [opt, shortflags, longflags, type, help, default, meta]) 655 -> throw(error(domain_error(opt_spec, F), 656 context(validate_opts_spec/1, 'unknown opt spec'))) 657 658 %invalid if mandatory option spec opt(ID) is not unique in the entire Spec 659 ; member(O1, OptsSpec), member(opt(Name), O1), 660 member(O2, OptsSpec), member(opt(Name), O2), 661 O1 \= O2 662 -> throw(error(domain_error(unique_atom, Name), 663 context(_, 'ambiguous id'))) 664 ). 665invalidate_opts_spec(OptsSpec, _ParseOptions) :- 666 member(OptSpec, OptsSpec), 667 \+ member(opt(_Name), OptSpec), 668 %invalid if mandatory option spec opt(ID) is absent 669 throw(error(domain_error(unique_atom, OptSpec), 670 context(_, 'opt(id) missing'))). 671invalidate_opts_spec(OptsSpec, ParseOptions) :- 672 member(OptSpec, OptsSpec), %if we got here, OptSpec has a single unique Name 673 member(opt(Name), OptSpec), 674 675 option(allow_empty_flag_spec(AllowEmpty), ParseOptions, true), 676 677 %invalid if allow_empty_flag_spec(false) and no flag is given 678 ( ( AllowEmpty \== true, 679 \+ flags(OptSpec, [_|_]) 680 ) 681 -> format(atom(Msg), 'no flag specified for option ''~w''', [Name]), 682 throw(error(domain_error(unique_atom, _), 683 context(_, Msg))) 684 685 %invalid if any short flag is not actually single-letter 686 ; memberchk(shortflags(Flags), OptSpec), 687 member(F, Flags), 688 atom_length(F, L), 689 L > 1 690 -> format(atom(Msg), 'option ''~w'': flag too long to be short', [Name]), 691 throw(error(domain_error(short_flag, F), 692 context(_, Msg))) 693 694 %invalid if any option spec is given more than once 695 ; duplicate_optspec(OptSpec, 696 [type,opt,default,help,shortflags,longflags,meta]) 697 -> format(atom(Msg), 'duplicate spec in option ''~w''', [Name]), 698 throw(error(domain_error(unique_functor, _), 699 context(_, Msg))) 700 701 %invalid if unknown type 702 ; memberchk(type(Type), OptSpec), 703 Type \== term, 704 \+ ( current_type(Type, _Var, _Body) 705 ; clause(parse_type(Type, _, _), _) 706 ) 707 -> existence_error(type, Type) 708 709 ; memberchk(type(Type), OptSpec), 710 current_type(Type, _, _), 711 memberchk(default(Default), OptSpec), 712 Default \== '_' 713 -> \+ must_be(Type, Default) 714 715 ; fail 716 ). 717 718duplicate_optspec(_, []) :- !, fail. 719duplicate_optspec(OptSpec, [Func|Funcs]) :- 720 functor(F, Func, 1), 721 findall(F, member(F, OptSpec), Xs), 722 ( Xs = [_,_|_] 723 -> true 724 ; duplicate_optspec(OptSpec, Funcs) 725 ). 726 727%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PARSE OPTIONS 728% NOTE: 729% -sbar could be interpreted in two ways: as short for -s bar, and 730% as short ('clustered') for -s -b -a -r. Here, the former interpretation 731% is chosen. 732% Cf http://perldoc.perl.org/Getopt/Long.html (no clustering by default) 733 734 735parse_options(OptsSpec, Args0, Options, PosArgs) :- 736 append(Args0, [""], Args1), 737 parse_args_(Args1, OptsSpec, Args2), 738 partition_args_(Args2, Options, PosArgs). 739 740%{{{ PARSE ARGS 741 742 743%if arg is boolean flag given as --no-my-arg, expand to my-arg, false, re-call 744parse_args_([Arg,Arg2|Args], OptsSpec, [opt(KID, false)|Result]) :- 745 flag_name_long_neg(Dashed, NonDashed, Arg, []), 746 flag_id_type(OptsSpec, NonDashed, KID, boolean), 747 !, 748 parse_args_([Dashed, "false", Arg2|Args], OptsSpec, Result). 749 750%if arg is ordinary boolean flag, fill in implicit true if arg absent; re-call 751parse_args_([Arg,Arg2|Args], OptsSpec, Result) :- 752 flag_name(K, Arg, []), 753 flag_id_type(OptsSpec, K, _KID, boolean), 754 \+ member(Arg2, ["true", "false"]), 755 !, 756 parse_args_([Arg, "true", Arg2 | Args], OptsSpec, Result). 757 758% separate short or long flag run together with its value and parse 759parse_args_([Arg|Args], OptsSpec, [opt(KID, Val)|Result]) :- 760 flag_name_value(Arg1, Arg2, Arg, []), 761 \+ short_flag_w_equals(Arg1, Arg2), 762 flag_name(K, Arg1, []), 763 !, 764 parse_option(OptsSpec, K, Arg2, opt(KID, Val)), 765 parse_args_(Args, OptsSpec, Result). 766 767%from here, unparsed args have form 768% PosArg1,Flag1,Val1,PosArg2,PosArg3,Flag2,Val2, PosArg4... 769%i.e., positional args may go anywhere except between FlagN and ValueN 770%(of course, good programming style says they should go last, but it is poor 771%programming style to assume that) 772 773parse_args_([Arg1,Arg2|Args], OptsSpec, [opt(KID, Val)|Result]) :- 774 flag_name(K, Arg1, []), 775 !, 776 parse_option(OptsSpec, K, Arg2, opt(KID, Val)), 777 parse_args_(Args, OptsSpec, Result). 778 779parse_args_([Arg1,Arg2|Args], OptsSpec, [pos(At)|Result]) :- 780 \+ flag_name(_, Arg1, []), 781 !, 782 atom_codes(At, Arg1), 783 parse_args_([Arg2|Args], OptsSpec, Result). 784 785parse_args_([""], _, []) :- !. %placeholder, but useful for error messages 786parse_args_([], _, []) :- !. 787 788short_flag_w_equals([0'-,_C], [0'=|_]) :- 789 throw(error(syntax_error('disallowed: <shortflag>=<value>'),_)). 790 791%! flag_id_type(+OptSpec, +FlagCodes, -ID, -Type) is semidet. 792 793flag_id_type(OptsSpec, FlagCodes, ID, Type) :- 794 atom_codes(Flag, FlagCodes), 795 member(OptSpec, OptsSpec), 796 flags(OptSpec, Flags), 797 member(Flag, Flags), 798 member(type(Type), OptSpec), 799 member(opt(ID), OptSpec). 800 801%{{{ FLAG DCG 802 803%DCG non-terminals: 804% flag_name(NonDashed) %c, flag-name, x 805% flag_name_short(Dashed, NonDashed) %c, x 806% flag_name_long(Dashed, NonDashed) %flag-name 807% flag_name_long_neg(Dashed, NonDashed) %no-flag-name 808% flag_value(Val) %non-empty string 809% flag_value0(Val) %any string, also empty 810% flag_name_value(Dashed, Val) %pair of flag_name, flag_value 811 812 813flag_name(NonDashed) --> flag_name_long(_, NonDashed). 814flag_name(NonDashed) --> flag_name_short(_, NonDashed). 815flag_name(NonDashed) --> flag_name_long_neg(_, NonDashed). 816 817flag_name_long_neg([0'-,0'-|Cs], Cs) --> "--no-", name_long(Cs). 818flag_name_long([0'-,0'-|Cs], Cs) --> "--", name_long(Cs). 819flag_name_short([0'-|C], C) --> "-", name_1st(C). 820 821flag_value([C|Cs]) --> [C], flag_value0(Cs). 822flag_value0([]) --> []. 823flag_value0([C|Cs]) --> [C], flag_value0(Cs). 824flag_name_value(Dashed, Val) --> flag_name_long(Dashed, _), "=", flag_value0(Val). 825flag_name_value(Dashed, Val) --> flag_name_short(Dashed, _), flag_value(Val). 826 827name_long([C|Cs]) --> name_1st([C]), name_rest(Cs). 828name_1st([C]) --> [C], {name_1st(C)}. 829name_rest([]) --> []. 830name_rest([C|Cs]) --> [C], {name_char(C)}, name_rest(Cs). 831name_1st(C) :- char_type(C, alpha). 832name_char(C) :- char_type(C, alpha). 833name_char( 0'_ ). 834name_char( 0'- ). %}}} 835 836 837%! parse_option(+OptSpec, +Flag:codes, +Val:codes, -Opt) 838 839parse_option(OptsSpec, Arg1, Arg2, opt(KID, Val)) :- 840 ( flag_id_type(OptsSpec, Arg1, KID, Type) 841 -> parse_val(Arg1, Type, Arg2, Val) 842 ; atom_codes(Flag, Arg1), 843 existence_error(commandline_option, Flag) 844 ). 845 846 847parse_val(Opt, Type, Cs, Val) :- 848 catch( 849 parse_loc(Type, Cs, Val), 850 E, 851 ( format('~nERROR: flag ''~s'': expected atom parsable as ~w, found ''~s'' ~n', 852 [Opt, Type, Cs]), 853 throw(E)) 854 ). 855 856%! parse_loc(+Type, +ListOfCodes, -Result). 857 858parse_loc(Type, _LOC, _) :- 859 var(Type), !, throw(error(instantiation_error, _)). 860parse_loc(_Type, LOC, _) :- 861 var(LOC), !, throw(error(instantiation_error, _)). 862parse_loc(boolean, Cs, true) :- atom_codes(true, Cs), !. 863parse_loc(boolean, Cs, false) :- atom_codes(false, Cs), !. 864parse_loc(atom, Cs, Result) :- atom_codes(Result, Cs), !. 865parse_loc(integer, Cs, Result) :- 866 number_codes(Result, Cs), 867 integer(Result), 868 !. 869parse_loc(float, Cs, Result) :- 870 number_codes(Result, Cs), 871 float(Result), 872 !. 873parse_loc(term, Cs, Result) :- 874 atom_codes(A, Cs), 875 term_to_atom(Result, A), 876 !. 877parse_loc(Type, Cs, Result) :- 878 parse_type(Type, Cs, Result), 879 !. 880parse_loc(Type, _Cs, _) :- %could not parse Cs as Type 881 throw(error(type_error(flag_value, Type), _)), 882 !. %}}} 883%}}} 884 885%% parse_type(+Type, +Codes:list(code), -Result) is semidet. 886% 887% Hook to parse option text Codes to an object of type Type. 888 889partition_args_([], [], []). 890partition_args_([opt(K,V)|Rest], [opt(K,V)|RestOpts], RestPos) :- 891 !, 892 partition_args_(Rest, RestOpts, RestPos). 893partition_args_([pos(Arg)|Rest], RestOpts, [Arg|RestPos]) :- 894 !, 895 partition_args_(Rest, RestOpts, RestPos). 896 897 898 899 900%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ADD DEFAULTS 901 902add_default_opts([], Opts, Opts). 903add_default_opts([OptSpec|OptsSpec], OptsIn, Result) :- 904 memberchk(opt(OptName), OptSpec), 905 ( memberchk(opt(OptName, _Val), OptsIn) 906 -> Result = OptsOut %value given on cl, ignore default 907 908 ; %value not given on cl: 909 memberchk(default('_'), OptSpec) % no default in OptsSpec (or 'VAR'): 910 -> Result = [opt(OptName, _) | OptsOut] % create uninstantiated variable 911 ; 912 memberchk(default(Def), OptSpec), % default given in OptsSpec 913% memberchk(type(Type), OptSpec), % already typechecked 914% assertion(must_be(Type, Def)), 915 Result = [opt(OptName, Def) | OptsOut] 916 ), 917 add_default_opts(OptsSpec, OptsIn, OptsOut). 918 919 920 921%}}} 922 923 924%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% REMOVE DUPLICATES 925remove_duplicates(_, [], []) :- !. 926remove_duplicates(keeplast, [opt(OptName, Val) | Opts], Result) :- 927 !, 928 ( memberchk(opt(OptName, _), Opts) 929 -> Result = RestOpts 930 ; Result = [opt(OptName, Val) | RestOpts] 931 ), 932 remove_duplicates(keeplast, Opts, RestOpts). 933 934remove_duplicates(keepfirst, OptsIn, OptsOut) :- 935 !, 936 reverse(OptsIn, OptsInRev), 937 remove_duplicates(keeplast, OptsInRev, OptsOutRev), 938 reverse(OptsOutRev, OptsOut). 939 940remove_duplicates(keepall, OptsIn, OptsIn) :- !. 941remove_duplicates(K, [_|_], _) :- 942 !, 943 throw(error(domain_error(keep_flag, K), _)). %}}} 944 945 946%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% REFUNCTOR 947refunctor_opts(Fnct, OptsIn, OptsOut) :- 948 maplist(refunctor_opt(Fnct), OptsIn, OptsOut). 949 950refunctor_opt('OPTION', opt(OptName, OptVal), Result) :- 951 !, 952 Result =.. [OptName, OptVal]. 953 954refunctor_opt(F, opt(OptName, OptVal), Result) :- 955 Result =.. [F, OptName, OptVal]. %}}} 956 957 958%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ACCESSORS 959 960flags(OptSpec, Flags) :- memberchk(shortflags(Flags), OptSpec). 961flags(OptSpec, Flags) :- memberchk(longflags(Flags), OptSpec). %}}} 962 963%{{{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% UTILS 964is_list_of_atoms([]). 965is_list_of_atoms([X|Xs]) :- atom(X), is_list_of_atoms(Xs). 966%}}}