1:- module(try_compile, [configurations/3, compiles/1, compiles/2, compiles/3, compiles/4]).    2
    3:- use_module(library(filesex)).    4
    5:- use_module(build_systems).    6:- use_module(utility).    7
    8configurations(RepoPath, System, Goal) :-
    9    build_system(System),
   10    goal(Goal),
   11    builds_with(System, RepoPath).
   12
   13% This will only be true if the build succeeds
   14compiles(Path) :- compiles(Path, compile).
   15compiles(Path, Goal) :- builds_with(System, Path), compiles(Path, System, Goal).
   16compiles(Path, System, Goal) :- compiles(Path, System, Goal, []).
   17compiles(Path, System, Goal, _) :- files_exist(Path, System, Goal).
   18compiles(Path, System, Goal, Args) :-
   19    not(files_exist(Path, System, Goal)),
   20
   21    (
   22        run_compile(Path, System, Goal, Args, Output);
   23
   24        absolute_file_name(Path, Absolute),
   25        file_directory_name(Absolute, ParentPath),
   26        run_compile(ParentPath, System, Goal, Args, Output)
   27    ),
   28    success_string(System, SuccessString),
   29    sub_atom(Output, _, _, _, SuccessString).
   30
   31files_exist(Path, System, Goal) :-
   32    goal_files(System, Goal, Files),
   33    forall(member(File, Files),
   34        (
   35            directory_file_path(Path, File, FullPath),
   36            ( exists_file(FullPath); exists_directory(FullPath) )
   37        )).
   38
   39run_compile(Path, System, Goal, CustomArgs, Output) :-
   40    % Retrieve information about the build system so we can actually run it.
   41    exe_name(System, SystemPath),
   42    goal_args(System, Goal, GoalArgs),
   43
   44    output_file(Path, System, Goal, CustomArgs, OutputPath),
   45
   46    append(GoalArgs, CustomArgs, AllArgs),
   47    process(SystemPath, AllArgs, [path(Path), output(Output)]),
   48    write_file(OutputPath, Output).
   49
   50output_file(Path, System, Goal, CustomArgs, OutputPath) :-
   51    maplist(surround_atom('\'', '\''), CustomArgs, QuotedArgs),
   52    atomic_list_concat(QuotedArgs, '-', ArgsPart),
   53    atomic_list_concat(['output', System, Goal, ArgsPart], '-', TempFilename),
   54    file_name_extension(TempFilename, 'txt', Filename),
   55    directory_file_path(Path, Filename, OutputPath)