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

command line parsing

This module helps in building a command-line interface to an application. In particular, it provides functions that take an option specification and a list of atoms, probably given to the program on the command line, and return a parsed representation (a list of the customary Key(Val) by default; or optionally, a list of Func(Key, Val) terms in the style of current_prolog_flag/2). It can also synthesize a simple help text from the options specification.

The terminology in the following is partly borrowed from python, see http://docs.python.org/library/optparse.html#terminology . Very briefly, arguments is what you provide on the command line and for many prologs show up as a list of atoms Args in current_prolog_flag(argv, Args). For a typical prolog incantation, they can be divided into

runtime arguments, which controls the prolog runtime; conventionally, they are ended by '--';
options, which are key-value pairs (with a boolean value possibly implicit) intended to control your program in one way or another; and
positional arguments, which is what remains after all runtime arguments and options have been removed (with implicit arguments -- true/false for booleans -- filled in).

Positional arguments are in particular used for mandatory arguments without which your program won't work and for which there are no sensible defaults (e.g,, input file names). Options, by contrast, offer flexibility by letting you change a default setting. Options are optional not only by etymology: this library has no notion of mandatory or required options (see the python docs for other rationales than laziness).

The command-line arguments enter your program as a list of atoms, but the programs perhaps expects booleans, integers, floats or even prolog terms. You tell the parser so by providing an options specification. This is just a list of individual option specifications. One of those, in turn, is a list of ground prolog terms in the customary Name(Value) format. The following terms are recognized (any others raise error).

opt(Key): Key is what the option later will be accessed by, just like for current_prolog_flag(Key, Value). This term is mandatory (an error is thrown if missing).
shortflags(ListOfFlags): ListOfFlags denotes any single-dashed, single letter args specifying the current option (-s , -K, etc). Uppercase letters must be quoted. Usually ListOfFlags will be a singleton list, but sometimes aliased flags may be convenient.
longflags(ListOfFlags): ListOfFlags denotes any double-dashed arguments specifying the current option (--verbose, --no-debug, etc). They are basically a more readable alternative to short flags, except

long flags can be specified as --flag value or --flag=value (but not as --flagvalue); short flags as -f val or -fval (but not -f=val)
boolean long flags can be specified as --bool-flag or --bool-flag=true or --bool-flag true; and they can be negated as --no-bool-flag or --bool-flag=false or --bool-flag false.
Except that shortflags must be single characters, the distinction between long and short is in calling convention, not in namespaces. Thus, if you have shortflags([v]), you can use it as -v2 or -v 2 or --v=2 or --v 2 (but not -v=2 or --v2).

Shortflags and longflags both default to []. It can be useful to have flagless options -- see example below.

meta(Meta): Meta is optional and only relevant for the synthesized usage message and is the name (an atom) of the metasyntactic variable (possibly) appearing in it together with type and default value (e.g, x:integer=3, interest:float=0.11). It may be useful to have named variables (x, interest) in case you wish to mention them again in the help text. If not given the Meta: part is suppressed -- see example below.
type(Type): Type is one of boolean, atom, integer, float, term. The corresponding argument will be parsed appropriately. This term is optional; if not given, defaults to term.
default(Default): Default value. This term is optional; if not given, or if given the special value '_', an uninstantiated variable is created (and any type declaration is ignored).
help(Help): Help is (usually) an atom of text describing the option in the help text. This term is optional (but obviously strongly recommended for all options which have flags).
Long lines are subject to basic word wrapping -- split on white space, reindent, rejoin. However, you can get more control by supplying the line breaking yourself: rather than a single line of text, you can provide a list of lines (as atoms). If you do, they will be joined with the appropriate indent but otherwise left untouched (see the option mode in the example below).

Absence of mandatory option specs or the presence of more than one for a particular option throws an error, as do unknown or incompatible types.

As a concrete example from a fictive application, suppose we want the following options to be read from the command line (long flag(s), short flag(s), meta:type=default, help)

--mode                  -m     atom=SCAN       data gathering mode,
                                               one of
                                                SCAN: do this
                                                READ: do that
                                                MAKE: make numbers
                                                WAIT: do nothing
--rebuild-cache         -r     boolean=true    rebuild cache in
                                               each iteration
--heisenberg-threshold  -t,-h  float=0.1       heisenberg threshold
--depths, --iters       -i,-d  K:integer=3     stop after K
                                               iterations
--distances                    term=[1,2,3,5]  initial prolog term
--output-file           -o     FILE:atom=_     write output to FILE
--label                 -l     atom=REPORT     report label
--verbosity             -v     V:integer=2     verbosity level,
                                               1 <= V <= 3

We may also have some configuration parameters which we currently think not needs to be controlled from the command line, say path('/some/file/path').

This interface is described by the following options specification (order between the specifications of a particular option is irrelevant).

ExampleOptsSpec =
    [ [opt(mode    ), type(atom), default('SCAN'),
        shortflags([m]),   longflags(['mode'] ),
        help([ 'data gathering mode, one of'
             , '  SCAN: do this'
             , '  READ: do that'
             , '  MAKE: fabricate some numbers'
             , '  WAIT: don''t do anything'])]

    , [opt(cache), type(boolean), default(true),
        shortflags([r]),   longflags(['rebuild-cache']),
        help('rebuild cache in each iteration')]

    , [opt(threshold), type(float), default(0.1),
        shortflags([t,h]),  longflags(['heisenberg-threshold']),
        help('heisenberg threshold')]

    , [opt(depth), meta('K'), type(integer), default(3),
        shortflags([i,d]),longflags([depths,iters]),
        help('stop after K iterations')]

    , [opt(distances), default([1,2,3,5]),
        longflags([distances]),
        help('initial prolog term')]

    , [opt(outfile), meta('FILE'), type(atom),
        shortflags([o]),  longflags(['output-file']),
        help('write output to FILE')]

    , [opt(label), type(atom), default('REPORT'),
        shortflags([l]), longflags([label]),
        help('report label')]

    , [opt(verbose),  meta('V'), type(integer), default(2),
        shortflags([v]),  longflags([verbosity]),
        help('verbosity level, 1 <= V <= 3')]

    , [opt(path), default('/some/file/path/')]
    ].

The help text above was accessed by opt_help(ExamplesOptsSpec, HelpText). The options appear in the same order as in the OptsSpec.

Given ExampleOptsSpec, a command line (somewhat syntactically inconsistent, in order to demonstrate different calling conventions) may look as follows

ExampleArgs = [ '-d5'
              , '--heisenberg-threshold', '0.14'
              , '--distances=[1,1,2,3,5,8]'
              , '--iters', '7'
              , '-ooutput.txt'
              , '--rebuild-cache', 'true'
              , 'input.txt'
              , '--verbosity=2'
              ].

opt_parse(ExampleOptsSpec, ExampleArgs, Opts, PositionalArgs) would then succeed with

Opts =    [ mode('SCAN')
          , label('REPORT')
          , path('/some/file/path')
          , threshold(0.14)
          , distances([1,1,2,3,5,8])
          , depth(7)
          , outfile('output.txt')
          , cache(true)
          , verbose(2)
          ],
PositionalArgs = ['input.txt'].

Note that path('/some/file/path') showing up in Opts has a default value (of the implicit type 'term'), but no corresponding flags in OptsSpec. Thus it can't be set from the command line. The rest of your program doesn't need to know that, of course. This provides an alternative to the common practice of asserting such hard-coded parameters under a single predicate (for instance setting(path, '/some/file/path')), with the advantage that you may seamlessly upgrade them to command-line options, should you one day find this a good idea. Just add an appropriate flag or two and a line of help text. Similarly, suppressing an option in a cluttered interface amounts to commenting out the flags.

opt_parse/5 allows more control through an additional argument list as shown in the example below.

?- opt_parse(ExampleOptsSpec, ExampleArgs,  Opts, PositionalArgs,
             [ output_functor(appl_config)
             ]).

Opts =    [ appl_config(verbose, 2),
          , appl_config(label, 'REPORT')
          ...
          ]

This representation may be preferable with the empty-flag configuration parameter style above (perhaps with asserting appl_config/2).

Notes and tips

In the example we were mostly explicit about the types. Since the default is term, which subsumes integer, float, atom, it may be possible to get away cheaper (e.g., by only giving booleans). However, it is recommended practice to always specify types: parsing becomes more reliable and error messages will be easier to interpret.
Note that -sbar is taken to mean -s bar, not -s -b -a -r, that is, there is no clustering of flags.
-s=foo is disallowed. The rationale is that although some command-line parsers will silently interpret this as -s =foo, this is very seldom what you want. To have an option argument start with '=' (very un-recommended), say so explicitly.
The example specifies the option depth twice: once as -d5 and once as --iters 7. The default when encountering duplicated flags is to keeplast (this behaviour can be controlled, by ParseOption duplicated_flags).
The order of the options returned by the parsing functions is the same as given on the command line, with non-overridden defaults prepended and duplicates removed as in previous item. You should not rely on this, however.
Unknown flags (not appearing in OptsSpec) will throw errors. This is usually a Good Thing. Sometimes, however, you may wish to pass along flags to an external program (say, one called by shell/2), and it means duplicated effort and a maintenance headache to have to specify all possible flags for the external program explicitly (if it even can be done). On the other hand, simply taking all unknown flags as valid makes error checking much less efficient and identification of positional arguments uncertain. A better solution is to collect all arguments intended for passing along to an indirectly called program as a single argument, probably as an atom (if you don't need to inspect them first) or as a prolog term (if you do).

author: - Marcus Uneson
version: - 0.20 (2011-04-27)
To be done: - : validation? e.g, numbers; file path existence; one-out-of-a-set-of-atoms */

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.

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 ( BLF 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%}}}

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 ( SuppressEmptyMeta 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').

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>'),_)).

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'- ). %}}}

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 ).

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%}}}

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%}}}