From 3f08092d02c448e416ea2362af201f40148a1283 Mon Sep 17 00:00:00 2001
From: Hugo Duncan <hugo@hugoduncan.org>
Date: Mon, 26 Nov 2012 12:30:25 -0500
Subject: [PATCH] Update with-profile to accept +/- prefixes

Allow the profiles to be used to be specified as a delta from the default
profile list.
---
 doc/PROFILES.md                |  1 +
 src/leiningen/with_profile.clj | 67 ++++++++++++++++++++++++++--------
 2 files changed, 52 insertions(+), 16 deletions(-)

diff --git a/doc/PROFILES.md b/doc/PROFILES.md
index ccdcb58f8..6787f9e8b 100644
--- a/doc/PROFILES.md
+++ b/doc/PROFILES.md
@@ -1,3 +1,4 @@
+<!-- TODO update for with-profile +/- syntax -->
 # Profiles
 
 In Leiningen 2.x you can change the configuration of your project by
diff --git a/src/leiningen/with_profile.clj b/src/leiningen/with_profile.clj
index cbb607ec2..c93688046 100644
--- a/src/leiningen/with_profile.clj
+++ b/src/leiningen/with_profile.clj
@@ -1,39 +1,74 @@
 (ns leiningen.with-profile
-  (:require [leiningen.core.main :as main]
+  (:require [clojure.string :as string]
+            [leiningen.core.main :as main]
             [leiningen.core.project :as project]
             [robert.hooke :as hooke]))
 
-(defn- with-profile*
+(defn ^:internal with-profiles*
   "Apply the given task with a comma-separated profile list."
-  [project profiles task-name & args]
+  [project profiles task-name args]
   (hooke/with-scope
-    (let [profiles (map keyword (.split profiles ","))
-          project (and project (project/set-profiles project profiles))
+    (let [project (and project (project/set-profiles project profiles))
           task-name (main/lookup-alias task-name project)]
       (main/apply-task task-name project args))))
 
+(defn profiles-in-group
+  [project profile-group]
+  (let [profiles (.split profile-group ",")
+        prefixes (map first profiles)]
+    (cond
+     (every? #{\+ \-} prefixes)
+     (reduce
+      (fn [result profile]
+        (if (= \+ (first profile))
+          (concat result [(keyword (subs profile 1))])
+          (remove #(= (keyword (subs profile 1)) %) result)))
+      (:active-profiles (meta project))
+      profiles)
+
+     (not-any? #{\+ \-} prefixes)
+     (map keyword profiles)
+
+     :else
+     (throw
+      (ex-info
+       "Profiles in with-profile must either all be qualified, or none qualified"
+       {:exit-code 1})))))
+
 (defn ^:no-project-needed ^:higher-order with-profile
   "Apply the given task with the profile(s) specified.
 
 Comma-separated profiles may be given to merge profiles and perform the task.
 Colon-separated profiles may be given for sequential profile task application.
 
+A profile list may either be a list of profiles to use, or may specify the
+profiles to add or remove from the active profile list using + or - prefixes.
+
+For example:
+
+     lein with-profile user,dev test
+     lein with-profile -dev test
+     lein with-profile +1.4:+1.4,-dev:base,user test
+
 To list all profiles or show a single one, see the show-profiles task.
 For a detailed description of profiles, see `lein help profiles`."
   [project profiles task-name & args]
   (let [profile-groups (seq (.split profiles ":"))
         failures (atom 0)]
-    (doseq [profile-group profile-groups]
+    (doseq [profiles (map (partial profiles-in-group project) profile-groups)]
+      (main/info (format "Performing task '%s' with profile(s): '%s'"
+                         task-name (string/join "," (map name profiles))))
       (binding [main/*exit-process?* false]
-        (main/info (format "Performing task '%s' with profile(s): '%s'"
-                           task-name profile-group))
-        (try (apply with-profile* project profile-group task-name args)
-             (catch Exception e
-               (main/info (format "Error encountered performing task '%s' with profile(s): '%s'"
-                           task-name profile-group))
-               (if (and (:exit-code (ex-data e)) (not main/*debug*))
-                 (main/info (.getMessage e))
-                 (.printStackTrace e))
-               (swap! failures inc)))))
+        (try
+          (with-profiles* project profiles task-name args)
+          (catch Exception e
+            (main/info
+             (format
+              "Error encountered performing task '%s' with profile(s): '%s'"
+              task-name (string/join "," (map name profiles))))
+            (if (and (:exit-code (ex-data e)) (not main/*debug*))
+              (main/info (.getMessage e))
+              (.printStackTrace e))
+            (swap! failures inc)))))
     (when (pos? @failures)
       (main/abort))))