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

   12:- use_module(library(apply)).   13:- use_module(library(clpfd)).   14
   15:- use_module(library(dcg)).   16:- use_module(library(dict)).   17:- use_module(library(pair_ext)).   18:- use_module(library(string_ext)).

 cli_help(+Name:atom, +Usages:list(atom), +Specs:list(dict)) is det

   24cli_help(Name, Usages, Specs) :-
   25  usages_message(Name, Usages, String1),
   26  flags_message(Specs, String2),
   27  format(user_output, "Usage:\n~s\nOptions:\n~s", [String1,String2]).

 flags_message(+Specs:list(dict), -Message:string) is det

   32flags_message(Specs, Message) :-
   33  maplist(pp_short_flags, Specs, ShortStrings),
   34  max_string_length(ShortStrings, ShortWidth),
   35  maplist(pp_long_flags, Specs, LongStringss),
   36  flatten(LongStringss, LongStrings0),
   37  max_string_length(LongStrings0, LongWidth),
   38  maplist(
   39    {ShortWidth,LongWidth}/
   40      [ShortString0,LongStrings0,Dict0,Line0]>>
   41      format_option(
   42        ShortWidth-ShortString0,
   43        LongWidth-LongStrings0,
   44        Dict0,
   45        Line0
   46      ),
   47    ShortStrings,
   48    LongStringss,
   49    Specs,
   50    Lines
   51  ),
   52  string_list_concat(Lines, Message).
   53
   54pp_long_flag(Long, String) :-
   55  format(string(String), "--~a", [Long]).
   56
   57pp_long_flags(Spec, Strings) :-
   58  dict_get(longflags, Spec, [], Longs),
   59  maplist(pp_long_flag, Longs, Strings).
   60
   61pp_short_flag(Short, String) :-
   62  format(string(String), "-~a", [Short]).
   63
   64pp_short_flags(Spec, String) :-
   65  dict_get(shortflags, Spec, [], Shorts),
   66  maplist(pp_short_flag, Shorts, Strings),
   67  string_list_concat(Strings, ',',  String).
   68
   69
   70%! format_option(+ShortFlags:pair(nonneg,string),
   71%!               +LongFlags:pair(nonneg,list(string)),
   72%!               +OptionSpec:dict,
   73%!               -Line:string) is det.
   74
   75format_option(ShortWidth1-ShortString, LongWidth1-LongStrings1, Dict, Line) :-
   76  optionSpec{help: Message} :< Dict,
   77  words_lines(LongStrings1, LongWidth1, ", ", LongStrings2),
   78  % Make room for a comma and a space.
   79  LongWidth2 #= LongWidth1 + 2,
   80  ShortWidth2 #= ShortWidth1 + 2,
   81  string_list_concat(LongStrings2, ",\n", LongsString),
   82  Indent #= ShortWidth2 + LongWidth2 + 4,
   83  format_lines(Message, Indent, Lines),
   84  format(
   85    string(Line),
   86    "~s~t~*+~s~t~*+~s\n",
   87    [LongsString,LongWidth2,ShortString,ShortWidth2,Lines]
   88  ).
   89
   90
   91%! format_lines(+Message1:or([string,list(string)]),
   92%!              +Indent:nonneg,
   93%!              -Message2:string) is det.
   94
   95% Line splitting determined algorithmically.
   96format_lines(Message1, Indent, Message2) :-
   97  string(Message1), !,
   98  MinWidth = 40,
   99  LineWidth = 80,
  100  MaxWidth #= max(MinWidth, LineWidth - Indent),
  101  insert_line_breaks(Message1, MaxWidth, Indent, Message2).
  102% Line splitting determined by the option specification.
  103format_lines(Message, Indent, Message) :-
  104  indent_lines(Message, Indent, Message).

 insert_line_breaks(+Message:string, +LineLength:positive_integer, +Indent:nonneg, -TextLines:list(string)) is det

  112insert_line_breaks(Message, LineLength, Indent, TextLines) :-
  113  message_lines(Message, LineLength, Lines),
  114  indent_lines(Lines, Indent, TextLines).

 indent_lines(+Lines:list(string), +Indent:nonneg, -Message:string) is det

  119indent_lines(Lines, Indent, Message) :-
  120  format(string(Sep), "~n~*|", [Indent]),
  121  string_list_concat(Lines, Sep, Message).

 usages_message(+Name:atom, +Usages:list(list(atom)), -Message:string) is det

  128usages_message(Name, Usages, Msg) :-
  129  maplist(usage_line(Name), Usages, Lines),
  130  string_list_concat(Lines, Msg).
  131
  132usage_line(Name, Usage, Line) :-
  133  string_phrase(usage_line(Name, Usage), Line).
  134
  135usage_line(Name, PosArgs) -->
  136  "  ",
  137  atom(Name),
  138  pos_args(PosArgs),
  139  " [options]\n".
  140
  141pos_args([]) --> !, "".
  142pos_args([H|T]) -->
  143  " {",
  144  atom(H),
  145  "}",
  146  pos_args(T)