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

Now tracking excluded options, for reportage.

This commit is contained in:
Elf M. Sternberg 2016-09-21 14:16:04 -07:00
parent 7e52c9a5ef
commit e4e4151587
4 changed files with 215 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
git_lint_src/git-lint.hy → git_lint_src/git-lint.hy.orig
View File

175
git_lint_src/git_lint.hy Normal file
View File

@ -0,0 +1,175 @@
#!/usr/bin/env hy ; -*- mode: clojure -*-
(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 (_ "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.")]
["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).") []]
["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") []]
["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
: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
: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 [cmd]
(let [[stream (.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)]]
(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 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-file options git-base)]]
(print options)
(print config)
(print (make-match-filter config))))
(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)))))

4
git_lint_src/git_lint_config.hy
View File

@ -1,4 +1,6 @@
(import sys os.path ConfigParser)
; -*- mode: clojure -*-
(import sys os.path gettext ConfigParser)
(def _ gettext.gettext)
(defn -find-config-file [options base]
(if (.has_key options "config")

59
git_lint_src/git_lint_options.hy
View File

@ -1,3 +1,4 @@
; -*- mode: clojure -*-
; 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"
@ -7,7 +8,8 @@
; array, creates a function to map either the short or long option
; to the option name.
(import os sys inspect getopt)
(import os sys inspect getopt gettext)
(def _ gettext.gettext)
(defn get-script-name []
(if (getattr sys "frozen" False)
@ -20,40 +22,53 @@
[name (.pop names)]]
(name))))
(defn make-opt-assoc [prefix pos]
(fn [acc it] (assoc acc (+ prefix (get it pos)) (get it 1)) acc))
(defn make-options-rationalizer [optlist]
(let [[short-opt-assoc (make-opt-assoc "-" 0)]
[long-opt-assoc (make-opt-assoc "--" 1)]
[fullset
(reduce (fn [acc i] (-> (short-opt-assoc acc i)
(long-opt-assoc i))) optlist {})]]
[fullset (reduce (fn [acc i] (-> (short-opt-assoc acc i)
(long-opt-assoc i))) optlist {})]]
(fn [acc it] (do (assoc acc (get fullset (get it 0)) (get it 1)) acc))))
(defn make-opt-assoc [prefix pos]
(fn [acc it] (assoc acc (+ prefix (get it pos)) (get it 1)) acc))
(defn remove-conflicted-options [optlist config]
(let [[keys (.keys config)]
[marked (filter (fn [opt] (in (get opt 1) keys)) optlist)]
[exclude (reduce (fn [memo opt] (+ memo (if (> (len opt) 4) (get opt 4) []))) marked [])]
[excluded (filter (fn [key] (in key exclude)) keys)]
[cleaned (reduce (fn [memo key]
(if (not (in key exclude)) (assoc memo key (get config key))) memo) keys {})]]
(, cleaned excluded)))
(defclass hyopt []
[[print-help (fn [self]
[[--init-- (fn [self optlist args &optional [name ""] [copyright ""] [version "0.0.1"]]
(let [[optstringsshort
(.join "" (map (fn [i] (+ (. i [0]) (cond [(. i [2]) ":"] [true ""]))) optlist))]
[optstringslong
(list (map (fn [i] (+ (. i [1]) (cond [(. i [2]) "="] [true ""]))) optlist))]
[(, opt arg)
(getopt.getopt (slice args 1) optstringsshort optstringslong)]
[rationalize-options (make-options-rationalizer optlist)]
[(, newoptions excluded) (remove-conflicted-options
optlist (reduce (fn [acc i] (rationalize-options acc i)) opt {}))]]
(setv self.options newoptions)
(setv self.excluded excluded)
(setv self.filesames arg)
(setv self.name (if name name (get-script-name)))
(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))))
(sys.exit))]
[print-version (fn [self]
(print (.format "{}" self.name self.version))
(if (self.copyright)
(print self.copyright))
(sys.exit))]
[--init-- (fn [self optlist args &optional [name ""] [copyright ""] [version "0.0.1"]]
(let [[optstringsshort
(.join "" (map (fn [i] (+ (. i [0]) (cond [(. i [2]) ":"] [true ""]))) optlist))]
[optstringslong
(list (map (fn [i] (+ (. i [1]) (cond [(. i [2]) "="] [true ""]))) optlist))]
[(, opt arg)
(getopt.getopt (slice args 1) optstringsshort optstringslong)]
[rationalize-options (make-options-rationalizer optlist)]]
(setv self.options (reduce (fn [acc i] (rationalize-options acc i)) opt {}))
(setv self.name (if name name (get-script-name)))
(setv self.version version)
(setv self.copyright copyright))
None)]])
(sys.exit))]])