Skip to content

Commit

Permalink
General cleanup.
Browse files Browse the repository at this point in the history
Sneaking in just under 1000 LOC modulo lein-newnew.
  • Loading branch information
technomancy committed Jan 13, 2012
1 parent ec89737 commit b1046bc
Show file tree
Hide file tree
Showing 16 changed files with 126 additions and 295 deletions.
2 changes: 2 additions & 0 deletions doc/PLUGINS.md
Expand Up @@ -54,6 +54,8 @@ user. Be sure to explain all these arguments in the docstring. Note
that all your arguments will be strings, so it's up to you to call that all your arguments will be strings, so it's up to you to call
`read-string` on them if you want keywords, numbers, or symbols. `read-string` on them if you want keywords, numbers, or symbols.


TODO: document subtasks and subtask help

If your task returns an integer, it will be used as the exit code for If your task returns an integer, it will be used as the exit code for
the process. If tasks are chained together, a nonzero integer return the process. If tasks are chained together, a nonzero integer return
value will halt the chain and exit immediately. Throwing an exception value will halt the chain and exit immediately. Throwing an exception
Expand Down
10 changes: 3 additions & 7 deletions doc/TUTORIAL.md
Expand Up @@ -72,10 +72,6 @@ to setting `:dependencies`. Note that Clojure is just another
dependency here. Unlike most languages, it's easy to swap out any dependency here. Unlike most languages, it's easy to swap out any
version of Clojure. version of Clojure.


If you've got a simple pure-clojure project, you may be fine with the
default of depending only on Clojure, but otherwise you'll need to
list other dependencies.

## Dependencies ## Dependencies


By default, Leiningen projects download dependencies from By default, Leiningen projects download dependencies from
Expand Down Expand Up @@ -135,9 +131,9 @@ in project.clj. See the


## Profiles ## Profiles


Sometimes you want to pull in dependencies that are really only for Sometimes you want to pull in dependencies that are really only
your convenience while developing; they aren't strictly required for necessary while developing; they aren't required for the project to
the project to function. You can do this by adding a `:dependencies` function in production. You can do this by adding a `:dependencies`
entry to the `:dev` profile. These will be available by default unless entry to the `:dev` profile. These will be available by default unless
you specify another profile from the defaults, but they are not you specify another profile from the defaults, but they are not
brought along when another project depends on your project. brought along when another project depends on your project.
Expand Down
8 changes: 1 addition & 7 deletions src/leiningen/classpath.clj
Expand Up @@ -7,12 +7,6 @@
(str/join java.io.File/pathSeparatorChar (classpath/get-classpath project))) (str/join java.io.File/pathSeparatorChar (classpath/get-classpath project)))


(defn classpath (defn classpath
"Print the classpath of the current project. "Print the classpath of the current project. Suitable for java's -cp option."
Suitable for java's -classpath option.
Warning: due to a bug in ant, calling this task with :local-repo-classpath set
when the dependencies have not been fetched will result in spurious output before
the classpath. In such cases, pipe to tail -n 1."
[project] [project]
(println (get-classpath-string project))) (println (get-classpath-string project)))
2 changes: 1 addition & 1 deletion src/leiningen/clean.clj
Expand Up @@ -8,7 +8,7 @@ Raise an exception if any deletion fails unless silently is true."
[f & [silently]] [f & [silently]]
(System/gc) ; This sometimes helps release files for deletion on windows. (System/gc) ; This sometimes helps release files for deletion on windows.
(let [f (file f)] (let [f (file f)]
(if (.isDirectory f) (when (.isDirectory f)
(doseq [child (.listFiles f)] (doseq [child (.listFiles f)]
(delete-file-recursively child silently))) (delete-file-recursively child silently)))
(delete-file f silently))) (delete-file f silently)))
Expand Down
128 changes: 59 additions & 69 deletions src/leiningen/compile.clj
Expand Up @@ -8,12 +8,6 @@
(:refer-clojure :exclude [compile]) (:refer-clojure :exclude [compile])
(:import (java.io PushbackReader))) (:import (java.io PushbackReader)))


(declare compile)

(def ^:dynamic *silently* false)

(def ^:dynamic *skip-auto-compile* false)

(defn- regex? [str-or-re] (defn- regex? [str-or-re]
(instance? java.util.regex.Pattern str-or-re)) (instance? java.util.regex.Pattern str-or-re))


Expand Down Expand Up @@ -57,57 +51,56 @@


;; .class file cleanup ;; .class file cleanup


(defn- has-source-package? ;; (defn- has-source-package?
"Test if the class file's package exists as a directory in source-path." ;; "Test if the class file's package exists as a directory in source-path."
[project f source-path] ;; [project f source-path]
(and source-path ;; (and source-path
(let [[[parent] [_ _ proxy-mod-parent]] ;; (let [[[parent] [_ _ proxy-mod-parent]]
(->> f, (iterate #(.getParentFile %)), ;; (->> f, (iterate #(.getParentFile %)),
(take-while identity), rest, ;; (take-while identity), rest,
(split-with #(not (re-find #"^proxy\$" (.getName %)))))] ;; (split-with #(not (re-find #"^proxy\$" (.getName %)))))]
(.isDirectory (io/file (.replace (.getPath (or proxy-mod-parent parent)) ;; (.isDirectory (io/file (.replace (.getPath (or proxy-mod-parent parent))
(:compile-path project) ;; (:compile-path project)
source-path)))))) ;; source-path))))))


(defn- class-in-project? [project f] ;; (defn- class-in-project? [project f]
(or (has-source-package? project f (:source-path project)) ;; (or (has-source-package? project f (:source-path project))
(has-source-package? project f (:java-source-path project)) ;; (has-source-package? project f (:java-source-path project))
(.exists (io/file (str (.replace (.getParent f) ;; (.exists (io/file (str (.replace (.getParent f)
(:compile-path project) ;; (:compile-path project)
(:source-path project)) ".clj"))))) ;; (:source-path project)) ".clj")))))


(defn- relative-path [project f] ;; (defn- relative-path [project f]
(let [root-length (if (= \/ (last (:compile-path project))) ;; (let [root-length (if (= \/ (last (:compile-path project)))
(count (:compile-path project)) ;; (count (:compile-path project))
(inc (count (:compile-path project))))] ;; (inc (count (:compile-path project))))]
(subs (.getAbsolutePath f) root-length))) ;; (subs (.getAbsolutePath f) root-length)))


(defn- blacklisted-class? [project f] ;; (defn- blacklisted-class? [project f]
;; true indicates all non-project classes are blacklisted ;; ;; true indicates all non-project classes are blacklisted
(or (true? (:clean-non-project-classes project)) ;; (or (true? (:clean-non-project-classes project))
(some #(re-find % (relative-path project f)) ;; (some #(re-find % (relative-path project f))
(:clean-non-project-classes project)))) ;; (:clean-non-project-classes project))))


(defn- whitelisted-class? [project f] ;; (defn- whitelisted-class? [project f]
(or (class-in-project? project f) ;; (or (class-in-project? project f)
(and (:class-file-whitelist project) ;; (and (:class-file-whitelist project)
(re-find (:class-file-whitelist project) ;; (re-find (:class-file-whitelist project)
(relative-path project f))))) ;; (relative-path project f)))))


(defn clean-non-project-classes [project] ;; (defn clean-non-project-classes [project]
#_(when (:clean-non-project-classes project) ;; (when (:clean-non-project-classes project)
(doseq [f (file-seq (io/file (:compile-path project))) ;; (doseq [f (file-seq (io/file (:compile-path project)))
:when (and (.isFile f) ;; :when (and (.isFile f)
(not (whitelisted-class? project f)) ;; (not (whitelisted-class? project f))
(blacklisted-class? project f))] ;; (blacklisted-class? project f))]
(.delete f)))) ;; (.delete f))))


;; actual task ;; actual task


(defn- status [code msg] (defn- status [code msg]
(when-not *silently* ; TODO: should silently only affect success? (binding [*out* (if (zero? code) *out* *err*)]
(binding [*out* (if (zero? code) *out* *err*)] (println msg))
(println msg)))
code) code)


(def ^:private success (partial status 0)) (def ^:private success (partial status 0))
Expand All @@ -123,22 +116,19 @@ as command-line arguments."
;; (javac/javac project)) ;; (javac/javac project))
(if (seq (compilable-namespaces project)) (if (seq (compilable-namespaces project))
(if-let [namespaces (seq (stale-namespaces project))] (if-let [namespaces (seq (stale-namespaces project))]
(binding [*skip-auto-compile* true] (try
(try (let [form `(doseq [namespace# '~namespaces]
(let [form `(doseq [namespace# '~namespaces] (println "Compiling" namespace#)
(when-not ~*silently* (clojure.core/compile namespace#))]
(println "Compiling" namespace#)) ;; TODO: should eval-in-project be allowed to return
(clojure.core/compile namespace#))] ;; non-integers?
;; TODO: should eval-in-project be allowed to return (if (zero? (eval/eval-in-project project form))
;; non-integers? (success "Compilation succeeded.")
(if (zero? (eval/eval-in-project project form)) (failure "Compilation failed.")))
(success "Compilation succeeded.") #_(finally (clean-non-project-classes project)))
(failure "Compilation failed.")))
(finally (clean-non-project-classes project))))
(success "All namespaces already :aot compiled.")) (success "All namespaces already :aot compiled."))
(success "No namespaces to :aot compile listed in project.clj."))) (success "No namespaces to :aot compile listed in project.clj.")))
([project & namespaces] ([project & namespaces]
(compile (assoc project (compile (assoc project :aot (if (= namespaces [":all"])
:aot (if (= namespaces [":all"]) :all
:all (map symbol namespaces))))))
(map symbol namespaces))))))
13 changes: 0 additions & 13 deletions src/leiningen/deploy.clj
Expand Up @@ -6,19 +6,6 @@
[leiningen.pom :only [pom snapshot?]] [leiningen.pom :only [pom snapshot?]]
[clojure.java.io :only [file]])) [clojure.java.io :only [file]]))


(declare make-model make-artifact)

(defn- make-maven-project [project]
)

(defn- get-repository [project repository-name]
(let [deploy-repositories (repositories-for project :kind :deploy-repositories)
repositories (repositories-for project)
repository (or (deploy-repositories repository-name)
(repositories repository-name)
{:url repository-name})]
#_(make-repository [repository-name repository])))

(defn deploy (defn deploy
"Build jar and deploy to remote repository. "Build jar and deploy to remote repository.
Expand Down
60 changes: 3 additions & 57 deletions src/leiningen/deps.clj
@@ -1,62 +1,8 @@
(ns leiningen.deps (ns leiningen.deps
"Download all dependencies." "Download all dependencies."
(:require [clojure.java.io :as io] (:require [leiningen.core.classpath :as classpath]))
[leiningen.clean :as clean]
[leiningen.core.classpath :as classpath]
[leiningen.core.user :as user])
(:import (java.security MessageDigest)
(java.util.jar JarFile)))

(defn- sha1-digest [content]
(.toString (BigInteger. 1 (-> (MessageDigest/getInstance "SHA1")
(.digest (.getBytes content)))) 16))

(defn- deps-checksum [project]
(sha1-digest (pr-str (:dependencies project))))

(defn- new-deps-checksum-file [project]
(io/file (:target-path project) ".lein-deps-sum"))

(defn- has-dependencies? [project]
(some (comp seq project) [:dependencies :dev-dependencies]))

;; TODO: is this necessary with keeping everything in ~/.m2?
(defn fetch-deps?
"Should we even bother fetching dependencies?"
[project]
(let [deps-checksum-file (new-deps-checksum-file project)]
(and (has-dependencies? project)
;; There's got to be a better way to detect direct invocation?
(or ;; (= "deps" *current-task*)
(not (:checksum-deps project (:checksum-deps (user/settings) true)))
(not (.exists deps-checksum-file))
(not= (slurp deps-checksum-file) (deps-checksum project))))))

(defn- jar-files [files]
(for [file files
:when (.endsWith (.getName file) ".jar")]
(JarFile. file)))

(defn extract-native-deps [project files]
(doseq [jar (jar-files files)
entry (enumeration-seq (.entries jar))
:when (.startsWith (.getName entry) "native/")]
(let [f (io/file (:native-path project)
(subs (.getName entry) (count "native/")))]
(if (.isDirectory entry)
(.mkdirs f)
(io/copy (.getInputStream jar entry) f)))))


(defn deps (defn deps
"Download :dependencies and put them in :library-path." "Download all dependencies. You should never need to invoke this manually."
[project] [project]
(when (fetch-deps? project) (classpath/resolve-dependencies project))
(when-not (or (:disable-deps-clean project)
(:disable-implicit-clean project))
(clean/clean project))
(let [files (classpath/resolve-dependencies project)]
(extract-native-deps project files)
(let [checksum-file (new-deps-checksum-file project)]
(.mkdirs (.getParentFile checksum-file))
(spit checksum-file (deps-checksum project)))
files)))
4 changes: 2 additions & 2 deletions src/leiningen/help.clj
Expand Up @@ -84,12 +84,12 @@
(defn help (defn help
"Display a list of tasks or help for a given task. "Display a list of tasks or help for a given task.
Also provides readme, tutorial, news, sample, deploying and copying documentation." Also provides readme, tutorial, news, sample, deploying and copying info."
([_ task] (println (or (static-help task) (help-for task)))) ([_ task] (println (or (static-help task) (help-for task))))
([_ ] ([_ ]
(println "Leiningen is a tool for working with Clojure projects.\n") (println "Leiningen is a tool for working with Clojure projects.\n")
(println "Several tasks are available:") (println "Several tasks are available:")
(doseq [task-ns tasks] (doseq [task-ns tasks]
(println (help-summary-for task-ns))) (println (help-summary-for task-ns)))
(println "\nRun lein help $TASK for details.") (println "\nRun lein help $TASK for details.")
(println "See also: readme, tutorial, copying, sample, deploying and news."))) (println "See also: readme, tutorial, news, sample, deploying and copying.")))
65 changes: 33 additions & 32 deletions src/leiningen/install.clj
Expand Up @@ -13,28 +13,28 @@
make-artifact add-metadata tmp-dir make-artifact add-metadata tmp-dir
get-os leiningen-home) get-os leiningen-home)


(defn bin-path [] ;; (defn bin-path []
(doto (file (leiningen-home) "bin") .mkdirs)) ;; (doto (file (leiningen-home) "bin") .mkdirs))


(defn install-shell-wrappers [jarfile] ;; (defn install-shell-wrappers [jarfile]
(when-let [bin-name ((manifest-map (.getManifest jarfile)) ;; (when-let [bin-name ((manifest-map (.getManifest jarfile))
"Leiningen-shell-wrapper")] ;; "Leiningen-shell-wrapper")]
(let [entry-paths (if (= :windows (get-os)) ;; (let [entry-paths (if (= :windows (get-os))
[bin-name (format "%s.bat" bin-name)] ;; [bin-name (format "%s.bat" bin-name)]
[bin-name])] ;; [bin-name])]
(doseq [entry-path entry-paths] ;; (doseq [entry-path entry-paths]
(let [bin-file (file (bin-path) (last (.split entry-path "/")))] ;; (let [bin-file (file (bin-path) (last (.split entry-path "/")))]
(when-let [zip-entry (.getEntry jarfile entry-path)] ;; (when-let [zip-entry (.getEntry jarfile entry-path)]
(.mkdirs (.getParentFile bin-file)) ;; (.mkdirs (.getParentFile bin-file))
(println "Installing shell wrapper to" (.getAbsolutePath bin-file)) ;; (println "Installing shell wrapper to" (.getAbsolutePath bin-file))
(copy (.getInputStream jarfile zip-entry) bin-file) ;; (copy (.getInputStream jarfile zip-entry) bin-file)
(.setExecutable bin-file true))))))) ;; (.setExecutable bin-file true)))))))


(defn standalone-download [name group version] ;; (defn standalone-download [name group version]
#_(.resolveAlways (.lookup container ArtifactResolver/ROLE) ;; (.resolveAlways (.lookup container ArtifactResolver/ROLE)
(make-remote-artifact name group version) ;; (make-remote-artifact name group version)
(map make-remote-repo default-repos) ;; (map make-remote-repo default-repos)
(make-local-repo))) ;; (make-local-repo)))


(defn install (defn install
"Install current project or download specified project. "Install current project or download specified project.
Expand All @@ -56,24 +56,25 @@ shell wrappers in ~/.lein/bin when provided."
(if (number? jarfile) (if (number? jarfile)
;; if we failed to create the jar, return the status code for exit ;; if we failed to create the jar, return the status code for exit
jarfile jarfile
(do (install-shell-wrappers (JarFile. jarfile)) (do ;; (install-shell-wrappers (JarFile. jarfile))
(.install installer (file jarfile) artifact local-repo) (.install installer (file jarfile) artifact local-repo)
0)))) 0))))
([project-name version] ([project-name version]
(let [[name group] ((juxt name namespace) (symbol project-name)) (let [[name group] ((juxt name namespace) (symbol project-name))
_ (standalone-download name (or group name) version) ;; _ (standalone-download name (or group name) version)
temp-project (format "%s/lein-%s" tmp-dir (UUID/randomUUID)) temp-project (format "%s/lein-%s" tmp-dir (UUID/randomUUID))
jarfile (local-repo-path (or group name) name version)] jarfile (local-repo-path (or group name) name version)]
(install-shell-wrappers (JarFile. jarfile)) ;; (install-shell-wrappers (JarFile. jarfile))
;; TODO: reach in and pull out project.clj rather than ;; TODO: reach in and pull out project.clj rather than
;; extracting it all ;; extracting it all
(try ;; (extract-jar (file jarfile) temp-project) ;; (try (extract-jar (file jarfile) temp-project)
(when-let [p (read-project (str temp-project "/project.clj"))] ;; (when-let [p (read-project (str temp-project "/project.clj"))]
(deps (dissoc p :dev-dependencies :native-dependencies))) ;; (deps (dissoc p :dev-dependencies :native-dependencies)))
(finally ;; (finally
#_(delete-file-recursively temp-project :silently)))))) ;; (delete-file-recursively temp-project :silently)))
)))


(defn get-jar-entry [jar-file entry-name] ;; (defn get-jar-entry [jar-file entry-name]
(let [jar (JarFile. jar-file true) ;; (let [jar (JarFile. jar-file true)
entry (.getJarEntry jar entry-name)] ;; entry (.getJarEntry jar entry-name)]
(.getInputStream jar entry))) ;; (.getInputStream jar entry)))

0 comments on commit b1046bc

Please sign in to comment.