b9933e6637
BREAKING CHANGE: This restructures the project in preparation for Doom to be split into two repos. Users that have reconfigured Doom's CLI stand a good chance of seeing breakage, especially if they've referred to any core-* feature, e.g. (after! core-cli-ci ...) To fix it, simply s/core-/doom-/, i.e. (after! doom-cli-ci ...) What this commit specifically changes is: - Renames all core features from core-* to doom-* - Moves core/core-* -> lisp/doom-* - Moves core/autoloads/* -> lisp/lib/* - Moves core/templates -> templates/ Ref: #4273
472 lines
20 KiB
EmacsLisp
472 lines
20 KiB
EmacsLisp
;;; lisp/cli/ci.el -*- lexical-binding: t; -*-
|
|
|
|
;;
|
|
;;; Variables
|
|
|
|
(defvar doom-ci-commit-trailer-keys
|
|
'(("Fix" ref hash url)
|
|
("Ref" ref hash url)
|
|
("Close" ref)
|
|
("Revert" ref hash)
|
|
("Amend" ref hash)
|
|
("Co-authored-by" name)
|
|
("Signed-off-by" name))
|
|
"An alist of valid trailer keys and their accepted value types.
|
|
|
|
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
|
|
|
(defvar doom-ci-commit-trailer-types
|
|
'((ref . "^\\(https?://[^ ]+\\|[^/]+/[^/]+\\)?#[0-9]+$")
|
|
(hash . "^\\(https?://[^ ]+\\|[^/]+/[^/]+@\\)?[a-z0-9]\\{12\\}$")
|
|
(url . "^https?://")
|
|
(name . "^[a-zA-Z0-9-_ \\.']+<[^@]+@[^.]+\\.[^>]+>$")
|
|
(username . "^@[^a-zA-Z0-9_-]+$"))
|
|
"An alist of valid trailer keys and their accepted value types.
|
|
|
|
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
|
|
|
(defvar doom-ci-commit-types
|
|
'(bump dev docs feat fix merge nit perf refactor release revert test tweak)
|
|
"A list of valid commit types.")
|
|
|
|
(defvar doom-ci-commit-scopeless-types '(bump merge release revert)
|
|
"A list of commit types whose scopes should be passed in its BODY.
|
|
|
|
Don't: \"bump(SCOPE): ...\"
|
|
Do: \"bump: SCOPE\"")
|
|
|
|
(defvar doom-ci-commit-scopes '("ci" doom-ci-enforce-scopeless-types)
|
|
"A list of valid commit scopes as strings, predicate functions, or lists.
|
|
|
|
These are checked against each item in the comma-delimited scope field of the
|
|
current commit's message. E.g. 'fix(foo,bar,baz): ...' => foo, bar and baz
|
|
|
|
Each element of this list can be one of:
|
|
|
|
- A string, compared literally against the scope's name.
|
|
- A function predicate, taking two arguments (a scope as a symbol, and a plist
|
|
containing information about the current commit--see `doom-ci-commit-scopes'
|
|
for more about its structure). These predicates should:
|
|
- Return non-nil to immediately pass a scope.
|
|
- Throw a `user-error' to immediately fail the scope.
|
|
- Return nil to continue with the checks in this list.
|
|
- A list, denoting type-specific scopes. Its CAR is the type as a symbol, and
|
|
its CDR is a nested list of scopes as strings/predicates. E.g.
|
|
|
|
'(docs \"faq\" \"install\" check-docs)")
|
|
|
|
(defvar doom-ci-commit-rules
|
|
;; TODO Extract into named functions
|
|
(list (lambda! (&key subject)
|
|
"If a fixup/squash commit, don't lint this commit"
|
|
(when (string-match "^\\(\\(?:fixup\\|squash\\)!\\|FIXUP\\|WIP\\) " subject)
|
|
(skip! (format "Found %S commit, skipping commit" (match-string 1 subject)))))
|
|
|
|
(lambda! (&key type subject)
|
|
"Test SUBJECT length"
|
|
(let ((len (length subject)))
|
|
(cond ((memq type '(bump revert)))
|
|
((<= len 10)
|
|
(fail! "Subject is too short (<10) and should be more descriptive"))
|
|
((<= len 20)
|
|
(warn! "Subject is short (<20); are you sure it's descriptive enough?"))
|
|
((> len 72)
|
|
(fail! "Subject is %d characters, above the 72 maximum"
|
|
len))
|
|
((> len 50)
|
|
(warn! "Subject is %d characters; <=50 is ideal"
|
|
len)))))
|
|
|
|
(lambda! (&key type)
|
|
"Ensure commit has valid type"
|
|
(or (memq type doom-ci-commit-types)
|
|
(if type
|
|
(fail! "Invalid commit type: %s" type)
|
|
(fail! "Commit has no detectable type"))))
|
|
|
|
(lambda! (&key summary)
|
|
"Ensure commit has a summary"
|
|
(when (or (not (stringp summary))
|
|
(string-blank-p summary))
|
|
(fail! "Commit has no summary")))
|
|
|
|
(lambda! (&key type summary subject)
|
|
"Ensure summary isn't needlessly capitalized"
|
|
(and (stringp summary)
|
|
(string-match-p "^[A-Z][^-A-Z.]" summary)
|
|
(fail! "%S in summary should not be capitalized"
|
|
(car (split-string summary " ")))))
|
|
|
|
(lambda! (&rest plist &key type scopes)
|
|
"Ensure scopes are valid"
|
|
(dolist (scope scopes)
|
|
(condition-case e
|
|
(letf! (defun* check-rule (rule)
|
|
(or (and (stringp rule)
|
|
(string= rule scope))
|
|
(and (functionp rule)
|
|
(funcall rule scope plist))
|
|
(and (listp rule)
|
|
(eq type (car rule))
|
|
(seq-find #'check-rule (cdr rule)))))
|
|
(or (seq-find #'check-rule doom-ci-commit-scopes)
|
|
(fail! "Invalid scope: %s" scope)))
|
|
(user-error (fail! "%s" (error-message-string e))))))
|
|
|
|
(lambda! (&key scopes)
|
|
"Esnure scopes are sorted correctly"
|
|
(unless (equal scopes (sort (copy-sequence scopes) #'string-lessp))
|
|
(fail! "Scopes are not in lexicographical order")))
|
|
|
|
(lambda! (&key type body)
|
|
"Enforce 72 character line width for BODY"
|
|
(catch 'result
|
|
(with-temp-buffer
|
|
(save-excursion (insert body))
|
|
(while (re-search-forward "^[^\n]\\{73,\\}" nil t)
|
|
(save-excursion
|
|
(or
|
|
;; Long bump lines are acceptable
|
|
(let ((bump-re "\\(https?://.+\\|[^/]+\\)/[^/]+@[a-z0-9]\\{12\\}"))
|
|
(re-search-backward (format "^%s -> %s$" bump-re bump-re) nil t))
|
|
;; Long URLs are acceptable
|
|
(re-search-backward "https?://[^ ]+\\{73,\\}" nil t)
|
|
;; Lines that start with # or whitespace are comment or
|
|
;; code blocks.
|
|
(re-search-backward "^\\(?:#\\| +\\)" nil t)
|
|
(throw 'result (fail! "Line(s) in commit body exceed 72 characters"))))))))
|
|
|
|
(lambda! (&key bang body type)
|
|
"Ensure ! is accompanied by a 'BREAKING CHANGE:' in BODY"
|
|
(if bang
|
|
(cond ((not (string-match-p "^BREAKING CHANGE:" body))
|
|
(fail! "'!' present in commit type, but missing 'BREAKING CHANGE:' in body"))
|
|
((not (string-match-p "^BREAKING CHANGE: .+" body))
|
|
(fail! "'BREAKING CHANGE:' present in commit body, but missing explanation")))
|
|
(when (string-match-p "^BREAKING CHANGE:" body)
|
|
(fail! "'BREAKING CHANGE:' present in body, but missing '!' after %S"
|
|
type))))
|
|
|
|
(lambda! (&key type body)
|
|
"Ensure bump commits have package ref lines"
|
|
(and (eq type 'bump)
|
|
(let ((bump-re "\\(?:https?://.+\\|[^/]+\\)/[^/]+@\\([a-z0-9]+\\)"))
|
|
(not (string-match-p (concat "^" bump-re " -> " bump-re "$")
|
|
body)))
|
|
(fail! "Bump commit is missing commit hash diffs")))
|
|
|
|
(lambda! (&key body)
|
|
"Ensure commit hashes in bump lines are 12 characters long"
|
|
(with-temp-buffer
|
|
(insert body)
|
|
(let ((bump-re "\\<\\(?:https?://[^@]+\\|[^/]+\\)/[^/]+@\\([a-z0-9]+\\)")
|
|
refs)
|
|
(while (re-search-backward bump-re nil t)
|
|
(when (/= (length (match-string 1)) 12)
|
|
(push (match-string 0) refs)))
|
|
(when refs
|
|
(fail! "%d commit hash(s) not 12 characters long: %s"
|
|
(length refs) (string-join (nreverse refs) ", "))))))
|
|
|
|
;; TODO Add bump validations for revert: type.
|
|
(lambda! (&key body trailers)
|
|
"Validate commit trailers."
|
|
(let* ((keys (mapcar #'car doom-ci-commit-trailer-keys))
|
|
(key-re (regexp-opt keys t))
|
|
(lines
|
|
;; Scan BODY because invalid trailers won't be in TRAILERS.
|
|
(save-match-data
|
|
(and (string-match "\n\\(\n[a-zA-Z][a-zA-Z-]*:? [^ ][^\n]+\\)+\n+\\'" body)
|
|
(split-string (match-string 0 body) "\n" t)))))
|
|
(dolist (line lines)
|
|
(unless (string-match-p (concat "^" key-re ":? [^ ]") line)
|
|
(fail! "Found %S, expected one of: %s"
|
|
(truncate-string-to-width (string-trim line) 16 nil nil "…")
|
|
(string-join keys ", ")))
|
|
(when (and (string-match "^[^a-zA-Z-]+:? \\(.+\\)$" line)
|
|
(string-match-p " " (match-string 1 line)))
|
|
(fail! "%S has multiple references, but should only have one per line"
|
|
(truncate-string-to-width (string-trim line) 20 nil nil "…")))
|
|
(when (or (string-match (concat "^" key-re "\\(?:e?[sd]\\|ing\\)? [^ ]") line)
|
|
(string-match (concat "^\\([a-zA-Z-]+\\) [^ \n]+$") line))
|
|
(fail! "%S missing colon after %S"
|
|
(truncate-string-to-width (string-trim line) 16 nil nil "…")
|
|
(match-string 1 line))))
|
|
(pcase-dolist (`(,key . ,value) trailers)
|
|
(if (and (not (memq 'name (cdr (assoc key doom-ci-commit-trailer-keys))))
|
|
(string-match-p " " value))
|
|
(fail! "Found %S, but only one value allowed per trailer"
|
|
(truncate-string-to-width (concat key ": " value) 20 nil nil "…"))
|
|
(when-let (allowed-types (cdr (assoc key doom-ci-commit-trailer-keys)))
|
|
(or (cl-loop for type in allowed-types
|
|
if (cdr (assq type doom-ci-commit-trailer-types))
|
|
if (string-match-p it value)
|
|
return t)
|
|
(fail! "%S expects one of %s, but got %S"
|
|
key allowed-types value)))))))
|
|
|
|
;; TODO Check that bump/revert SUBJECT list: 1) valid modules and 2)
|
|
;; modules whose files are actually being touched.
|
|
|
|
;; TODO Ensure your diff corraborates your SCOPE
|
|
|
|
)
|
|
"A list of validator functions to run against a commit.
|
|
|
|
Each function is N-arity and is passed a plist with the following keys:
|
|
|
|
:bang
|
|
(Boolean) If `t', the commit is declared to contain a breaking change.
|
|
e.g. 'refactor!: this commit breaks everything'
|
|
:body
|
|
(String) Contains the whole BODY of a commit message, excluding the
|
|
TRAILERS.
|
|
:scopes
|
|
(List<Symbol>) Contains a list of scopes, as symbols. e.g. with
|
|
'feat(org,lsp): so on and so forth', this contains '(org lsp).
|
|
:subject
|
|
(String) Contains the whole first line of a commit message.
|
|
:summary
|
|
(String) Contains the summary following the type and scopes. e.g. In
|
|
'feat(org): fix X, Y, and Z' the summary is 'fix X, Y, and Z.
|
|
:trailers
|
|
(Map<String, String>) Contains an alist of 'KEY: VALUE' trailers, i.e. All
|
|
Fix, Ref, Close, Revert, etc lines with a valid value. This will be empty if
|
|
the formatting of a commit's trailers is invalid.
|
|
:type
|
|
(Symbol) The type of commit this is. E.g. `feat', `fix', `bump', etc.
|
|
|
|
Each function should call `fail!' or `warn!' one or more times, or `skip!'
|
|
(immediately returns). Each of these lexical functions take the same arguments
|
|
as `format'.
|
|
|
|
Note: warnings are not considered failures.")
|
|
|
|
|
|
;;
|
|
;;; Commands
|
|
|
|
;;; doom ci
|
|
(defcli! (:before ci) (&args _)
|
|
(when-let*
|
|
((repo-root
|
|
(if-let* ((result (sh! "git" "rev-parse" "--show-toplevel"))
|
|
((zerop (car result))))
|
|
(cdr result)
|
|
default-directory))
|
|
(local-config
|
|
(car (or (doom-glob repo-root "ci.el")
|
|
(doom-glob doom-private-dir "ci.el")))))
|
|
(defgroup! :prefix '(doom ci)
|
|
(load local-config nil t t))
|
|
(print! (item "Loaded %S") local-config)))
|
|
|
|
(defcli! ci (&args _)
|
|
"Commands that automate development processes."
|
|
:partial t)
|
|
|
|
(defcli! (ci deploy-hooks) ((force ("--force")))
|
|
"TODO"
|
|
(let* ((repo-path (sh! "git" "rev-parse" "--show-toplevel"))
|
|
(repo-path (if (zerop (car repo-path))
|
|
(cdr repo-path)
|
|
(user-error "Cannot locate a git repo in %s"
|
|
(file-relative-name default-directory))))
|
|
(submodule-p (string-empty-p (cdr (sh! "git" "rev-parse" "show-superproject-working-tree"))))
|
|
(config-hooks-path (cdr (sh! "git" "config" "core.hooksPath")))
|
|
(hooks-path (cdr (sh! "git" "rev-parse" "--git-path" "hooks"))))
|
|
(unless (string-empty-p config-hooks-path)
|
|
(or force
|
|
(y-or-n-p
|
|
(format (concat "Detected non-standard core.hookPath: %S\n\n"
|
|
"Install Doom's commit-msg and pre-push git hooks anyway?")
|
|
hooks-path))
|
|
(user-error "Aborted")))
|
|
(make-directory hooks-path 'parents)
|
|
(print-group!
|
|
(dolist (hook '("commit-msg" "pre-push"))
|
|
(let* ((hook (doom-path hooks-path hook))
|
|
(overwrite-p (file-exists-p hook)))
|
|
(with-temp-file hook
|
|
(insert "#!/usr/bin/env sh\n"
|
|
(doom-path doom-emacs-dir "bin/doom")
|
|
" --no-color ci hook " (file-name-base hook)
|
|
" \"$@\""))
|
|
(set-file-modes hook #o700)
|
|
(print! (success "%s %s")
|
|
(if overwrite-p "Overwrote" "Created")
|
|
(path hook)))))))
|
|
|
|
(defcli! (ci lint-commits) (from &optional to)
|
|
"TODO"
|
|
(with-temp-buffer
|
|
(insert
|
|
(cdr (doom-call-process
|
|
"git" "log"
|
|
(format "%s...%s" from (or to (concat from "~1"))))))
|
|
(doom-ci--lint
|
|
(let (commits)
|
|
(while (re-search-backward "^commit \\([a-z0-9]\\{40\\}\\)" nil t)
|
|
(push (cons (match-string 1)
|
|
(replace-regexp-in-string
|
|
"^ " ""
|
|
(save-excursion
|
|
(buffer-substring-no-properties
|
|
(search-forward "\n\n")
|
|
(if (re-search-forward "\ncommit \\([a-z0-9]\\{40\\}\\)" nil t)
|
|
(match-beginning 0)
|
|
(point-max))))))
|
|
commits))
|
|
commits))))
|
|
|
|
;;; TODO
|
|
(defstub! (ci run-tests))
|
|
|
|
;;; doom ci hook
|
|
(defcli! (ci hook commit-msg) (file)
|
|
"Run git commit-msg hook.
|
|
|
|
Lints the current commit message."
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(doom-ci--lint
|
|
`(("CURRENT" .
|
|
,(buffer-substring
|
|
(point-min)
|
|
(if (re-search-forward "^# Please enter the commit message" nil t)
|
|
(match-beginning 0)
|
|
(point-max))))))))
|
|
|
|
(defcli! (ci hook pre-push) (remote url)
|
|
"Run git pre-push hook.
|
|
|
|
Prevents pushing if there are unrebased or WIP commits."
|
|
(with-temp-buffer
|
|
(let ((z40 (make-string 40 ?0))
|
|
line error)
|
|
(while (setq line (ignore-errors (read-from-minibuffer "")))
|
|
(catch 'continue
|
|
(seq-let (local-ref local-sha remote-ref remote-sha)
|
|
(split-string line " ")
|
|
;; TODO Extract this branch detection to a variable
|
|
(unless (or (string-match-p "^refs/heads/\\(master\\|main\\)$" remote-ref)
|
|
(equal local-sha z40))
|
|
(throw 'continue t))
|
|
(print-group!
|
|
(mapc (lambda (commit)
|
|
(seq-let (hash msg) (split-string commit "\t")
|
|
(setq error t)
|
|
(print! (item "%S commit in %s"
|
|
(car (split-string msg " "))
|
|
(substring hash 0 12)))))
|
|
(split-string
|
|
(cdr (doom-call-process
|
|
"git" "rev-list"
|
|
"--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ")
|
|
"--format=%H\t%s"
|
|
(if (equal remote-sha z40)
|
|
local-sha
|
|
(format "%s..%s" remote-sha local-sha))))
|
|
"\n" t))
|
|
(when error
|
|
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
|
|
(exit! 1)))))))))
|
|
|
|
|
|
;;
|
|
;;; Helpers
|
|
|
|
(cl-defun doom-ci-enforce-scopeless-types (scope (&key type scopes summary &allow-other-keys))
|
|
"Complain about scoped commit types that shouldn't be scoped."
|
|
(when (memq type doom-ci-commit-scopeless-types)
|
|
(user-error "Scopes for %s commits should go after the colon, not before"
|
|
type)))
|
|
|
|
|
|
(defun doom-ci--parse-commit (commit-msg)
|
|
(with-temp-buffer
|
|
(save-excursion (insert commit-msg))
|
|
(append
|
|
(let ((end
|
|
(save-excursion
|
|
(if (re-search-forward "\n\\(\n[a-zA-Z-]+: [^ ][^\n]+\\)+\n*\\'" nil t)
|
|
(1+ (match-beginning 0))
|
|
(point-max)))))
|
|
`(:subject ,(buffer-substring (point-min) (line-end-position))
|
|
:body ,(string-trim-right (buffer-substring (line-beginning-position 3) end))
|
|
:trailers ,(save-match-data
|
|
(cl-loop with footer = (buffer-substring end (point-max))
|
|
for line in (split-string footer "\n" t)
|
|
if (string-match "^\\([a-zA-Z-]+\\): \\(.+\\)$" line)
|
|
collect (cons (match-string 1 line) (match-string 2 line))))))
|
|
(save-match-data
|
|
(when (looking-at "^\\([a-zA-Z0-9_-]+\\)\\(!?\\)\\(?:(\\([^)]+\\))\\)?: \\([^\n]+\\)")
|
|
`(:type ,(intern (match-string 1))
|
|
:bang ,(equal (match-string 2) "!")
|
|
:summary ,(match-string 4)
|
|
:scopes ,(ignore-errors (split-string (match-string 3) ",")))))
|
|
(save-excursion
|
|
(let ((bump-re "\\(\\(?:https?://.+\\|[^/ \n]+\\)/[^/ \n]+@[a-z0-9]\\{12\\}\\)")
|
|
bumps)
|
|
(while (re-search-forward (format "^\\s-*\\<%s -> %s\\>" bump-re bump-re) nil t)
|
|
(cond ((rassoc (match-string 1) bumps)
|
|
(setcdr (rassoc (match-string 1) bumps) (match-string 2)))
|
|
((assoc (match-string 2) bumps)
|
|
(setcar (assoc (match-string 2) bumps) (match-string 1)))
|
|
((setf (alist-get (match-string 1) bumps nil nil #'equal)
|
|
(match-string 2)))))
|
|
`(:bumps ,(cl-sort (delete-dups bumps) #'string-lessp :key #'car)))))))
|
|
|
|
(defun doom-ci--parse-bumps (from end)
|
|
(with-temp-buffer
|
|
(save-excursion
|
|
(insert
|
|
(cdr (doom-call-process "git" "log" "--format=full" "--grep=\\(bump\\|revert\\):"
|
|
(format "%s...%s" from end)))))
|
|
(save-match-data
|
|
(let (packages)
|
|
(while (let ((bump-re "\\(\\(?:https?://.+\\|[^/ ]+\\)/[^/ ]+@[a-z0-9]\\{12\\}\\)"))
|
|
(re-search-forward (format "^\\s-*\\<%s -> %s\\>" bump-re bump-re) nil t))
|
|
(cond ((rassoc (match-string 1) packages)
|
|
(setcdr (rassoc (match-string 1) packages) (match-string 2)))
|
|
((assoc (match-string 2) packages)
|
|
(setcar (assoc (match-string 2) packages) (match-string 1)))
|
|
((setf (alist-get (match-string 1) packages nil nil #'equal)
|
|
(match-string 2)))))
|
|
(cl-sort (delete-dups packages) #'string-lessp :key #'car)))))
|
|
|
|
(defun doom-ci--lint (commits)
|
|
(let ((warnings 0)
|
|
(failures 0))
|
|
(print! (start "Linting %d commits" (length commits)))
|
|
(print-group!
|
|
(pcase-dolist (`(,ref . ,commitmsg) commits)
|
|
(let* ((commit (doom-ci--parse-commit commitmsg))
|
|
(shortref (substring ref 0 7))
|
|
(subject (plist-get commit :subject)))
|
|
(cl-block 'linter
|
|
(letf! ((defun skip! (reason &rest args)
|
|
(print! (warn "Skipped because: %s") (apply #'format reason args))
|
|
(cl-return-from 'linter))
|
|
(defun warn! (reason &rest args)
|
|
(cl-incf warnings)
|
|
(print! (warn "%s") (apply #'format reason args)))
|
|
(defun fail! (reason &rest args)
|
|
(cl-incf failures)
|
|
(print! (error "%s") (apply #'format reason args))))
|
|
(print! (start "%s %s") shortref subject)
|
|
(print-group!
|
|
(mapc (doom-rpartial #'apply commit)
|
|
doom-ci-commit-rules)))))))
|
|
(let ((issues (+ warnings failures)))
|
|
(if (= issues 0)
|
|
(print! (success "There were no issues!"))
|
|
(if (> warnings 0) (print! (warn "Warnings: %d" warnings)))
|
|
(if (> failures 0) (print! (warn "Failures: %d" failures)))
|
|
(print! "\nSee https://discourse.doomemacs.org/git-conventions")
|
|
(unless (zerop failures)
|
|
(exit! 1)))
|
|
t)))
|
|
|
|
(provide 'doom-cli-ci)
|
|
;;; ci.el ends here
|