1:- module(utility, [string_concat_list/2, intercalate/3, lookup_path/2,
    2                    process/2, process/3,
    3                    read_file/2, read_file_lines/2, write_file/2, list_empty/1,
    4                    cache/3, cache_global/3,
    5                    drop/3, drop_while/3, split/4, take_while/3, take/3,
    6                    min_by/3, max_by/3, group_by_dict/3, group_by/3,
    7                    replace_atom/4, trim/2, trim_left/2, trim_right/2, empty/1,
    8                    always/1,
    9                    startswith/2, endswith/2,
   10                    delete_cache/0, delete_cache/1,
   11                    chars_of_type/2, numbers/1, letters_lower/1, letters_upper/1, letters/1,
   12                    unique/1, unique/2,
   13                    sublist/2,
   14                    surround_atom/4,
   15                    parse/2,
   16                    call_if_var/2,
   17                    line/2, next_matching/2,
   18                    range/3,
   19                    partition/2, selectN/4, group/3,
   20                    call_or_inverse/2, apply_each/2,
   21                    pad_begin/4, pad_end/4, repeated/2]).   22
   23:- use_module(library(filesex)).   24:- use_module(library(clpfd)).   25
   26:- use_module(term_util).   27:- use_module(path).   28
   29min_by(Comp, [X|Xs], Min) :- foldl(Comp, Xs, X, Min).
   30max_by(Comp, [X|Xs], Max) :- foldl(Comp, Xs, X, Max).
   31
   32add_to_groups(Pred, X, Dict, NewDict) :-
   33    call(Pred, X, Key),
   34    (
   35        List = Dict.get(Key) ->
   36            NewDict = Dict.put(Key, [X|List]);
   37        NewDict = Dict.put(Key, [X])
   38    ).
   39
   40group_by_dict(_, [], pairs{}).
   41group_by_dict(Pred, [X|Xs], Dict) :-
   42    group_by_dict(Pred, Xs, TempDict),
   43    add_to_groups(Pred, X, TempDict, Dict).
   44
   45group_by(Pred, Xs, Groups) :-
   46    group_by_dict(Pred, Xs, Dict),
   47    dict_pairs(Dict, pairs, Pairs),
   48    pairs_values(Pairs, Groups).
   49
   50rep(A, B, A, B).
   51rep(A, _, C, A) :- not(A = C).
   52
   53replace_atom(Search, Rep, Atom, NewAtom) :-
   54    atom_chars(Atom, Chars),
   55    maplist(rep(Search, Rep), Chars, NewChars),
   56    atom_chars(NewAtom, NewChars).
   57
   58whitespace(' ').
   59whitespace('\t').
   60whitespace('\r').
   61whitespace('\n').
   62
   63trim_left(Atom, Trimmed) :-
   64    atom_chars(Atom, Chars),
   65    drop_while(whitespace, Chars, NewChars),
   66    atom_chars(Trimmed, NewChars).
   67
   68trim_right(Atom, Trimmed) :-
   69    atom_chars(Atom, Chars),
   70    reverse(Chars, RevChars),
   71    drop_while(whitespace, RevChars, RevNewChars),
   72    reverse(RevNewChars, NewChars),
   73    atom_chars(Trimmed, NewChars).
   74
   75trim(Atom, Trimmed) :-
   76    trim_left(Atom, Temp),
   77    trim_right(Temp, Trimmed).
   78
   79empty(Atom) :- trim(Atom, '').
   80
   81startswith(A, B) :- atom_concat(B, _, A).
   82endswith(A, B) :- atom_concat(_, B, A).
   83
   84repeated(_, []).
   85repeated(X, [X|Xs]) :- repeated(X, Xs).
   86
   87pad_begin(N, E, Xs, NewXs) :-
   88    length(Xs, L), L #=< N ->
   89        Dif #= N - L,
   90        length(Padding, Dif),
   91        repeated(E, Padding),
   92        append(Padding, Xs, NewXs);
   93    Xs = NewXs.
   94
   95pad_end(N, E, Xs, NewXs) :-
   96    length(Xs, L), L #=< N ->
   97        Dif #= N - L,
   98        length(Padding, Dif),
   99        repeated(E, Padding),
  100        append(Xs, Padding, NewXs);
  101    Xs = NewXs.
  102
  103selectN(0, [], List, List).
  104selectN(N, [X|Xs], List, NewList) :-
  105    N #> 0,
  106    select(X, List, Temp),
  107
  108    N1 #= N - 1,
  109    selectN(N1, Xs, Temp, NewList).
  110
  111partition([], []).
  112partition(List, [Partition|Partitions]) :-
  113    length(List, L),
  114    between(1, L, N),
  115    selectN(N, Partition, List, NewList),
  116    partition(NewList, Partitions).
  117
  118group(_, [], []).
  119group(N, List, []) :-
  120    length(List, L),
  121    L #< N.
  122group(N, List, [Group|Groups]) :-
  123    length(Group, N),
  124    append(Group, NewList, List),
  125    group(N, NewList, Groups).
  126
  127drop(0, Xs, Xs).
  128drop(N, [_|Xs], Rest) :-
  129    N #> 0,
  130    N1 #= N - 1,
  131    drop(N1, Xs, Rest).
  132
  133drop_while(_, [], []).
  134drop_while(Pred, [X|Xs], Rest) :-
  135    call(Pred, X) -> drop_while(Pred, Xs, Rest);
  136    Rest = [X|Xs].
  137
  138split(0, Xs, [], Xs).
  139split(N, [X|Xs], [X|Taken], Dropped) :-
  140    N #> 0,
  141    N1 #= N - 1,
  142    split(N1, Xs, Taken, Dropped).
  143
  144apply_each(_Pred, []).
  145apply_each(Pred, [H|T]) :- call(Pred, H), apply_each(Pred, T).
  146
  147% If V is a var, then call Expr, otherwise, reverse the order of the operations in Expr, then call it
  148call_or_inverse(V, Expr) :-
  149    call(V) -> call(Expr);
  150
  151    Expr =.. [',' | _] ->
  152        reverse_conjunction(Expr, Reversed),
  153        call(Reversed);
  154
  155    call(Expr).
  156
  157range(A, B, Ns) :- findall(N, between(A, B, N), Ns).
  158
  159% By default the format is the same as the extension, but all lowercase.
  160% Can be extended with your specific case if necessary.
  161line(Line, Stream) :-
  162    read_line_to_codes(Stream, Codes),
  163    atom_codes(Line, Codes);
  164
  165    line(Line, Stream).
  166
  167call_if_var(Pred, V) :-
  168    var(V) -> call(Pred);
  169    true.
  170
  171next_matching(Phrase, Stream) :-
  172    line(Line, Stream),
  173    parse(Phrase, Line) -> true;
  174
  175    next_matching(Phrase, Stream).
  176
  177parse(Phrase, A) :-
  178    atom_codes(A, Codes),
  179    phrase(Phrase, Codes).
  180
  181count_atom(Atom, Search, C) :-
  182    atomic_list_concat(Split, Search, Atom),
  183    length(Split, C).
  184
  185surround_atom(Left, Right, A, B) :-
  186    nonvar(B),
  187    atom_concat(LeftPart, RightPart, B),
  188    atom_concat(Left, ALeft, LeftPart),
  189    atom_concat(ARight, Right, RightPart),
  190    atom_concat(ALeft, ARight, A).
  191surround_atom(Left, Right, A, B) :-
  192    nonvar(Left), nonvar(Right), nonvar(A),
  193    atom_concat(Left, A, Temp),
  194    atom_concat(Temp, Right, B).
  195
  196% Delete everything
  197delete_cache :-
  198    cache_path('Test', AcheloisPath, _),
  199    exists_directory(AcheloisPath),
  200    delete_directory_and_contents(AcheloisPath).
  201
  202% Delete just one part of the cache
  203delete_cache(BasePath) :-
  204    cache_path(BasePath, AcheloisPath, Path),
  205    (
  206        exists_file(Path),
  207        delete_file(Path);
  208
  209        exists_directory(Path),
  210        delete_directory_and_contents(Path)
  211    ),
  212
  213    % Check if cache is empty and delete everything if so
  214    (
  215        exists_directory(AcheloisPath),
  216        list_files(AcheloisPath, []),
  217        delete_directory_and_contents(AcheloisPath);
  218
  219        true
  220    ).
  221
  222cache_path(BasePath, AcheloisPath, Path) :-
  223    working_directory(CWD, CWD),
  224    directory_file_path(CWD, '.achelois', AcheloisPath),
  225    directory_file_path(AcheloisPath, BasePath, Path).
  226
  227cache(BasePath, Pred, Data) :-
  228    cache_path(BasePath, _, Path),
  229    cache_global(Path, Pred, Data).
  230
  231cache_global(BasePath, Pred, Data) :-
  232    read_cache(BasePath, Data);
  233
  234    call(Pred),
  235    write_cache(BasePath, Data).
  236
  237read_cache(Path, Data) :-
  238    exists_file(Path),
  239    read_file(Path, [Atom]),
  240    term_to_atom(Data, Atom).
  241
  242write_cache(Path, Data) :-
  243    file_directory_name(Path, Dir),
  244    make_directory_path(Dir),
  245    term_to_atom(Data, Atom),
  246    write_file(Path, Atom).
  247
  248list_empty([]).
  249
  250replace(Str, Search, Rep, OutStr) :-
  251    split_string(Str, Search, "", StrList),
  252    join(StrList, Rep, OutStr).
  253
  254join(List, Sep, Str) :-
  255    intercalate(List, Sep, StrList),
  256    string_concat_list(StrList, Str).
  257
  258string_concat_list([], "").
  259string_concat_list([H|T], Str) :-
  260    string_concat_list(T, TempStr),
  261    string_concat(H, TempStr, Str).
  262
  263intercalate([], _, []).
  264intercalate([H], _, [H]).
  265intercalate([H|T], Sep, [H, Sep | List]) :- intercalate(T, Sep, List).
  266
  267lookup_path(ExeName, Path) :-
  268    read_process(path(which), [ExeName], [output(TempPath)]),
  269    atomic_list_concat([Path|_], '\n', TempPath).
  270
  271process(Exe, Args) :- process(Exe, Args, []).
  272process(Exe, Args, Options) :-
  273    (
  274        member(path(Path), Options) -> true; Path = '.'
  275    ),
  276
  277    (
  278        member(exit_code(ExitCode), Options) -> true; true
  279    ),
  280
  281    (
  282        member(pid(PID), Options) -> true; true
  283    ),
  284
  285    (
  286        member(stream(Stream), Options) -> process_stream(Path, Stream, Stream, Exe, Args, PID, Options);
  287        member(output(Output), Options) -> read_process(Path, Exe, Args, Output, ExitCode, PID, Options);
  288        member(lines(Lines), Options) ->
  289        (
  290            read_process(Path, Exe, Args, Output, ExitCode, PID, Options),
  291            atomic_list_concat(Lines, '\n', Output)
  292        );
  293
  294        run_process(Path, Exe, Args, ExitCode, PID, Options)
  295    ).
  296
  297copy_data(Source, DestStream) :-
  298    nonvar(Source),
  299    nonvar(DestStream),
  300    is_stream(Source),
  301    copy_stream_data(Source, DestStream),
  302    close(DestStream).
  303copy_data(Source, DestStream) :-
  304    nonvar(Source),
  305    nonvar(DestStream),
  306    atom(Source),
  307    writeln(DestStream, Source),
  308    close(DestStream).
  309% If both vars, do nothing
  310copy_data(Source, DestStream) :-
  311    var(Source),
  312    var(DestStream).
  313
  314process_stream(Path, Stdout, Stderr, Exe, Args, PID, Options) :-
  315    InitArgs = [cwd(Path), stdout(pipe(Stdout)), stderr(pipe(Stderr)), process(PID), detached(true)],
  316    (
  317        member(input(Stdin), Options) -> append(InitArgs, [stdin(pipe(InputStream))], CreateArgs);
  318        CreateArgs = InitArgs
  319    ),
  320    process_create(Exe, Args, CreateArgs),
  321    copy_data(Stdin, InputStream).
  322
  323run_process(Path, Exe, Args, ExitCode, PID, Options) :-
  324    InitArgs = [cwd(Path), process(PID), detached(true)],
  325    (
  326        member(input(Stdin), Options) -> append(InitArgs, [stdin(pipe(InputStream))], CreateArgs);
  327        CreateArgs = InitArgs
  328    ),
  329    setup_call_cleanup(
  330        process_create(Exe, Args, CreateArgs),
  331        copy_data(Stdin, InputStream),
  332        process_wait(PID, exit(ExitCode))).
  333
  334read_process(Exe, Args, Output) :- read_process('.', Exe, Args, Output).
  335read_process(Path, Exe, Args, Output) :- read_process(Path, Exe, Args, Output, _, _, []).
  336read_process(Path, Exe, Args, Output, ExitCode, PID, Options) :-
  337    InitArgs = [stdout(pipe(OutputStream)), stderr(pipe(OutputStream)), cwd(Path), process(PID), detached(true)],
  338    (
  339        member(input(Stdin), Options) -> append(InitArgs, [stdin(pipe(InputStream))], CreateArgs);
  340        CreateArgs = InitArgs
  341    ),
  342    setup_call_cleanup(
  343        process_create(Exe, Args, CreateArgs),
  344        (
  345            copy_data(Stdin, InputStream),
  346            read_string(OutputStream, _, OutputStr),
  347            atom_string(Output, OutputStr)
  348        ),
  349        (
  350            process_wait(PID, exit(ExitCode)),
  351            close(OutputStream)
  352        )).
  353
  354read_file(Path, Contents) :-
  355    setup_call_cleanup(
  356        open(Path, read, Stream),
  357        (
  358            read_string(Stream, _, String),
  359            atom_string(Contents, String)
  360        ),
  361        close(Stream)).
  362
  363read_file_lines(Path, Lines) :-
  364    read_file(Path, Atom),
  365    atomic_list_concat(Lines, '\n', Atom).
  366
  367write_file(OutputPath, Str) :-
  368    open(OutputPath, write, Stream),
  369    write(Stream, Str),
  370    close(Stream).
  371
  372always(_).
  373
  374take_while(_, [], []).
  375take_while(Pred, [H|T], [H|Rest]) :- call(Pred, H), take_while(Pred, T, Rest).
  376take_while(_, _, []).
  377
  378take(_, [], []).
  379take(0, _, []).
  380take(N, [H|T], [H|Rest]) :-
  381    N #>= 0,
  382    N1 #= N - 1,
  383    take(N1, T, Rest),
  384    length(Rest, N1).
  385
  386sublist([], _).
  387sublist(SubList, List) :-
  388    var(SubList),
  389    SubList = [H|T],
  390    member(H, List),
  391    select(H, List, NewList),
  392    sublist(T, NewList).
  393sublist(SubList, List) :-
  394    nonvar(SubList),
  395    forall(member(X, SubList), member(X, List)).
  396
  397chars_of_type(Type, Chars) :-
  398    findall(C, char_type(C, Type), Temp),
  399    sort(Temp, Chars).
  400
  401numbers(Numbers) :- chars_of_type(digit, Numbers).
  402letters(Letters) :-
  403    letters_lower(LowerLetters),
  404    letters_upper(UpperLetters),
  405    append(LowerLetters, UpperLetters, Letters).
  406letters_lower(LowerLetters) :- atom_chars('abcdefghijklmnopqrstuvwxyz', LowerLetters).
  407letters_upper(UpperLetters) :- atom_chars('ABCDEFGHIJKLMNOPQRSTUVWXYZ', UpperLetters).
  408
  409
  410unique(L) :- unique(L, L).
  411
  412unique([], []).
  413unique([H|T], [H|Rest]) :-
  414    findall(X, (member(X, T), dif(X, H)), Temp),
  415    unique(Temp, Rest)