From: Frank Duncan Date: Fri, 14 Jan 2022 14:24:14 +0000 (-0600) Subject: Add ability to specify first line copyright notices X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=wolf;a=commitdiff_plain;h=d8636e889212a943adefc3837476bfb2efd23a7b Add ability to specify first line copyright notices --- diff --git a/README.md b/README.md index b7e06ac..a9a31c7 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,7 @@ If you like, you can [download it](https://consxy.com/wolf/releases/0.1/style-ch * Never have two empty lines in a row * Only one in-package per file * No hanging close parens +* If specified, a matching copyright notice must be at the top of the file ### Exceptions * comments diff --git a/docs/Reference.md b/docs/Reference.md index 24fb20d..bc2c8f5 100644 --- a/docs/Reference.md +++ b/docs/Reference.md @@ -14,26 +14,29 @@ This package walks over common lisp code to make sure it adheres to a set of syn #### Syntax: -**check-directory** _dir_ => _results_ +**check-directory** _dir_ _&key_ _copyright-notice_ => _results_ ```results::= result*``` #### Arguments and Values: _dir_---A directory to recurse into and check files +_copyright-notice_---A regex string _result_---A result as returned by check-file #### Description: _check-directory_ grabs all .lisp files in the tree under _dir_, and loads checks them all. +If _copyright-notice_ is included, then the first line must match the regular expression passed. + The results are then put together into a list which can be programatically evaluated. As opposed to pretty-print-check-directory, this function doesn't clutter up your standard out. ## Function **CHECK-FILE** #### Syntax: -**check-file** _file_ => _result_ +**check-file** _file_ _&key_ _copyright-notice_ => _result_ ```result::= success-result | failure-result``` ```success-result::= (:success filename)``` @@ -42,6 +45,7 @@ The results are then put together into a list which can be programatically evalu #### Arguments and Values: _file_---a pathname +_copyright-notice_---A regex string _filename_---the file this check was run on _msg_---a string containing the failure message _line-no_---an integer, the line number on which the failure appeared @@ -51,26 +55,32 @@ _col-no_---an integer, the column number on which the failure appeared _check-file_ runs all the checks against a file and returns as soon as the first style error is found. +If _copyright-notice_ is included, then the first line must match the regular expression passed. + #### Examples: ```(check-file #P"path/to/file.lisp")``` => ```(:success "path/to/file.lisp")``` ```(check-file #P"path/to/error.lisp")``` => ```(:failure "path/to/error.lisp" "File cannot end with empty line" 20 0)``` +```(check-file #P"path/to/error.lisp" :copyright-notice "; Copyright .* AGPL")``` => ```(:failure ...)``` ## Function **PRETTY-PRINT-CHECK-DIRECTORY** #### Syntax: -**pretty-print-check-directory** _dir_ => _success_ +**pretty-print-check-directory** _dir_ _&key_ _copyright-notice_ => _success_ #### Arguments and Values: _dir_---A directory to recurse into and check files +_copyright-notice_---A regex string _success_---T if there were no failures #### Description: _pretty-print-check-directory_ checks _dir_ for any errors, dumping them to output and returning a single flag. +If _copyright-notice_ is included, then the first line must match the regular expression passed. + Unlike check-directory, _pretty-print-check-directory_ is built for continuous integration, dumping errors to standard out and returning a singular result. #### Examples: diff --git a/resources/copyrightnotice.lisp b/resources/copyrightnotice.lisp new file mode 100644 index 0000000..adfb51f --- /dev/null +++ b/resources/copyrightnotice.lisp @@ -0,0 +1,2 @@ +; Copyright XXXX AGPL +(in-package #:nothing) diff --git a/src/main/wolf.lisp b/src/main/wolf.lisp index d6f60e3..776a535 100644 --- a/src/main/wolf.lisp +++ b/src/main/wolf.lisp @@ -18,7 +18,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *possible-states* - '(:begin ; start of file + '(:copyright-required + :begin ; start of file :normal ; normal processing :beginning-of-line :beginning-of-line-with-separator ; empty space in there @@ -36,27 +37,28 @@ (setf *state* state) nil) +(defun make-evaluator (eval-state match func) + (let + ((scanner (when (stringp match) (cl-ppcre:create-scanner match)))) + (list + (lambda (state text) + (and + (or (eql :all eval-state) (eql eval-state state)) + (or + (and (symbolp text) (eql text match)) + (and + scanner + (stringp text) + (multiple-value-bind (start end) (cl-ppcre:scan scanner text) + (and start end (= 0 start))))))) + (lambda (text) (nth-value 1 (cl-ppcre:scan scanner text))) + func))) + (defmacro defevaluator (state match func) (when (not (find state *possible-states*)) (error "~A is an invalid state" state)) (let ((scanner (gensym))) - `(let - ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match)))) - (pushnew - (list - (lambda (state text) - (and - (or (eql :all ,state) (eql ,state state)) - (or - (and (symbolp text) (eql text ,match)) - (and - ,scanner - (stringp text) - (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text) - (and start end (= 0 start))))))) - (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text)))) - ,func) - *evaluators*)))) + `(pushnew (make-evaluator ,state ,match ,func) *evaluators*))) (defun evaluate (text) (if (string= "" text) @@ -77,7 +79,10 @@ (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*))) (let ((length-of-match (funcall (cadr evaluator) text))) - (incf *col-no* length-of-match) + (if + (eql *col-no* :reset) + (setf *col-no* 0) + (incf *col-no* length-of-match)) (when (< 120 *col-no*) (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0))) (evaluate (subseq text length-of-match))))))) @@ -86,8 +91,35 @@ (with-open-file (str filename :element-type element-type) (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq))) -(defun check-file (file) - "CHECK-FILE FILE => RESULT +(defun check-file (file &key copyright-notice) + (cond + (copyright-notice (set-state :copyright-required)) + ((string= "package" (pathname-name file)) (set-state :normal)) + (t (set-state :begin))) + (setf *line-no* 0) + (setf *col-no* 0) + (setf *form-stack* nil) + (setf *form-ended-on-same-line* nil) + (when copyright-notice + (setf *evaluators* + (append *evaluators* + (list + (make-evaluator :copyright-required (format nil "~A\\n" copyright-notice) + (lambda () + (incf *line-no*) + (setf *col-no* :reset) + (if (string= "package" (pathname-name file)) + (set-state :normal) + (set-state :begin)))))))) + (handler-case + (progn + (evaluate (slurp-file file)) + (list :success file)) + (check-failure (cf) + (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))))) + +(setf (documentation 'check-file 'function) + "CHECK-FILE FILE &key COPYRIGHT-NOTICE => RESULT RESULT: SUCCESS-RESULT | FAILURE-RESULT SUCCESS-RESULT: (:success FILENAME) @@ -96,6 +128,7 @@ ARGUMENTS AND VALUES: FILE: a pathname + COPYRIGHT-NOTICE: A regex string FILENAME: the file this check was run on MSG: a string containing the failure message LINE-NO: an integer, the line number on which the failure appeared @@ -106,33 +139,24 @@ DESCRIPTION: CHECK-FILE runs all the checks against a file and returns as soon as the first style error is found. + If COPYRIGHT-NOTICE is included, then the first line must match the + regular expression passed. + EXAMPLES: (check-file #P\"path/to/file.lisp\") => (:success \"path/to/file.lisp\") - (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0)" + (check-file #P\"path/to/error.lisp\") => (:failure \"path/to/error.lisp\" \"File cannot end with empty line\" 20 0) + (check-file #P\"path/to/error.lisp\" :copyright-notice \"; Copyright .* AGPL\") => (:failure ...)") - (if (string= "package" (pathname-name file)) - (set-state :normal) - (set-state :begin)) - (setf *line-no* 0) - (setf *col-no* 0) - (setf *form-stack* nil) - (setf *form-ended-on-same-line* nil) - (handler-case - (progn - (evaluate (slurp-file file)) - (list :success file)) - (check-failure (cf) - (list :failure file (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))))) - -(defun check-directory (dir) - "CHECK-DIRECTORY DIR => RESULTS +(defun check-directory (dir &key copyright-notice) + "CHECK-DIRECTORY DIR &key COPYRIGHT-NOTICE => RESULTS RESULTS: RESULT* ARGUMENTS AND VALUES: DIR: A directory to recurse into and check files + COPYRIGHT-NOTICE: A regex string RESULT: A result as returned by check-file DESCRIPTION: @@ -140,10 +164,15 @@ DESCRIPTION: CHECK-DIRECTORY grabs all .lisp files in the tree under DIR, and loads checks them all. + If COPYRIGHT-NOTICE is included, then the first line must match the + regular expression passed. + The results are then put together into a list which can be programatically evaluated. As opposed to pretty-print-check-directory, this function doesn't clutter up your standard out." - (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))) + (mapcar + (lambda (file) (check-file file :copyright-notice copyright-notice)) + (directory (format nil "~A/**/*.lisp" dir)))) (defun any-failures (checks) (find :failure checks :key #'car)) @@ -158,12 +187,13 @@ DESCRIPTION: (with-open-file (str (second failure)) (loop :repeat (fourth failure) :do (read-line str)) (read-line str)) (+ (fifth failure) 2))) -(defun pretty-print-check-directory (dir) - "PRETTY-PRINT-CHECK-DIRECTORY DIR => SUCCESS +(defun pretty-print-check-directory (dir &key copyright-notice) + "PRETTY-PRINT-CHECK-DIRECTORY DIR &key COPYRIGHT-NOTICE => SUCCESS ARGUMENTS AND VALUES: DIR: A directory to recurse into and check files + COPYRIGHT-NOTICE: A regex string SUCCESS: T if there were no failures DESCRIPTION: @@ -171,6 +201,9 @@ DESCRIPTION: PRETTY-PRINT-CHECK-DIRECTORY checks DIR for any errors, dumping them to output and returning a single flag. + If COPYRIGHT-NOTICE is included, then the first line must match the + regular expression passed. + Unlike check-directory, PRETTY-PRINT-CHECK-DIRECTORY is built for continuous integration, dumping errors to standard out and returning a singular result. @@ -178,7 +211,7 @@ EXAMPLES: (pretty-print-check-directory \"src\") => nil" (let - ((checks (check-directory dir))) + ((checks (check-directory dir :copyright-notice copyright-notice))) (format t "In ~A: Checked ~A files with ~A failures~%~%" dir (length checks) (length (remove :success checks :key #'car))) (format t "~{~A~%~}" (mapcar #'print-failure (remove :success checks :key #'car))) @@ -212,6 +245,7 @@ EXAMPLES: (defevaluator :all "\\t" (constantly "Must not use tabs")) (defevaluator :begin "\\(in-package[^\\)]*\\)" (lambda () (set-state :normal))) +(defevaluator :copyright-required "\\(in-package[^\\)]*\\)" (constantly "Must begin with specified copyright notice")) (defevaluator :beginning-of-line-with-separator :eof (lambda () @@ -220,6 +254,8 @@ EXAMPLES: (defevaluator :beginning-of-line-with-separator "\\n" (constantly "Must not have two empty lines in a row")) +(defevaluator :copyright-required ".*" (constantly "Must begin with specified copyright notice")) + (defevaluator :begin ".*" (constantly "Must begin with in-package form")) (defevaluator :all "\\( *in-package " (constantly "Only one in-package per file")) @@ -227,13 +263,13 @@ EXAMPLES: (defevaluator :normal "\\n" (lambda () (incf *line-no*) - (setf *col-no* -1) + (setf *col-no* :reset) (set-state :beginning-of-line))) (defevaluator :comment-with-separator "\\n" (lambda () (incf *line-no*) - (setf *col-no* -1) + (setf *col-no* :reset) (set-state :beginning-of-line-with-comment-and-separator) nil)) @@ -247,7 +283,7 @@ EXAMPLES: (lambda () (progn (incf *line-no*) - (setf *col-no* -1) + (setf *col-no* :reset) (set-state :beginning-of-line-with-separator)))) (defevaluator :beginning-of-line-with-comment-and-separator " *" @@ -260,7 +296,7 @@ EXAMPLES: "No whitespace only lines" (progn (incf *line-no*) - (setf *col-no* -1) + (setf *col-no* :reset) (set-state :beginning-of-line-with-separator))))) (defevaluator :beginning-of-symbols "\\)" (constantly "No hanging close parens")) @@ -298,7 +334,7 @@ EXAMPLES: (defevaluator :in-string "\\n" (lambda () (incf *line-no*) - (setf *col-no* -1) + (setf *col-no* :reset) nil)) (defevaluator :in-string "." (constantly nil)) diff --git a/src/test/main.lisp b/src/test/main.lisp index e1176db..a63e2f8 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -2,13 +2,13 @@ (defvar *tests* nil) -(defmacro deftest (filename success &optional msg line-no col-no) +(defmacro deftest (filename success &optional msg line-no col-no copyright-notice) `(push (lambda () (let ((green (format nil "~c[1;32m" #\Esc)) (red (format nil "~c[1;31m" #\Esc)) - (result (wolf:check-file ,filename))) + (result (wolf:check-file ,filename :copyright-notice ,copyright-notice))) (cond ((not (eql ,success (car result))) (format t "~A- ~A failed, expected ~A and got ~A~c[0m~%" @@ -55,3 +55,6 @@ (deftest #P"resources/unspacedforms.lisp" :failure "Multiline top level forms must be separated by a space" 4 0) (deftest #P"resources/whitespaceendline.lisp" :failure "No whitespace at end of line" 4 106) (deftest #P"resources/whitespacelines.lisp" :failure "No whitespace only lines" 1 1) +(deftest #P"resources/copyrightnotice.lisp" :success nil nil nil "; Copyright XXXX AGPL") +(deftest #P"resources/copyrightnotice.lisp" :failure "Must begin with in-package form" 0 0) +(deftest #P"resources/package.lisp" :failure "Must begin with specified copyright notice" 0 0 "; Copyright XXXX AGPL")