/
core.clj
160 lines (140 loc) · 5.85 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
(ns leiningen.core
(:use [clojure.contrib.find-namespaces :only [find-namespaces-on-classpath]]
[clojure.string :only [split]]
[clojure.walk :only [walk]])
(:import [java.io File])
(:gen-class))
(def project nil)
(defn- unquote-project [args]
(walk (fn [item]
(cond (and (seq? item) (= `unquote (first item))) (second item)
(symbol? item) (list 'quote item)
:else (unquote-project item)))
identity
args))
(defmacro defproject [project-name version & args]
;; This is necessary since we must allow defproject to be eval'd in
;; any namespace due to load-file; we can't just create a var with
;; def or we would not have access to it once load-file returned.
`(do
(let [m# (apply hash-map ~(cons 'list (unquote-project args)))
root# ~(.getParent (File. *file*))]
(alter-var-root #'project
(fn [_#] (assoc m#
:name ~(name project-name)
:group ~(or (namespace project-name)
(name project-name))
:version ~version
:compile-path (or (:compile-path m#)
(str root# "/classes"))
:source-path (or (:source-path m#)
(str root# "/src"))
:library-path (or (:library-path m#)
(str root# "/lib"))
:test-path (or (:test-path m#)
(str root# "/test"))
:resources-path (or (:resources-path m#)
(str root# "/resources"))
:test-resources-path
(or (:test-resources-path m#)
(str root# "/test-resources"))
:jar-dir (or (:jar-dir m#) root#)
:root root#))))
(def ~(symbol (name project-name)) project)))
(defn abort [msg]
(println msg)
(System/exit 1))
(defn read-project
([file]
(try
(load-file file)
project
(catch java.io.FileNotFoundException _
(abort "No project.clj found in this directory."))))
([] (read-project "project.clj")))
(def aliases (atom {"--help" "help" "-h" "help" "-?" "help" "-v" "version"
"--version" "version" "überjar" "uberjar"
"int" "interactive"}))
(defn task-not-found [& _]
(abort "That's not a task. Use \"lein help\" to list all tasks."))
(defn resolve-task
([task not-found]
(let [task-ns (symbol (str "leiningen." task))
task (symbol task)]
(try
(when-not (find-ns task-ns)
(require task-ns))
(or (ns-resolve task-ns task)
not-found)
(catch java.io.FileNotFoundException e
not-found))))
([task] (resolve-task task #'task-not-found)))
(defn- hook-namespaces [project]
(sort (or (:hooks project)
(and (:implicit-hooks project)
(filter #(re-find #"^leiningen\.hooks\." (name %))
(find-namespaces-on-classpath))))))
(defn- load-hooks [project]
(try (doseq [n (hook-namespaces project)]
(require n))
(catch Exception e
(when-not (empty? (.list (File. "lib")))
(println "Warning: problem requiring hooks:" (.getMessage e))
(println "...continuing without hooks completely loaded.")))))
(defn ns->path [n]
(str (.. (str n)
(replace \- \_)
(replace \. \/))
".clj"))
(defn path->ns [path]
(.. (.replaceAll path "\\.clj" "")
(replace \_ \-)
(replace \/ \.)))
(defn arglists [task-name not-found]
(:arglists (meta (resolve-task task-name not-found))))
(defn project-needed [task-name not-found]
(some #{'project} (map first (arglists task-name not-found))))
(defn matching-arity [task-name project args not-found]
(let [arg-count (if (project-needed task-name not-found)
(inc (count args))
(count args))]
(some (fn [defined-args]
(if (= '& (last (butlast defined-args)))
(>= arg-count (- (count defined-args) 2))
(= arg-count (count defined-args))))
(arglists task-name not-found))))
(defn apply-task [task-name project args not-found]
(let [task (resolve-task task-name not-found)]
(if (matching-arity task-name project args not-found)
(if (project-needed task-name not-found)
(apply task project args)
(apply task args))
(not-found))))
(def arg-separator ",")
(defn- append-to-group [groups arg]
(update-in groups [(dec (count groups))] conj arg))
(defn make-groups
([args]
(reduce make-groups [[]] args))
;; This could be a separate defn, but I can't think of a good name for it...
([groups arg]
(if (.endsWith arg arg-separator)
(-> groups
(append-to-group (apply str (butlast arg)))
(conj []))
(append-to-group groups arg))))
(defn -main
([& [task-name & args]]
(let [task-name (or (@aliases task-name) task-name "help")
project (if (project-needed task-name task-not-found) (read-project))
compile-path (:compile-path project)]
(when compile-path (.mkdirs (File. compile-path)))
(binding [*compile-path* compile-path]
(when project
(load-hooks project))
(let [value (apply-task task-name project args task-not-found)]
(when (integer? value)
(System/exit value))))))
([]
(doseq [arg-group (make-groups *command-line-args*)]
(apply -main (or arg-group ["help"])))))