;;; Tests for rule modules

(use-modules (srfi srfi-64)
             (srfi srfi-1)
             (gulie rule)
             (gulie diagnostic)
             (gulie rules surface)
             (gulie rules comments))

(test-begin "rules")

;;; Surface rules

(test-group "trailing-whitespace"
  (let ((rule (find-rule 'trailing-whitespace)))
    (test-assert "rule registered" rule)

    (test-equal "clean line produces no diagnostics"
      '()
      ((rule-check-proc rule) "f.scm" 1 "(define x 42)" '()))

    (let ((diags ((rule-check-proc rule) "f.scm" 1 "(define x 42)  " '())))
      (test-equal "trailing spaces detected" 1 (length diags))
      (test-equal "correct column"
        (string-length "(define x 42)")
        (diagnostic-column (car diags))))

    (test-equal "empty line no diagnostic"
      '()
      ((rule-check-proc rule) "f.scm" 1 "" '()))))

(test-group "line-length"
  (let ((rule (find-rule 'line-length)))
    (test-assert "rule registered" rule)

    (test-equal "short line ok"
      '()
      ((rule-check-proc rule) "f.scm" 1 "(define x 42)" '()))

    (let* ((long-line (make-string 119 #\x))
           (diags ((rule-check-proc rule) "f.scm" 1 long-line '())))
      (test-equal "long line detected" 1 (length diags)))

    (let* ((config '((line-length . 120)))
           (line (make-string 100 #\x))
           (diags ((rule-check-proc rule) "f.scm" 1 line config)))
      (test-equal "respects config" 0 (length diags)))))

(test-group "no-tabs"
  (let ((rule (find-rule 'no-tabs)))
    (test-assert "rule registered" rule)

    (test-equal "no tabs ok"
      '()
      ((rule-check-proc rule) "f.scm" 1 "  (define x 1)" '()))

    (let ((diags ((rule-check-proc rule) "f.scm" 1 "\t(define x 1)" '())))
      (test-equal "tab detected" 1 (length diags)))))

(test-group "blank-lines"
  (let ((rule (find-rule 'blank-lines)))
    (test-assert "rule registered" rule)

    (test-equal "normal blank ok"
      '()
      ((rule-check-proc rule) "f.scm" 5 ""
       '((max-blank-lines . 2) (%consecutive-blanks . 1))))

    (let ((diags ((rule-check-proc rule) "f.scm" 5 ""
                  '((max-blank-lines . 2) (%consecutive-blanks . 3)))))
      (test-equal "excessive blanks detected" 1 (length diags)))))

;;; Comment rules

(test-group "comment-semicolons"
  (let ((rule (find-rule 'comment-semicolons)))
    (test-assert "rule registered" rule)

    (test-equal "double semicolon on own line ok"
      '()
      ((rule-check-proc rule) "f.scm" 1 "  ;; good comment" '()))

    ;; Single semicolon on own line
    (let ((diags ((rule-check-proc rule) "f.scm" 1 "  ; bad comment" '())))
      (test-equal "single ; on own line flagged" 1 (length diags)))))

;;; Diagnostic formatting

(test-group "diagnostic-format"
  (let ((d (make-diagnostic "foo.scm" 10 5 'warning 'test-rule "oops" #f)))
    (test-equal "format matches expected"
      "foo.scm:10:5: warning: test-rule: oops"
      (format-diagnostic d))))

(test-group "diagnostic-sorting"
  (let ((d1 (make-diagnostic "a.scm" 10 0 'warning 'r "m" #f))
        (d2 (make-diagnostic "a.scm" 5 0 'warning 'r "m" #f))
        (d3 (make-diagnostic "b.scm" 1 0 'warning 'r "m" #f)))
    (let ((sorted (sort (list d1 d2 d3) diagnostic<?)))
      (test-equal "first is a.scm:5" 5 (diagnostic-line (car sorted)))
      (test-equal "second is a.scm:10" 10 (diagnostic-line (cadr sorted)))
      (test-equal "third is b.scm" "b.scm" (diagnostic-file (caddr sorted))))))

(test-end "rules")