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-2017, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module('$pack',
   36          [ attach_packs/0,
   37            attach_packs/1,                     % +Dir
   38            attach_packs/2,                     % +Dir, +Options
   39            '$pack_detach'/2,                   % +Name, -Dir
   40            '$pack_attach'/1                    % +Dir
   41          ]).   42
   43:- multifile user:file_search_path/2.   44:- dynamic user:file_search_path/2.   45
   46:- dynamic
   47    pack_dir/3,                             % Pack, Type, Dir
   48    pack/2.                                 % Pack, BaseDir
   49:- volatile
   50    pack_dir/3,
   51    pack/2.   52
   53
   54user:file_search_path(pack, app_data(pack)).
   55user:file_search_path(pack, swi(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).
   61
   62%!  '$pack_detach'(+Name, -Dir) is det.
   63%
   64%   Detach the given package  from  the   search  paths  and list of
   65%   registered packages, but does not delete the files.
   66
   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    ).
   77
   78%!  '$pack_attach'(+Dir) is det.
   79%
   80%   Attach the given package
   81
   82'$pack_attach'(Dir) :-
   83    attach_package(Dir, []),
   84    !.
   85'$pack_attach'(Dir) :-
   86    (   exists_directory(Dir)
   87    ->  throw(error(existence_error(directory, Dir), _))
   88    ;   throw(error(domain_error(pack, Dir), _))
   89    ).
   90
   91%!  attach_packs
   92%
   93%   Attach packages from all package directories.
   94
   95attach_packs :-
   96    findall(PackDir, absolute_file_name(pack(.), PackDir,
   97                                        [ file_type(directory),
   98                                          access(read),
   99                                          solutions(all)
  100                                        ]),
  101            PackDirs),
  102    (   PackDirs \== []
  103    ->  remove_dups(PackDirs, UniquePackDirs, []),
  104        forall('$member'(PackDir, UniquePackDirs),
  105               attach_packs(PackDir))
  106    ;   true
  107    ).
  108
  109%!  remove_dups(+List, -Unique, +Seen) is det.
  110%
  111%   Remove duplicates from List, keeping the first solution.
  112
  113remove_dups([], [], _).
  114remove_dups([H|T0], T, Seen) :-
  115    memberchk(H, Seen),
  116    !,
  117    remove_dups(T0, T, Seen).
  118remove_dups([H|T0], [H|T], Seen) :-
  119    remove_dups(T0, T, [H|Seen]).
  120
  121
  122%!  attach_packs(+Dir) is det.
  123%!  attach_packs(+Dir, +Options) is det.
  124%
  125%   Attach packages from directory Dir.  Options processed:
  126%
  127%     - duplicate(+Action)
  128%     What to do if the same package is already installed in a different
  129%     directory.  Action is one of
  130%       - warning
  131%       Warn and ignore the package
  132%       - keep
  133%       Silently ignore the package
  134%       - replace
  135%       Unregister the existing and insert the new package
  136%     - search(+Where)
  137%     Determines the order of searching package library directories.
  138%     Default is `last`, alternative is `first`.
  139
  140attach_packs(Dir) :-
  141    attach_packs(Dir, []).
  142
  143attach_packs(Dir, Options) :-
  144    absolute_file_name(Dir, Path,
  145                       [ file_type(directory),
  146                         file_errors(fail)
  147                       ]),
  148    catch(directory_files(Path, Entries), _, fail),
  149    !,
  150    ensure_slash(Path, SPath),
  151    attach_packages(Entries, SPath, Options).
  152attach_packs(_, _).
  153
  154attach_packages([], _, _).
  155attach_packages([H|T], Dir, Options) :-
  156    attach_package(H, Dir, Options),
  157    attach_packages(T, Dir, Options).
  158
  159attach_package(Entry, Dir, Options) :-
  160    \+ special(Entry),
  161    atom_concat(Dir, Entry, PackDir),
  162    attach_package(PackDir, Options),
  163    !.
  164attach_package(_, _, _).
  165
  166special(.).
  167special(..).
  168
  169
  170%!  attach_package(+PackDir, +Options) is semidet.
  171%
  172%   @tbd    Deal with autoload index.  Reload?
  173
  174attach_package(PackDir, Options) :-
  175    atomic_list_concat([PackDir, '/pack.pl'], InfoFile),
  176    access_file(InfoFile, read),
  177    file_base_name(PackDir, Pack),
  178    check_existing(Pack, PackDir, Options),
  179    foreign_dir(Pack, PackDir, ForeignDir),
  180    prolog_dir(PackDir, PrologDir),
  181    !,
  182    assertz(pack(Pack, PackDir)),
  183    '$option'(search(Where), Options, last),
  184    (   Where == last
  185    ->  assertz(pack_dir(Pack, prolog, PrologDir))
  186    ;   Where == first
  187    ->  asserta(pack_dir(Pack, prolog, PrologDir))
  188    ;   '$domain_error'(option_search, Where)
  189    ),
  190    update_autoload(PrologDir),
  191    (   ForeignDir \== (-)
  192    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  193    ;   true
  194    ),
  195    print_message(silent, pack(attached(Pack, PackDir))).
  196
  197
  198%!  check_existing(+Pack, +PackDir, +Options) is semidet.
  199%
  200%   Verify that we did not load this package before.
  201
  202check_existing(Entry, Dir, _) :-
  203    retract(pack(Entry, Dir)),             % registered from same place
  204    !,
  205    retractall(pack_dir(Entry, _, _)).
  206check_existing(Entry, Dir, Options) :-
  207    pack(Entry, OldDir),
  208    !,
  209    '$option'(duplicate(Action), Options, warning),
  210    (   Action == warning
  211    ->  print_message(warning, pack(duplicate(Entry, OldDir, Dir))),
  212        fail
  213    ;   Action == keep
  214    ->  fail
  215    ;   Action == replace
  216    ->  print_message(silent, pack(replaced(Entry, OldDir, Dir))),
  217        '$pack_detach'(Entry, OldDir)
  218    ;   '$domain_error'(option_duplicate, Action)
  219    ).
  220check_existing(_, _, _).
  221
  222
  223prolog_dir(PackDir, PrologDir) :-
  224    atomic_list_concat([PackDir, '/prolog'], PrologDir),
  225    exists_directory(PrologDir).
  226
  227update_autoload(PrologDir) :-
  228    atom_concat(PrologDir, '/INDEX.pl', IndexFile),
  229    (   exists_file(IndexFile)
  230    ->  reload_library_index
  231    ;   true
  232    ).
  233
  234foreign_dir(Pack, PackDir, ForeignDir) :-
  235    current_prolog_flag(arch, Arch),
  236    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
  237    exists_directory(ForeignBaseDir),
  238    !,
  239    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
  240    (   exists_directory(ForeignDir)
  241    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  242    ;   print_message(warning, pack(no_arch(Pack, Arch))),
  243        fail
  244    ).
  245foreign_dir(_, _, (-)).
  246
  247ensure_slash(Dir, SDir) :-
  248    (   sub_atom(Dir, _, _, 0, /)
  249    ->  SDir = Dir
  250    ;   atom_concat(Dir, /, SDir)
  251    )