(in-package :passepartout)

(defun context-query (&key tag todo-state type scope)
  "Filters the Memory based on tags, todo states, or types.
Optional SCOPE restricts results to objects with that scope
or :memex (global scope always visible)."
  (let ((results nil))
    (maphash (lambda (id obj)
               (declare (ignore id))
               (let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
                 ;; Scope filter: if scope specified, only match :memex (global) or same scope
                 (when (and scope (not (eq (memory-object-scope obj) :memex))
                            (not (eq (memory-object-scope obj) scope)))
                   (setf match nil))
                 (when (and type (not (eq (memory-object-type obj) type))) (setf match nil))
                 (when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
                 (when (and todo-state (not (equal state todo-state))) (setf match nil))
                 (when match (push obj results))))
             *memory-store*)
    results))

(defun context-active-projects ()
  "Returns headlines tagged as 'project' that are not yet marked DONE."
  (remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE"))
             (context-query :tag "project" :type :HEADLINE)))

(defun context-recent-tasks () 
  "Retrieves recently finished tasks from the store."
  (context-query :todo-state "DONE" :type :HEADLINE))

(defun context-skill-list ()
  "Provides a sorted overview of currently loaded system capabilities."
  (let ((results nil))
    (maphash (lambda (name skill)
               (declare (ignore name))
               (push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
             *skill-registry*)
    (sort results #'> :key (lambda (x) (getf x :priority)))))

(defun context-skill-source (skill-name)
  "Reads the raw literate source of a specific skill for inspection."
  (let* ((filename (format nil "~a.org" skill-name))
         (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
         (org-dir (merge-pathnames "org/" data-dir))
         (full-path (merge-pathnames filename org-dir)))
     (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))

(defun context-skill-subtree (skill-name heading-name)
  "Reads a specific headline subtree from a skill's Org source file.
Returns the content under HEADING-NAME (including children) as a string,
or nil if the heading is not found."
  (let ((full-source (context-skill-source skill-name)))
    (unless full-source (return-from context-skill-subtree nil))
    (if (fboundp 'org-subtree-extract)
        (org-subtree-extract full-source heading-name)
        ;; Fallback: no org-subtree-extract available, return full source
        full-source)))

(defun context-logs (&optional limit)
  "Retrieves the most recent lines from the harness's internal log."
  (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
    (bt:with-lock-held (*log-lock*)
      (let ((count (min log-limit (length *log-buffer*)))) 
        (subseq *log-buffer* 0 count)))))

(defun context-get-system-logs (&optional limit)
  "Backward-compatibility alias for context-logs."
  (context-logs limit))

(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
  "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
  (let* ((id (memory-object-id obj))
         (is-foveal (equal id foveal-id))
         (title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
         (content (memory-object-content obj))
         (children (memory-object-children obj))
         (stars (make-string depth :initial-element #\*))
         (obj-vector (memory-object-vector obj))
         (threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
         (similarity (if (and foveal-vector obj-vector (not is-foveal))
                          (vector-cosine-similarity foveal-vector obj-vector)
                         0.0))
         (is-semantically-relevant (>= similarity threshold))
         (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
         (output ""))
    
    (when should-render
      (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
      (when is-semantically-relevant
        (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
      (setf output (concatenate 'string output (format nil ":END:~%")))
      
      (when (and content (or is-foveal is-semantically-relevant))
        (setf output (concatenate 'string output content (string #\Newline))))
      
      (dolist (child-id children)
        (let ((child-obj (memory-object-get child-id)))
          (when child-obj
            (let ((next-foveal (if is-foveal child-id foveal-id)))
              (setf output (concatenate 'string output 
                                        (context-object-render child-obj 
                                                               :depth (1+ depth) 
                                                               :foveal-id next-foveal
                                                               :semantic-threshold threshold
                                                               :foveal-vector foveal-vector))))))))
    output))

(defun context-path-resolve (path-string)
  "Expands environment variables and strips literal quotes from a path string."
  (let ((path (if (stringp path-string) 
                  (string-trim '(#\" #\' #\Space) path-string)
                  path-string)))
    (if (and (stringp path) (search "$" path))
        (let ((result path))
          (ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
            (let ((var-val (uiop:getenv var-name)))
              (when var-val
                (setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
          result)
        path)))

(defun context-privacy-filtered-p (obj)
  "Returns T if an org-object's :TAGS attribute matches the Dispatcher's privacy tags."
  (let* ((attrs (memory-object-attributes obj))
         (tags (getf attrs :TAGS))
         (privacy-tags (and (find-package :passepartout.security-dispatcher)
                            (symbol-value
                             (find-symbol "*DISPATCHER-PRIVACY-TAGS*"
                                          :passepartout.security-dispatcher)))))
    (when (and tags privacy-tags)
      (let ((tag-list (if (listp tags) tags (list tags))))
        (some (lambda (tag)
                (some (lambda (private)
                        (string-equal (string-trim '(#\:) tag)
                                      (string-trim '(#\:) private)))
                      privacy-tags))
              tag-list)))))

(defun context-awareness-assemble (&optional signal)
  "Produces a high-level skeletal outline of the current Memory for the LLM.
Privacy-filtered objects (matching the Dispatcher's privacy tags) are excluded."
  (let* ((foveal-id (or (getf signal :foveal-focus) 
                         (ignore-errors (getf (getf signal :payload) :target-id))))
         (foveal-vector (when foveal-id
                          (memory-object-vector (memory-object-get foveal-id))))
         (all-projects (context-active-projects))
         (projects (remove-if #'context-privacy-filtered-p all-projects))
         (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
    (if projects
        (dolist (project projects)
          (setf output (concatenate 'string output
                                    (context-object-render project :foveal-id foveal-id :foveal-vector foveal-vector))))
          (setf output (concatenate 'string output "No active projects found.~%")))
    output))

(defun context-assemble-global-awareness ()
  (context-awareness-assemble))

(defskill :passepartout-symbolic-awareness
  :priority 50
  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-peripheral-vision-tests
  (:use :cl :fiveam :passepartout)
  (:export #:vision-suite))
(in-package :passepartout-peripheral-vision-tests)

(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
(in-suite vision-suite)

(test test-foveal-rendering
  "Contract 1: foveal content inline, peripheral content title-only."
  (clrhash passepartout::*memory-store*)
  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
                             :raw-content "FOVEAL CONTENT" :contents nil)
                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
    (ingest-ast ast)
    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
      (is (search "FOVEAL CONTENT" output))
      (is (search "* Peripheral Node" output))
      (is (not (search "PERIPHERAL CONTENT" output))))))

(test test-awareness-budget
  "Contract 1: all active projects appear in awareness output."
  (clrhash passepartout::*memory-store*)
  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
  (let ((output (context-awareness-assemble)))
    (is (search "Project 1" output))
    (is (search "Project 2" output))))

(test test-context-empty-memory
  "Contract 1: empty memory produces clean output without error."
  (clrhash passepartout::*memory-store*)
  (let ((output (context-awareness-assemble)))
    (is (stringp output))
    (is (search "MEMEX" output :test #'char-equal))))

(test test-context-no-foveal-focus
  "Contract 2: without foveal focus, no inline content appears."
  (clrhash passepartout::*memory-store*)
  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
                             :raw-content "CHILD CONTENT" :contents nil)))))
    (ingest-ast ast)
    (let ((output (context-awareness-assemble nil)))
      (is (stringp output))
      (is (not (search "CHILD CONTENT" output))))))

(test test-semantic-retrieval-trigram
  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
      (is (> sim 0.0))))
  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
      (is (> sim 0.75))))
  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
        (v6 (passepartout::embedding-backend-trigram "banana")))
    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
      (is (< sim 0.3)))))