1:- module(maven_xml, [pom/2, add_artifact/4, artifacts/3]).    2
    3:- use_module(library(sgml)).    4:- use_module(library(sgml_write)).    5:- use_module(xml).    6
    7pom(File, Pom) :-
    8    var(Pom) -> load_xml(File, Pom, []);
    9
   10    setup_call_cleanup(
   11        open(File, write, Stream),
   12        xml_write(Stream, Pom, []),
   13        close(Stream)).
   14
   15config_option(element(Name, [], [V]), Name=V).
   16
   17artifact_type(Artifact, ArtifactType) :-
   18    Artifact =.. [ArtifactType, _,  _, _, _].
   19
   20coords(Artifact, Coords) :-
   21    Artifact =.. [_, Coords, _, _, _].
   22
   23configuration(Artifact, Configuration) :-
   24    Artifact =.. [_, _, Configuration, _, _].
   25
   26dependencies(Artifact, Dependencies) :-
   27    Artifact =.. [_, _, _, Dependencies, _].
   28
   29artifact_element(Artifact, Element) :-
   30    (
   31        nonvar(Artifact) -> Artifact =.. [ArtifactType, GroupId:ArtifactId:Version, Configuration, Dependencies, Element];
   32
   33        true
   34    ),
   35
   36    Element = element(ArtifactType, [], Tags),
   37
   38    member(element(groupId, [], [GroupId]), Tags),
   39    member(element(artifactId, [], [ArtifactId]), Tags),
   40
   41    % The following are optionally part of the artifact
   42
   43    % Version
   44    (
   45        not(Version = ''), member(element(version, [], [Version]), Tags) -> true;
   46
   47        Version = ''
   48    ),
   49
   50    % Configuration
   51    (
   52        not(Configuration = []), member(element(configuration, [], ConfigurationOptions), Tags) ->
   53            maplist(config_option, ConfigurationOptions, Configuration);
   54
   55        Configuration = []
   56    ),
   57
   58    % Dependencies
   59    (
   60        not(Dependencies = []), member(element(dependencies, [], DependencyElements), Tags) ->
   61            maplist(artifact_element, Dependencies, DependencyElements);
   62
   63        Dependencies = []
   64    ),
   65
   66    (
   67        var(Artifact) -> Artifact =.. [ArtifactType, GroupId:ArtifactId:Version, Configuration, Dependencies, Element];
   68
   69        true
   70    ).
   71
   72artifacts(Pom, Container, Artifact) :-
   73    xml_element(element(Container, _, Artifacts), Pom),
   74    member(ArtifactElement, Artifacts),
   75    artifact_element(Artifact, ArtifactElement).
   76
   77artifact_adder(Container, Artifact, element(Container, Attrs, Children), element(Container, Attrs, NewChildren)) :-
   78    artifact_element(Artifact, ArtifactElement),
   79    select(ArtifactElement, NewChildren, Children).
   80
   81add_artifact(Container, Artifact, Pom, NewPom) :-
   82    % If the plugins element exists
   83    xml_element(element(plugins, _, _), Pom) ->
   84        modify_element(maven_xml:artifact_adder(Container, Artifact), Pom, NewPom);
   85    % otherwise, we need to add it:
   86
   87    [element(E, Attrs, Children)] = Pom,
   88    select(element(build, [], [element(plugins, [], [])]), NewChildren, Children),
   89    add_artifact(Container, Artifact, [element(E, Attrs, NewChildren)], NewPom)