-
Notifications
You must be signed in to change notification settings - Fork 0
/
plugin.clj
169 lines (148 loc) · 6.86 KB
/
plugin.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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
(ns lein-git-revisions.plugin
(:require [clojure.java.shell :refer [with-sh-dir]]
[clojure.string :as str]
[cuddlefish.core :as git])
(:import (java.util.regex Matcher Pattern)))
(defn map->nsmap
"Namespaces all non-namespaced keys in the given map.
```clojure
(map->nsmap {:a 1 :b 2 :c/d 3} \"x\")
=> {:x/a 1, :x/b 2, :c/d 3}
```
Originally from [StackOverflow Q#44523 A#43722784](https://stackoverflow.com/a/43722784/44523)"
[m n]
(reduce-kv (fn [acc k v]
(let [new-kw (if (and (keyword? k)
(not (qualified-keyword? k)))
(keyword (str n) (name k))
k)]
(assoc acc new-kw v)))
{}
m))
(defn adjust-value
[value adjust]
(case adjust
:inc (inc (Integer/parseInt value))
:clear 0
value))
(def predefined-formats {:semver {:tag-pattern #"v(?<major>\d+)\.(?<minor>\d+)\.(?<patch>\d+).*$"
:pattern [:segment/when [:git/untagged? :constants/unknown]
:segment/when [:git/tag :rev/major "." :rev/minor "." :rev/patch]
:segment/when-not [:env/lein_revisions_release "-" :constants/ahead]
:segment/when [:env/lein_revisions_prerelease "-" :env/lein_revisions_prerelease]
:segment/when-not [:env/lein_revisions_release "+" :git/ref-short]
:segment/when [:git/unversioned? "+" :constants/unversioned]]
:adjustments {:major {:rev/major :inc :rev/minor :clear :rev/patch :clear}
:minor {:rev/minor :inc :rev/patch :clear}
:patch {:rev/patch :inc}}
:constants {:ahead "SNAPSHOT"
:unknown "UNKNOWN"
:unversioned "UNVERSIONED"}}})
(defn lookup-env
[part]
(when (= "env" (namespace part))
(System/getenv (str/upper-case (name part)))))
(defn lookup-gen
"Generates a dynamic value for supported lookup `parts`."
[part]
(when (= "gen" (namespace part))
(case (name part)
"timestamp" "2022-02-22")))
(defn- lookup-group
"Returns a `part` `lookup function` using the provided [java.util.regex.Matcher][Matcher] as a backing source for
the values.
Lookups are done by converting the `part` keyword's name segment to Regular Expression
[named group][Pattern-groupname] lookup.
```clojure
(resolve-part
:rev/numbers
(lookup-group (re-matcher #\"(?<numbers>\\d+)\" \"abc123def\")))
;=> \"123\"
```
[Matcher]: https://docs.oracle.com/en/java/javase/17/docs/api/java.base/java/util/regex/Pattern.html#groupname
[Pattern-groupname]: https://docs.oracle.com/en/java/javase/17/docs/api/java.base/java/util/regex/Pattern.html#groupname"
[^Matcher matcher]
(re-find matcher) ; initializes the matcher
(fn [part]
(when (= "rev" (namespace part))
(try (.group matcher (name part))
(catch IllegalStateException ise
nil)))))
(defn- resolve-part
"Resolve a single revision `part` possibly using the provided `lookup function`. Returns either the resolved
value as string or `nil` if resolution failed to produce a meaningful value.
The final revision string is made up of parts where each part is either a namespaced keyword or plain string
to guide the value lookup process. The namespace of the keyword defines the expected lookup source while the
name part of the keyword is used as the lookup value. The value may be modified before final lookup, depending
on the implementation of the lookup source.
```clojure
(resolve-part :env/user lookup-env)
;=> \"esko.suomi\"
```"
[part lookup]
(str (condp #(%1 %2) part
keyword? (lookup part)
part)))
(defn resolve-and-adjust
[lookup adjustments]
(fn [acc part]
(let [v (resolve-part part lookup)
adjust (when adjustments (adjustments part))]
(str acc (if (and (not (str/blank? v))
(not (nil? adjust)))
(adjust-value v adjust)
v
)))))
(defn create-adjustments
[adjustments lookup adjust-key]
(let [adjust (or adjust-key [])
adjustments (or adjustments {})]
(->> (if-not (vector? adjust) (vector adjust) adjust)
(map
(fn [k]
(adjustments (or (some-> (lookup k) keyword)
k))))
(filter (complement nil?))
first)))
(defn revision-generator
[{:keys [tag] :as git}
format
adjust]
(let [git (merge git
(when (nil? git) {:unversioned? true})
(when (nil? tag) {:untagged? true}))
{:keys [tag-pattern pattern constants adjustments] :as config}
(cond (keyword? format) (get predefined-formats format)
(map? format) format) ; TODO: else "unsupported format <blaa>"
lookup (some-fn (map->nsmap constants "constants")
(map->nsmap git "git")
(lookup-group (re-matcher (or tag-pattern #"$^") (or tag "")))
lookup-gen
lookup-env)
adjustments (create-adjustments adjustments lookup adjust)
into-version-segment (resolve-and-adjust lookup adjustments)]
(reduce
(fn [acc [directive format]]
(str acc (case directive
:segment/always (reduce into-version-segment "" format)
:segment/when (when (lookup (first format))
(reduce into-version-segment "" (rest format)))
:segment/when-not (when-not (lookup (first format))
(reduce into-version-segment "" (rest format)))
""))) ; TODO: what could be good default?
""
(partition 2 pattern))))
; TODO: write revision file
(defn middleware
; TODO: some minimal default config
[{:keys [git-revisions root]
:as project}]
(with-sh-dir root
(let [{:keys [format adjust]} git-revisions
git-config {:git "git"
:describe-pattern git/git-describe-pattern}
git-context (-> (git/status git-config)
(dissoc :version)
(assoc :branch (git/current-branch git-config)))]
(-> project
(assoc :version (revision-generator git-context format adjust))))))