Pull in code from xfthhxk (#1)

* filter on :mvn manifest when getting dep jars to fix luchiniatwork#9

* uberjar-exclusions to fix luchiniatwork#11

* use merged deps config by default, optionally specify --no-merge-config

* copy resource (non-source) files from gitlib/local deps for uberjar

* get deps and jar paths in one go

* write project pom.properties as lein does

src/cambada/cli.clj

@@ -46,6 +46,9 @@
   [["-d" "--deps FILE_PATH" "Location of deps.edn file"
     :default "deps.edn"]
 
+   [nil "--[no-]merge-config" "Merges various deps.edn files according to tools.deps by default"
+    :default true]
+
    ["-o" "--out PATH" "Output directory"
     :default "target"]
 
@@ -55,27 +58,26 @@
   [args cli-options]
   (cli/parse-opts args cli-options))
 
-(defn ^:private conj-default-paths [{:keys [paths] :as m}]
-  (assoc m :paths
-         (-> paths
-             set
-             (conj "src")
-             vec)))
-
-(defn ^:private assoc-default-deps [{:keys [deps] :or {deps {}} :as m}]
-  (cond-> m
-    (nil? (get deps 'org.clojure/clojure))
-    (assoc :deps (assoc deps 'org.clojure/clojure {:mvn/version "1.9.0"}))))
+(defn ^:private config-files
+  "Read clojure env to get config files and append deps if not already present.
+   Returns a vector of strings which represent the config files"
+  [deps]
+  (let [{:keys [config-files]} (deps.reader/clojure-env)]
+    (cond-> config-files
+      (not= deps (last config-files)) (conj deps))))
+
+(defn ^:private cli-options->deps-map
+  [{:keys [deps merge-config] :as opts}]
+  (let [all-files (config-files deps)]
+    (if merge-config
+      (deps.reader/read-deps all-files)
+      (-> deps io/file deps.reader/slurp-deps))))
 
 (defn ^:private parsed-opts->task
   [{{:keys [deps main aot] :as options} :options
     :keys [summary errors]}]
   (try
-    (let [deps-map (-> deps
-                       io/file
-                       deps.reader/slurp-deps
-                       conj-default-paths
-                       assoc-default-deps)
+    (let [deps-map (cli-options->deps-map options)
           opts (cond-> options
                  ;; if main is not nil, it needs to be added to aot
                  ;; unless user chose all or main has been added

src/cambada/fs.clj

@@ -0,0 +1,110 @@
+(ns cambada.fs
+  (:import [java.io File RandomAccessFile]
+           [java.nio.file.attribute BasicFileAttributes FileAttribute]
+           [java.nio ByteBuffer]
+           [java.nio.charset StandardCharsets]
+           [java.nio.channels FileChannel]
+           [java.nio.file FileSystem FileSystems FileVisitOption Files Path Paths
+            CopyOption LinkOption StandardCopyOption OpenOption StandardOpenOption]
+           [java.util.function BiPredicate]))
+
+
+
+
+(def kw->open-option
+  {:append StandardOpenOption/APPEND
+   :create StandardOpenOption/CREATE
+   :create-new StandardOpenOption/CREATE_NEW
+   :delete-on-close StandardOpenOption/DELETE_ON_CLOSE
+   :dsync StandardOpenOption/DSYNC
+   :read StandardOpenOption/READ
+   :sparse StandardOpenOption/SPARSE
+   :sync StandardOpenOption/SYNC
+   :truncate-existing StandardOpenOption/TRUNCATE_EXISTING
+   :write StandardOpenOption/WRITE})
+
+
+
+(defn normalize-open-options
+  "returns a set of StandardOpenOption from an input of
+   opts which contains keywords"
+  [opts]
+  (set (map kw->open-option opts)))
+
+(defn ^FileSystem default-fs
+  []
+  (FileSystems/getDefault))
+
+(defprotocol IPath
+  (path [this]))
+
+(extend-protocol IPath
+  String
+  (path [this]
+    (path (-> (default-fs) (.getPath this (make-array String 0)))))
+
+  File
+  (path [this]
+    (path (.getPath this)))
+
+  Path
+  (path [this] this))
+
+
+(defn directory?
+  "path is an instance of java.nio.file.Path"
+  [path & link-opts]
+  (Files/isDirectory path (into-array LinkOption link-opts)))
+
+(defn exists?
+  [path-like & link-opts]
+  (Files/exists (path path-like) (into-array LinkOption link-opts)))
+
+
+(def overwrite   "Overwrite file option"   ::overwrite)
+(def atomic-move "Atomic Move file option" ::atomic-move)
+(def copy-attrs  "Copy file attrs"         ::copy-attrs)
+
+(defn ^:private bi-predicate
+  [f]
+  (reify BiPredicate
+    (test [this t u] (f t u))))
+
+(defn relative-path
+  "Given parent path of `/usr/local/lib` and child of
+  `/usr/local/lib/clojure/deps.edn`returns a path that
+  is `clojure/deps.edn`"
+  ^Path [^Path parent ^Path child]
+  (.relativize parent child))
+
+(defn find-files
+  "root-path is something that can be converted to a path. Can be a String.
+   Returns nil or a seq of paths. nil is returned if the root-path doesn't
+   represent a valid path"
+  [root-path bi-pred]
+  (let [root-path (path root-path)]
+    (when (exists? root-path)
+      (->> (Files/find
+            root-path
+            Integer/MAX_VALUE
+            (bi-predicate bi-pred)
+            (into-array FileVisitOption []))
+           .iterator
+           iterator-seq))))
+
+(defn find-non-source-files
+  [root-path]
+  (let [pattern (re-pattern #".+(clj|cljs|cljc)$")]
+    (find-files
+     root-path
+     (fn [^Path path ^BasicFileAttributes file-attrs]
+       (and (.isRegularFile file-attrs)
+            (->> path .getFileName str (re-find pattern) nil?))))))
+
+
+(defn input-stream
+  "open-opts are keywords"
+  [file-path & open-opts]
+  (Files/newInputStream
+   (path file-path)
+   (into-array (normalize-open-options open-opts))))

src/cambada/jar.clj

@@ -92,6 +92,19 @@
        ByteArrayInputStream.
        Manifest.))
 
+
+(defn make-project-properties
+  [{:keys [app-group-id app-artifact-id app-version] :as task}]
+  (with-open [baos (java.io.ByteArrayOutputStream.)]
+    (let [properties (doto (java.util.Properties.)
+                       (.setProperty "version" app-version)
+                       (.setProperty "groupId" app-group-id)
+                       (.setProperty "artifactId" app-artifact-id))]
+      (when-let [revision (utils/read-git-head)]
+        (.setProperty properties "revision" revision))
+      (.store properties baos "Cambada"))
+    (str baos)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Jar proper functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -194,6 +207,12 @@
     (first (filter #(instance? Element %) (first roots)))))
 
 
+(defn- write-pom-properties [{:keys [app-group-id app-artifact-id] :as task} jar-os jar-paths]
+  (let [path (format "META-INF/maven/%s/%s/pom.properties" app-group-id app-artifact-id)
+        props (make-project-properties task)]
+    (copy-to-jar task jar-os jar-paths {:type :bytes :bytes props :path path})))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Main functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -207,6 +226,7 @@
     (let [jar-paths (reduce (partial copy-to-jar task jar-os)
                             #{}
                             filespecs)]
+      (write-pom-properties task jar-os jar-paths)
       (if main
         (let [main-path (str (-> (string/replace main "." "/")
                                  (string/replace "-" "_"))
@@ -221,8 +241,8 @@
 
 (defn ^:private sync-pom
   [{:keys [deps-map] :as task}]
-  (cli/info "Updating pom.xml") 
-  (gen.pom/sync-pom deps-map (io/file ".")) 
+  (cli/info "Updating pom.xml")
+  (gen.pom/sync-pom deps-map (io/file "."))
   (let [pom-file (io/file "." "pom.xml")
         pom (with-open [rdr (io/reader pom-file)]
               (-> rdr

src/cambada/uberjar.clj

@@ -4,11 +4,13 @@
             [cambada.jar :as jar]
             [cambada.jar-utils :as jar-utils]
             [cambada.utils :as utils]
+            [cambada.fs :as fs]
             [clojure.java.io :as io]
             [clojure.string :as string]
+            [clojure.pprint :as pprint]
             [clojure.tools.deps.alpha :as tools.deps])
   (:import [java.io BufferedOutputStream FileOutputStream ByteArrayInputStream]
-           [java.nio.file Files Paths]
+           [java.nio.file Files Paths Path]
            [java.util.jar Manifest JarEntry JarOutputStream]
            [java.util.regex Pattern]
            [java.util.zip ZipFile ZipOutputStream ZipEntry]
@@ -27,7 +29,7 @@
      Pattern (re-find pattern filename))))
 
 (def ^:private default-merger
-  [(fn [in out file prev]
+  [(fn [^ZipFile in ^ZipOutputStream out ^ZipEntry file prev]
      (when-not prev
        (.setCompressedSize file -1)
        (.putNextEntry out file)
@@ -68,7 +70,7 @@
   (into (map-vals {}
                   (comp make-merger eval))
         (map #(vector % skip-merger)
-             [])))
+             (:uberjar-exclusions project))))
 
 (defn ^:private select-merger [mergers filename]
   (or (->> mergers (filter #(merger-match? % filename)) first second)
@@ -90,7 +92,8 @@
   new `merged-map` merged entry map."
   [in out mergers merged-map]
   (reduce (fn [merged-map file]
-            (let [filename (.getName file), prev (get merged-map filename)]
+            (let [filename (.getName file)
+                  prev (get merged-map filename)]
               (if (identical? ::skip prev)
                 (do (warn-on-drop filename)
                     merged-map)
@@ -104,12 +107,6 @@
   (with-open [zipfile (ZipFile. dep)]
     (copy-entries zipfile out mergers merged-map)))
 
-(defn ^:private get-dep-jars
-  [{:keys [deps-map]}]
-  (->> (tools.deps/resolve-deps deps-map nil)
-       (map (fn [[_ {:keys [paths]}]] paths))
-       (mapcat identity)))
-
 (defn ^:private write-components
   "Given a list of jarfiles, writes contents to a stream"
   [task jars out]
@@ -121,6 +118,58 @@
             :let [[_ write] (select-merger mergers filename)]]
       (write out filename result))))
 
+(defn ^:private get-deps-by-manifest
+  "Returns a map of manifest values ie `:mvn` and `:deps` as keys
+   and a seq of path strings. For `:mvn` the values represent jar files.
+   For `:deps` the values represent directory locations on the file system."
+  [{:keys [deps-map]}]
+  (->> (tools.deps/resolve-deps deps-map nil)
+       vals
+       (utils/group-by+ :deps/manifest :paths (partial reduce into []))))
+
+(defn ^:private non-source-paths
+  "Returns a seq of maps with `:fs-path` and `:jar-path` keys."
+  [root]
+  (let [root (fs/path root)]
+    (map (fn [path]
+           {:fs-path path
+            :jar-path (fs/relative-path root path)})
+         (fs/find-non-source-files root))))
+
+
+(defn write-fs-file-to-zip
+  [^ZipOutputStream out ^Path fs-path ^Path jar-path]
+  (let [entry (ZipEntry. (str jar-path))]
+    (.setCompressedSize entry -1)
+    (.putNextEntry out entry)
+    (io/copy (fs/input-stream fs-path :read) out)
+    (.closeEntry out)))
+
+(defn ^:private copy-non-source-files
+  [copied root out]
+  (reduce (fn [copied {:keys [fs-path jar-path]}]
+            (if (copied jar-path)
+              (do
+                (cli/warn "Skipping " fs-path " which would yield duplicate " jar-path)
+                copied)
+              (do
+                (write-fs-file-to-zip out fs-path jar-path)
+                (conj copied jar-path))))
+          copied
+          (non-source-paths root)))
+
+(defn ^:private write-deps-resources
+  "gitlibs and local non-source code (ie files that are not .clj, cljs, or .cljc)
+   are copied to the output jar. Normally, lein would have copied things from resource-paths
+   to the jar and write-components would take care of it. However, here we don't have a jar
+   so have to use the deps :paths key and filter on non source code to include in out."
+  [{:keys [deps-map] :as task} deps-paths out]
+  (reduce (fn [copied path]
+            (cli/info "Including non-source files from deps root " path)
+            (copy-non-source-files copied path out))
+          #{}
+          deps-paths))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Main functions
@@ -129,16 +178,19 @@
 (defn apply! [{:keys [deps deps-map out] :as task}]
   (jar/apply! task)
   (let [filename (jar-utils/get-jar-filename task {:kind :uberjar})
-        jars (conj (get-dep-jars task)
-                   (jar-utils/get-jar-filename task {:kind :jar}))]
+        {mvn-paths :mvn deps-paths :deps} (get-deps-by-manifest task)
+        jars (cons (jar-utils/get-jar-filename task {:kind :jar}) mvn-paths)]
     (cli/info "Creating" filename)
     (with-open [out (-> filename
                         (FileOutputStream.)
                         (ZipOutputStream.))]
-      (write-components task jars out))))
+      (write-components task jars out)
+      (write-deps-resources task deps-paths out))))
 
 (defn -main [& args]
-  (let [{:keys [help] :as task} (cli/args->task args cli-options)]
+  (let [{:keys [help] :as task} (-> (cli/args->task args cli-options)
+                                    (assoc :uberjar-exclusions [#"(?i)^META-INF/[^/]*\.(SF|RSA|DSA)$"]))]
+
     (cli/runner
      {:help? help
       :task task

src/cambada/utils.clj

@@ -1,5 +1,6 @@
 (ns cambada.utils
-  (:require [clojure.java.io :as io])
+  (:require [clojure.java.io :as io]
+            [clojure.java.shell :as sh])
   (:import (java.io File)))
 
 ;; # OS detection
@@ -109,3 +110,26 @@
 (defn compiled-classes-path
   [out-path]
   (str out-path "/classes"))
+
+(defn group-by+
+  "Similar to group by, but allows applying val-fn to each item in the grouped by list of each key.
+   Can also apply val-agg-fn to the result of mapping val-fn. All input fns are 1 arity.
+   If val-fn and val-agg-fn were the identity fn then this behaves the same as group-by."
+  ([key-fn val-fn xs]
+   (group-by+ key-fn val-fn identity xs))
+  ([key-fn val-fn val-agg-fn xs]
+   (reduce (fn [m [k v]]
+             (assoc m k (val-agg-fn (map val-fn v))))
+           {}
+           (group-by key-fn xs))))
+
+
+(defn read-git-head
+  "Reads the value of HEAD and returns a commit SHA1, or nil if no commit
+  exist."
+  []
+  (try
+    (let [git-ref (sh/sh "git" "rev-parse" "HEAD")]
+      (when (= (:exit git-ref) 0)
+        (.trim (:out git-ref))))
+    (catch java.io.IOException e)))