From c83b2facfe8a22dca34e4d613aade9bf0f364c51 Mon Sep 17 00:00:00 2001 From: Phil Hagelberg Date: Sat, 24 May 2014 09:59:29 -0700 Subject: [PATCH] WIP: merge change task and release. --- leiningen-core/src/leiningen/core/project.clj | 22 +++--- src/leiningen/change.clj | 78 ++++++++----------- test/leiningen/test/change.clj | 46 +++++------ test/leiningen/test/release.clj | 4 +- 4 files changed, 69 insertions(+), 81 deletions(-) diff --git a/leiningen-core/src/leiningen/core/project.clj b/leiningen-core/src/leiningen/core/project.clj index 470cb7aa..a63ce6ac 100644 --- a/leiningen-core/src/leiningen/core/project.clj +++ b/leiningen-core/src/leiningen/core/project.clj @@ -181,17 +181,17 @@ :clean-targets ^:top-displace [:target-path] ;; TODO: remove :top-displace for :prep-tasks in 3.0 :prep-tasks ^:top-displace ["javac" "compile"] - :prep-tasks ^:top-displace [["vcs" "assert-committed"] - ["change" "version" - "leiningen.release/bump-version" "release"] - ["vcs" "commit"] - ["vcs" "tag"] - ["deploy"] - ["change" "version" - ;; TODO: level here should come from task arg - "leiningen.release/bump-version" "minor"] - ["vcs" "commit"] - ["vcs" "push"]] + :release-tasks ^:top-displace [["vcs" "assert-committed"] + ["change" "version" + "leiningen.release/bump-version" "release"] + ["vcs" "commit"] + ["vcs" "tag"] + ["deploy"] + ["change" "version" + ;; TODO: level here should come from task arg + "leiningen.release/bump-version" "minor"] + ["vcs" "commit"] + ["vcs" "push"]] :jar-exclusions [#"^\."] :certificates ["clojars.pem"] :offline? (not (nil? (System/getenv "LEIN_OFFLINE"))) diff --git a/src/leiningen/change.clj b/src/leiningen/change.clj index b0872588..41506b0d 100644 --- a/src/leiningen/change.clj +++ b/src/leiningen/change.clj @@ -1,8 +1,10 @@ (ns leiningen.change + "Rewrite project.clj by applying a function." (:require [clojure.string :as str] [clojure.zip :as zip] - [net.cgrand.sjacket :refer [str-pt]] - [net.cgrand.sjacket.parser :refer [parser]])) + [clojure.java.io :as io] + [net.cgrand.sjacket :as sj] + [net.cgrand.sjacket.parser :as parser])) ;;; Helpers @@ -12,39 +14,22 @@ (defn- clj->sjacket [value] (if (string? value) (str "\"" value "\"") - (-> value print-str parser :content first))) + (-> value print-str parser/parser :content first))) ;; NOTE: this destroy comments, formatting, etc. -;; NOTE: read-string may throw parse errors on badly formed config.. -;; is this an issue or will files already have been sanity -;; checked before this task can run? (defn- sjacket->clj [value] - (->> value str-pt read-string)) + (->> value sj/str-pt read-string)) -(defn- lookup-var [x] - ;; ensure it's a namespaced var reference to avoid error - (if (re-find #"^[a-zA-Z]+\..+\/.+$" x) - (-> x symbol find-var var-get))) +(defn ^:internal normalize-path [value] + (if (coll? value) + value + (map keyword (remove empty? (str/split value #":"))))) -(defn ^:internal normalize-path - "Coerce scalars, colls and cli-encoded lists of symbols/strings into keyword vector" - [value] - (mapv keyword - (if (coll? value) - (map name value) - (let [value (name value)] - (if (re-find #":" (name value)) - (remove empty? (str/split (name value) #":")) - [(name value)]))))) - -(defn ^:internal collapse-fn - "Partially apply args to right if fn, else return constant of first arg. - If string corresponds to a namespaced var, substite value for string" - [fn args] - (let [fn' (or (and (string? fn) (lookup-var fn)) fn)] - (if (fn? fn') - #(apply fn' % args) - (constantly fn')))) +(defn ^:internal collapse-fn [f args] + (let [f (if (ifn? f) + f + (resolve (symbol f)))] + #(apply f % args))) ;;; Traversal @@ -84,8 +69,8 @@ (remove (comp #{:whitespace :comment} :tag zip/node)) first)) -(defn- get-project [project-str] - (-> (parser project-str) +(defn- parse-project [project-str] + (-> (parser/parser project-str) zip/xml-zip find-defproject (or (fail-argument! "Project definition not found")) @@ -123,20 +108,23 @@ ;;; Public API -(defn change* - [project-str key-or-path fn & args] - (let [fn' (collapse-fn fn args) - fn'' (comp clj->sjacket fn' sjacket->clj) +(defn change-string + [project-str key-or-path f & args] + (let [f (collapse-fn f args) + wrapped-f (comp clj->sjacket f sjacket->clj) path (normalize-path key-or-path) - proj (get-project project-str)] - (str-pt + proj (parse-project project-str)] + (sj/str-pt + ;; TODO: support :artifact-id, :group-id (if (= path [:version]) - (update-version proj fn'') - (update-setting proj path fn''))))) + (update-version proj wrapped-f) + (update-setting proj path wrapped-f))))) (defn change - "Rewrite project.clj with new settings" - [project & args] - ;; cannot work with project, want to preserve formatting, comments, etc - (let [source (slurp "project.clj")] - (spit "project.clj" (apply change* source args)))) + "Rewrite project.clj with f applied to the value at key-or-path. + +TODO: document accepted args." + [project key-or-path f & args] + ;; cannot work with project map, want to preserve formatting, comments, etc + (let [source (slurp (io/file (:root project) "project.clj"))] + (spit "project.clj" (apply change-string source key-or-path f args)))) diff --git a/test/leiningen/test/change.clj b/test/leiningen/test/change.clj index c7310bba..4c51eb82 100644 --- a/test/leiningen/test/change.clj +++ b/test/leiningen/test/change.clj @@ -13,23 +13,23 @@ (testing "project definition not found" (is (thrown-with-msg? IllegalArgumentException #"Project definition not found" - (change* ";;(defproject stealth.library \"0.0.0\")" - :version "0.0.1")))) + (change-string ";;(defproject stealth.library \"0.0.0\")" + :version "0.0.1")))) (testing "project version not found" (is (thrown-with-msg? IllegalArgumentException #"Project version not found" - (change* "(defproject com.someproject :dependencies [[\"some.thing\" \"2.3.1\"]])" - :version "1.2.3")))) + (change-string "(defproject com.someproject :dependencies [[\"some.thing\" \"2.3.1\"]])" + :version "1.2.3")))) (testing "simplest possible case" (is (= "(defproject leingingen.change \"0.0.2-SNAPSHOT\")" - (change* "(defproject leingingen.change \"0.0.1\")" - :version "0.0.2-SNAPSHOT")))) + (change-string "(defproject leingingen.change \"0.0.1\")" + :version "0.0.2-SNAPSHOT")))) (testing "the largest project.clj in the repo" (let [before (slurp (clojure.java.io/resource "leiningen/help/project.clj")) - after (change* before :version "6.4.1")] + after (change-string before :version "6.4.1")] ;; check the key portion (is (= "(defproject org.example/sample \"6.4.1\" " (.substring after 529 568))) ;; check a random dependency for changes @@ -38,42 +38,42 @@ (deftest test-external-function (testing "regular function by function reference" (is (= "(defproject leingingen.change \"1.9.53-SNAPSHOT\")" - (change* "(defproject leingingen.change \"1.9.52-SNAPSHOT\")" - :version bump-version)))) + (change-string "(defproject leingingen.change \"1.9.52-SNAPSHOT\")" + :version bump-version)))) - (testing "regular function by function reference" + (testing "regular function by function reference" (is (= "(defproject leingingen.change \"1.9.53-SNAPSHOT\")" - (change* "(defproject leingingen.change \"1.9.52-SNAPSHOT\")" - :version "leiningen.test.change/bump-version"))))) + (change-string "(defproject leingingen.change \"1.9.52-SNAPSHOT\")" + :version "leiningen.test.change/bump-version"))))) (deftest test-set-regular-key (testing "can set a key" (is (= "(defproject leingingen.change \"0.0.1\" :description \"a dynamic description\")" - (change* "(defproject leingingen.change \"0.0.1\" :description \"a static description\")" - :description "a dynamic description")))) + (change-string "(defproject leingingen.change \"0.0.1\" :description \"a static description\")" + :description "a dynamic description")))) (testing "can create a new key" (is (= "(defproject leingingen.change \"0.0.1\" :description \"a dynamic description\")" - (change* "(defproject leingingen.change \"0.0.1\")" - :description "a dynamic description"))))) + (change-string "(defproject leingingen.change \"0.0.1\")" + :description "a dynamic description"))))) (deftest test-nested-key (testing "can set a nested key" (is (= "(defproject leingingen.change \"0.0.1\" :license {:url \"http://example.com\"})" - (change* "(defproject leingingen.change \"0.0.1\" :license {:url \"http://old.com\"})" - [:license :url] "http://example.com")))) + (change-string "(defproject leingingen.change \"0.0.1\" :license {:url \"http://old.com\"})" + [:license :url] "http://example.com")))) (testing "can create a nested value" (is (= "(defproject leingingen.change \"0.0.1\" :a {:b {:c 1}})" - (change* "(defproject leingingen.change \"0.0.1\")" - [:a :b :c] 1)))) + (change-string "(defproject leingingen.change \"0.0.1\")" + [:a :b :c] 1)))) - (testing "can understand cli short form" + (testing "can understand cli short form" (is (= "(defproject leingingen.change \"0.0.1\" :license {:url \"http://example.com\"})" - (change* "(defproject leingingen.change \"0.0.1\")" - :license:url "http://example.com"))))) + (change-string "(defproject leingingen.change \"0.0.1\")" + :license:url "http://example.com"))))) (deftest test-normalize-path (is (= [:a] diff --git a/test/leiningen/test/release.clj b/test/leiningen/test/release.clj index b4b3f0b3..2355e365 100644 --- a/test/leiningen/test/release.clj +++ b/test/leiningen/test/release.clj @@ -69,7 +69,7 @@ (is (= (nth semver-test-data 2) (version-map->string (second semver-test-data)))))) -(deftest test-increment-version +(deftest test-bump-version (testing "Testing semantic version increment" (doseq [semver-test-data valid-semver-version-values] (testing (format "with valid version: %s\n" @@ -77,5 +77,5 @@ (doseq [[k v] (map identity (nth semver-test-data 3))] (testing (format "version-level %s" (name k)) (is (= v (version-map->string - (increment-version + (bump-version (nth semver-test-data 1) k))))))))))