1:- module(build_systems, [build_system/1, goal/1, goal_args/3, exe_name/2, builds_with/2, success_string/2,
2 maven_module/2, maven_modules/2, classpath/2, classpath/3, goal_files/3,
3 quick_classpath/2, quick_classpath/3]). 4
5:- use_module(library(filesex)). 6
7:- use_module(utility). 8
9build_system(maven).
10build_system(ant).
11build_system(gradle).
12build_system(make).
13
14goal(compile).
15goal(testCompile).
16goal(test).
17goal(package).
18goal(dependencies).
19goal(install).
20
21goal_args(maven, compile, ['compile']).
22goal_args(maven, testCompile, ['test-compile']).
23goal_args(maven, test, ['test']).
24goal_args(maven, package, ['package', '-DskipTests', '-Drat.skip']).
25goal_args(maven, dependencies, ['dependency:copy-dependencies']).
26goal_args(maven, install, ['install', '-fn', '-DskipTests', '-Drat.skip']).
27
28goal_args(ant, compile, ['build']).
29goal_args(ant, testCompile, ['build']).
30goal_args(ant, test, ['test']).
31
32goal_args(gradle, compile, ['assemble']).
33goal_args(gradle, testCompile, ['assemble']).
34goal_args(gradle, test, ['test']).
35
36goal_args(make, compile, ['']).
37
41goal_files(maven, compile, ['target/classes']).
42goal_files(maven, testCompile, ['target/test-classes']).
43goal_files(maven, dependencies, ['target/dependency']).
44
45exe_name(maven, path(mvn)).
46exe_name(ant, path(ant)).
47exe_name(gradle, path(gradle)).
48exe_name(make, path(make)).
49
50success_string(maven, 'BUILD SUCCESS').
51success_string(ant, 'BUILD SUCCESSFUL').
52success_string(gradle, 'BUILD SUCCESSFUL').
53success_string(make, ''). 54
55buildfile(maven, Path, P) :- directory_file_path(Path, 'pom.xml', P).
56buildfile(ant, Path, P) :- directory_file_path(Path, 'build.xml', P).
57buildfile(gradle, Path, P) :- directory_file_path(Path, 'build.gradle', P).
58buildfile(make, Path, P) :- directory_file_path(Path, 'Makefile', P).
59
60builds_with(System, Path) :- buildfile(System, Path, P), exists_file(P).
61
62maven_module(Path, ModulePath) :-
63 file_base_name(Path, 'pom.xml'),
64 file_directory_name(Path, ModulePath).
65maven_module(Path, ModulePath) :-
66 exists_directory(Path),
67 list_files(Path, Files),
68 member(File, Files),
69 maven_module(File, ModulePath).
70
71maven_modules(Path, Modules) :- findall(ModulePath, maven_module(Path, ModulePath), Modules).
72
73classpath(Path, Classpath) :-
74 builds_with(System, Path),
75 classpath(System, Path, Classpath).
76classpath(maven, Path, Classpath) :-
77 tmp_file('cp', OutputPath),
78 atom_concat('-Dmdep.outputFile=', OutputPath, OutputArg),
79 process(path(mvn), ['dependency:build-classpath', OutputArg], [path(Path)]),
80 read_file(OutputPath, [Classpath|_]),
81 delete_file(OutputPath).
82
83find_jars(Path, Jars) :-
84 findall(Jar,
85 (
86 walk(Path, Jar),
87 file_name_extension(_, 'jar', Jar)),
88 Jars).
89
90quick_classpath(Path, Classpath) :-
91 builds_with(System, Path),
92 quick_classpath(System, Path, Classpath).
93quick_classpath(maven, Path, Classpath) :-
94 directory_file_path(Path, 'target/classes', Classes),
95 directory_file_path(Path, 'target/test-classes', TestClasses),
96 directory_file_path(Path, 'target', TargetPath),
97
98 find_jars(TargetPath, Jars),
99 append([Classes, TestClasses], Jars, AllPaths),
100
101 atomic_list_concat(AllPaths, ':', Classpath)