code.consxy.com Git - wolf/blob - src/main/checker.lisp

   1 (in-package #:style-checker)
   2
   3 ; Rules
   4 ; - Elements in each form must be indented the same amount
   5 ; - No form longer than 50 lines
   6 ; - Top level multiline forms must be separated by exactly one space
   7 ; - No line longer than 120 characters
   8 ; - No use of unexported symbols in other packages
   9 ; - No tabs
  10 ; - Only one space between elements in a form on a single line
  11 ; - in-package must be first line in file unless file is package.lisp
  12 ; - No whitespace only lines
  13 ; - No empty lines at end of file
  14 ;
  15 ; Some thoughts
  16 ; - form starting reader macros will have to be hand added to this code
  17 ; - exceptions will eventually arise, and the rule file will have to be changed
  18 ; - the proper formatting of "loop" is weird
  19
  20 (define-condition check-failure nil ((msg :initarg :msg :reader check-failure-msg)
  21                                      (line-no :initarg :line-no :reader check-failure-line-no)
  22                                      (col-no :initarg :col-no :reader check-failure-col-no)))
  23
  24 (defvar *state* nil)
  25 (defvar *line-no* nil)
  26 (defvar *col-no* nil)
  27 (defvar *evaluators* nil)
  28
  29 (defun set-state (state)
  30  (when (not (find state (list :begin ; start of file
  31                               :normal
  32                         )))
  33   (error "Can't set state to ~A" state))
  34  (setf *state* state)
  35  nil)
  36
  37 (defmacro defevaluator (state match func)
  38  (let
  39   ((scanner (gensym)))
  40  `(let
  41    ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match))))
  42    (pushnew
  43     (list
  44      (lambda (state text)
  45       (and
  46        (eql ,state state)
  47        (or
  48         (and (symbolp text) (eql text ,match))
  49         (and ,scanner
  50              (stringp text)
  51              (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text)
  52               (and start end (= 0 start) (/= 0 end)))))))
  53      (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text))))
  54      ,func)
  55     *evaluators*))))
  56
  57 (defun evaluate (text)
  58 ; (if (string= "" text)
  59      (let
  60       ((evaluator (find-if (lambda (f) (funcall f *state* text)) *evaluators* :from-end t :key #'car)))
  61       (when (not evaluator) (error (make-condition 'check-failure :msg (format nil "Can't check in state ~S: ~S..." *state* (subseq text 0 (min (length text) 10))) :line-no *line-no* :col-no *col-no*)))
  62       (let
  63        ((problem (funcall (third evaluator))))
  64        (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))
  65        (let
  66         ((length-of-match (funcall (cadr evaluator) text)))
  67         (incf *col-no* length-of-match)
  68         (when (< 120 *col-no*) (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no *col-no*)))
  69         (evaluate (subseq text length-of-match))))));)
  70
  71 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  72  (with-open-file (str filename :element-type element-type)
  73   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  74
  75 (defun check-file (file)
  76  (set-state :begin)
  77  (setf *line-no* 0)
  78  (setf *col-no* 0)
  79  (handler-case
  80   (progn (evaluate (slurp-file file)) t)
  81   (check-failure (cf)
  82    (format t "In file ~A, Had an error: ~S at ~A:~A~%" (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))
  83    nil)))
  84
  85 (defun check-directory (dir)
  86  (every #'identity (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))))
  87
  88 (progn
  89  (setf *evaluators* nil)
  90  (defevaluator :begin "\\(in-package[^\\)]*\\)"
  91   (lambda ()
  92    (set-state :normal) nil))
  93  (defevaluator :begin ".*"
  94   (lambda ()
  95    "Must begin with in-package form")))