-
Notifications
You must be signed in to change notification settings - Fork 12
/
pom.clj
129 lines (102 loc) · 4.36 KB
/
pom.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
(ns metav.domain.pom
(:require
[clojure.data.xml :as xml]
[clojure.data.xml.tree :as tree]
[clojure.data.xml.event :as event]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[clojure.tools.deps.alpha.gen.pom :as deps-pom]
[clojure.zip :as zip]
[me.raynes.fs :as fs]
[metav.domain.git :as git]
[metav.utils :as utils])
(:import [java.io Reader]
[clojure.data.xml.node Element]))
(s/def :metav.maven/group-id string?)
(s/def :metav.maven.pom/name string?)
(s/def :metav.maven.pom/options
(s/keys
:opt [:metav.maven/group-id
:metav.maven.pom/name]))
(defn ctxt->group-id [context]
(:metav/project-name context))
(defn ctxt->pom-name [context]
(let [{:metav/keys [artefact-name version]
group-id :metav.maven/group-id} context]
(str group-id "/" artefact-name "-" version)))
(defn ctxt->pom-path [context]
(-> context :metav/working-dir (fs/file "pom.xml") str))
;;----------------------------------------------------------------------------------------------------------------------
;; taken from clojure.tools.deps.alpha.gen.pom
(xml/alias-uri 'pom "http://maven.apache.org/POM/4.0.0")
(defn- make-xml-element
[{:keys [tag attrs] :as node} children]
(with-meta
(apply xml/element tag attrs children)
(meta node)))
(defn- xml-update
[root tag-path replace-node]
(let [z (zip/zipper xml/element? :content make-xml-element root)]
(zip/root
(loop [[tag & more-tags :as tags] tag-path, parent z, child (zip/down z)]
(if child
(if (= tag (:tag (zip/node child)))
(if (seq more-tags)
(recur more-tags child (zip/down child))
(zip/edit child (constantly replace-node)))
(recur tags parent (zip/right child)))
(zip/append-child parent replace-node))))))
(defn- parse-xml
[^Reader rdr]
(let [roots (tree/seq-tree event/event-element event/event-exit? event/event-node
(xml/event-seq rdr {:include-node? #{:element :characters :comment}
:skip-whitespace true}))]
(first (filter #(instance? Element %) (first roots)))))
;;----------------------------------------------------------------------------------------------------------------------
(defn read-xml [path]
(with-open [rdr (-> path fs/file io/reader)]
(parse-xml rdr)))
(defn update-element [xml-root xml-path v]
(xml-update xml-root
xml-path
(-> xml-path
last
(-> (vector v)
xml/sexp-as-element))))
(defn update-pom [xml-root context]
(let [{group-id :metav.maven/group-id
pom-name :metav.maven.pom/name
:metav/keys [artefact-name version]} context]
(-> xml-root
(update-element [::pom/groupId] group-id)
(update-element [::pom/artifactId] artefact-name)
(update-element [::pom/version] (str version))
(update-element [::pom/name] pom-name))))
;; rework of clojure.tools.deps.alpha.gen.pom/sync-pom
(defn update-pom! [context]
(let [pom-file-path (ctxt->pom-path context)
updated-pom (-> pom-file-path
read-xml
(update-pom context))]
(spit pom-file-path (xml/indent-str updated-pom))
(assoc context :metav.maven.pom/sync-path pom-file-path)))
(s/def ::sync-pom!-param (s/merge :metav/context
:metav.maven.pom/options))
(defn sync-pom! [context]
(let [{:metav/keys [project-deps working-dir]
:as context} (-> context
(as-> context
(utils/ensure-key context :metav.maven/group-id (ctxt->group-id context))
(utils/ensure-key context :metav.maven.pom/name (ctxt->pom-name context)))
(->> (utils/check-spec ::sync-pom!-param)))]
(deps-pom/sync-pom project-deps (fs/file working-dir))
(update-pom! context)))
(s/def ::git-add-pom!-param (s/keys :req [:metav/working-dir
:metav.maven.pom/sync-path]))
(defn git-add-pom! [context]
(let [{working-dir :metav/working-dir
pom :metav.maven.pom/sync-path} context]
(-> context
(->> (utils/check-spec ::git-add-pom!-param))
(assoc :metav.maven.pom/git-add-pom-result
(git/add! working-dir pom)))))