Map where filter needed.

This commit is contained in:
Elf M. Sternberg 2015-05-27 20:13:40 -07:00
parent dbd6f8e1e9
commit d63e2f9ad0
1 changed files with 68 additions and 64 deletions

View File

@ -9,7 +9,7 @@
; below.
(def *config-path* (os.path.join (.get os.environ "GIT_DIR" "./.git") "pccs"))
(def *modified* (.compile re "^[MA]\s+(?P<name>.*)$"))
(def *git-modified-pattern* (.compile re "^[MA]\s+(?P<name>.*)$"))
(def *checks*
[
@ -58,7 +58,7 @@
]
)
(defn get-git-value [cmd]
(defn get-git-response [cmd]
(let [[fullcmd (+ ["git"] cmd)]
[process (subprocess.Popen fullcmd
:stdout subprocess.PIPE
@ -72,7 +72,7 @@
:stdout subprocess.PIPE
:stderr subprocess.PIPE)))
(defn get-shell-value [fullcmd]
(defn get-shell-response [fullcmd]
(let [[process (subprocess.Popen fullcmd
:stdout subprocess.PIPE
:stderr subprocess.PIPE
@ -88,34 +88,34 @@
(defn derive-message-bodies [code-pairs]
(lmap (fn [i] (get i 1)) code-pairs))
(defn matches-file [filename match-files]
(any (map (fn [match-file] (-> (.compile re match-file)
(.match filename)))
match-files)))
; Hy is overeager to return an iterators which is consumed during
; later traversal. lmap returns a concrete list instead.
(defn lmap (pred iter) (list (map pred iter)))
(defn encode-shell-messages [prefix messages]
(lmap (fn [line] (.format "{}{}" prefix (.decode line "utf-8")))
(.splitlines messages)))
(defn run-external-checker [filename check]
(let [[cmd (-> (get check "command") (.format
:filename filename
:config_path *config-path*))]
[(, out err returncode) (get-shell-value cmd)]]
(let [[cmd (-> (get check "command")
(.format
:filename filename
:config_path *config-path*))]
[(, out err returncode) (get-shell-response cmd)]]
(if (or (and out (= (.get check "error_condition" "error") "output"))
err
(not (= returncode 0)))
(let [[prefix (if (get check "print_filename")
(.format "\t{}:" filename)
"\t")]
[output (+
(lmap (fn [line] (.format "{}{}" prefix (.decode line "utf-8")))
(.splitlines out))
(if err [err] []))]]
[output (+ (encode-shell-messages prefix out)
(if err (encode-shell-messages prefix err) []))]]
[(or returncode 1) output])
[0 []])))
(defn matches-file [filename match-files]
(any (map (fn [match-file] (-> (.compile re match-file)
(.match filename)))
match-files)))
(defn check-scan-wanted [filename check]
(cond [(and (in "match_files" check)
(not (matches-file filename (get check "match_files")))) false]
@ -123,35 +123,40 @@
(matches-file filename (get check "ignore_files"))) false]
[true true]))
(defn tap [x] (print x) x)
(defn check-files [filenames check]
(let [[filenames-to-check
(lmap (fn [filename] (check-scan-wanted filename check)) filenames)]
[scan-results
(filter (fn [filename] (check-scan-wanted filename check)) filenames)]
[results-of-checks
(lmap (fn [filename]
(run-external-checker filename check)) filenames-to-check)]
[messages (+ [(get check "output")] (derive-message-bodies scan-results))]]
[(derive-max-code scan-results) messages]))
[messages (+ [(get check "output")]
(derive-message-bodies results-of-checks))]]
[(derive-max-code results-of-checks) messages]))
(defn gather-all-filenames []
(let [[build-filenames
(fn [filenames]
(map
(fn [f] (os.path.join (get filenames 0) f)) (get filenames 2)))]]
(list (flatten (list-comp (build-filenames o) [o (.walk os ".")])))))
; I removed the originally recommended "-u" command from stash; it was
; "cleaning up" far too zealously, deleting my node_modules directory
(list
(flatten
(list-comp (build-filenames o) [o (.walk os ".")])))))
(defn gather-staged-filenames [against]
(let [[(, out err returncode)
(get-git-value ["diff-index" "--name-status" against])]
(get-git-response ["diff-index" "--name-status" against])]
[lines (.splitlines out)]
[matcher (fn [line] (.match *modified* (.decode line "utf-8")))]]
(list (filter
(fn [x] (not (= x "")))
(list-comp (.group match "name") [match (map matcher lines)] match)))))
[matcher
(fn [line]
(.match *git-modified-pattern* (.decode line "utf-8")))]]
(list
(filter
(fn [x] (not (= x "")))
(list-comp (.group match "name") [match (map matcher lines)] match)))))
(defn scan-files [scan-all-files against]
(defn run-checks-for [scan-all-files against]
(do
(run-git-command ["stash" "--keep-index"])
(let [[filenames-to-scan
@ -170,10 +175,9 @@
(defn get-head-tag []
(let [[empty-repository-hash "4b825dc642cb6eb9a060e54bf8d69288fbee4904"]
[(, out err returncode) (get-git-value ["rev-parse" "--verify HEAD"])]]
[(, out err returncode) (get-git-response ["rev-parse" "--verify HEAD"])]]
(if err empty-repository-hash "HEAD")))
(defmain [&rest args]
(let [[scan-all-files (and (> (len args) 1) (= (get args 2) "--all-files"))]]
(sys.exit (scan-files scan-all-files (get-head-tag)))))
(sys.exit (run-checks-for scan-all-files (get-head-tag)))))