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

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) 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 ( SuppressEmptyMeta 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 ( (\+ AllowEmpty, \+ 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%}}}

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