elf
/
git-linter
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Got the porcelain -z parser working, and got rid of that damned 'contrib' and 'common' submodules warning.

This commit is contained in:
Elf M. Sternberg 2016-09-21 15:07:09 -07:00
parent b170cff52c
commit caed12257f
4 changed files with 307 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
foo.txt
View File

286
git_lint_src/git-lint.hy Normal file
View File

@ -0,0 +1,286 @@
; -*- mode: clojure -*-
(import os re subprocess sys gettext)
(def *version* "0.0.2")
(def _ gettext.gettext)
; 0: Short opt, 1: long opt, 2: takes argument, 3: help text
(def optlist [["o" "only" true (_ "A comma-separated list of only those linters to run") ["x"]]
["x" "exclude" true (_ "A comma-separated list of linters to skip") []]
["b" "base" false (_ "Check all changed files in the repository, not just those in the current directory.") []]
["a" "all" false (_ "Scan all files in the repository, not just those that have changed.")]
["w" "workspace" false (_ "Scan the workspace") ["s"]]
["s" "staging" false (_ "Scan the staging area (pre-commit).") []]
["g" "changes" false (_ "Report lint failures only for diff'd sections") ["l"]]
["l" "complete" false (_ "Report lint failures for all files") []]
["c" "config" true (_ "Path to config file") []]
["h" "help" false (_ "This help message") []]
["v" "version" false (_"Version information") []]])
; Given a set of command-line arguments, compare that to a mapped
; version of the optlist and return a canonicalized dictionary of all
; the arguments that have been set. For example "-c" and "--config"
; will both be mapped to "config".
; Given a prefix of one or two dashes and a position in the above
; array, creates a function to map either the short or long option
; to the option name.
(defn make-opt-assoc [prefix pos]
(fn [acc it] (assoc acc (+ prefix (get it pos)) (get it 1)) acc))
; Using the above, create a full map of all arguments, then return a
; function ready to look up any argument and return the option name.
(defn make-options-rationalizer [optlist]
(let [
[short-opt-assoc (make-opt-assoc "-" 0)]
[long-opt-assoc (make-opt-assoc "--" 1)]
[fullset
(ap-reduce (-> (short-opt-assoc acc it)
(long-opt-assoc it)) optlist {})]]
(fn [acc it] (do (assoc acc (get fullset (get it 0)) (get it 1)) acc))))
(defn print-version []
(print (.format "git-lint (hy version {})" *version*))
(print "Copyright (c) 2008, 2014 Kenneth M. \"Elf\" Sternberg <elf.sternberg@gmail.com>")
(sys.exit))
(defn print-help []
(print "Usage: git lint [options] [filename]")
(ap-each optlist (print (.format " -{} --{} {}" (get it 0) (get it 1) (get it 3))))
(sys.exit))
; `lint` should be a directory under your .git where you store the RCs
; for your various linters. If you want to use a global one, you'll
; have to edit the configuration entries below.
(def *config-path*
(os.path.join (.get os.environ "GIT_DIR" "./.git") "lint"))
(def *git-modified-pattern* (.compile re "^[MA]\s+(?P<name>.*)$"))
(def *checks*
[
; {
; "output" "Checking for debugger commands in Javascript..."
; "command" "grep -n debugger {filename}"
; "match_files" [".*\.js$"]
; "print_filename" True
; "error_condition" "output"
; }
{
"output" "Running Jshint..."
"command" "jshint -c {config_path}/jshint.rc {filename}"
"match_files" [".*\.js$"]
"print_filename" False
"error_condition" "error"
}
{
"output" "Running Coffeelint..."
"command" "coffeelint {filename}"
"match_files" [".*\.coffee$"]
"print_filename" False
"error_condition" "error"
}
{
"output" "Running JSCS..."
"command" "jscs -c {config_path}/jscs.rc {filename}"
"match_files" [".*\.js$"]
"print_filename" False
"error_condition" "error"
}
{
"output" "Running pep8..."
"command" "pep8 -r --ignore=E501,W293,W391 {filename}"
"match_files" [".*\.py$"]
"print_filename" False
"error_condition" "error"
}
{
"output" "Running xmllint..."
"command" "xmllint {filename}"
"match_files" [".*\.xml"]
"print_filename" False
"error_condition" "error"
}
]
)
(defn get-git-response [cmd]
(let [[fullcmd (+ ["git"] cmd)]
[process (subprocess.Popen fullcmd
:stdout subprocess.PIPE
:stderr subprocess.PIPE)]
[(, out err) (.communicate process)]]
(, out err process.returncode)))
(defn run-git-command [cmd]
(let [[fullcmd (+ ["git"] cmd)]]
(subprocess.call fullcmd
:stdout subprocess.PIPE
:stderr subprocess.PIPE)))
(defn get-shell-response [fullcmd]
(let [[process (subprocess.Popen fullcmd
:stdout subprocess.PIPE
:stderr subprocess.PIPE
:shell True)]
[(, out err) (.communicate process)]]
(, out err process.returncode)))
(defn derive-max-code [code-pairs]
(reduce
(fn [m i] (if (> (abs (get i 0)) (abs m)) (get i 0) m))
code-pairs 0))
(defn derive-message-bodies [code-pairs]
(lmap (fn [i] (get i 1)) code-pairs))
(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-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 (+ (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]
[(and (in "ignore_files" check)
(matches-file filename (get check "ignore_files"))) false]
[true true]))
(defn check-files [filenames check]
(let [[filenames-to-check
(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 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 ".")])))))
(defn gather-staged-filenames [against]
(let [[(, out err returncode)
(get-git-response ["diff-index" "--name-status" against])]
[lines (.splitlines out)]
[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 run-checks-for [scan-all-files against]
(do
(run-git-command ["stash" "--keep-index"])
(let [[filenames-to-scan
(if scan-all-files
(gather-all-filenames)
(gather-staged-filenames against))]
[results-of-scan
(lmap (fn [check] (check-files filenames-to-scan check)) *checks*)]
[exit-code (derive-max-code results-of-scan)]
[messages (flatten (derive-message-bodies results-of-scan))]]
(do
(for [line messages] (print line))
(run-git-command ["reset" "--hard"])
(run-git-command ["stash" "pop" "--quiet" "--index"])
exit-code))))
(defn get-head-tag []
(let [[empty-repository-hash "4b825dc642cb6eb9a060e54bf8d69288fbee4904"]
[(, 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 (int (run-checks-for scan-all-files (get-head-tag))))))
(defmain [&rest args]
(try
(let [[optstringsshort
(string.join (ap-map (+ (. it [0]) (cond [(. it [2]) ":"] [true ""])) optlist) "")]
[optstringslong
(list (ap-map (+ (. it [1]) (cond [(. it [2]) "="] [true ""])) optlist))]
[(, opt arg)
(getopt.getopt (slice args 1) optstringsshort optstringslong)]
[rationalize-options
(make-options-rationalizer optlist)]
[options
(sanify-options (ap-reduce (rationalize-options acc it) opt {}))]]
(cond [(.has_key options "help") (print-help)]
[(.has_key options "version") (print-version)]
[true (suggest options)]))
(catch [err getopt.GetoptError]
(print (str err))
(print-help))))
; staging or workspace
; if workspace:
; modified or all
; CWD or base
(defn get-porcelain-status [cmd]
(let [[stream (.split (get-git-response ["status" "--porcelain" "--untracked-files=all" "--ignore-submodules=all"]) "\0")]
[parse-stream (fn [acc stream]
(if (= 0 (len stream))
acc
(let [[temp (.pop stream 0)]
[index (.pop temp 0)]
[workspace (.pop temp 0)]
[filename (slice temp 1)]]
(if (= index "R")
(.pop stream 0))
(parse-stream (.append acc (, index workspace filename)) stream))))]]
(parse-stream [] stream)))
(defn modified-in-workspace [s] (s[0] in ["M" "A" "?"]))
(defn modified-in-staging [s] (s[1] in ["M" "A" "?"]))
(defn get-name [s] (s[2]))
(defn run-staged-scan [options]
(let [[to-scan (filter (fn [a] (in (get (get a 0) 0) ["R" "M"]))
(defn get-head-tag []
(let [[empty-repository-hash "4b825dc642cb6eb9a060e54bf8d69288fbee4904"]
[(, out err returncode) (get-git-response ["rev-parse" "--verify HEAD"])]]
(if err empty-repository-hash "HEAD")))

9
git_lint_src/git_lint_options.hy
View File

@ -52,6 +52,7 @@
[rationalize-options (make-options-rationalizer optlist)]
[(, newoptions excluded) (remove-conflicted-options
optlist (reduce (fn [acc i] (rationalize-options acc i)) opt {}))]]
(setv self.optlist optlist)
(setv self.options newoptions)
(setv self.excluded excluded)
(setv self.filesames arg)
@ -59,15 +60,15 @@
(setv self.version version)
(setv self.copyright copyright))
None)]
[print-help (fn [self]
(print (.format (_ "Usage: {} [options] [filenames]") self.name))
(for [item optlist] (print (.format " -{:<1} --{:<12} {}" (get item 0) (get item 1) (get item 3))))
(for [item self.optlist] (print (.format " -{:<1} --{:<12} {}" (get item 0) (get item 1) (get item 3))))
(sys.exit))]
[print-version (fn [self]
(print (.format "{}" self.name self.version))
(if (self.copyright)
(if self.copyright
(print self.copyright))
(sys.exit))]])

27
git_lint_src/load-config.hy
View File

@ -17,7 +17,7 @@
["a" "all" false (_ "Scan all files in the repository, not just those that have changed.")]
["e" "every" false (_ "Short for -b -a: scan everything")]
["w" "workspace" false (_ "Scan the workspace") ["staging"]]
["s" "staging" false (_ "Scan the staging area (useful for pre-commit).") []]
["s" "staging" false (_ "Scan the staging area (useful for pre-commit).") ["base" "all" "every"]]
["g" "changes" false (_ "Report lint failures only for diff'd sections") ["complete"]]
["p" "complete" false (_ "Report lint failures for all files") []]
["c" "config" true (_ "Path to config file") []]
@ -27,6 +27,7 @@
(defn get-git-response-raw [cmd]
(let [[fullcmd (+ ["git"] cmd)]
[process (subprocess.Popen fullcmd
:universal-newlines True
:stdout subprocess.PIPE
:stderr subprocess.PIPE)]
[(, out err) (.communicate process)]]
@ -52,6 +53,7 @@
(let [[process (subprocess.Popen fullcmd
:stdout subprocess.PIPE
:stderr subprocess.PIPE
:universal-newlines True
:shell True)]
[(, out err) (.communicate process)]]
(, out err process.returncode)))
@ -75,22 +77,24 @@
(sys.exit (_ "Current repository contains merge conflicts. Linters will not be run."))
trackings)))
(defn get-porcelain-status [cmd]
(let [[stream (.split (get-git-response cmd) "\0")]
(defn get-porcelain-status []
(let [[cmd ["status" "-z" "--porcelain" "--untracked-files=all" "--ignore-submodules=all"]]
[nonnull (fn [s] (> (len s) 0))]
[stream (tap (list (filter nonnull (.split (get-git-response cmd) "\0"))))]
[parse-stream (fn [acc stream]
(if (= 0 (len stream))
acc
(let [[temp (.pop stream 0)]
[index (.pop temp 0)]
[workspace (.pop temp 0)]
[filename (slice temp 1)]]
[index (get temp 0)]
[workspace (get temp 1)]
[filename (tap (slice temp 3))]]
(if (= index "R")
(.pop stream 0))
(parse-stream (.append acc (, index workspace filename)) stream))))]]
(parse-stream (+ acc [(, index workspace filename)]) stream))))]]
(parse-stream [] stream)))
(defn modified-in-workspace [s] (s[0] in ["M" "A" "?"]))
(defn modified-in-staging [s] (s[1] in ["M" "A" "?"]))
(defn modified-in-workspace [s] (in s[0] ["M" "A" "?"]))
(defn modified-in-staging [s] (in s[1] ["M" "A"]))
(defn get-name [s] (s[2]))
;(defn get-changed-from-cwd []
@ -152,10 +156,11 @@
(defn git-lint-main [options]
(print git-base)
(print (os.path.abspath __file__))
(let [[config (get-config-file options git-base)]]
(let [[config (get-config options git-base)]]
(print options)
(print config)
(print (make-match-filter config))))
(print (make-match-filter config))
(print (get-porcelain-status))))
(defmain [&rest args]
(if (= git-base None)