passepartout/library/gen/org-skill-engineering-standards.lisp

(in-package :opencortex)

(defvar *engineering-std-*project-root* nil
  "Path to the project root for enforcement checks.")

(defun engineering-std-set-project-root (path)
  (setf *engineering-std-*project-root* (uiop:ensure-directory-pathname path)))

(defstruct engineering-violation
  (phase nil)
  (rule nil)
  (message nil)
  (severity nil))

(defvar *enforcement-rules*
  '((:pre-task
     (:git-clean "Working tree must be clean before modifications")
     (:skill-queried "Skill catalog should be queried before analysis")
     (:tangle-synced "Tangled .lisp files must match Org source"))
    (:during-task
     (:org-only "Only .org files may be edited; .lisp is generated")
     (:one-per-block "One definition per src block")
     (:prose-required "Every block must have preceding prose"))
    (:post-task
     (:tests-pass "All tests must pass")
     (:no-artifacts "No orphaned .bak, .log, .tmp files"))))

(defun verify-git-clean-p (&optional (dir *engineering-std-*project-root*))
  "Returns T if the git repository at DIR has no uncommitted changes."
  (when dir
    (let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
                                    :output :string
                                    :ignore-error-status t)))
      (string= "" (string-trim '(#\Space #\Newline #\Tab) status)))))

(defun check-git-clean (&optional (dir *engineering-std-*project-root*))
  "Returns violation if git is dirty, nil if clean."
  (unless (verify-git-clean-p dir)
    (make-engineering-violation
     :phase :pre-task
     :rule :git-clean
     :message "ENGINEERING STANDARDS VIOLATION: Working tree is dirty. Commit changes before modifying files."
     :severity :blocker)))

(defvar *tangle-targets*
  '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp")
    ("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp")
    ("harness/memory.org" . "library/memory.lisp")
    ("harness/loop.org" . "library/loop.lisp")
    ("harness/perceive.org" . "library/perceive.lisp")
    ("harness/reason.org" . "library/reason.lisp")
    ("harness/act.org" . "library/act.lisp")
    ("harness/skills.org" . "library/skills.lisp")
    ("harness/communication.org" . "library/communication.lisp")))

(defun check-tangle-sync (&optional (root *engineering-std-*project-root*))
  "Returns violation if any tangled .lisp file is newer than its Org source.
  
This detects direct .lisp edits (which violate the LP workflow)."
  (when root
    (dolist (pair *tangle-targets*)
      (let* ((org-file (merge-pathnames (car pair) root))
             (lisp-file (merge-pathnames (cdr pair) root))
             (org-time (ignore-errors (file-write-date org-file)))
             (lisp-time (ignore-errors (file-write-date lisp-file))))
        (when (and org-time lisp-time (> lisp-time org-time))
          (return-from check-tangle-sync
            (make-engineering-violation
             :phase :pre-task
             :rule :tangle-synced
             :message (format nil "ENGINEERING STANDARDS VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly."
                                    (file-namestring lisp-file) (file-namestring org-file))
             :severity :blocker))))))
  nil)

(defun engineering-standards-gate (action context)
  "The deterministic HARD BLOCK gate for Engineering Standards.

  BLOCKING checks (return :LOG on violation):
  - Git tree must be clean before file modifications

  WARNING checks (log only):
  - Skill catalog should be queried first

  Returns modified action, or :LOG/:EVENT on violation."
  (let* ((payload (getf action :payload))
         (tool (getf payload :tool))
         (file (getf payload :file))
         (code (getf payload :code))
         (modifies-files-p (or file code tool)))

    ;; BLOCKING: Git clean required for file modifications
    (when modifies-files-p
      (let ((git-check (check-git-clean *engineering-std-*project-root*)))
        (when git-check
          (harness-log "~a" (engineering-violation-message git-check))
          (return-from engineering-standards-gate
            (list :type :log
                  :payload (list :text (engineering-violation-message git-check))))))

    ;; BLOCKING: Tangle sync check - .lisp must not be newer than .org
    (let ((tangle-check (check-tangle-sync *engineering-std-*project-root*)))
      (when tangle-check
        (harness-log "~a" (engineering-violation-message tangle-check))
        (return-from engineering-standards-gate
          (list :type :log
                :payload (list :text (engineering-violation-message tangle-check))))))))

    action)

(defskill :skill-engineering-standards
  :priority 1000
  :trigger (lambda (ctx)
             (declare (ignore ctx))
             t)
  :probabilistic nil
  :deterministic #'engineering-standards-gate)

(defvar *engineering-std-initialized* nil)

(defun engineering-std-init ()
  "Initialize the enforcement system with project root."
  (unless *engineering-std-initialized*
    (let ((env-root (or (uiop:getenv "OPENCORTEX_ROOT")
                       (uiop:getenv "MEMEX_DIR")
                       "/home/user/memex/projects/opencortex")))
      (engineering-std-set-project-root env-root)
      (setf *engineering-std-initialized* t)
      (harness-log "ENGINEERING STANDARDS: Initialized with root ~a" *engineering-std-*project-root*))))

;; Auto-initialize on load
(engineering-std-init)