1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-26 07:03:16 +00:00

Update jpm.

Silence git warnings on git pull, and fix issue with double
dependencies in rules.
This commit is contained in:
Calvin Rose 2020-06-15 10:43:18 -05:00
parent 79f5751375
commit e2d8750625

68
jpm
View File

@ -76,11 +76,13 @@
(defn rm (defn rm
"Remove a directory and all sub directories." "Remove a directory and all sub directories."
[path] [path]
(if (= (os/lstat path :mode) :directory) (case (os/lstat path :mode)
(do :directory (do
(each subpath (os/dir path) (each subpath (os/dir path)
(rm (string path sep subpath))) (rm (string path sep subpath)))
(os/rmdir path)) (os/rmdir path))
nil nil # do nothing if file does not exist
# Default, try to remove
(os/rm path))) (os/rm path)))
(defn- rimraf (defn- rimraf
@ -88,7 +90,8 @@
[path] [path]
(if is-win (if is-win
# windows get rid of read-only files # windows get rid of read-only files
(os/shell (string `rmdir /S /Q "` path `"`)) (when (os/stat path :mode)
(os/shell (string `rmdir /S /Q "` path `"`)))
(rm path))) (rm path)))
(defn clear-cache (defn clear-cache
@ -185,9 +188,27 @@
(unless item (error (string "No rule for target " target))) (unless item (error (string "No rule for target " target)))
item) item)
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(unless (find |(= dep $) deps)
(array/push deps dep)))
(defn- add-thunk
[target more &opt phony]
(def item (gettarget target))
(def [_ thunks pthunks] item)
(array/push (if phony pthunks thunks) more)
item)
(defn- rule-impl (defn- rule-impl
[target deps thunk &opt phony] [target deps thunk &opt phony]
(put (getrules) target @[(array/slice deps) @[thunk] phony])) (def rules (getrules))
(unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
(each d deps (add-dep target d))
(add-thunk target thunk phony))
(defmacro rule (defmacro rule
"Add a rule to the rule graph." "Add a rule to the rule graph."
@ -211,20 +232,6 @@
[target deps & body] [target deps & body]
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true)) ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(array/push deps dep))
(defn- add-thunk
[target more]
(def item (gettarget target))
(def [_ thunks] item)
(array/push thunks more)
item)
(defmacro add-body (defmacro add-body
"Add recipe code to an existing rule. This makes existing rules do more but "Add recipe code to an existing rule. This makes existing rules do more but
does not modify the dependency graph." does not modify the dependency graph."
@ -254,9 +261,11 @@
(error (string "No rule for file " target " found.")))) (error (string "No rule for file " target " found."))))
(def [deps thunks phony] item) (def [deps thunks phony] item)
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x)) (def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
(when (or phony (needs-build-some target realdeps)) (each thunk phony (thunk))
(each thunk thunks (thunk))) (unless (empty? thunks)
(unless phony target)) (when (needs-build-some target realdeps)
(each thunk thunks (thunk))
target)))
# #
# Importing a file # Importing a file
@ -743,7 +752,7 @@ int main(int argc, const char **argv) {
:binpath (abspath (dyn :binpath JANET_BINPATH))] :binpath (abspath (dyn :binpath JANET_BINPATH))]
(os/cd module-dir) (os/cd module-dir)
(unless fresh (unless fresh
(os/execute [(git-path) "pull" "origin" "master"] :p)) (os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
(when tag (when tag
(os/execute [(git-path) "reset" "--hard" tag] :p)) (os/execute [(git-path) "reset" "--hard" tag] :p))
(unless (dyn :offline) (unless (dyn :offline)
@ -762,9 +771,9 @@ int main(int argc, const char **argv) {
(def name (last parts)) (def name (last parts))
(def path (string destdir sep name)) (def path (string destdir sep name))
(array/push (dyn :installed-files) path) (array/push (dyn :installed-files) path)
(add-body "install" (phony "install" []
(mkdir destdir) (mkdir destdir)
(copy src destdir))) (copy src destdir)))
(defn- make-lockfile (defn- make-lockfile
[&opt filename] [&opt filename]
@ -928,7 +937,7 @@ int main(int argc, const char **argv) {
(def name (last parts)) (def name (last parts))
(def path (string binpath sep name)) (def path (string binpath sep name))
(array/push (dyn :installed-files) path) (array/push (dyn :installed-files) path)
(add-body "install" (phony "install" []
(def contents (def contents
(with [f (file/open main)] (with [f (file/open main)]
(def first-line (:read f :line)) (def first-line (:read f :line))
@ -946,7 +955,7 @@ int main(int argc, const char **argv) {
(def bat (string "@echo off\r\njanet \"" fullname "\" %*")) (def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
(def newname (string binpath sep name ".bat")) (def newname (string binpath sep name ".bat"))
(array/push (dyn :installed-files) newname) (array/push (dyn :installed-files) newname)
(add-body "install" (phony "install" []
(spit newname bat)))) (spit newname bat))))
(defn- print-rule-tree (defn- print-rule-tree
@ -993,7 +1002,8 @@ int main(int argc, const char **argv) {
(phony "build" []) (phony "build" [])
(phony "manifest" [] (phony "manifest" [manifest])
(rule manifest []
(print "generating " manifest "...") (print "generating " manifest "...")
(mkdir manifests) (mkdir manifests)
(def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD"))) (def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
@ -1005,7 +1015,7 @@ int main(int argc, const char **argv) {
:paths installed-files}) :paths installed-files})
(spit manifest (string/format "%j\n" man))) (spit manifest (string/format "%j\n" man)))
(phony "install" ["uninstall" "build" "manifest"] (phony "install" ["uninstall" "build" manifest]
(when (dyn :test) (when (dyn :test)
(do-rule "test")) (do-rule "test"))
(print "Installed as '" (meta :name) "'.")) (print "Installed as '" (meta :name) "'."))