1:- module(
    2  cli,
    3  [
    4    cli_main/3, % +Name, +Usages, :Goal_2
    5    cli_main/4  % +Name, +Usages, +Specs, :Goal_2
    6  ]
    7).

Generic support for CLI tools

This module can be used to build a CLI tool with minimal custom code.

The predicate cli_main/4 takes:

  1. the name of the tool,
  2. usage specifications (positional arguments),
  3. flag specifications (flag arguments), and
  4. the tool's main goal.

It takes care of the common flags -h/`--help and -v/--version`.

The following three types of command-line argument can be distinguised:

*/

   45:- use_module(library(aggregate)).   46:- use_module(library(apply)).   47:- use_module(library(lists)).   48
   49:- use_module(library(cli_arguments)).   50:- use_module(library(cli_help)).   51:- use_module(library(cli_version)).   52:- use_module(library(dict)).   53
   54:- meta_predicate
   55    cli_main(+, +, 2),
   56    cli_main(+, +, +, 2),
   57    cli_main_(+, +, +, +, +, 2).
 cli_main(+Name:atom, +Usages:list(list(atom)), :Goal_2) is det
   63cli_main(Name, Usages, Goal_2) :-
   64  cli_main(Name, Usages, [], Goal_2).
 cli_main(+Name:atom, +Usages:list(list(atom)), +Specs:list(dict), :Goal_2) is det
   69cli_main(Name, Usages, Specs1, Goal_2) :-
   70  Specs0 = [
   71    optionSpec{
   72      default: false,
   73      help: "Display help information for this tool and exit.",
   74      longflags: [help],
   75      shortflags: [h],
   76      type: boolean
   77    },
   78    optionSpec{
   79      default: false,
   80      help: "Display the version number of this tool and exit.",
   81      longflags: [version],
   82      shortflags: [v],
   83      type: boolean
   84    }
   85  ],
   86  append(Specs0, Specs1, Specs2),
   87  maplist(compile_flags_(Specs2), [longflags,shortflags], [LongSpecs,ShortSpecs]),
   88  catch(
   89    (
   90      cli_arguments(Usages, LongSpecs, ShortSpecs, Options, Args),
   91      cli_main_(Name, Usages, Specs2, Options, Args, Goal_2)
   92    ),
   93    Error,
   94    (
   95      cli_error(Error),
   96      cli_help(Name, Usages, Specs2)
   97    )
   98  ).
   99
  100% Explicitly requested help message.
  101cli_main_(Name, Usages, Specs, Options, _, _) :-
  102  member(Key, [h,help]),
  103  dict_get(Key, Options, true), !,
  104  cli_help(Name, Usages, Specs).
  105% Explicitly requested version message.
  106cli_main_(_, _, _, Options, _, _) :-
  107  member(Key, [v,version]),
  108  dict_get(Key, Options, true), !,
  109  cli_version.
  110% A recognized usage.
  111cli_main_(_, _, _, Options, Args, Goal_2) :-
  112  call(Goal_2, Args, Options).
  113
  114cli_error(Error) :-
  115  print_message(error, Error).
  116
  117compile_flags_(Specs1, Key0, Specs2) :-
  118  aggregate_all(
  119    set(Key-Spec),
  120    (
  121      member(Spec, Specs1),
  122      dict_get(Key0, Spec, Keys),
  123      member(Key, Keys)
  124    ),
  125    Pairs2
  126  ),
  127  dict_pairs(Specs2, Pairs2)