Code cleanup

This commit is contained in:
Jean Niklas L'orange 2016-02-04 23:32:52 +01:00
parent e14da08963
commit c630502d18
6 changed files with 16 additions and 20 deletions

View file

@ -34,7 +34,7 @@
(defn- update-each-contained [m keys f & args]
(reduce (fn [m k]
(if (contains? m k)
(apply update-in m [k] f args)
(apply update m k f args)
m)) m keys))
(defn- update-first [coll pred f]

View file

@ -204,3 +204,11 @@
(cons x (step (rest s) (conj seen fx)))))))
xs seen)))]
(reverse (step (reverse coll) #{}))))
(defn ancestor?
"Is a an ancestor of b?"
[a b]
(let [hypothetical-ancestor (.getCanonicalPath (io/file a))
hypothetical-descendant (.getCanonicalPath (io/file b))]
(and (.startsWith hypothetical-descendant hypothetical-ancestor)
(not (= hypothetical-descendant hypothetical-ancestor)))))

View file

@ -76,7 +76,7 @@
(.mkdirs d1)
(spit (io/file d1 "project.clj")
(pr-str '(defproject hello "1.0")))
(is (= (for [path ["src" "dev-resources" "resources"
(is (= (for [path ["src" "dev-resources" "resources"
"target/classes" "foo"]]
(lthelper/pathify (format "/tmp/lein-sample-project/checkouts/d1/%s" path)))
(#'leiningen.core.classpath/checkout-deps-paths project)))

View file

@ -34,9 +34,7 @@
cemerick.pomegranate
classlojure.core
clojure.tools.nrepl
clj-http.core
;; to avoid compile warnings at runtime:
clj-http.client]}}
clj-http.core]}}
:test-selectors {:default (complement :disabled)
:offline (comp (partial not-any? identity)
(juxt :online :disabled))}

View file

@ -25,14 +25,6 @@
(.setWritable f true)
(io/delete-file f silently)))
(defn- ancestor?
"Is a an ancestor of b?"
[a b]
(let [hypothetical-ancestor (.getCanonicalPath (io/file a))
hypothetical-descendant (.getCanonicalPath (io/file b))]
(and (.startsWith hypothetical-descendant hypothetical-ancestor)
(not (= hypothetical-descendant hypothetical-ancestor)))))
(defn- protected-paths
"Returns a set of leiningen project source directories and important files."
[project]
@ -52,7 +44,7 @@
[project path]
(let [protected-paths (protected-paths project)]
(or (protected-paths (.getCanonicalPath (io/file path)))
(some #(ancestor? % path) protected-paths))))
(some #(utils/ancestor? % path) protected-paths))))
(defn- protect-clean-targets?
"Returns the value of :protect in the metadata map for the :clean-targets
@ -72,7 +64,7 @@
[project clean-target]
(when (and (string? clean-target)
(protect-clean-targets? project))
(cond (not (ancestor? (:root project) clean-target))
(cond (not (utils/ancestor? (:root project) clean-target))
(main/abort (error-msg "Deleting path outside of the project root [\""
clean-target "\"] is not allowed."))
(protected-path? project clean-target)

View file

@ -14,11 +14,9 @@
task+args]))
(defn ^:internal update-project [project keys-vec f args]
(let [f #(apply apply (concat (if (seq keys-vec)
[clj/update-in % keys-vec f]
[f %])
args
[nil]))]
(let [f #(if (seq keys-vec)
(apply clj/update-in % keys-vec f args)
(apply f % args))]
(-> (vary-meta (f project) clj/update-in [:without-profiles] f)
(project/load-plugins)
(project/activate-middleware))))