Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add show-fingerprints command #91

Merged
merged 1 commit into from
Jul 11, 2022
Merged

Add show-fingerprints command #91

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
114 changes: 90 additions & 24 deletions src/lein_monolith/task/fingerprint.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -190,14 +190,14 @@

(defn- hash-upstream-projects
[project dep-map subprojects cache]
(->> (dep-map (dep/project-name project))
(keep (fn hash-upstream
[subproject-name]
(when-let [subproject (subprojects subproject-name)]
[subproject-name
(::final (hash-inputs subproject dep-map subprojects cache))])))
(into {})
(kv-hash :projects)))
(into (sorted-map)
(keep
(fn hash-upstream
[subproject-name]
(when-let [subproject (subprojects subproject-name)]
[subproject-name
(::final (hash-inputs subproject dep-map subprojects cache))])))
(dep-map (dep/project-name project))))


(defn- hash-inputs
Expand All @@ -211,17 +211,20 @@
[project dep-map subprojects cache]
(let [project-name (dep/project-name project)]
(or (@cache project-name)
(let [prints
(let [upstream-hashes
(hash-upstream-projects project dep-map subprojects cache)

prints
{::version (str (:version project))
::java-version (System/getProperty "java.version")
::seed (str (:monolith/fingerprint-seed project 0))
::sources (hash-sources project)
::deps (hash-dependencies project)
::upstream (hash-upstream-projects
project dep-map subprojects cache)}
::upstream (kv-hash :projects upstream-hashes)}

prints
(assoc prints
::upstream-hashes upstream-hashes
::final (kv-hash :inputs prints)
::time (System/currentTimeMillis))]
(swap! cache assoc project-name prints)
Expand Down Expand Up @@ -377,6 +380,62 @@
(str/join ", ")))


(defn- debug-project-fingerprints
"Print a detailed representation of a project's fingerprints for debugging."
[project-name past current]
(let [all-attrs (disj (into (sorted-set)
(concat (keys past)
(keys current)))
::upstream-hashes
::final
::time)
ordered-attrs (into []
(filter all-attrs)
fingerprint-priority)
compare-attrs (concat
ordered-attrs
(sort (remove (set ordered-attrs) all-attrs))
[::final])
render-attr (fn render-attr
[old-val new-val same-color]
(cond
(and (nil? old-val) new-val)
(colorize :green new-val)

(and old-val (nil? new-val))
(colorize :red old-val)

(= old-val new-val)
(if same-color
(colorize same-color new-val)
new-val)

:else
(str (colorize :red old-val)
" => "
(colorize :green new-val))))]
(println project-name)
(doseq [attr compare-attrs]
(printf "%24s: %s\n"
(colorize :cyan (name attr))
(render-attr (get past attr)
(get current attr)
nil))
(when (= ::upstream attr)
(let [past-map (::upstream-hashes past)
curr-map (::upstream-hashes current)]
(doseq [upstream (into (sorted-set)
(concat (keys past-map)
(keys curr-map)))]
(printf "%16s * %s: %s\n"
" " upstream
(render-attr (get past-map upstream)
(get curr-map upstream)
:yellow)))))))
(newline)
(flush))


(defn changed
[project opts markers]
(let [[monolith subprojects] (u/load-monolith! project)
Expand Down Expand Up @@ -424,19 +483,10 @@
(not= k ::new-project)
(not= k ::up-to-date))
(doseq [project-name projs]
(let [past (get-in ctx [:initial marker project-name])
current (fingerprints ctx project-name)
attrs (disj (into (sorted-set) (concat (keys past) (keys current))) ::time)]
(println project-name)
(doseq [attr attrs]
(let [past-val (get past attr)
curr-val (get current attr)]
(if (= past-val curr-val)
(printf "%12s: %s\n" (name attr) curr-val)
(printf "%12s: %s => %s\n" (name attr) past-val curr-val)))))
(newline)
(flush)
,,,))))))
(debug-project-fingerprints
project-name
(get-in ctx [:initial marker project-name])
(fingerprints ctx project-name))))))))
(lein/info)))))


Expand Down Expand Up @@ -465,6 +515,22 @@
(colorize :bold (count targets))))))


(defn show
[project marker targets]
(when-not (seq targets)
(lein/abort "Please specify at least one project to show"))
(let [[monolith subprojects] (u/load-monolith! project)
ctx (context monolith subprojects)
projects (->> {:in (set targets)}
(target/select monolith subprojects)
(dep/topological-sort (dep/dependency-map subprojects)))]
(doseq [project-name projects]
(debug-project-fingerprints
project-name
(get-in ctx [:initial marker project-name])
(fingerprints ctx project-name)))))


(defn clear
[project opts markers]
(let [[monolith subprojects] (u/load-monolith! project)
Expand Down
13 changes: 12 additions & 1 deletion src/leiningen/monolith.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -250,6 +250,16 @@
(fingerprint/mark-fresh project opts more)))


(defn show-fingerprints
"Show information about the calculation of one or more projects'
fingerprints, compared to a current marker.

Usage:
lein monolith show-fingerprints marker project [...]"
[project [marker & args]]
(fingerprint/show project marker args))


(defn clear-fingerprints
"Clear projects' cached fingerprints so they will be re-built next :refresh.

Expand All @@ -270,7 +280,7 @@
"Tasks for working with Leiningen projects inside a monorepo."
{:subtasks [#'info #'lint #'deps #'deps-on #'deps-of #'graph
#'with-all #'each #'link #'unlink
#'changed #'mark-fresh #'clear-fingerprints]}
#'changed #'mark-fresh #'show-fingerprints #'clear-fingerprints]}
[project command & args]
(case command
"info" (info project args)
Expand All @@ -285,6 +295,7 @@
"unlink" (unlink project args)
"changed" (changed project args)
"mark-fresh" (mark-fresh project args)
"show-fingerprints" (show-fingerprints project args)
"clear-fingerprints" (clear-fingerprints project args)
(lein/abort (pr-str command) "is not a valid monolith command! Try: lein help monolith"))
(flush))