From 1937e561d25ef141065598dc133af4d7d8ecdd50 Mon Sep 17 00:00:00 2001
From: Nicolas Berger <nicoberger@gmail.com>
Date: Tue, 19 Sep 2017 00:33:06 -0300
Subject: [PATCH] Pom: refactor write-scm-tag and make-git-scm

Makes it to return plain maps for all values of :scm to use xmlify and
xml-tags in all cases. Apart from easier to read code, it will make it
easy to implement merging values from git and from project map when
(= "git" scm)
---
 src/leiningen/pom.clj       | 29 +++++++++++++++--------------
 test/leiningen/test/pom.clj | 17 ++++++++++++++++-
 2 files changed, 31 insertions(+), 15 deletions(-)

diff --git a/src/leiningen/pom.clj b/src/leiningen/pom.clj
index ae9d9a28..3e47e1b3 100644
--- a/src/leiningen/pom.clj
+++ b/src/leiningen/pom.clj
@@ -86,19 +86,15 @@
      :dev-clone (str "ssh://git@github.com/" user "/" repo ".git")
      :browse (str "https://github.com/" user "/" repo)}))
 
-(defn- make-git-scm [git-dir]
+(defn- make-git-scm-map [git-dir]
   (try
     (let [origin (read-git-origin git-dir)
           head (read-git-head git-dir)
           urls (github-urls origin)]
-      [:scm
-       (and (:public-clone urls)
-            [:connection (str "scm:git:" (:public-clone urls))])
-       (and (:dev-clone urls)
-            [:developerConnection (str "scm:git:" (:dev-clone urls))])
-       (and head
-            [:tag head])
-       [:url (:browse urls)]])
+      (cond-> {:url (:browse urls)}
+        (:public-clone urls) (assoc :connection (str "scm:git:" (:public-clone urls)))
+        (:dev-clone urls)    (assoc :developerConnection (str "scm:git:" (:dev-clone urls)))
+        head                 (assoc :tag head)))
     (catch java.io.FileNotFoundException _)))
 
 (def disclaimer
@@ -128,15 +124,20 @@
   [scm]
   (map #(xml-tags (first %) (second %)) scm))
 
+(defn- make-project-scm-map [project]
+  (select-keys (:scm project) [:url :connection
+                               :tag :developerConnection]))
+
 (defn- write-scm-tag
   "Write the <scm> tag for pom.xml.
   Retains backwards compatibility without an :scm map."
   [scm project]
-  (if (= "auto" scm)
-    (make-git-scm (resolve-git-dir project))
-    (xml-tags :scm (xmlify (select-keys (:scm project)
-                                        [:url :connection
-                                         :tag :developerConnection])))))
+  (->> (case scm
+         "auto" (make-git-scm-map (resolve-git-dir project))
+         ; else
+         (make-project-scm-map project))
+       xmlify
+       (xml-tags :scm)))
 
 (defmethod xml-tags :default
   ([tag value]
diff --git a/test/leiningen/test/pom.clj b/test/leiningen/test/pom.clj
index 3ddebf67..c1be27c1 100644
--- a/test/leiningen/test/pom.clj
+++ b/test/leiningen/test/pom.clj
@@ -1,7 +1,7 @@
 (ns leiningen.test.pom
   (:use [clojure.test]
         [clojure.java.io :only [file delete-file]]
-        [leiningen.pom :only [make-pom pom snapshot?]]
+        [leiningen.pom :as pom :only [make-pom pom snapshot?]]
         [leiningen.core.user :as user]
         [leiningen.test.helper
          :only [sample-project sample-profile-meta-project
@@ -49,6 +49,21 @@
   ([project name profile]
       (project/merge-profiles (with-profile project name profile) [name])))
 
+(deftest test-pom-scm-auto
+  (with-redefs [pom/parse-github-url (constantly ["techno" "lein"])
+                pom/read-git-head (constantly "the git head")]
+    (let [project (with-profile-merged sample-project
+                  ^:leaky {:scm {:name "auto"
+                                 :dir "." ;; so resolve-git-dir looks for lein project .git dir, not the sample
+                                 :connection "https://example.org/ignored-url"
+                                 :url "https://github.com/this-is/ignored"}})
+        pom (make-pom project)
+        xml (xml/parse-str pom)]
+      (is (= "scm:git:git://github.com/techno/lein.git" (first-in xml [:project :scm :connection])))
+      (is (= "scm:git:ssh://git@github.com/techno/lein.git" (first-in xml [:project :scm :developerConnection])))
+      (is (= "https://github.com/techno/lein" (first-in xml [:project :scm :url])))
+      (is (= "the git head" (first-in xml [:project :scm :tag]))))))
+
 (deftest test-pom-default-values
   (let [xml (xml/parse-str (make-pom sample-project))]
     (is (= "nomnomnom" (first-in xml [:project :groupId]))