1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2019, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module('$pack',
   37          [ attach_packs/0,
   38            attach_packs/1,                     % +Dir
   39            attach_packs/2,                     % +Dir, +Options
   40            '$pack_detach'/2,                   % +Name, -Dir
   41            '$pack_attach'/1,                   % +Dir
   42            '$pack_attach'/2
   43          ]).   44
   45:- multifile user:file_search_path/2.   46:- dynamic user:file_search_path/2.   47
   48:- dynamic
   49    pack_dir/3,                             % Pack, Type, Dir
   50    pack/2.                                 % Pack, BaseDir
   51:- volatile
   52    pack_dir/3,
   53    pack/2.   54
   55user:file_search_path(pack, app_data(pack)).
   56
   57user:file_search_path(library, PackLib) :-
   58    pack_dir(_Name, prolog, PackLib).
   59user:file_search_path(foreign, PackLib) :-
   60    pack_dir(_Name, foreign, PackLib).

 $pack_detach(+Name, -Dir) is det

Detach the given package from the search paths and list of registered packages, but does not delete the files.

   67'$pack_detach'(Name, Dir) :-
   68    (   atom(Name)
   69    ->  true
   70    ;   throw(error(type_error(atom, Name), _))
   71    ),
   72    (   retract(pack(Name, Dir))
   73    ->  retractall(pack_dir(Name, _, _)),
   74        reload_library_index
   75    ;   throw(error(existence_error(pack, Name), _))
   76    ).

 $pack_attach(+Dir) is det

Attach the given package

   82'$pack_attach'(Dir) :-
   83    '$pack_attach'(Dir, []).
   84
   85'$pack_attach'(Dir, Options) :-
   86    attach_package(Dir, Options),
   87    !.
   88'$pack_attach'(Dir, _) :-
   89    (   exists_directory(Dir)
   90    ->  throw(error(existence_error(directory, Dir), _))
   91    ;   throw(error(domain_error(pack, Dir), _))
   92    ).

 attach_packs

Attach packages from all package directories.

   98attach_packs :-
   99    set_prolog_flag(packs, true),
  100    findall(PackDir, absolute_file_name(pack(.), PackDir,
  101                                        [ file_type(directory),
  102                                          access(read),
  103                                          solutions(all)
  104                                        ]),
  105            PackDirs),
  106    (   PackDirs \== []
  107    ->  remove_dups(PackDirs, UniquePackDirs, []),
  108        forall('$member'(PackDir, UniquePackDirs),
  109               attach_packs(PackDir))
  110    ;   true
  111    ).

 remove_dups(+List, -Unique, +Seen) is det

Remove duplicates from List, keeping the first solution.

  117remove_dups([], [], _).
  118remove_dups([H|T0], T, Seen) :-
  119    memberchk(H, Seen),
  120    !,
  121    remove_dups(T0, T, Seen).
  122remove_dups([H|T0], [H|T], Seen) :-
  123    remove_dups(T0, T, [H|Seen]).

 attach_packs(+Dir) is det

 attach_packs(+Dir, +Options) is det

Attach packages from directory Dir. Options processed:

duplicate(+Action)

What to do if the same package is already installed in a different directory. Action is one of

warning

Warn and ignore the package

keep

Silently ignore the package

replace

Unregister the existing and insert the new package

search(+Where)

Determines the order of searching package library directories. Default is last, alternative is first.

  144attach_packs(Dir) :-
  145    attach_packs(Dir, []).
  146
  147attach_packs(Dir, Options) :-
  148    absolute_file_name(Dir, Path,
  149                       [ file_type(directory),
  150                         file_errors(fail)
  151                       ]),
  152    catch(directory_files(Path, Entries), _, fail),
  153    !,
  154    ensure_slash(Path, SPath),
  155    attach_packages(Entries, SPath, Options).
  156attach_packs(_, _).
  157
  158attach_packages([], _, _).
  159attach_packages([H|T], Dir, Options) :-
  160    attach_package(H, Dir, Options),
  161    attach_packages(T, Dir, Options).
  162
  163attach_package(Entry, Dir, Options) :-
  164    \+ special(Entry),
  165    atom_concat(Dir, Entry, PackDir),
  166    attach_package(PackDir, Options),
  167    !.
  168attach_package(_, _, _).
  169
  170special(.).
  171special(..).

 attach_package(+PackDir, +Options) is semidet

To be done

- Deal with autoload index. Reload?

  178attach_package(PackDir, Options) :-
  179    atomic_list_concat([PackDir, '/pack.pl'], InfoFile),
  180    access_file(InfoFile, read),
  181    file_base_name(PackDir, Pack),
  182    check_existing(Pack, PackDir, Options),
  183    foreign_dir(Pack, PackDir, ForeignDir),
  184    prolog_dir(PackDir, PrologDir),
  185    !,
  186    assertz(pack(Pack, PackDir)),
  187    '$option'(search(Where), Options, last),
  188    (   Where == last
  189    ->  assertz(pack_dir(Pack, prolog, PrologDir))
  190    ;   Where == first
  191    ->  asserta(pack_dir(Pack, prolog, PrologDir))
  192    ;   '$domain_error'(option_search, Where)
  193    ),
  194    update_autoload(PrologDir),
  195    (   ForeignDir \== (-)
  196    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  197    ;   true
  198    ),
  199    print_message(silent, pack(attached(Pack, PackDir))).

 check_existing(+Pack, +PackDir, +Options) is semidet

Verify that we did not load this package before.

  206check_existing(Entry, Dir, _) :-
  207    retract(pack(Entry, Dir)),             % registered from same place
  208    !,
  209    retractall(pack_dir(Entry, _, _)).
  210check_existing(Entry, Dir, Options) :-
  211    pack(Entry, OldDir),
  212    !,
  213    '$option'(duplicate(Action), Options, warning),
  214    (   Action == warning
  215    ->  print_message(warning, pack(duplicate(Entry, OldDir, Dir))),
  216        fail
  217    ;   Action == keep
  218    ->  fail
  219    ;   Action == replace
  220    ->  print_message(silent, pack(replaced(Entry, OldDir, Dir))),
  221        '$pack_detach'(Entry, OldDir)
  222    ;   '$domain_error'(option_duplicate, Action)
  223    ).
  224check_existing(_, _, _).
  225
  226
  227prolog_dir(PackDir, PrologDir) :-
  228    atomic_list_concat([PackDir, '/prolog'], PrologDir),
  229    exists_directory(PrologDir).
  230
  231update_autoload(PrologDir) :-
  232    atom_concat(PrologDir, '/INDEX.pl', IndexFile),
  233    (   exists_file(IndexFile)
  234    ->  reload_library_index
  235    ;   true
  236    ).
  237
  238foreign_dir(Pack, PackDir, ForeignDir) :-
  239    current_prolog_flag(arch, Arch),
  240    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
  241    exists_directory(ForeignBaseDir),
  242    !,
  243    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
  244    (   exists_directory(ForeignDir)
  245    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  246    ;   print_message(warning, pack(no_arch(Pack, Arch))),
  247        fail
  248    ).
  249foreign_dir(_, _, (-)).
  250
  251ensure_slash(Dir, SDir) :-
  252    (   sub_atom(Dir, _, _, 0, /)
  253    ->  SDir = Dir
  254    ;   atom_concat(Dir, /, SDir)
  255    )