1/*  Part of Extended Tools for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xtools
    6    Copyright (C): 2015, Process Design Center, Breda, The Netherlands.
    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(option_utils, [select_option_default/3,
   36                         option_module_files/2,
   37                         option_module_files/3,
   38                         option_files/2,
   39                         option_dirs/2,
   40                         source_extension/2,
   41                         check_dir_file/3,
   42                         check_pred/2,
   43                         check_module/2
   44                        ]).   45
   46:- reexport(library(module_files)).   47:- use_module(library(apply)).   48:- use_module(library(lists)).   49:- use_module(library(option)).   50:- use_module(library(pairs)).   51:- use_module(library(solution_sequences)).   52:- use_module(library(from_utils)).   53:- use_module(library(implemented_in_base)).   54
   55:- multifile user:prolog_file_type/2.   56:- dynamic   user:prolog_file_type/2.   57
   58% TBD: This module requires optimization
   59
   60select_option_default(Holder-Default, Options1, Options) :-
   61    select_option(Holder, Options1, Options, Default).
   62
   63curr_alias_file(AliasL, EL, Loaded, File, Options1) :-
   64    member(Alias, AliasL),
   65    ( EL = (-)
   66    ->Options = Options1
   67    ; Options = [extensions([''|EL])|Options1]
   68    ),
   69    absolute_file_name(Alias, Pattern, [solutions(all)|Options]),
   70    expand_file_name(Pattern, FileL),
   71    member(File, FileL),
   72    check_file(Loaded, File).
   73
   74alias_files(AliasL, EL, Loaded, FileL, Options) :-
   75    findall(File, curr_alias_file(AliasL, EL, Loaded, File, Options), FileL).
   76
   77check_file(false, File) :- access_file(File, exist).  % exist checked at the end to avoid premature fail
   78check_file(true,  _).
   79
   80% For some reason the next declaration was causing a performance bug --EMM
   81% :- table module_file_/2 as subsumptive.
   82
   83% module_file_(M, F) :- module_file(M, F).
   84
   85check_module(Module, File) :-
   86    distinct(File, module_file(Module, File)).
   87
   88source_extension(Type, Ext) :-
   89    user:prolog_file_type(Ext, Type),
   90    ( Type \= prolog
   91    ->true
   92    ; \+ user:prolog_file_type(Ext, qlf)
   93    ).
   94
   95% Based on predicate with same name in prolog_source.pl:
   96
   97src_files([], _, _) --> [].
   98src_files([H|T], Dir, Options1) -->
   99    { \+ special(H),
  100      file_name_extension(_, Ext, H),
  101      select_option(extensions(ExtL), Options1, Options, []),
  102      ( ExtL \= []
  103      ->memberchk(Ext, ExtL)
  104      ; option(file_type(Type), Options, prolog)
  105      ->once(source_extension(Type, Ext))
  106      ),
  107      directory_file_path(Dir, H, File1),
  108      absolute_file_name(File1, File,
  109                         [ file_errors(fail)
  110                         | Options
  111                         ])
  112    },
  113    !,
  114    [File],
  115    src_files(T, Dir, Options1).
  116src_files([H|T], Dir, Options) -->
  117    { \+ special(H),
  118      option(recursive(true), Options),
  119      directory_file_path(Dir, H, SubDir),
  120      exists_directory(SubDir),
  121      !,
  122      catch(directory_files(SubDir, Files), _, fail)
  123    },
  124    !,
  125    src_files(Files, SubDir, Options),
  126    src_files(T, Dir, Options).
  127src_files([_|T], Dir, Options) -->
  128    src_files(T, Dir, Options).
  129
  130special(.).
  131special(..).
  132
  133process_files(File, OFile, Options1) :-
  134    EL = OFile.extensions,
  135    Loaded = OFile.loaded,
  136    Files = OFile.files,
  137    AFile = OFile.file,
  138    merge_options(Options1, [file_type(prolog)], Options),
  139    ( ( nonvar(Files)
  140      ->( nonvar(AFile)
  141        ->flatten([AFile|Files], AliasL)
  142        ; AFile = File,
  143          flatten(Files, AliasL)
  144        )
  145      ; nonvar(AFile)
  146      ->AliasL = [AFile]
  147      )
  148    ->alias_files(AliasL, EL, Loaded, FileL, Options),
  149      member(File, FileL)
  150    ; AFile = File
  151    ).
  152
  153process_exclude_files(ExFileL, OFile, Options1) :-
  154    merge_options(Options1, [file_type(prolog)], Options),
  155    EL = OFile.extensions,
  156    Loaded = OFile.loaded,
  157    AExFileL = OFile.exclude_files,
  158    alias_files(AExFileL, EL, Loaded, ExFileL, Options).
  159
  160process_exclude_fdirs(ExDirL, OFile, Options1) :-
  161    ExADirL = OFile.exclude_dirs,
  162    merge_options([file_type(directory)], Options1, Options),
  163    alias_files(ExADirL, -, true, ExDirL, Options).
  164
  165process_fdirs(File, OFile, Options1) :-
  166    Loaded = OFile.loaded,
  167    Dirs = OFile.dirs,
  168    ADir = OFile.dir,
  169    merge_options([file_type(directory)], Options1, Options),
  170    ( ( nonvar(Dirs)
  171      ->( nonvar(ADir)
  172        ->flatten([ADir|Dirs], ADirL)
  173        ; ADir = Dir,
  174          flatten(Dirs, ADirL)
  175        )
  176      ; nonvar(ADir)
  177      ->ADirL = [ADir]
  178      )
  179    ->alias_files(ADirL, -, true, DirL, Options),
  180      ( Loaded = false
  181      ->EL = OFile.extensions,
  182        ( EL = (-)
  183        ->Options2 = Options1
  184        ; Options2 = [extensions(EL)|Options1]
  185        ),
  186        Params = source(Options2)
  187      ; % Note: here we can not use distinct(File, module_file(_, File)) because
  188        % that will be too slow, instead we findall and deduplicate via sort/2
  189        findall(F, module_file(_, F), LFileU),
  190        sort(LFileU, LFileL),
  191        Params = loaded(LFileL)
  192      ),
  193      member(Dir, DirL),
  194      check_dir_file(Params, Dir, File)
  195    ; true
  196    ).
  197
  198% here, we need all the files, even if the option specifies only loaded
  199% files, otherwise included files without clauses will be ignored
  200% directory_source_files(Dir, FileL, [recursive(true), loaded(false)]),
  201
  202check_dir_file(source(Options), Dir, File) :-
  203    directory_files(Dir, Files),
  204    phrase(src_files(Files, Dir, [recursive(true)|Options]), FileU),
  205    sort(FileU, FileL),
  206    member(File, FileL).
  207
  208check_dir_file(loaded(FileL), Dir, File) :-
  209    member(File, FileL),
  210    directory_file_path(Dir, _, File).
  211
  212option_exclude_dirs(EL, DirL, Options1, Options2) :-
  213    foldl(select_option_default,
  214	 [exclude_dirs(ExDirL)-[]
  215	 ], Options1, Options2),
  216    merge_options([file_type(directory)], Options2, Options),
  217    alias_files(ExDirL, EL, true, DirL, Options).
  218
  219option_dirs(EL, Dir, Options1, Options2) :-
  220    foldl(select_option_default,
  221	  [dirs(Dirs)-Dirs,
  222	   dir( ADir)-ADir
  223	  ], Options1, Options2),
  224    merge_options([file_type(directory)], Options2, Options),
  225    ( nonvar(Dirs)
  226    ->( nonvar(ADir)
  227      ->flatten([ADir|Dirs], ADirL)
  228      ; ADir = Dir,
  229        flatten(Dirs, ADirL)
  230      )
  231    ; nonvar(ADir)
  232    ->ADirL = [ADir]
  233    ),
  234    alias_files(ADirL, EL, true, DirL, Options),
  235    member(Dir, DirL).
  236
  237check_pred(Head, File) :-
  238    implemented_in(Head, From, _),
  239    from_to_file(From, File).
  240
  241process_preds(File, OFile) :-
  242    HeadL = OFile.preds,
  243    ( is_list(HeadL)
  244    ->member(Head, HeadL),
  245      check_pred(Head, File)
  246    ; nonvar(HeadL)
  247    ->check_pred(HeadL, File)
  248    ; true
  249    ).
  250
  251option_file(M, ML, File, OFile, Options) :-
  252    process_exclude_files(ExFileL, OFile, Options),
  253    process_exclude_fdirs(ExDirL,  OFile, Options),
  254    process_fdirs(File, OFile, Options),
  255    process_preds(File, OFile),
  256    process_files(File, OFile, Options),
  257    \+ member(File, ExFileL),
  258    \+ ( member(ExDir, ExDirL),
  259         directory_file_path(ExDir, _, File)
  260       ),
  261    ( ML \= (-)
  262    ->member(M, ML)
  263    ; true
  264    ),
  265    ( var(M),
  266      nonvar(File)
  267    ->(   file_module(File, M)
  268      *-> true
  269      ;   false = OFile.loaded,
  270          M = (-) % File not loaded
  271      )
  272    ; module_file(M, File)
  273    ),
  274    ( Prop \= []
  275    ->module_property(M, Prop)
  276    ; true
  277    ).
  278
  279option_dir(Dir) -->
  280    foldl(select_option_default,
  281          [extensions(EL)-(-)
  282          ]),
  283    option_exclude_dirs(EL, ExDirL),
  284    option_dirs(EL, Dir),
  285    {\+ member(Dir, ExDirL)}.
  286
  287% The empty list doesn't mean anything, is just to avoid usage of a variable
  288to_nv(Name, Name=[]).
  289
  290pair_nv(M-FileL, M=FileD) :-
  291    list_dict(FileL, file, FileD).
  292
  293collect_elem(file,  _, File, File).
  294collect_elem(mfile, M, File, M-File).
  295
  296collect_dict(file, FileL, FileD) :-
  297    list_dict(FileL, file, FileD).
  298collect_dict(mfile, MFileU, MFileD) :-
  299    keysort(MFileU, MFileS),
  300    group_pairs_by_key(MFileS, MFileL),
  301    maplist(pair_nv, MFileL, MFileNV),
  302    dict_create(MFileD, mfile, MFileNV).
  303
  304project_dict(file,  M, MFileD, FileD) :-
  305    findall(File,
  306              ( get_dict(M, MFileD, FileD1),
  307                get_dict(File, FileD1, _)
  308              ), FileL),
  309    list_dict(FileL, file, FileD).
  310project_dict(mfile, _, MFileD, MFileD).
  311
  312option_collect(Name, Dict, Options1, Options) :-
  313    foldl(select_option_default,
  314          [module_files(MFileD)-(-),
  315           loaded(Loaded)-true,
  316           module_property(Prop)-[],
  317           module(M)-M,
  318           modules(ML)-(-),
  319           extensions(EL)-(-),
  320           exclude_files(AExFileL)-[],
  321           exclude_dirs(ExADirL)-[],
  322           dirs(Dirs)-Dirs,
  323	   dir( ADir)-ADir,
  324           preds(HeadL)-HeadL,
  325           files(Files)-Files,
  326	   file( AFile)-AFile
  327          ], Options1, Options),
  328    ( MFileD == (-)
  329    ->OFile = ofile{loaded:Loaded,
  330                    module_property:Prop,
  331                    modules:ML,
  332                    extensions:EL,
  333                    exclude_files:AExFileL,
  334                    exclude_dirs:ExADirL,
  335                    dirs:Dirs,
  336                    dir:ADir,
  337                    preds:HeadL,
  338                    files:Files,
  339                    file:AFile},
  340      findall(Elem,
  341              ( option_file(M, ML, File, OFile, Options),
  342                collect_elem(Name, M, File, Elem)
  343              ), ElemL),
  344      collect_dict(Name, ElemL, Dict)
  345    ; project_dict(Name, M, MFileD, Dict)
  346    ).
  347
  348option_module_files(Options, MFileD) :-
  349    option_module_files(MFileD, Options, _).
  350
  351
  352option_module_files(MFileD, Options1, Options) :-
  353    option_collect(mfile, MFileD, Options1, Options).
  354
  355option_files(Options, FileD) :-
  356    option_files(FileD, Options, _).
  357
  358option_files(FileD, Options1, Options) :-
  359    option_collect(file, FileD, Options1, Options).
  360
  361list_dict(ElemU, Key, ElemD) :-
  362    sort(ElemU, ElemL),
  363    maplist(to_nv, ElemL, ElemKVL),
  364    dict_create(ElemD, Key, ElemKVL).
  365
  366option_dirs(Options, DirD) :-
  367    findall(Dir, option_dir(Dir, Options, _), DirU),
  368    list_dict(DirU, dir, DirD)