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.

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

Update merged profile paths #83

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
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
99 changes: 68 additions & 31 deletions src/lein_monolith/plugin.clj
Original file line number Diff line number Diff line change
Expand Up @@ -36,13 +36,6 @@
:subproject-key :monolith/inherit-leaky-raw}]])


(defn- subproject-dependencies
"Given a map of internal projects, return a vector of dependency coordinates
for the subprojects."
[subprojects]
(mapv #(vector (key %) (:version (val %))) subprojects))


(defn- maybe-mark-leaky
"Add ^:leaky metadata to a profile if it is of the leaky type."
[profile {:keys [leaky?]}]
Expand Down Expand Up @@ -188,36 +181,80 @@
;; ## Merged Profiles (`with-all`) Creation


(def ^:private path-keys
(defn- subproject-dependency
"Given a map entry of an internal project, return the dependency coordinates
for the subproject."
[entry]
[(key entry) (:version (val entry))])


(defn- subproject-dependencies
"Given a map of internal projects, return a vector of dependency coordinates
for the subprojects."
[subprojects]
(mapv subproject-dependency subprojects))


(def ^:private paths-keys
"Project map keys for (re)source and test paths."
#{:resource-paths :source-paths :test-paths})


(defn- add-profile-paths
"Update a profile paths entry by adding the paths from the given project.
(defn- add-project-paths
;; Applies a set union to the current set of profile paths and any incoming
;; project paths to ensure complete, unique paths.
[profile-paths project-paths]
(into (set profile-paths) project-paths))


(defn- merge-profile-paths
"Update profile paths entries by adding the paths from the given project.
Returns the updated profile."
[project profile k]
(update profile k (fn combine-colls
[coll]
(-> coll
set
(into (get project k))
(vary-meta assoc :replace true)))))
[profile project]
(reduce (fn update-profile-paths
[profile paths-key]
(update profile paths-key add-project-paths (paths-key project)))
profile paths-keys))


(defn- finalize-paths
"Sorts the paths set stored under a given key and marks the result with
^:replace so Leiningen's meta-merge logic prefers the merged profile paths."
[profile key]
(with-meta (update profile key sort) {:replace true}))


(defn- prep-subproject-for-merging
"Ensures that the profiles that are active in the given monolith project are
active in the given subproject, then activates the inherited profiles and
absolutizes any paths in the subproject that may be relative."
[monolith [_project-name subproject]]
(-> subproject
(project/project-with-profiles)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(project/init-profiles (:active-profiles (meta monolith)))
(middleware monolith)
(project/absolutize-paths)))


(defn- prep-subprojects-for-merging
"Prepares a given subproject map for creating a merged set of (re)source and
test paths."
[monolith subprojects]
(map (partial prep-subproject-for-merging monolith) subprojects))


(defn- merged-profile-paths
"Constructs a profile map containing merged (re)source and test paths for the
given monolith and subprojects."
[monolith subprojects]
(let [prepped-subprojects (prep-subprojects-for-merging monolith subprojects)
profile (reduce merge-profile-paths {} prepped-subprojects)]
(reduce finalize-paths profile paths-keys)))


(defn merged-profile
"Constructs a profile map containing merged (re)source and test paths."
"Constructs a profile map containing merged (re)source, test paths, and
dependency coordinates for the given monolith and subprojects."
[monolith subprojects]
(let [profile
(reduce-kv
(fn [profile _project-name subproject]
(let [with-inherited-profiles (middleware subproject monolith)
project (project/absolutize-paths with-inherited-profiles)]
(reduce (partial add-profile-paths project)
profile
path-keys)))
(select-keys monolith path-keys)
subprojects)]
(as-> profile v
(reduce (fn sort-paths [acc k] (update acc k sort)) v path-keys)
(assoc v :dependencies (subproject-dependencies subprojects)))))
(assoc (merged-profile-paths monolith subprojects)
:dependencies (subproject-dependencies subprojects)))
13 changes: 8 additions & 5 deletions src/leiningen/monolith.clj
Original file line number Diff line number Diff line change
Expand Up @@ -109,6 +109,13 @@
args)))


(defn- assoc-empty-displaceable
"Associate a given key with an empty, ^:displace-able version of its value,
meant to be suberseded by a value from an incoming profile."
[proj k v]
(assoc proj k (with-meta (empty v) {:displace true})))


(defn ^:higher-order with-all
"Apply the given task with a merged set of dependencies, sources, and tests
from all the internal projects.
Expand All @@ -123,11 +130,7 @@
[monolith subprojects] (u/load-monolith! project)
targets (target/select monolith subprojects opts)
profile (plugin/merged-profile monolith (select-keys subprojects targets))
project (reduce-kv
(fn remove-replace-meta
[proj k _v]
(update proj k vary-meta dissoc :replace))
project profile)]
project (reduce-kv assoc-empty-displaceable project profile)]
(lein/apply-task
task
(plugin/add-active-profile project :monolith/all profile)
Expand Down
24 changes: 14 additions & 10 deletions test/lein_monolith/monolith_test.clj
Original file line number Diff line number Diff line change
Expand Up @@ -41,25 +41,29 @@


(deftest with-all-test
(is (= ["apps/app-a/resources"
"dev-resources"
(is (= [['lein-monolith.example/lib-a "MONOLITH-SNAPSHOT"]
['lein-monolith.example/app-a "MONOLITH-SNAPSHOT"]
['lein-monolith.example/lib-b "MONOLITH-SNAPSHOT"]]
(read-pprint-output :dependencies)))

(is (= ["apps/app-a/dev-resources"
"apps/app-a/resources"
"libs/lib-a/dev-resources"
"libs/lib-a/resources"
"libs/lib-b/resources"
"resources"]
"libs/lib-b/dev-resources"
"libs/lib-b/resources"]
(relativize-pprint-output :resource-paths)))

(is (= ["apps/app-a/src"
(is (= ["apps/app-a/bench"
"apps/app-a/src"
"libs/lib-a/src"
"libs/lib-b/src"
"src"]
"libs/lib-b/src"]
(relativize-pprint-output :source-paths)))

(is (= ["apps/app-a/test/integration"
"apps/app-a/test/unit"
"libs/lib-a/test/integration"
"libs/lib-a/test/unit"
"libs/lib-b/test/integration"
"libs/lib-b/test/unit"
"test/integration"
"test/unit"]
"libs/lib-b/test/unit"]
(relativize-pprint-output :test-paths))))