From f979d48e54a50740d41ea2898827b19ca493331e Mon Sep 17 00:00:00 2001 From: Steffen Beyer Date: Sat, 4 Apr 2026 13:30:48 +0200 Subject: [PATCH] Fix 8 bugs found by running gulie on the Guix source tree MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug 1: Config auto-discovery — load-config now walks CWD and parent directories for .gulie.sexp when no --config is given, matching the documented behavior. Added find-config helper. Bug 2: Compile-error messages garbled — the catch handler now properly destructures Guile exception args (subr fmt fmt-args . _) and uses apply+format instead of raw display, producing readable messages like "no code for module (guix licenses)" instead of "#f no code for module ~S ((guix licenses)) #f". Bug 3: --init template unreadable — generate-template now uses pretty-print instead of write, producing properly indented output. Bug 4: CLI options silently ignored — --pass, --disable, --rule, and --severity are now wired up in main and threaded into config as %pass, augmented disable list, enable list, and %min-severity respectively. Bug 5: enable/disable config keys never consulted — added filter-rules-by-config, used in run-line-rules and run-cst-rules. Bug 6: blank-lines rule spammed one diagnostic per excess line — changed trigger to fire once per group at the boundary. Bug 7: read-file-to-string slow — replaced line-by-line accumulation with get-string-all. Bug 8: No way to skip semantic pass — lint-file now respects %pass config key (surface/semantic/all) and %min-severity for filtering. --- .gitignore | 4 ++ gulie/cli.scm | 26 +++++++++++- gulie/compiler.scm | 26 ++++++++++-- gulie/config.scm | 29 +++++++++---- gulie/engine.scm | 91 +++++++++++++++++++++++++++-------------- gulie/rules/surface.scm | 4 +- 6 files changed, 136 insertions(+), 44 deletions(-) diff --git a/.gitignore b/.gitignore index 07cd09e..f6f6f0e 100644 --- a/.gitignore +++ b/.gitignore @@ -10,5 +10,9 @@ devenv.local.yaml # pre-commit .pre-commit-config.yaml +# Agents +/.pi/ + # Temporary +.gulie.sexp /refs/ diff --git a/gulie/cli.scm b/gulie/cli.scm index 26f475b..46f1b15 100644 --- a/gulie/cli.scm +++ b/gulie/cli.scm @@ -74,7 +74,6 @@ 0) ((option-ref options 'list-rules #f) - ;; Ensure rules are loaded (list-all-rules) 0) @@ -93,6 +92,31 @@ (let* ((config-path (option-ref options 'config #f)) (user-config (load-config config-path)) (config (merge-configs default-config user-config)) + ;; Wire up --pass + (pass-str (option-ref options 'pass #f)) + (config (if pass-str + (cons (cons '%pass (string->symbol pass-str)) config) + config)) + ;; Wire up --disable (add to existing disable list) + (cli-disable (option-ref options 'disable #f)) + (config (if cli-disable + (let* ((current (or (assq-ref config 'disable) '())) + (new (cons (string->symbol cli-disable) current))) + (cons (cons 'disable new) config)) + config)) + ;; Wire up --rule (single-rule mode: set enable to just that rule) + (cli-rule (option-ref options 'rule #f)) + (config (if cli-rule + (cons (cons 'enable (list (string->symbol cli-rule))) + config) + config)) + ;; Wire up --severity + (cli-severity (option-ref options 'severity #f)) + (config (if cli-severity + (cons (cons '%min-severity + (string->symbol cli-severity)) + config) + config)) (paths (if (null? rest) (list ".") rest)) (ignore-pats (config-ignore-patterns config)) (files (discover-scheme-files paths ignore-pats))) diff --git a/gulie/compiler.scm b/gulie/compiler.scm index 6b84c1f..ac52ea3 100644 --- a/gulie/compiler.scm +++ b/gulie/compiler.scm @@ -6,6 +6,7 @@ (define-module (gulie compiler) #:use-module (system base compile) + #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (gulie diagnostic) @@ -67,13 +68,32 @@ Returns a list of records." #:warning-level 3 #:env (make-fresh-user-module)))) (lambda (key . args) - ;; Compilation errors become diagnostics too + ;; Format the error message properly. + ;; Guile exceptions typically have args: (subr fmt fmt-args data) (let ((msg (call-with-output-string (lambda (p) (display key p) (display ": " p) - (for-each (lambda (a) (display a p) (display " " p)) - args))))) + (catch #t + (lambda () + (match args + ((subr fmt fmt-args . _) + (when subr + (display subr p) + (display ": " p)) + (if fmt-args + (apply format p fmt (if (list? fmt-args) + fmt-args + (list fmt-args))) + (display fmt p))) + (_ (for-each (lambda (a) + (display a p) (display " " p)) + args)))) + (lambda _ + ;; Fallback: just display the raw args + (for-each (lambda (a) + (display a p) (display " " p)) + args))))))) (set! diagnostics (cons (make-diagnostic file 1 0 'error 'compile-error msg #f) diagnostics)))))) diff --git a/gulie/config.scm b/gulie/config.scm index ae91ebf..e8cd3f4 100644 --- a/gulie/config.scm +++ b/gulie/config.scm @@ -5,7 +5,9 @@ (define-module (gulie config) #:use-module (srfi srfi-1) + #:use-module (ice-9 pretty-print) #:export (default-config + find-config load-config merge-configs config-ref @@ -90,14 +92,25 @@ (define (config-indent-rules config) (or (config-ref config 'indent-rules) '())) +(define (find-config start-dir) + "Search START-DIR and its ancestors for .gulie.sexp. Returns the +path if found, or #f." + (let lp ((dir start-dir)) + (let ((candidate (string-append dir "/.gulie.sexp"))) + (cond + ((file-exists? candidate) candidate) + ((string=? dir "/") #f) + (else (lp (dirname dir))))))) (define (load-config path) - "Load a .gulie.sexp config file at PATH. Returns an alist." - (if (and path (file-exists? path)) - (call-with-input-file path - (lambda (port) - (let ((data (read port))) - (if (list? data) data '())))) - '())) + "Load a .gulie.sexp config file at PATH. Returns an alist. +If PATH is #f, auto-discover by searching CWD and parent directories." + (let ((resolved (or path (find-config (getcwd))))) + (if (and resolved (file-exists? resolved)) + (call-with-input-file resolved + (lambda (port) + (let ((data (read port))) + (if (list? data) data '())))) + '()))) (define (merge-configs base override) "Merge OVERRIDE config on top of BASE. Override wins for scalar values; @@ -115,5 +128,5 @@ lists are replaced, not appended." (display ";;; gulie configuration\n" port) (display ";;; Place this file as .gulie.sexp in your project root.\n" port) (display ";;; All fields are optional — defaults are shown below.\n\n" port) - (write default-config port) + (pretty-print default-config port #:width 60 #:max-expr-width 50) (newline port)) diff --git a/gulie/engine.scm b/gulie/engine.scm index 7c2c8d3..d003e5d 100644 --- a/gulie/engine.scm +++ b/gulie/engine.scm @@ -6,7 +6,7 @@ (define-module (gulie engine) #:use-module (ice-9 ftw) - #:use-module (ice-9 rdelim) + #:use-module (ice-9 textual-ports) #:use-module (srfi srfi-1) #:use-module (gulie diagnostic) #:use-module (gulie rule) @@ -17,17 +17,37 @@ (define (read-file-to-string path) "Read entire file at PATH into a string." - (call-with-input-file path - (lambda (port) - (let lp ((acc '())) - (let ((line (read-line port))) - (if (eof-object? line) - (string-join (reverse acc) "\n") - (lp (cons line acc)))))))) + (call-with-input-file path get-string-all)) +(define (severity-rank sev) + "Return a numeric rank for severity: error=3, warning=2, info=1." + (case sev + ((error) 3) + ((warning) 2) + ((info) 1) + (else 0))) +(define (severity>=? sev min-sev) + "Is SEV at least as severe as MIN-SEV?" + (>= (severity-rank sev) (severity-rank min-sev))) +(define (filter-rules-by-config rules config) + "Filter RULES according to enable/disable lists in CONFIG. +If enable is non-empty, only those rules are kept. +Then any rules in disable are removed." + (let ((enabled (or (assq-ref config 'enable) '())) + (disabled (or (assq-ref config 'disable) '()))) + (let ((rules (if (null? enabled) + rules + (filter (lambda (r) + (memq (rule-name r) enabled)) + rules)))) + (if (null? disabled) + rules + (filter (lambda (r) + (not (memq (rule-name r) disabled))) + rules))))) (define (run-line-rules file lines config) "Run all line-type rules against LINES. Returns list of diagnostics." - (let ((line-rules (rules-of-type 'line)) + (let ((line-rules (filter-rules-by-config (rules-of-type 'line) config)) (diagnostics '()) (consecutive-blanks 0)) (when (not (null? line-rules)) @@ -52,7 +72,7 @@ (define (run-cst-rules file cst config) "Run all cst-type rules against CST. Returns list of diagnostics." - (let ((cst-rules (rules-of-type 'cst))) + (let ((cst-rules (filter-rules-by-config (rules-of-type 'cst) config))) (if (null? cst-rules) '() (append-map @@ -61,34 +81,45 @@ cst-rules)))) (define (lint-file file config) - "Lint a single FILE with CONFIG. Returns a sorted list of diagnostics." + "Lint a single FILE with CONFIG. Returns a sorted list of diagnostics. +CONFIG may contain '%pass with value 'surface, 'semantic, or 'all (default) +and '%min-severity with value 'error, 'warning, or 'info (default)." (let* ((text (read-file-to-string file)) (lines (string-split text #\newline)) + (pass (or (assq-ref config '%pass) 'all)) + (min-severity (or (assq-ref config '%min-severity) 'info)) (diagnostics '())) ;; Pass 1: line-based surface rules - (set! diagnostics (append (run-line-rules file lines config) - diagnostics)) - ;; Pass 1b: CST rules (if tokenizer is loaded) - ;; Dynamically check if tokenizer module is available - (let ((tok-mod (resolve-module '(gulie tokenizer) #:ensure #f))) - (when tok-mod - (let ((tokenize (module-ref tok-mod 'tokenize)) - (cst-mod (resolve-module '(gulie cst) #:ensure #f))) - (when cst-mod - (let* ((parse-cst (module-ref cst-mod 'parse-cst)) - (tokens (tokenize text file)) - (cst (parse-cst tokens))) - (set! diagnostics (append (run-cst-rules file cst config) - diagnostics))))))) + (when (memq pass '(all surface)) + (set! diagnostics (append (run-line-rules file lines config) + diagnostics)) + ;; Pass 1b: CST rules (if tokenizer is loaded) + (let ((tok-mod (resolve-module '(gulie tokenizer) #:ensure #f))) + (when tok-mod + (let ((tokenize (module-ref tok-mod 'tokenize)) + (cst-mod (resolve-module '(gulie cst) #:ensure #f))) + (when cst-mod + (let* ((parse-cst (module-ref cst-mod 'parse-cst)) + (tokens (tokenize text file)) + (cst (parse-cst tokens))) + (set! diagnostics (append (run-cst-rules file cst config) + diagnostics)))))))) ;; Pass 2: semantic rules (if compiler module is loaded) - (let ((comp-mod (resolve-module '(gulie compiler) #:ensure #f))) - (when comp-mod - (let ((compile-and-capture (module-ref comp-mod 'compile-and-capture-warnings))) - (set! diagnostics (append (compile-and-capture file text config) - diagnostics))))) + (when (memq pass '(all semantic)) + (let ((comp-mod (resolve-module '(gulie compiler) #:ensure #f))) + (when comp-mod + (let ((compile-and-capture (module-ref comp-mod 'compile-and-capture-warnings))) + (set! diagnostics (append (compile-and-capture file text config) + diagnostics)))))) ;; Filter suppressions (let ((suppressions (parse-suppressions text))) (set! diagnostics (filter-suppressions diagnostics suppressions))) + ;; Filter by minimum severity + (when (not (eq? min-severity 'info)) + (set! diagnostics + (filter (lambda (d) + (severity>=? (diagnostic-severity d) min-severity)) + diagnostics))) ;; Sort by location (sort diagnostics diagnostic consecutive max-blanks)) + (= consecutive (1+ max-blanks))) (list (make-diagnostic - file line-num 0 + file (- line-num max-blanks) 0 'warning 'blank-lines (format #f "more than ~a consecutive blank lines" max-blanks) #f))