190 lines
8.2 KiB
Hy
190 lines
8.2 KiB
Hy
#!/usr/bin/env hy
|
|
(import ConfigParser os subprocess operator re gettext sys getopt)
|
|
(.append sys.path "Users/ksternberg/build/git-lint/git_lint_src")
|
|
(import [git-lint-options [hyopt]])
|
|
(import [git-lint-config [get-config]])
|
|
|
|
(def _ gettext.gettext)
|
|
(def *version* "0.0.2")
|
|
|
|
(defn tap [a] (print "TAP:" a) a)
|
|
|
|
; short-name long-name takes-args description precludes
|
|
(def optlist [["o" "only" true (_ "A comma-separated list of only those linters to run") ["exclude"]]
|
|
["x" "exclude" true (_ "A comma-separated list of linters to skip") []]
|
|
["l" "linters" false (_ "Show the list of configured linters")]
|
|
["b" "base" false (_ "Scan from the base directory rather than the current working") []]
|
|
["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).") ["base" "all" "every" "workspace"]]
|
|
["g" "changes" false (_ "Report lint failures only for diff'd sections") ["complete"]]
|
|
["p" "complete" false (_ "Report lint failures over whole files") []]
|
|
["c" "config" true (_ "Path to config file") []]
|
|
["d" "dryrun" false (_ "Report what git-lint would do, but don't actually do anything.") []]
|
|
["q" "quiet" false (_ "Produce a short report of files that failed to pass.") []]
|
|
["h" "help" false (_ "This help message") []]
|
|
["v" "version" false (_"Version information") []]])
|
|
|
|
(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)]]
|
|
(, out err process.returncode)))
|
|
|
|
(defn get-git-response [cmd]
|
|
(let [[(, out error returncode) (get-git-response-raw cmd)]] out))
|
|
|
|
(defn split-git-response [cmd]
|
|
(let [[(, out error returncode) (get-git-response-raw cmd)]] (.splitlines out)))
|
|
|
|
(defn split-git-response [cmd]
|
|
(let [[(, out error returncode) (get-git-response-raw cmd)]] (.splitlines out)))
|
|
|
|
|
|
(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
|
|
:universal-newlines True
|
|
:shell True)]
|
|
[(, out err) (.communicate process)]]
|
|
(, out err process.returncode)))
|
|
|
|
(def git-base (let [[(, out error returncode)
|
|
(get-git-response-raw ["rev-parse" "--show-toplevel"])]]
|
|
(if (not (= returncode 0)) None (.rstrip out))))
|
|
|
|
(defn get-all-from-cwd []
|
|
(split-git-response ["ls-tree" "--name-only" "-r" "HEAD"]))
|
|
|
|
(defn get-all-from-base []
|
|
(split-git-response ["ls-tree" "--name-only" "-r" "--full-tree" "HEAD"]))
|
|
|
|
; Any of these indicate the tree is in a merge
|
|
; conflict state and the user has bigger problems.
|
|
(def *merge-conflict-pairs* (set ["DD" "DU" "AU" "AA" "UD" "UA" "UU"]))
|
|
(defn get-changed-from-source [trackings]
|
|
(let [[conflicts (filter (fn [t] (t[0:2] in *merge-conflict-pairs*)) trackings)]]
|
|
(if (len conflicts)
|
|
(sys.exit (_ "Current repository contains merge conflicts. Linters will not be run."))
|
|
trackings)))
|
|
|
|
(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 (get temp 0)]
|
|
[workspace (get temp 1)]
|
|
[filename (tap (slice temp 3))]]
|
|
(if (= index "R")
|
|
(.pop stream 0))
|
|
(parse-stream (+ acc [(, index workspace filename)]) stream))))]]
|
|
(parse-stream [] stream)))
|
|
|
|
(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 []
|
|
; (->> (get-changed-from_source (split-git-response ["status" "--porcelain" "--untracked-files=all"]))
|
|
; (filter (fn [s] (s[0] in
|
|
;
|
|
; (map (fn [s]
|
|
; (filter (fn [s] (
|
|
;
|
|
|
|
(defn get-changed-from-base []
|
|
(get-changed-from_source (split-git-response ["status" "--porcelain" "--untracked-files=all" git-base])))
|
|
|
|
(defn get-staged-from-cwd []
|
|
())
|
|
|
|
(defn gen-staged-from-base []
|
|
())
|
|
|
|
|
|
(defn make-match-filter-matcher [extensions]
|
|
(->> (map (fn [s] (.split s ",")) extensions)
|
|
(reduce operator.add)
|
|
(map (fn [s] (.strip s)))
|
|
(set)
|
|
(filter (fn [s] (not (= 0 (len s)))))
|
|
(map (fn [s] (.sub re "^\." "" s)))
|
|
(.join "|")
|
|
((fn [s] (+ "\.(" s ")$")))
|
|
((fn [s] (re.compile s re.I)))))
|
|
|
|
(defn make-match-filter [config]
|
|
(let [[matcher (make-match-filter-matcher (map (fn [v] (.get v "match" "" ))
|
|
(.itervalues config)))]]
|
|
(fn [path] (.search matcher path))))
|
|
|
|
(defn executable-exists [script label]
|
|
(if (not (len script))
|
|
(sys.exit (.format (_ "Syntax error in command configuration for {} ") label))
|
|
(let [[scriptname (get (.split script " ") 0)]
|
|
[paths (.split (.get os.environ "PATH") ":")]
|
|
[isexecutable (fn [p] (and (os.path.exists p) (os.access p os.X_OK)))]]
|
|
(if (not (len scriptname))
|
|
(sys.exit (.format (_ "Syntax error in command configuration for {} ") label))
|
|
(if (= (get scriptname 0) "/")
|
|
(if (isexecutable scriptname)
|
|
scriptname None)
|
|
(let [[possibles (list (filter (fn [path] (isexecutable (os.path.join path scriptname))) paths))]]
|
|
(if (len possibles)
|
|
(get possibles 0) None)))))))
|
|
|
|
(defn print-linters [config]
|
|
(print (_ "Currently supported linters:"))
|
|
(for [(, linter items) (.iteritems config)]
|
|
(if (not (executable-exists (.get items "command" "") linter))
|
|
(print (.format "{:<14} {}" linter (_ "(WARNING: executable not found)")))
|
|
(print (.format "{:<14} {}" linter (.get items "comment" ""))))))
|
|
|
|
(defn git-lint-main [options]
|
|
(print git-base)
|
|
(print (os.path.abspath __file__))
|
|
(let [[config (get-config options git-base)]]
|
|
(print options)
|
|
(print config)
|
|
(print (make-match-filter config))
|
|
(print (get-porcelain-status))))
|
|
|
|
|
|
(defmain [&rest args]
|
|
(for [option optlist]
|
|
(print (.format "``-{}`` ``--{}``\n {}" (get option 0) (get option 1) (get option 3)))))
|
|
|
|
|
|
;(defmain [&rest args]
|
|
; (if (= git-base None)
|
|
; (sys.exit (_ "Not currently in a git repository."))
|
|
; (try
|
|
; (let [[opts (hyopt optlist args "git lint"
|
|
; "Copyright (c) 2008, 2016 Kenneth M. \"Elf\" Sternberg <elf.sternberg@gmail.com>"
|
|
; "0.0.4")]
|
|
; [options opts.options]
|
|
; [config (get-config options git-base)]]
|
|
; (cond [(.has_key options "help") (opts.print-help)]
|
|
; [(.has_key options "version") (opts.print-version)]
|
|
; [(.has_key options "linters") (print-linters config)]
|
|
; [true (git-lint-main options)]))
|
|
; (catch [err getopt.GetoptError]
|
|
; (print (str err))
|
|
; (print-help)))))
|
|
;
|