Show More
Commit Description:
Added tag 0.1.3 for changeset ab5a9f26a3e1
Commit Description:
Added tag 0.1.3 for changeset ab5a9f26a3e1
References:
File last commit:
Show/Diff file:
Action:
src/project_checkup/core.clj
134 lines | 4.6 KiB | text/x-clojure | ClojureLexer
134 lines | 4.6 KiB | text/x-clojure | ClojureLexer
r0 | #!/usr/bin/env lumo | |||
(ns project-checkup.core | ||||
(:gen-class) | ||||
(:require [clojure.java.shell :as shell] | ||||
[clojure.string :as string])) | ||||
r8 | (defn get-extension [path] | |||
"Extracts the extension of a path. | ||||
Returns the extension with the period, e.g., '.txt' because that's the format | ||||
people are used to seeing extensions in." | ||||
(re-find #"\.[a-zA-Z0-9]+$" path)) | ||||
r0 | ||||
r10 | (defn gather-untracked | |||
[vcs-systems] | ||||
"Gather untracked files in Git or Mercurial." | ||||
(reduce into [ | ||||
(if (contains? vcs-systems ".hg") | ||||
(string/split (:out (shell/sh "chg" "st" "-u" "-n")) #"\n")) | ||||
(if (contains? vcs-systems ".git") | ||||
(string/split (:out (shell/sh "git" "ls-files" "--others" | ||||
"--exclude-standard")) #"\n"))] | ||||
) | ||||
) | ||||
r0 | (defn gather-project-info | |||
r10 | "Creates a dictionary of project information." | |||
r0 | [] | |||
r6 | (let [all-files (map str (file-seq (clojure.java.io/file "."))) | |||
r4 | ; files (string/split (:out (shell/sh "hg" "st" "-m" "-a" "-r" "-d" "-c" "-n" )) #"\n") | |||
r10 | ||||
files (map #(clojure.string/replace % #"./(.*)" "$1") all-files ) | ||||
;note that using some here means that if both are present, hg is | ||||
;ignored: | ||||
vcs-systems (set (vector (some #{".git" ".hg"} files))) ] | ||||
r0 | {:files files | |||
:extensions (frequencies (map get-extension files )) | ||||
r6 | :path (System/getProperty "user.dir") | |||
r10 | :untracked-files (gather-untracked vcs-systems) | |||
r4 | :readme (if-let [filename (some #{"README.md" "README.txt" "README.mkd"} files)] (slurp filename) "") | |||
r6 | }) ) | |||
r0 | ||||
(defn color [color string] | ||||
(let [color-sequence (case color | ||||
:green "\u001B[32m" | ||||
:yellow "\u001B[33m" | ||||
:blue "\u001B[34m" | ||||
r4 | :red "\u001B[31m" | |||
:cyan "\u001B[36m" | ||||
:magenta "\u001B[35m" | ||||
r0 | ) | |||
reset "\u001B[m" ] | ||||
(str color-sequence string reset)) ) | ||||
(defn check-vcs [project] | ||||
(let [{files :files } project] | ||||
r4 | (boolean (some #{".git" ".hg"} files)) )) | |||
r0 | ||||
(defn check-readme [project] | ||||
(let [{files :files } project] | ||||
r7 | (boolean (some #{"README.md" "README.txt" "README.mkd" "README"} files)) )) | |||
r0 | ||||
(defn check-untracked [project] | ||||
(let [{untracked :untracked-files } project] | ||||
(= (count untracked) 0)) ) | ||||
(defn check-taskpaper [project] | ||||
r4 | (let [{extensions :extensions files :files } project] | |||
(or (>= (get ".taskpaper" extensions 0) 1) | ||||
(some #{"TODO" "TODO.txt" } files)))) | ||||
(defn check-readme-placeholders [project] | ||||
r7 | (= (count (re-find #"(FIXME|TODO)" (:readme project) )) 0)) | |||
r4 | ||||
r0 | ||||
(def checks [{:name "Has VCS" | ||||
:description "" | ||||
:function check-vcs | ||||
:level :error | ||||
:follow-up "Initialize a repository." } | ||||
{:name "Always True" | ||||
:function #(or true %) | ||||
:level :error | ||||
:follow-up "This is a bug." } | ||||
{:name "Has Untracked" | ||||
:description "" | ||||
:function check-untracked | ||||
:level :warning | ||||
r10 | :follow-up "Commit or ignore files from 'hg st -u' or 'git ls-files --others --exclude-standard'." } | |||
r0 | {:name "No Todo" | |||
:function check-taskpaper | ||||
:description "" | ||||
:level :suggestion | ||||
:follow-up "Add a todo file using Taskpaper." } | ||||
{:name "Has Readme" | ||||
:function check-readme | ||||
:description "Readme exists" | ||||
:level :suggestion | ||||
r4 | :follow-up "Add a README." } | |||
{:name "README has no placeholders" | ||||
:function check-readme-placeholders | ||||
:description "No placeholders in README" | ||||
:level :error | ||||
:follow-up "Address placeholders or convert them to tasks." | ||||
} ]) | ||||
r0 | ||||
(defn perform-check [check project] | ||||
(let [{check-name :name function :function follow-up :follow-up | ||||
level :level } check | ||||
result (function project) | ||||
false-color (case level | ||||
:suggestion :blue | ||||
:warning :yellow | ||||
:error :red | ||||
:red) ] | ||||
{:name check-name | ||||
:result result | ||||
:output (if result | ||||
(color :green (str "✓" check-name " passed!")) | ||||
(str check-name (color false-color " failed! ") "\n\tFollow up: " follow-up))})) | ||||
(defn -main | ||||
r4 | "Run checks." | |||
r0 | [& args] | |||
r4 | (try | |||
r10 | (let [project-info (gather-project-info)] | |||
(doseq [check checks] | ||||
(println (:output (perform-check check project-info ))))) | ||||
r4 | (catch Exception ex | |||
(.printStackTrace ex) | ||||
(str "caught exception: " (.getMessage ex))) | ||||
r6 | (finally (shutdown-agents) )) ) | |||