tribes/gulie
1
0
Fork 0
Code Issues Pull Requests Releases Activity

Fix 8 bugs found by running gulie on the Guix source tree

Browse Source 
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.
This commit is contained in:
Steffen
2026-04-04 13:30:48 +02:00
parent e3e28a911a
commit f979d48e54
6 changed files with 136 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@@ -10,5 +10,9 @@ devenv.local.yaml
# pre-commit
.pre-commit-config.yaml
# Agents
/.pi/
# Temporary
.gulie.sexp
/refs/

26
gulie/cli.scm
View File

@@ -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)))

26
gulie/compiler.scm
View File

@@ -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 <diagnostic> 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))))))

23
gulie/config.scm
View File

@@ -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
"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))

59
gulie/engine.scm
View File

@@ -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,15 +81,19 @@
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
(when (memq pass '(all surface))
(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))
@@ -79,16 +103,23 @@
(tokens (tokenize text file))
(cst (parse-cst tokens)))
(set! diagnostics (append (run-cst-rules file cst config)
diagnostics)))))))
diagnostics))))))))
;; Pass 2: semantic rules (if compiler module is loaded)
(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)))))
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<?)))

4
gulie/rules/surface.scm
View File

@@ -83,9 +83,9 @@
(let ((max-blanks (or (assq-ref config 'max-blank-lines) 2))
(consecutive (or (assq-ref config '%consecutive-blanks) 0)))
(if (and (string-every char-whitespace? line-text)
(> 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))