1:- encoding(utf8).
    2:- module(
    3  atom_ext,
    4  [
    5    atom_capitalize/2, % +Original, ?Capitalized
    6    atom_ellipsis/3,   % +Original, ?MaxLength, ?Ellipsed
    7    atom_postfix/2,    % +Original, ?Postfix
    8    atom_postfix/3,    % +Original, ?Length, ?Postfix
    9   %atom_prefix/2,     % +Original, ?Prefix
   10    atom_prefix/3,     % +Original, ?Length, ?Prefix
   11    atom_same_ci/2,    % +Atom1, +Atom2
   12    atom_strip/2,      % +Original, ?Stripped
   13    atom_strip/3,      % +Original, +Strip, ?Stripped
   14    atom_terminator/3, % +Original, +Terminator, ?Terminated
   15    atom_truncate/3,   % +Original, +MaxLength, ?Truncated
   16    sub_atom/2         % ?Atom, ?Subatom
   17  ]
   18).

Extended support for atoms

This module extends the support for handling atoms in the SWI-Prolog standard library.

*/

   27:- use_module(library(apply)).   28:- use_module(library(error)).   29:- use_module(library(lists)).   30:- use_module(library(plunit)).   31
   32:- use_module(library(call_ext)).
 atom_capitalize(+Original:atom, +Capitalized:atom) is semidet
atom_capitalize(+Original:atom, -Capitalized:atom) is det
Succeeds if Capitalized is a copy of Original where the first character is in upper case (if applicable).

If the first character of Atom is already in upper case then Capitalized is a plain copy of Atom.

   47atom_capitalize('', '').
   48atom_capitalize(Atom, Capitalized) :-
   49  atom_codes(Atom, [H1|T]),
   50  to_upper(H1, H2),
   51  atom_codes(Capitalized, [H2|T]).
   52
   53:- begin_tests(atom_capitalize).   54
   55test('atom_capitalize(+,+)', [forall(atom_capitalize_test(Original,Capitalized))]) :-
   56  atom_capitalize(Original, Capitalized).
   57test('atom_capitalize(+,-)', [forall(atom_capitalize_test(Original,Capitalized))]) :-
   58  atom_capitalize(Original, Capitalized0),
   59  assertion(Capitalized == Capitalized0).
   60
   61atom_capitalize_test(monkey, 'Monkey').
   62% Atoms with a first character that does not have a capital variant.
   63atom_capitalize_test('123', '123').
   64atom_capitalize_test(' a ', ' a ').
   65% Atom with a first character this is non-ASCII.
   66atom_capitalize_test('ὰ', 'Ὰ').
   67
   68:- end_tests(atom_capitalize).
 atom_ellipsis(+Original:atom, +MaxLength:between(2,inf), +Ellipsed:atom) is semidet
atom_ellipsis(+Original:atom, +MaxLength:between(2,inf), -Ellipsed:atom) is semidet
atom_ellipsis(+Original:atom, -MaxLength:between(2,inf), -Ellipsed:atom) is nondet
Succeeds if Ellipsed is like Orginal, but has ellipsis applied in order to have MaxLength. If Original is not longer than MaxLength, Orignal and Ellipsed are the same.

For mode `(+,-,-)' the enumeration order prioritizes shorter atoms:

?- atom_ellipsis(monkey, Length, Ellipsed).
Length = 2,
Ellipsed = 'm…' ;
Length = 3,
Ellipsed = 'mo…' ;
Length = 4,
Ellipsed = 'mon…' ;
Length = 5,
Ellipsed = 'monk…' ;
Length = 6,
Ellipsed = monkey.

Can be used to display a shorter atom to human users. For example, an atom that is displayed inside a table cell.

See also
- string_ellipsis/3 provides the same functionality for strings.
  101atom_ellipsis(Original, MaxLength, Ellipsed) :-
  102  atom_length(Original, Length),
  103  (   between(2, Length, MaxLength)
  104  *-> (   MaxLength =:= Length
  105      ->  Ellipsed = Original
  106      ;   TruncateLength is MaxLength - 1,
  107          atom_truncate(Original, TruncateLength, Truncated),
  108          atomic_concat(Truncated, "…", Ellipsed)
  109      )
  110  ;   must_be(between(2,inf), MaxLength),
  111      Ellipsed = Original
  112  ).
  113
  114:- begin_tests(atom_ellipsis).  115
  116test('atom_ellipsis(+,+,+)', [forall(atom_ellipsis_test(Original,MaxLength,Ellipsed))]) :-
  117  atom_ellipsis(Original, MaxLength, Ellipsed).
  118test('atom_ellipsis(+,+,-) err', [error(type_error(between(2,inf),_MaxLength))]) :-
  119  atom_ellipsis(monkey, 1, _).
  120test('atom_ellipsis(+,+,-)', [forall(atom_ellipsis_test(Original,MaxLength,Ellipsed))]) :-
  121  atom_ellipsis(Original, MaxLength, Ellipsed0),
  122  assertion(Ellipsed == Ellipsed0).
  123test('atom_ellipsis(+,-,-)', [all(MaxLength-Ellipsed == [2-'a…',3-'ab…',4-abcd])]) :-
  124  atom_ellipsis(abcd, MaxLength, Ellipsed).
  125
  126atom_ellipsis_test(monkey, 3, 'mo…').
  127
  128:- end_tests(atom_ellipsis).
 atom_postfix(+Original:atom, +Postfix:atom) is semidet
atom_postfix(+Original:atom, -Postfix:atom) is multi
 atom_postfix(+Original:atom, +Length:nonneg, +Postfix:atom) is semidet
atom_postfix(+Original:atom, +Length:nonneg, -Postfix:atom) is semidet
atom_postfix(+Original:atom, -Length:nonneg, +Postfix:atom) is semidet
atom_postfix(+Original:atom, -Length:nonneg, -Postfix:atom) is multi
Succeeds if Postfix is a postfix of Original with consisting of Length characters.

For mode `(+,-,-)' the enumeration order prioritizes longer atoms.

See also
- string_postfix/[2,3] provides the same functionality for strings.
  146atom_postfix(Atom, Postfix) :-
  147  atom_postfix(Atom, _, Postfix).
  148
  149
  150atom_postfix(Atom, Length, Postfix) :-
  151  sub_atom(Atom, _, Length, 0, Postfix).
  152
  153:- begin_tests(atom_postfix).  154
  155test('atom_postfix(+,+,+)', [forall(test_atom_postfix(Original,Length,Postfix))]) :-
  156  atom_postfix(Original, Length, Postfix).
  157test('atom_postfix(+,+,-)', [forall(test_atom_postfix(Original,Length,Postfix))]) :-
  158  atom_postfix(Original, Length, Postfix0),
  159  assertion(Postfix == Postfix0).
  160test('atom_postfix(+,-,+)', [forall(test_atom_postfix(Original,Length,Postfix))]) :-
  161  atom_postfix(Original, Length0, Postfix),
  162  assertion(Length == Length0).
  163test('atom_postfix(+,-,-)', [all(Length-Postfix == [4-abcd,3-bcd,2-cd,1-d,0-''])]) :-
  164  atom_postfix(abcd, Length, Postfix).
  165
  166test_atom_postfix(abcd, 4, abcd).
  167test_atom_postfix(abcd, 3, bcd).
  168test_atom_postfix(abcd, 2, cd).
  169test_atom_postfix(abcd, 1, d).
  170test_atom_postfix(abcd, 0, '').
  171
  172:- end_tests(atom_postfix).
 atom_prefix(+Original:atom, +Length:nonneg, +Prefix:atom) is semidet
atom_prefix(+Original:atom, +Length:nonneg, -Prefix:atom) is semidet
atom_prefix(+Original:atom, -Length:nonneg, +Prefix:atom) is semidet
atom_prefix(+Original:atom, -Length:nonneg, -Prefix:atom) is multi
Succeeds if Prefix is a prefix of Original consisting of Length characters.

Fails when Length is greater than the length of Original.

For mode `(+,-,-)' the enumeration order prioritizes shorter atoms.

See also
- string_prefix/[2,3] provides the same functionality for strings.
  190atom_prefix(Atom, Length, Prefix) :-
  191  sub_atom(Atom, 0, Length, _, Prefix).
  192
  193:- begin_tests(atom_prefix).  194
  195test('atom_prefix(+,+,+)', [forall(test_atom_prefix(Original,Length,Prefix))]) :-
  196  atom_prefix(Original, Length, Prefix).
  197test('atom_prefix(+,+,-)', [forall(test_atom_prefix(Original,Length,Prefix))]) :-
  198  atom_prefix(Original, Length, Prefix0),
  199  assertion(Prefix == Prefix0).
  200test('atom_prefix(+,-,+)', [forall(test_atom_prefix(Original,Length,Prefix))]) :-
  201  atom_prefix(Original, Length0, Prefix),
  202  assertion(Length == Length0).
  203test('atom_prefix(+,-,-)', [all(Length-Prefix == [0-'',1-a,2-ab,3-abc,4-abcd])]) :-
  204  atom_prefix(abcd, Length, Prefix).
  205
  206test_atom_prefix(abcd, 0, '').
  207test_atom_prefix(abcd, 1, a).
  208test_atom_prefix(abcd, 2, ab).
  209test_atom_prefix(abcd, 3, abc).
  210test_atom_prefix(abcd, 4, abcd).
  211
  212:- end_tests(atom_prefix).
 atom_same_ci(+A:atom, +B:atom) is semidet
  218atom_same_ci(A, B) :-
  219  equal_under(downcase_atom, A, B).
 atom_strip(+Original:atom, +Stripped:atom) is det
atom_strip(+Original:atom, -Stripped:atom) is det
 atom_strip(+Original:atom, +Strip:list(char), +Stripped:atom) is semidet
atom_strip(+Original:atom, +Strip:list(char), -Stripped:atom) is det
Succeeds if Stripped is a copy of Original where leading and trailing characters in Strip have been removed.

Notice that the order in which the characters in Strip are specified is significant.

The default Strip characters are space, newline and horizontal tab.

Arguments:
Strip- is a list of charaters that will be stripped from the Original atom. The default includes: horizontal tab, newline, space, NO-BREAK SPACE (0xa0).
See also
- string_strip/[2,3] provides the same functionality for strings.
  242atom_strip(Original, Stripped) :-
  243  atom_strip(Original, ['\r','\t','\n',' ','\u00a0'], Stripped).
  244
  245
  246atom_strip(A1, Strip, A3) :-
  247  atom_strip_begin_(A1, Strip, A2),
  248  atom_strip_end_(A2, Strip, A3).
  249
  250atom_strip_begin_(A1, Strip, A3) :-
  251  member(Char, Strip),
  252  atom_concat(Char, A2, A1), !,
  253  atom_strip_begin_(A2, Strip, A3).
  254atom_strip_begin_(A, _, A).
  255
  256atom_strip_end_(A1, Strip, A3) :-
  257  member(Char, Strip),
  258  atom_concat(A2, Char, A1), !,
  259  atom_strip_end_(A2, Strip, A3).
  260atom_strip_end_(A, _, A).
  261
  262:- begin_tests(atom_strip).  263
  264test('atom_strip(+,+,+)', [forall(test_atom_strip(Original,Strip,Stripped))]) :-
  265  atom_strip(Original, Strip, Stripped).
  266test('atom_strip(+,+,-)', [forall(test_atom_strip(Original,Strip,Stripped))]) :-
  267  atom_strip(Original, Strip, Stripped0),
  268  assertion(Stripped == Stripped0).
  269
  270test_atom_strip(' a ', [' '], a).
  271test_atom_strip(' a ', [' ',a], '').
  272test_atom_strip('', [' '], '').
  273test_atom_strip(' ', [], ' ').
  274
  275:- end_tests(atom_strip).
 atom_terminator(+Original:atom, +Terminator:char, +Terminated:atom) is semidet
atom_terminator(+Original:atom, +Terminator:char, -Terminated:atom) is det
Succeeds if Terminated is a copy of Original which is ensured to end with the Terminator character.
  285atom_terminator(Original, Terminator, Terminated) :-
  286  atom_chars(Original, Chars1),
  287  (Chars1 == [] -> true ; once(append(_, [Last], Chars1))),
  288  (   Last == Terminator
  289  ->  Terminated = Original
  290  ;   append(Chars1, [Terminator], Chars2),
  291      atom_chars(Terminated, Chars2)
  292  ).
  293
  294:- begin_tests(atom_terminator).  295
  296test('atom_terminator(+,+,+)', [forall(test_atom_terminator(Original,Terminator,Terminated))]) :-
  297  atom_terminator(Original, Terminator, Terminated).
  298test('atom_terminator(+,+,-)', [forall(test_atom_terminator(Original,Terminator,Terminated))]) :-
  299  atom_terminator(Original, Terminator, Terminated0),
  300  assertion(Terminated == Terminated0).
  301
  302test_atom_terminator('https://abc.com', /, 'https://abc.com/').
  303test_atom_terminator('https://abc.com/', /, 'https://abc.com/').
  304test_atom_terminator(/, /, /).
  305test_atom_terminator('', /, /).
  306
  307:- end_tests(atom_terminator).
 atom_truncate(+Original:atom, +MaxLength:nonneg, +Truncated:atom) is semidet
atom_truncate(+Original:atom, +MaxLength:nonneg, -Truncated:atom) is det
Hard-truncates the `Original' atom.

For example:

?- atom_truncate('This atom is too long.', 15, Truncated).
Trunaced = 'This atom is to'
See also
- Similar to atom_prefix/3, but the `Truncated' atom is the `Original' atom in case `MaxLength' exceeds the `Original' atom's length.
- Use atom_ellipse/3 in case the truncated atom will be displayed to human users.
- string_truncate/3 provides the same functionality for strings.
  332atom_truncate(Original, MaxLength, Truncated) :-
  333  atom_length(Original, Length),
  334  (   Length > MaxLength
  335  ->  atom_prefix(Original, MaxLength, Truncated)
  336  ;   Truncated = Original
  337  ).
  338
  339:- begin_tests(atom_truncate).  340
  341test('atom_truncate(+,+,+)', [forall(atom_truncate_test(Original,MaxLength,Truncated))]) :-
  342  atom_truncate(Original, MaxLength, Truncated).
  343test('atom_truncate(+,+,-)', [forall(atom_truncate_test(Original,MaxLength,Truncated))]) :-
  344  atom_truncate(Original, MaxLength, Truncated0),
  345  assertion(Truncated == Truncated0).
  346test('atom_truncate(+,-,-)', [error(instantiation_error,_Context)]) :-
  347  atom_truncate(abcd, _MaxLength, abcd).
  348
  349atom_truncate_test(monkey, 3, mon).
  350atom_truncate_test(monkey, 1 000, monkey).
  351
  352:- end_tests(atom_truncate).
 sub_atom(+Atom:atom, +Subatom:atom) is semidet
sub_atom(+Atom:atom, -Subatom:atom) is nondet
Suceeds iff `Subatom' is a subatom of `Atom'.
  361sub_atom(Atom, Subatom) :-
  362  sub_atom(Atom, _, _, _, Subatom)