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