;;; Tests for (gulie engine) — rule filtering, pass control, severity, fix mode

(use-modules (srfi srfi-64)
             (srfi srfi-1)
             (ice-9 textual-ports)
             (gulie engine)
             (gulie rule)
             (gulie config)
             (gulie diagnostic)
             (gulie rules surface)
             (gulie rules comments))

(test-begin "engine")

;;; filter-rules-by-config

(test-group "filter-rules-by-config"
  (let ((all-rules (all-rules)))
    ;; With empty enable/disable, all rules pass through
    (test-equal "empty config keeps all rules"
      (length all-rules)
      (length ((@@ (gulie engine) filter-rules-by-config)
               all-rules '())))

    ;; Enable only one rule
    (let ((filtered ((@@ (gulie engine) filter-rules-by-config)
                     all-rules '((enable trailing-whitespace)))))
      (test-equal "enable filters to one" 1 (length filtered))
      (test-eq "correct rule kept" 'trailing-whitespace
        (rule-name (car filtered))))

    ;; Disable one rule
    (let* ((before (length all-rules))
           (filtered ((@@ (gulie engine) filter-rules-by-config)
                      all-rules '((disable trailing-whitespace)))))
      (test-equal "disable removes one" (1- before) (length filtered))
      (test-assert "disabled rule absent"
        (not (find (lambda (r) (eq? (rule-name r) 'trailing-whitespace))
                   filtered))))

    ;; Enable + disable
    (let ((filtered ((@@ (gulie engine) filter-rules-by-config)
                     all-rules '((enable trailing-whitespace no-tabs)
                                 (disable no-tabs)))))
      (test-equal "enable then disable" 1 (length filtered))
      (test-eq "only non-disabled remains" 'trailing-whitespace
        (rule-name (car filtered))))))

;;; severity filtering

(test-group "severity-helpers"
  (test-assert "error >= warning"
    ((@@ (gulie engine) severity>=?) 'error 'warning))
  (test-assert "warning >= warning"
    ((@@ (gulie engine) severity>=?) 'warning 'warning))
  (test-assert "warning >= info"
    ((@@ (gulie engine) severity>=?) 'warning 'info))
  (test-assert "info not >= warning"
    (not ((@@ (gulie engine) severity>=?) 'info 'warning))))

;;; lint-file with pass control

(test-group "lint-file-pass-surface"
  ;; Create a temp file with issues
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 42)  \n" p)))  ;; trailing whitespace
    (let ((diags (lint-file tmp '((%pass . surface)))))
      (test-assert "finds trailing whitespace"
        (any (lambda (d) (eq? (diagnostic-rule d) 'trailing-whitespace))
             diags))
      ;; Should NOT have compile-error since semantic pass is skipped
      (test-assert "no compile errors in surface mode"
        (not (any (lambda (d) (eq? (diagnostic-rule d) 'compile-error))
                  diags))))
    (delete-file tmp)))

(test-group "lint-file-severity-filter"
  (let ((tmp (tmpnam)))
    ;; Single ; on own line (info) + trailing whitespace (warning)
    (call-with-output-file tmp
      (lambda (p) (display " ; comment  \n" p)))
    (let ((all-diags (lint-file tmp '((%pass . surface))))
          (warn-diags (lint-file tmp '((%pass . surface)
                                       (%min-severity . warning)))))
      (test-assert "all includes info"
        (any (lambda (d) (eq? (diagnostic-severity d) 'info)) all-diags))
      (test-assert "warning filter excludes info"
        (not (any (lambda (d) (eq? (diagnostic-severity d) 'info))
                  warn-diags)))
      (test-assert "warning filter keeps warnings"
        (any (lambda (d) (eq? (diagnostic-severity d) 'warning))
             warn-diags)))
    (delete-file tmp)))

(test-group "lint-file-disable-rule"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 42)  \n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)
                                  (disable trailing-whitespace)))))
      (test-assert "disabled rule produces no diagnostics"
        (not (any (lambda (d) (eq? (diagnostic-rule d) 'trailing-whitespace))
                  diags))))
    (delete-file tmp)))

;;; Fix mode

(test-group "fix-trailing-whitespace"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 42)  \n(define y 99)\n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "trailing whitespace removed"
        (not (string-contains result "42)  ")))
      (test-assert "content preserved"
        (string-contains result "(define x 42)")))
    (delete-file tmp)))

(test-group "fix-comment-semicolons"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "  ; bad comment\n  ;; good comment\n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "single ; fixed to ;;"
        (string-contains result "  ;; bad comment"))
      (test-assert "double ;; preserved"
        (string-contains result "  ;; good comment")))
    (delete-file tmp)))

(test-group "fix-no-tabs"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "\t(define x 1)\n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "tab replaced with spaces"
        (not (string-index result #\tab)))
      (test-assert "8-space expansion"
        (string-prefix? "        (define x 1)" result)))
    (delete-file tmp)))

(test-group "fix-tabs-with-alignment"
  ;; Tab at column 6 should expand to 2 spaces (next tab stop at 8)
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "abcdef\tg\n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "tab expanded"
        (not (string-index result #\tab)))
      (test-assert "correct expansion"
        (string-contains result "abcdef  g")))
    (delete-file tmp)))

(test-group "fix-blank-lines"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 1)\n\n\n\n\n(define y 2)\n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)
                                  (max-blank-lines . 2)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let* ((result (call-with-input-file tmp get-string-all))
           (lines (string-split result #\newline)))
      ;; Should have: (define x 1), 2 blanks, (define y 2) = 5 lines
      ;; Original: (define x 1), 4 blanks, (define y 2) = 7 lines (incl final)
      (test-assert "excess blank lines removed"
        (<= (length lines) 5)))
    (delete-file tmp)))

(test-group "fix-composition-tabs-and-trailing"
  ;; Line with BOTH tabs and trailing whitespace
  ;; Should fix both in a single pass
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "\t(define x 1)  \n" p)))
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "no tabs remain"
        (not (string-index result #\tab)))
      (test-assert "no trailing whitespace"
        (not (string-suffix? "  " (car (string-split result #\newline)))))
      (test-assert "content preserved"
        (string-contains result "(define x 1)")))
    (delete-file tmp)))

(test-group "fix-idempotent"
  ;; Running fix twice should produce the same result.
  ;; Note: when multiple fix types target the same line (tabs + trailing
  ;; whitespace + comment semicolons), convergence may take 2 passes.
  ;; This test uses a case that converges in one pass.
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 1)  \n\n\n\n\n(define y 2)\n" p)))
    ;; First fix
    (let ((diags (lint-file tmp '((%pass . surface)
                                  (max-blank-lines . 1)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((after-first (call-with-input-file tmp get-string-all)))
      ;; Second fix — should change nothing
      (let ((diags (lint-file tmp '((%pass . surface)
                                    (max-blank-lines . 1)))))
        ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
      (let ((after-second (call-with-input-file tmp get-string-all)))
        (test-equal "second fix is idempotent" after-first after-second)))
    (delete-file tmp)))

(test-group "fix-multi-pass-convergence"
  ;; Line with tabs + trailing whitespace + single semicolon:
  ;; may need 2 fix passes since 3 fixes compete for the same line.
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "\t; comment  \n" p)))
    ;; Pass 1
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    ;; Pass 2
    (let ((diags (lint-file tmp '((%pass . surface)))))
      ((@@ (gulie engine) apply-fixes-to-file) tmp diags))
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "tabs removed after 2 passes"
        (not (string-index result #\tab)))
      (test-assert "trailing whitespace removed"
        (not (string-contains result "  \n")))
      (test-assert "semicolon fixed to ;;"
        (string-contains result ";; comment")))
    (delete-file tmp)))

;;; Compile-error message formatting

(test-group "compile-error-formatting"
  ;; Compile a file that references a non-existent module
  (let ((diags ((@@ (gulie compiler) compile-and-capture-warnings)
                "test.scm"
                "(use-modules (nonexistent module))\n(define x 1)\n"
                '())))
    (let ((errors (filter (lambda (d) (eq? (diagnostic-severity d) 'error))
                          diags)))
      (test-assert "has compile error" (not (null? errors)))
      (let ((msg (diagnostic-message (car errors))))
        (test-assert "no raw format specifiers in message"
          (not (string-contains msg "~S")))
        (test-assert "no raw format specifiers ~A"
          (not (string-contains msg "~A")))
        (test-assert "contains module name"
          (string-contains msg "nonexistent"))))))

;;; Integration: lint-files with fix mode

(test-group "lint-files-fix-mode"
  (let ((tmp (tmpnam)))
    (call-with-output-file tmp
      (lambda (p) (display "(define x 42)  \n  ; comment\n" p)))
    (let ((count (lint-files (list tmp)
                             '((%pass . surface) (%fix . #t)))))
      ;; After fix, only unfixable diagnostics should be counted
      (test-equal "no unfixable issues" 0 count))
    ;; Verify file was actually modified
    (let ((result (call-with-input-file tmp get-string-all)))
      (test-assert "trailing whitespace fixed"
        (not (string-contains result "42)  ")))
      (test-assert "comment fixed"
        (string-contains result ";; comment")))
    (delete-file tmp)))

(test-end "engine")