Implement merging profiles into project maps.
This commit is contained in:
parent
a9c945505b
commit
d170dae303
4 changed files with 78 additions and 14 deletions
|
@ -2,7 +2,9 @@
|
||||||
"Read project.clj files."
|
"Read project.clj files."
|
||||||
(:refer-clojure :exclude [read])
|
(:refer-clojure :exclude [read])
|
||||||
(:require [clojure.walk :as walk]
|
(:require [clojure.walk :as walk]
|
||||||
[clojure.java.io :as io]))
|
[clojure.java.io :as io]
|
||||||
|
[clojure.set :as set]
|
||||||
|
[leiningen.core.user :as user]))
|
||||||
|
|
||||||
(defn- unquote-project
|
(defn- unquote-project
|
||||||
"Inside defproject forms, unquoting (~) allows for arbitrary evaluation."
|
"Inside defproject forms, unquoting (~) allows for arbitrary evaluation."
|
||||||
|
@ -59,15 +61,65 @@
|
||||||
:leiningen
|
:leiningen
|
||||||
:subprocess))}))))
|
:subprocess))}))))
|
||||||
|
|
||||||
|
(def profiles
|
||||||
|
"Profiles get merged into the project map. The :dev and :user
|
||||||
|
profiles are active by default."
|
||||||
|
(atom {:dev {:test-path ["test"]
|
||||||
|
:resources-path ["dev-resources"]}
|
||||||
|
:user (user/profile)}))
|
||||||
|
|
||||||
|
;; Modified merge-with to provide f with the conflicting key.
|
||||||
|
(defn- merge-with-key [f & maps]
|
||||||
|
(when (some identity maps)
|
||||||
|
(let [merge-entry (fn [m e]
|
||||||
|
(let [k (key e) v (val e)]
|
||||||
|
(if (contains? m k)
|
||||||
|
(assoc m k (f k (get m k) v))
|
||||||
|
(assoc m k v))))
|
||||||
|
merge2 (fn [m1 m2]
|
||||||
|
(reduce merge-entry (or m1 {}) (seq m2)))]
|
||||||
|
(reduce merge2 maps))))
|
||||||
|
|
||||||
|
(defn- merge-dependencies [result latter]
|
||||||
|
(let [latter-deps (set (map first latter))]
|
||||||
|
(concat latter (remove (comp latter-deps first) result))))
|
||||||
|
|
||||||
|
(defn- profile-key-merge [key result latter]
|
||||||
|
(cond (= :dependencies key)
|
||||||
|
(merge-dependencies result latter)
|
||||||
|
|
||||||
|
(= :repositories key)
|
||||||
|
(concat (seq result) (seq latter))
|
||||||
|
|
||||||
|
(and (map? result) (map? latter))
|
||||||
|
(merge-with profile-key-merge latter result)
|
||||||
|
|
||||||
|
(and (set? result) (set? latter))
|
||||||
|
(set/union latter result)
|
||||||
|
|
||||||
|
(and (coll? result) (coll? latter))
|
||||||
|
(concat latter result)
|
||||||
|
|
||||||
|
:else (doto latter (prn :profile-merge-else))))
|
||||||
|
|
||||||
|
(defn- merge-profile [project profile]
|
||||||
|
(merge-with-key profile-key-merge project profile))
|
||||||
|
|
||||||
|
(defn ^:internal merge-profiles [project profiles-to-apply]
|
||||||
|
;; We reverse because we want profile values to override the
|
||||||
|
;; project, so we need "last wins" in the reduce, but we want the
|
||||||
|
;; first profile specified by the user to take precedence.
|
||||||
|
(reduce merge-profile project (map @profiles (reverse profiles-to-apply))))
|
||||||
|
|
||||||
(defn read
|
(defn read
|
||||||
"Read project map out of file, which defaults to project.clj."
|
"Read project map out of file, which defaults to project.clj."
|
||||||
([file]
|
([file profiles]
|
||||||
(try (binding [*ns* (find-ns 'leiningen.core.project)]
|
(binding [*ns* (find-ns 'leiningen.core.project)]
|
||||||
(load-file file))
|
(load-file file))
|
||||||
(let [project (resolve 'leiningen.core.project/project)]
|
(let [project (resolve 'leiningen.core.project/project)]
|
||||||
(when-not project
|
(when-not project
|
||||||
(throw (Exception. "project.clj must define project map.")))
|
(throw (Exception. "project.clj must define project map.")))
|
||||||
;; (ns-unmap *ns* 'project) ; return it to original state
|
(ns-unmap *ns* 'project) ; return it to original state
|
||||||
@project)
|
(merge-profiles @project profiles)))
|
||||||
(catch java.io.FileNotFoundException _)))
|
([file] (read file [:dev :user]))
|
||||||
([] (read "project.clj")))
|
([] (read "project.clj")))
|
||||||
|
|
|
@ -32,3 +32,6 @@
|
||||||
[]
|
[]
|
||||||
(for [plugin (.listFiles (io/file (leiningen-home) "plugins"))]
|
(for [plugin (.listFiles (io/file (leiningen-home) "plugins"))]
|
||||||
(.getAbsolutePath plugin)))
|
(.getAbsolutePath plugin)))
|
||||||
|
|
||||||
|
(defn profile []
|
||||||
|
{})
|
|
@ -49,7 +49,7 @@
|
||||||
(spit (io/file d1 "project.clj")
|
(spit (io/file d1 "project.clj")
|
||||||
(pr-str '(def project {:source-path ["src"] :compile-path "classes"
|
(pr-str '(def project {:source-path ["src"] :compile-path "classes"
|
||||||
:resources-path ["resources"]})))
|
:resources-path ["resources"]})))
|
||||||
(is (= (for [path ["src" "resources" "classes"]]
|
(is (= (for [path ["src" "dev-resources" "resources" "classes"]]
|
||||||
(format "/tmp/lein-sample-project/checkouts/d1/%s" path))
|
(format "/tmp/lein-sample-project/checkouts/d1/%s" path))
|
||||||
(#'leiningen.core.classpath/checkout-deps-paths project)))
|
(#'leiningen.core.classpath/checkout-deps-paths project)))
|
||||||
(finally
|
(finally
|
||||||
|
|
|
@ -9,8 +9,8 @@
|
||||||
|
|
||||||
:source-path ["src"],
|
:source-path ["src"],
|
||||||
:compile-path "classes",
|
:compile-path "classes",
|
||||||
:test-path [],
|
:test-path ["test"],
|
||||||
:resources-path ["resources"],
|
:resources-path ["dev-resources" "resources"],
|
||||||
:native-path ["native"],
|
:native-path ["native"],
|
||||||
:target-path "target",
|
:target-path "target",
|
||||||
|
|
||||||
|
@ -33,4 +33,13 @@
|
||||||
:description :root :jar-exclusions :uberjar-exclusions))))
|
:description :root :jar-exclusions :uberjar-exclusions))))
|
||||||
|
|
||||||
;; TODO: test omit-default
|
;; TODO: test omit-default
|
||||||
;; TODO: test reading project that doesn't def project
|
;; TODO: test reading project that doesn't def project
|
||||||
|
|
||||||
|
(def test-profiles (atom {:qa {:resources-path ["/etc/myapp"]}
|
||||||
|
:test {:resources-path ["test/hi"]}
|
||||||
|
:dev {:test-path ["test"]}}))
|
||||||
|
|
||||||
|
(deftest test-merge-profile-paths
|
||||||
|
(with-redefs [profiles test-profiles]
|
||||||
|
(is (= {:resources-path ["/etc/myapp" "test/hi" "resources"]}
|
||||||
|
(merge-profiles {:resources-path ["resources"]} [:qa :test])))))
|
Loading…
Reference in a new issue