chore: structural cleanup of projects and patches
This commit is contained in:
@@ -0,0 +1,2 @@
|
|||||||
|
;;; TDD Suite for web-research
|
||||||
|
;;; TDD Suite for web-research\n(fiveam:test mock-test (5am:is t))
|
||||||
@@ -0,0 +1,2 @@
|
|||||||
|
;;; TDD Suite for workspace-manager
|
||||||
|
;;; TDD Suite for workspace-manager\n(fiveam:test mock-test (5am:is t))
|
||||||
19
system/patches/patch-architect-actuate.lisp
Normal file
19
system/patches/patch-architect-actuate.lisp
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
(in-package :org-agent.skills.org-skill-architect)
|
||||||
|
|
||||||
|
(defun architect-actuate (action context)
|
||||||
|
(declare (ignore context))
|
||||||
|
(let* ((payload (getf action :payload))
|
||||||
|
;; Support both (getf action :payload) and direct top-level keys
|
||||||
|
(note-path (or (getf payload :path) (getf action :path)))
|
||||||
|
(blueprint-content (or (getf payload :content) (getf action :content))))
|
||||||
|
|
||||||
|
(if (and note-path blueprint-content)
|
||||||
|
(progn
|
||||||
|
(org-agent:kernel-log "ARCHITECT - Appending PROTOCOL to ~a" note-path)
|
||||||
|
(with-open-file (out note-path :direction :output :if-exists :append)
|
||||||
|
(format out "~%* Phase B: Blueprint (PROTOCOL)~%:PROPERTIES:~%:STATUS: SIGNED~%:END:~%~%~a"
|
||||||
|
blueprint-content))
|
||||||
|
(format nil "SUCCESS - Architect established PROTOCOL in ~a" note-path))
|
||||||
|
(progn
|
||||||
|
(org-agent:kernel-log "ARCHITECT FAILURE - Missing path or content in action: ~a" action)
|
||||||
|
nil))))
|
||||||
24
system/patches/patch-architect-neuro.lisp
Normal file
24
system/patches/patch-architect-neuro.lisp
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
(in-package :org-agent.skills.org-skill-architect)
|
||||||
|
|
||||||
|
(defun neuro-skill-architect (context)
|
||||||
|
(let* ((payload (getf context :payload))
|
||||||
|
(note (car (getf payload :ready-notes)))
|
||||||
|
(note-path (getf note :note-path))
|
||||||
|
(prd-content (getf note :content))
|
||||||
|
(path-str (namestring note-path)))
|
||||||
|
(format nil "
|
||||||
|
You are the PSF Architect.
|
||||||
|
The Master Note '~a' has a FROZEN PRD and needs a PROTOCOL.
|
||||||
|
|
||||||
|
NOTE CONTENT:
|
||||||
|
---
|
||||||
|
~a
|
||||||
|
---
|
||||||
|
|
||||||
|
TASK:
|
||||||
|
Draft the '* Phase B: Blueprint (PROTOCOL)' section.
|
||||||
|
1. Define Architectural Intent.
|
||||||
|
2. Define Semantic Interfaces using Lisp signatures.
|
||||||
|
|
||||||
|
Return a Lisp plist: (:target :architect :action :actuate :path \"~a\" :content \"...blueprint section...\")
|
||||||
|
" path-str prd-content path-str)))
|
||||||
17
system/patches/patch-architect-scan.lisp
Normal file
17
system/patches/patch-architect-scan.lisp
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
(in-package :org-agent.skills.org-skill-architect)
|
||||||
|
|
||||||
|
(defun architect-scan-all-notes ()
|
||||||
|
(let* ((notes-dir (or (uiop:getenv "MEMEX_NOTES") "/home/user/memex/notes/"))
|
||||||
|
(files (uiop:directory-files (uiop:ensure-directory-pathname notes-dir)))
|
||||||
|
(ready-notes '()))
|
||||||
|
(org-agent:kernel-log "ARCHITECT - Scanning ~a files in ~a" (length files) notes-dir)
|
||||||
|
(dolist (file files)
|
||||||
|
(let ((name (pathname-name file))
|
||||||
|
(type (pathname-type file)))
|
||||||
|
(when (and name type
|
||||||
|
(uiop:string-prefix-p "org-skill-" name)
|
||||||
|
(string-equal type "org"))
|
||||||
|
(let ((status (architect-perceive-frozen-prd file)))
|
||||||
|
(when status (push status ready-notes))))))
|
||||||
|
(org-agent:kernel-log "ARCHITECT - Found ~a ready notes." (length ready-notes))
|
||||||
|
ready-notes))
|
||||||
19
system/patches/patch-neuro-debug.lisp
Normal file
19
system/patches/patch-neuro-debug.lisp
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
(in-package :org-agent)
|
||||||
|
|
||||||
|
(defun execute-openrouter-request (prompt system-prompt &key model)
|
||||||
|
(let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))
|
||||||
|
(endpoint "https://openrouter.ai/api/v1/chat/completions")
|
||||||
|
(model-id (or model "google/gemini-2.0-flash-001")))
|
||||||
|
(unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))"))
|
||||||
|
(kernel-log "OPENROUTER DEBUG - Using Model: ~a" model-id)
|
||||||
|
(let* ((headers `(("Content-Type" . "application/json")
|
||||||
|
("Authorization" . ,(format nil "Bearer ~a" api-key))
|
||||||
|
("HTTP-Referer" . "https://github.com/amr/org-agent")))
|
||||||
|
(body (cl-json:encode-json-to-string
|
||||||
|
`((model . ,model-id)
|
||||||
|
(messages . (( (role . "system") (content . ,system-prompt) )
|
||||||
|
( (role . "user") (content . ,prompt) )))))))
|
||||||
|
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30)))
|
||||||
|
(let ((json (cl-json:decode-json-from-string response)))
|
||||||
|
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json)))))))))
|
||||||
|
(error (c) (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c))))))
|
||||||
54
system/patches/patch-neuro-economist.lisp
Normal file
54
system/patches/patch-neuro-economist.lisp
Normal file
@@ -0,0 +1,54 @@
|
|||||||
|
(in-package :org-agent)
|
||||||
|
|
||||||
|
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
|
||||||
|
"Dispatches a neural request through the provider cascade.
|
||||||
|
If CASCADE is a function, it is called with CONTEXT to determine backends."
|
||||||
|
(let ((backends (cond
|
||||||
|
((listp cascade) cascade)
|
||||||
|
((functionp cascade) (funcall cascade context))
|
||||||
|
((functionp *provider-cascade*) (funcall *provider-cascade* context))
|
||||||
|
(t *provider-cascade*))))
|
||||||
|
(dolist (backend backends)
|
||||||
|
(let ((backend-fn (gethash backend *neuro-backends*)))
|
||||||
|
(when backend-fn
|
||||||
|
(kernel-log "SYSTEM 1: Attempting backend ~a..." backend)
|
||||||
|
(let* (;; Consult the Economist for the model ID if the skill is available
|
||||||
|
(model (ignore-errors
|
||||||
|
(uiop:symbol-call :org-agent.skills.org-skill-economist :economist-get-model-for-provider backend)))
|
||||||
|
(result (if model
|
||||||
|
(funcall backend-fn prompt system-prompt :model model)
|
||||||
|
(funcall backend-fn prompt system-prompt))))
|
||||||
|
(if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))
|
||||||
|
(kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend)
|
||||||
|
(return-from ask-neuro result))))))
|
||||||
|
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))
|
||||||
|
|
||||||
|
(defun execute-openrouter-request (prompt system-prompt &key model)
|
||||||
|
(let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))
|
||||||
|
(endpoint "https://openrouter.ai/api/v1/chat/completions")
|
||||||
|
(model-id (or model "google/gemini-2.0-flash-001")))
|
||||||
|
(unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))"))
|
||||||
|
(let* ((headers `(("Content-Type" . "application/json")
|
||||||
|
("Authorization" . ,(format nil "Bearer ~a" api-key))
|
||||||
|
("HTTP-Referer" . "https://github.com/amr/org-agent")))
|
||||||
|
(body (cl-json:encode-json-to-string
|
||||||
|
`((model . ,model-id)
|
||||||
|
(messages . (( (role . "system") (content . ,system-prompt) )
|
||||||
|
( (role . "user") (content . ,prompt) )))))))
|
||||||
|
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
|
||||||
|
(json (cl-json:decode-json-from-string response)))
|
||||||
|
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json))))))))
|
||||||
|
(error (c) (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c))))))
|
||||||
|
|
||||||
|
(defun execute-gemini-request (prompt system-prompt &key model)
|
||||||
|
(let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key)) (bearer-token (getf auth :bearer-token))
|
||||||
|
;; Use model from Economist if provided, else default to pro
|
||||||
|
(endpoint-base (if model (format nil "https://generativelanguage.googleapis.com/v1beta/models/~a:generateContent" model)
|
||||||
|
"https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent")))
|
||||||
|
(unless (or api-key bearer-token) (return-from execute-gemini-request "(:type :LOG :payload (:text \"Authentication missing\"))"))
|
||||||
|
(let* ((url (if api-key (format nil "~a?key=~a" endpoint-base api-key) endpoint-base))
|
||||||
|
(headers `(("Content-Type" . "application/json") ,@(when bearer-token `(("Authorization" . ,(format nil "Bearer ~a" bearer-token))))))
|
||||||
|
(body (cl-json:encode-json-to-string `((contents . ((parts . ((text . ,(format nil "~a~%~%Prompt: ~a" system-prompt prompt))))))))))
|
||||||
|
(handler-case (let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 30)) (json (cl-json:decode-json-from-string response)))
|
||||||
|
(cdr (assoc :text (cdr (assoc :parts (car (cdr (assoc :parts (car (cdr (assoc :candidates json)))))))))))
|
||||||
|
(error (c) (format nil "(:type :LOG :payload (:text \"Neural Engine Failure: ~a\"))" c))))))
|
||||||
22
system/patches/patch-neuro-trace.lisp
Normal file
22
system/patches/patch-neuro-trace.lisp
Normal file
@@ -0,0 +1,22 @@
|
|||||||
|
(in-package :org-agent)
|
||||||
|
|
||||||
|
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
|
||||||
|
(let ((backends (cond
|
||||||
|
((listp cascade) cascade)
|
||||||
|
((functionp cascade) (funcall cascade context))
|
||||||
|
((functionp *provider-cascade*) (funcall *provider-cascade* context))
|
||||||
|
(t *provider-cascade*))))
|
||||||
|
(dolist (backend backends)
|
||||||
|
(let ((backend-fn (gethash backend *neuro-backends*)))
|
||||||
|
(when backend-fn
|
||||||
|
(kernel-log "SYSTEM 1: Attempting backend ~a..." backend)
|
||||||
|
(let* ((model (ignore-errors
|
||||||
|
(uiop:symbol-call :org-agent.skills.org-skill-economist :economist-get-model-for-provider backend)))
|
||||||
|
(result (if model
|
||||||
|
(funcall backend-fn prompt system-prompt :model model)
|
||||||
|
(funcall backend-fn prompt system-prompt))))
|
||||||
|
(kernel-log "SYSTEM 1: Backend ~a returned: ~a" backend (if (stringp result) (subseq result 0 (min 50 (length result))) result))
|
||||||
|
(if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))
|
||||||
|
(kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend)
|
||||||
|
(return-from ask-neuro result))))))
|
||||||
|
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))
|
||||||
33
system/patches/patch-think-robust.lisp
Normal file
33
system/patches/patch-think-robust.lisp
Normal file
@@ -0,0 +1,33 @@
|
|||||||
|
(in-package :org-agent)
|
||||||
|
|
||||||
|
(defun think (context)
|
||||||
|
(let ((active-skill (find-triggered-skill context)))
|
||||||
|
(if active-skill
|
||||||
|
(progn
|
||||||
|
(kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill))
|
||||||
|
(let* ((prompt-generator (skill-neuro-prompt active-skill))
|
||||||
|
(prompt (when prompt-generator (funcall prompt-generator context))))
|
||||||
|
(if prompt
|
||||||
|
(let* ((thought (ask-neuro prompt :context context))
|
||||||
|
;; Improved cleaning: Extract content between ``` blocks if they exist
|
||||||
|
(cleaned-thought
|
||||||
|
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought)))
|
||||||
|
(if match
|
||||||
|
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought))))
|
||||||
|
(if (and regs (> (length regs) 0)) (elt regs 0) thought))
|
||||||
|
(string-trim '(#\Space #\Newline #\Tab) thought))))
|
||||||
|
(suggestion (ignore-errors (read-from-string cleaned-thought))))
|
||||||
|
(kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought)
|
||||||
|
(cond
|
||||||
|
((and suggestion (listp suggestion)) suggestion)
|
||||||
|
;; SALVAGE: If LLM returned plain text or a non-list symbol
|
||||||
|
((and (let ((p (getf context :payload))) (eq (getf p :sensor) :chat-message))
|
||||||
|
(> (length cleaned-thought) 0))
|
||||||
|
(kernel-log "SYSTEM 1: SALVAGING plain-text response.~%")
|
||||||
|
(let* ((no-prefix (cl-ppcre:regex-replace "(?i)^(okay,? |sure,? |i will |i've |i have |here is |got it\\.? |understood\\.? |done\\.? |yes,? )+" cleaned-thought "")))
|
||||||
|
`(:target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,no-prefix))))
|
||||||
|
(t
|
||||||
|
(kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%")
|
||||||
|
nil)))
|
||||||
|
nil)))
|
||||||
|
nil)))
|
||||||
25
system/plans/flight-plan-structural-cleanup.org
Normal file
25
system/plans/flight-plan-structural-cleanup.org
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
* Flight Plan: Structural Cleanup and Patch Management
|
||||||
|
:PROPERTIES:
|
||||||
|
:STATUS: IN-PROGRESS
|
||||||
|
:END:
|
||||||
|
|
||||||
|
** Analyst Phase
|
||||||
|
The workspace currently contains structural irregularities that violate the PARA and Zero-Bloat invariants:
|
||||||
|
1. Broken project directories: =projectsorg-skill-web-research= and =projectsorg-skill-workspace-manager= exist in the root due to a previous path concatenation error.
|
||||||
|
2. Root clutter: Seven =patch-*.lisp= files are located in the root directory, making system maintenance difficult.
|
||||||
|
3. Git Status: Recent changes have been pushed, but these structural fixes need to be atomically committed.
|
||||||
|
|
||||||
|
** Coder Phase
|
||||||
|
- [X] Create =system/patches/= directory if not already present.
|
||||||
|
- [X] Move =projectsorg-skill-web-research= to =projects/org-skill-web-research=.
|
||||||
|
- [X] Move =projectsorg-skill-workspace-manager= to =projects/org-skill-workspace-manager=.
|
||||||
|
- [X] Move all =patch-*.lisp= files to =system/patches/=.
|
||||||
|
- [ ] Stage deletions and new paths in git.
|
||||||
|
- [ ] Commit with message: "chore: structural cleanup of projects and patches"
|
||||||
|
- [ ] Push to origin main.
|
||||||
|
|
||||||
|
** Tester Phase
|
||||||
|
- [ ] Verify that =projects/org-skill-web-research/tests/test-suite.lisp= exists and is accessible.
|
||||||
|
- [ ] Verify that =projects/org-skill-workspace-manager/tests/test-suite.lisp= exists and is accessible.
|
||||||
|
- [ ] List =system/patches/= to confirm all seven patches are accounted for.
|
||||||
|
- [ ] Verify =git status= is clean.
|
||||||
Reference in New Issue
Block a user