You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
312 lines
14 KiB
312 lines
14 KiB
#!/usr/bin/env tclsh |
|
# goals_lint.tcl - lint the two-tier goals documentation |
|
# (root GOALS.md / GOALS-archive.md indexes + goals/ / goals/archive/ detail files) |
|
# |
|
# Validates the contracts declared in goals/AGENTS.md and root AGENTS.md: |
|
# - detail-file header grammar: '# G-<id> <title>' then a blank line, then |
|
# Status:/Scope:/Goal:/Acceptance: exactly once each, in order, one line each, |
|
# before any '## section'; no prose riding a header field |
|
# - Status: values are exactly one of proposed|active|abandoned|superseded or |
|
# 'achieved YYYY-MM-DD' |
|
# - active-tree detail files are not 'achieved'; archive detail files are |
|
# - no orphans: every goals/*.md detail file has a GOALS.md index entry and vice |
|
# versa; every goals/archive/*.md file has a GOALS-archive.md record and vice versa |
|
# - Status:/Scope: mirror lines in detail files match the owning index entry |
|
# - Scope delimiter grammar (v2): elements separated by '; ' at top level; |
|
# commas legal only inside parens/braces (sub-lists, brace globs) |
|
# Informational (stderr, never fatal): stale references to archived goals lacking |
|
# an achieved/archive marker; references to goal IDs present in neither index |
|
# (dangling); stale versioned path references (goals-system v3) - a live-tier |
|
# reference to a version-suffixed filename that does NOT exist while a same-stem |
|
# sibling exists at a different version is almost certainly version drift |
|
# (manually-versioned module bumps, magic-scheme conversions, stamped |
|
# bootsupport/vendored copies renamed at promotion). Genuinely future artifacts |
|
# have no versioned stem-sibling and stay quiet; exists-but-not-current series |
|
# references (an old vendored version still on disk) are deliberately not |
|
# judged. For relationship analysis (scope overlap vs cross-references) |
|
# see the sibling goals_xref.tcl. |
|
# |
|
# Plain tclsh (8.6+ or 9), no package dependencies - runnable from any checkout: |
|
# tclsh scriptlib/developer/goals_lint.tcl [repo-root] |
|
# Exit 0 when clean; exit 1 with one 'path: problem' line per finding. |
|
|
|
set root [expr {$argc >= 1 ? [lindex $argv 0] : [file dirname [file dirname [file dirname [file normalize [info script]]]]]}] |
|
if {![file isfile [file join $root GOALS.md]] || ![file isdir [file join $root goals]]} { |
|
puts stderr "goals_lint: '$root' does not look like the punkshell repo root (need GOALS.md and goals/)" |
|
exit 2 |
|
} |
|
|
|
set findings {} |
|
proc flag {path msg} { |
|
global findings |
|
lappend findings "$path: $msg" |
|
} |
|
|
|
set status_re {^(proposed|active|abandoned|superseded|achieved \d{4}-\d{2}-\d{2})$} |
|
|
|
# Scope delimiter grammar (v2): elements are separated by '; ' at top level; |
|
# commas are legal only inside parens/braces (sub-lists, brace globs). |
|
# One finding per line, at the first offending comma. |
|
proc lint_scope_commas {relpath where scope} { |
|
set depth 0 |
|
set n [string length $scope] |
|
for {set i 0} {$i < $n} {incr i} { |
|
set c [string index $scope $i] |
|
if {$c eq "(" || $c eq "\{"} { incr depth; continue } |
|
if {$c eq ")" || $c eq "\}"} { incr depth -1; continue } |
|
if {$c eq "," && $depth == 0} { |
|
flag $relpath "top-level comma in Scope$where - separate elements with '; ' (wrap prose sub-lists in parens)" |
|
return |
|
} |
|
} |
|
} |
|
|
|
proc read_lines {path} { |
|
set f [open $path r] |
|
fconfigure $f -encoding utf-8 |
|
set lines [split [read $f] \n] |
|
close $f |
|
return $lines |
|
} |
|
|
|
# --- parse an index file (GOALS.md or GOALS-archive.md) --------------------- |
|
# returns dict: id -> {status <s> title <t> scope <scope-or-empty>} |
|
proc parse_index {path} { |
|
global status_re |
|
set entries [dict create] |
|
set relpath [file tail $path] |
|
set curid "" |
|
foreach line [read_lines $path] { |
|
if {[regexp {^### G-(\d+) \[([^\]]*)\] (.*)$} $line -> id status title]} { |
|
set curid $id |
|
if {[dict exists $entries $id]} { |
|
flag $relpath "duplicate index entry G-$id" |
|
} |
|
if {![regexp $status_re $status]} { |
|
flag $relpath "G-$id: bad status '\[$status\]' (want proposed|active|abandoned|superseded|achieved YYYY-MM-DD)" |
|
} |
|
dict set entries $id [dict create status $status title $title scope ""] |
|
} elseif {[regexp {^### } $line]} { |
|
set curid "" |
|
} elseif {$curid ne "" && [regexp {^Scope: (.*)$} $line -> scope]} { |
|
lint_scope_commas $relpath " (G-$curid)" $scope |
|
dict set entries $curid scope $scope |
|
} |
|
} |
|
return $entries |
|
} |
|
|
|
# --- lint one detail file ---------------------------------------------------- |
|
# returns dict {id <id> status <s> scope <s>} (empty strings when unparseable) |
|
proc lint_detail {path relpath} { |
|
global status_re |
|
set lines [read_lines $path] |
|
set fname [file tail $path] |
|
set result [dict create id "" status "" scope ""] |
|
|
|
if {![regexp {^G-(\d+)-[a-z0-9-]+\.md$} $fname -> fid]} { |
|
flag $relpath "filename does not match G-<id>-<slug>.md" |
|
set fid "" |
|
} |
|
dict set result id $fid |
|
|
|
if {![regexp {^# G-(\d+) .+$} [lindex $lines 0] -> hid]} { |
|
flag $relpath "line 1 is not '# G-<id> <title>'" |
|
set hid "" |
|
} |
|
if {$fid ne "" && $hid ne "" && $hid ne $fid} { |
|
flag $relpath "title-line id G-$hid does not match filename id G-$fid" |
|
} |
|
if {[lindex $lines 1] ne ""} { |
|
flag $relpath "line 2 is not blank" |
|
} |
|
|
|
# header fields: Status/Scope/Goal/Acceptance exactly once each, in order, |
|
# before the first '## ' section |
|
set want {Status Scope Goal Acceptance} |
|
set found [dict create] |
|
set order {} |
|
set i 2 |
|
foreach line [lrange $lines 2 end] { |
|
incr i |
|
if {[regexp {^## } $line]} break |
|
if {[regexp {^(Status|Scope|Goal|Acceptance): ?(.*)$} $line -> field value]} { |
|
if {[dict exists $found $field]} { |
|
flag $relpath "duplicate header field '$field:' (line $i)" |
|
} else { |
|
dict set found $field $value |
|
lappend order $field |
|
} |
|
if {$value eq ""} { |
|
flag $relpath "empty header field '$field:' (line $i)" |
|
} |
|
if {$field eq "Scope"} { |
|
lint_scope_commas $relpath "" $value |
|
} |
|
} |
|
} |
|
foreach field $want { |
|
if {![dict exists $found $field]} { |
|
flag $relpath "missing header field '$field:'" |
|
} |
|
} |
|
if {[llength $order] == 4 && $order ne $want} { |
|
flag $relpath "header fields out of order ([join $order /] - want [join $want /])" |
|
} |
|
|
|
if {[dict exists $found Status]} { |
|
set status [dict get $found Status] |
|
dict set result status $status |
|
if {![regexp $status_re $status]} { |
|
flag $relpath "bad Status line 'Status: $status' - must be exactly proposed|active|abandoned|superseded or 'achieved YYYY-MM-DD' with no additional prose (verification evidence belongs in ## Progress / ## Notes)" |
|
} |
|
} |
|
if {[dict exists $found Scope]} { |
|
dict set result scope [dict get $found Scope] |
|
} |
|
return $result |
|
} |
|
|
|
# --- run ---------------------------------------------------------------------- |
|
set active_index [parse_index [file join $root GOALS.md]] |
|
set archive_index [parse_index [file join $root GOALS-archive.md]] |
|
|
|
foreach {dir index indexname achieved_expected} [list \ |
|
goals $active_index GOALS.md 0 \ |
|
[file join goals archive] $archive_index GOALS-archive.md 1] { |
|
set seen [dict create] |
|
foreach path [lsort [glob -nocomplain -directory [file join $root $dir] G-*.md]] { |
|
set relpath [string map {\\ /} [file join $dir [file tail $path]]] |
|
set info [lint_detail $path $relpath] |
|
set id [dict get $info id] |
|
if {$id eq ""} continue |
|
dict set seen $id 1 |
|
set achieved [string match "achieved *" [dict get $info status]] |
|
if {$achieved_expected && !$achieved && [dict get $info status] ne ""} { |
|
flag $relpath "archived detail file Status is '[dict get $info status]' - archive/ holds achieved goals only" |
|
} elseif {!$achieved_expected && $achieved} { |
|
flag $relpath "achieved goal still in goals/ - the achieved flip includes archiving (move to goals/archive/, record in GOALS-archive.md)" |
|
} |
|
if {![dict exists $index $id]} { |
|
flag $relpath "orphan detail file - no G-$id entry in $indexname" |
|
continue |
|
} |
|
set entry [dict get $index $id] |
|
if {[dict get $info status] ne "" && [dict get $info status] ne [dict get $entry status]} { |
|
flag $relpath "Status mirror '[dict get $info status]' disagrees with $indexname '\[[dict get $entry status]\]' (index wins)" |
|
} |
|
if {[dict get $info scope] ne "" && [dict get $entry scope] ne "" \ |
|
&& [dict get $info scope] ne [dict get $entry scope]} { |
|
flag $relpath "Scope mirror disagrees with $indexname (index wins)" |
|
} |
|
} |
|
foreach id [dict keys $index] { |
|
if {![dict exists $seen $id]} { |
|
flag $indexname "G-$id has no detail file in $dir/" |
|
} |
|
} |
|
} |
|
|
|
# --- informational: candidate stale references to archived goals --------------- |
|
# An active detail file mentioning an archived goal with no achieved/archive/landed |
|
# marker on ANY of the mentioning lines has likely missed the archive-time reference |
|
# sweep (goals/AGENTS.md Archive rules) - a reader cannot tell the referenced goal is |
|
# done. One marked mention per file suffices; pure-history mentions on other lines |
|
# are fine. Heuristic - reported as warnings, never fatal. |
|
# Also informational: references to goal IDs present in NEITHER index (dangling |
|
# references - typos, or pointers at goals that were never drafted). |
|
set warnings {} |
|
foreach path [lsort [glob -nocomplain -directory [file join $root goals] G-*.md]] { |
|
set relpath goals/[file tail $path] |
|
set mentioned [dict create] ;# id -> 1 when any mentioning line carries a marker |
|
set unknown [dict create] ;# id -> 1 when in neither index |
|
set lines [read_lines $path] |
|
set n [llength $lines] |
|
for {set i 0} {$i < $n} {incr i} { |
|
set line [lindex $lines $i] |
|
# marker may sit on the mention line or a wrapped neighbour |
|
set window "$line [lindex $lines [expr {$i-1}]] [lindex $lines [expr {$i+1}]]" |
|
set marked [regexp -nocase {achieved|archive|landed} $window] |
|
foreach id [regexp -all -inline {G-\d+} $line] { |
|
set num [string range $id 2 end] |
|
if {![dict exists $active_index $num] && ![dict exists $archive_index $num]} { |
|
dict set unknown $num 1 |
|
continue |
|
} |
|
if {![dict exists $archive_index $num]} continue |
|
if {$marked || ![dict exists $mentioned $num]} { |
|
dict set mentioned $num $marked |
|
} |
|
} |
|
} |
|
dict for {num marked} $mentioned { |
|
if {!$marked} { |
|
lappend warnings "$relpath: references archived goal G-$num with no achieved/archive marker anywhere - reference sweep candidate (goals/AGENTS.md Archive rules)" |
|
} |
|
} |
|
dict for {num _} $unknown { |
|
lappend warnings "$relpath: references G-$num - no such goal in GOALS.md or GOALS-archive.md (dangling reference)" |
|
} |
|
} |
|
|
|
# --- informational: stale versioned path references (stem-sibling repair) ------- |
|
# Version-suffixed filename references drift by construction: manually-versioned |
|
# modules rename at every bump (libunknown-<ver>.tm), modules convert to the magic |
|
# scheme, and bootsupport/vendored copies rename at every promotion/re-vendor. A |
|
# missing referenced file WITH a same-stem sibling on disk is high-confidence |
|
# drift - the warning names the sibling(s) as the suggested repair. A missing file |
|
# with NO sibling is silent (proposed goals legitimately name future artifacts). |
|
# Scanned: GOALS.md + live goals/G-*.md, full text (Scope lines are the contract |
|
# surface; body prose drifts the same way). Skipped: the archive tier |
|
# (point-in-time records), URLs, absolute/out-of-repo paths, glob references, and |
|
# the magic dev version 999999.0a1.0 (a stable name by design). Warnings only - |
|
# Scope lines are contract text, so the fix stays a directed edit. |
|
proc vdrift_glob_escape {s} { |
|
return [string map {\\ \\\\ * \\* ? \\? [ \\[ ] \\]} $s] |
|
} |
|
set vdrift_files [list [file join $root GOALS.md]] |
|
foreach p [lsort [glob -nocomplain -directory [file join $root goals] G-*.md]] { |
|
lappend vdrift_files $p |
|
} |
|
foreach path $vdrift_files { |
|
if {[file tail $path] eq "GOALS.md"} { |
|
set relpath GOALS.md |
|
} else { |
|
set relpath goals/[file tail $path] |
|
} |
|
set reported [dict create] ;# token -> 1 (one warning per reference per file) |
|
foreach line [read_lines $path] { |
|
foreach rawtok [split $line] { |
|
set tok [string trim $rawtok "\"'`()\[\]\{\}<>,;:!?"] |
|
set tok [string trimright $tok "."] |
|
if {$tok eq "" || [string first / $tok] < 0} continue |
|
if {[string match -nocase "*://*" $tok]} continue |
|
if {[regexp {^[A-Za-z]:/} $tok]} continue |
|
if {[string index $tok 0] in {/ ~}} continue |
|
if {[string first * $tok] >= 0 || [string first ? $tok] >= 0} continue |
|
if {[string match "*999999.0a1.0*" $tok]} continue |
|
if {[dict exists $reported $tok]} continue |
|
# version-suffixed FILE tail: <stem>-<n.n...>[a|b<n...>]<.ext> |
|
set ftail [file tail $tok] |
|
if {![regexp {^(.+)-([0-9]+(?:\.[0-9]+)+(?:[ab][0-9]+(?:\.[0-9]+)*)?)(\.[A-Za-z0-9_]+)$} $ftail -> stem ver ext]} continue |
|
set full [file join $root $tok] |
|
if {[file exists $full]} continue |
|
set sibs [lsort [glob -nocomplain -directory [file dirname $full] -tails -- "[vdrift_glob_escape $stem]-*[vdrift_glob_escape $ext]"]] |
|
if {![llength $sibs]} continue |
|
dict set reported $tok 1 |
|
lappend warnings "$relpath: references $tok (missing) - version drift? same-stem sibling(s) on disk: [join $sibs {, }]" |
|
} |
|
} |
|
} |
|
|
|
if {[llength $warnings]} { |
|
puts stderr "goals_lint: [llength $warnings] informational warning(s):" |
|
puts stderr [join $warnings \n] |
|
} |
|
if {[llength $findings]} { |
|
puts [join $findings \n] |
|
puts stderr "goals_lint: [llength $findings] finding(s)" |
|
exit 1 |
|
} |
|
puts "goals_lint: clean ([dict size $active_index] active-index goals, [dict size $archive_index] archived)" |
|
exit 0
|
|
|