|
|
#!/usr/bin/env lumo
|
|
|
(ns project-checkup.core
|
|
|
(:gen-class)
|
|
|
(:require [clojure.java.shell :as shell]
|
|
|
[clojure.string :as string]))
|
|
|
|
|
|
(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))
|
|
|
|
|
|
(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"))]))
|
|
|
(defn gather-project-info
|
|
|
"Creates a dictionary of project information."
|
|
|
[]
|
|
|
(let [all-files (map str (file-seq (clojure.java.io/file ".")))
|
|
|
files (map #(clojure.string/replace % #"./(.*)" "$1") all-files )
|
|
|
; file-set (set files)
|
|
|
;note that using some here means that if both are present, hg is
|
|
|
;ignored:
|
|
|
vcs-systems (set (vector (some #{".git" ".hg"} files))) ]
|
|
|
{:files files
|
|
|
:extensions (frequencies (map get-extension files ))
|
|
|
:path (System/getProperty "user.dir")
|
|
|
:untracked-files (gather-untracked vcs-systems)
|
|
|
:readme (if-let [filename (some #{"README.md" "README.txt" "README.mkd"} files)] (slurp filename) "") }) )
|
|
|
|
|
|
(defn color [color string]
|
|
|
(let [color-sequence (case color
|
|
|
:green "\u001B[32m"
|
|
|
:yellow "\u001B[33m"
|
|
|
:blue "\u001B[34m"
|
|
|
:red "\u001B[31m"
|
|
|
:cyan "\u001B[36m"
|
|
|
:magenta "\u001B[35m")
|
|
|
reset "\u001B[m"]
|
|
|
(str color-sequence string reset)))
|
|
|
|
|
|
|
|
|
(defn check-vcs [project]
|
|
|
(let [{files :files } project]
|
|
|
(boolean (some #{".git" ".hg"} files))))
|
|
|
|
|
|
(defn check-readme [project]
|
|
|
(let [{files :files } project]
|
|
|
(boolean (some #{"README.md" "README.txt" "README.mkd" "README"} files))))
|
|
|
|
|
|
(defn check-changelog [project]
|
|
|
(let [{files :files } project]
|
|
|
(boolean (some #{"CHANGELOG.md" "CHANGELOG.txt" "CHANGELOG.mkd" "CHANGELOG"} files))))
|
|
|
|
|
|
(defn check-untracked [project]
|
|
|
(let [{untracked :untracked-files } project]
|
|
|
(= (count untracked) 0)))
|
|
|
|
|
|
(defn check-taskpaper [project]
|
|
|
(let [{extensions :extensions files :files } project]
|
|
|
(or (>= (get extensions ".taskpaper" 0) 1)
|
|
|
(some #{"TODO" "TODO.txt" } files))))
|
|
|
|
|
|
(defn check-readme-placeholders [project]
|
|
|
(= (count (re-find #"(FIXME|TODO)" (:readme project))) 0))
|
|
|
|
|
|
|
|
|
(defn check-license [project]
|
|
|
(let [{files :files } project]
|
|
|
(boolean (some #{"LICENSE" "LICENSE.txt" "LICENSE.md" "LICENSE.mkd"} files))))
|
|
|
|
|
|
|
|
|
(def checks [{:name "Project is checked into revision control"
|
|
|
: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 "All files are tracked or ignored"
|
|
|
:description ""
|
|
|
:function check-untracked
|
|
|
:level :warning
|
|
|
:follow-up "Commit or ignore files from 'hg st -u' or 'git ls-files --others --exclude-standard'." }
|
|
|
{:name "Project has a todo file"
|
|
|
:function check-taskpaper
|
|
|
:description ""
|
|
|
:level :suggestion
|
|
|
:follow-up "Add a todo file using Taskpaper."}
|
|
|
{:name "Project has a README"
|
|
|
:function check-readme
|
|
|
:description "Readme exists"
|
|
|
:level :warning
|
|
|
:follow-up "Add a README."}
|
|
|
{:name "Project has a CHANGELOG"
|
|
|
:function check-changelog
|
|
|
:description "Changelog exists"
|
|
|
:level :warning
|
|
|
:follow-up "Add a CHANGELOG. Consider refering to keepachangelog.com for guidance." }
|
|
|
{: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."}
|
|
|
{ :name "Project has a license"
|
|
|
:function check-license
|
|
|
:description "Project has a LICENSE file."
|
|
|
:level :warning ;going with warning because a project might not have a license before release.
|
|
|
:follow-up "Add a license to LICENSE. Consider using https://choosealicense.com/ for guidance." }])
|
|
|
|
|
|
(defn perform-check [check project]
|
|
|
(let [{check-name :name :keys [function follow-up level]} check
|
|
|
result (function project)
|
|
|
false-color (case level
|
|
|
:suggestion :blue
|
|
|
:warning :yellow
|
|
|
:error :red
|
|
|
:red)
|
|
|
prefix (case level
|
|
|
:suggestion "Suggested "
|
|
|
:warning "Recommended "
|
|
|
:error "Required "
|
|
|
"Follow-up")]
|
|
|
{:name check-name
|
|
|
:result result
|
|
|
:output (if result
|
|
|
(color :green (str "✔" check-name "…passed!"))
|
|
|
(str (color false-color (str "❌" check-name "…failed!"))
|
|
|
"\n\t" prefix " Follow up: " follow-up))}))
|
|
|
|
|
|
(defn -main
|
|
|
"Run checks."
|
|
|
[& args]
|
|
|
(try
|
|
|
(let [project-info (gather-project-info)]
|
|
|
(doseq [check checks]
|
|
|
(println (:output (perform-check check project-info )))))
|
|
|
(catch Exception ex
|
|
|
(.printStackTrace ex)
|
|
|
(str "caught exception: " (.getMessage ex)))
|
|
|
(finally (shutdown-agents))))
|
|
|
|
