View source with formatted comments or as raw
    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    (  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%}}}
  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    (   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').
  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%}}}