1:- use_module(just_dot).    2:- use_module(library(main)).    3
    4:- initialization(main, main).    5
    6opt_type(tab, tab, nonneg).
    7opt_type(rankdir, rankdir, atom).
    8opt_type(bgcolor, bgcolor, atom).
    9opt_type(node, node, term).
   10opt_type(edge, edge, term).
   11opt_type(elides, elides, term).
   12
   13opt_help(help(header), 'Generate a DOT file from a JSON file produced by scasp').
   14opt_help(tab, 'Tab size for indentation').
   15opt_help(rankdir, 'Direction of the graph layout').
   16opt_help(bgcolor, 'Background colour of the graph').
   17opt_help(node, 'Node attributes').
   18opt_help(edge, 'Edge default attributes').
   19opt_help(elides, 'Nodes to elide in the graph').
   20
   21main(Argv) :-
   22    argv_options(Argv, Positional, Options, []),
   23    forall(member(Src, Positional), json_to_dot(Src, Options)).
   24
   25json_to_dot(Src, Options) :-
   26    file_name_extension(Base, json, Src),
   27    file_name_extension(Base, dot, Dest),
   28    setup_call_cleanup(open(Dest, write, Out),
   29                       scasp_just_dot_print(Out, Src, Options),
   30                       close(Out))