Files
passepartout/lisp/sensor-time.lisp
Amr Gharbeia 04c219468d passepartout: v0.6.0 — Time Awareness
Level 2: symbolic-time-memory skill
- memory-objects-since(timestamp) — hash-table walk, objects with version >= timestamp
- memory-objects-in-range(since until) — version between two timestamps
- context-query-with-time — extended query with :since :until
- 6 tests, 100% pass

Level 3: sensor-time skill
- format-time-for-llm — TIME: section for system prompt (iso/natural format)
- session-duration — session start tracking
- sensor-time-tick — deadline scanning, cron-registered, 0 LLM tokens
- TIME_AWARENESS / TIME_FORMAT / DEADLINE_WARNING_MINUTES env vars
- 13 tests, 100% pass

Level 1: TIME injection in think() (core-reason)
- fboundp-guarded call to format-time-for-llm
- session duration included when sensor-time skill loaded
- Injected at top of system prompt in both token-economics and fallback paths

Full suite: 135/135 (100%)
2026-05-08 09:42:22 -04:00

170 lines
7.7 KiB
Common Lisp

(in-package :passepartout)
(defvar *session-start-time* nil
"Universal time when sensor-time skill was loaded.")
(defun session-duration ()
"Returns duration in seconds since skill load, or nil if not initialized."
(when *session-start-time*
(- (get-universal-time) *session-start-time*)))
(defun sensor-time-initialize ()
"Record session start and register deadline-scanning cron."
(setf *session-start-time* (get-universal-time))
(handler-case
(when (fboundp 'orchestrator-register-cron)
(orchestrator-register-cron "time-tick"
:action (lambda () (sensor-time-tick))
:tier :reflex
:repeat "+1m"))
(error (c)
(log-message "SENSOR-TIME: Could not register cron: ~a" c))))
(defun format-time-for-llm (&key (session-duration-seconds nil))
"Returns a TIME: section string for the system prompt.
When TIME_AWARENESS=false, returns empty string.
TIME_FORMAT: iso = 2026-05-08T06:30:00Z, natural = 6:30 AM UTC, Thu May 8 2026.
When session-duration-seconds is provided, includes session info."
(unless (or (uiop:getenv "TIME_AWARENESS")
(not (string-equal "false" (or (uiop:getenv "TIME_AWARENESS") "true"))))
(return-from format-time-for-llm ""))
(let ((time-aware (uiop:getenv "TIME_AWARENESS")))
(when (and time-aware (string-equal time-aware "false"))
(return-from format-time-for-llm "")))
(multiple-value-bind (sec minute hour date month year day daylight zone)
(decode-universal-time (get-universal-time) 0)
(declare (ignore daylight zone))
(let* ((format (or (uiop:getenv "TIME_FORMAT") "iso"))
(iso-str (format nil "~4,'0d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0dZ"
year month date hour minute (round sec)))
(day-names '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
(month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(natural-str (format nil "~2,'0d:~2,'0d UTC, ~a ~a ~d ~d"
hour minute (nth day day-names)
(nth (1- month) month-names) date year))
(time-str (if (string-equal format "natural") natural-str iso-str))
(dur-str (when session-duration-seconds
(let* ((hours (floor session-duration-seconds 3600))
(mins (floor (mod session-duration-seconds 3600) 60)))
(if (> hours 0)
(format nil " Session: ~dh ~dm." hours mins)
(format nil " Session: ~dm." mins))))))
(if dur-str
(format nil "TIME: ~a.~a" time-str dur-str)
(format nil "TIME: ~a." time-str)))))
(defvar *deadline-warning-minutes* nil)
(defun sensor-time-tick ()
"Scans memory for approaching deadlines. Returns a formatted note string
if any deadlines are within *deadline-warning-minutes*, nil otherwise.
Called by the time-tick cron job every minute."
(let ((warning-min (or *deadline-warning-minutes*
(ignore-errors
(parse-integer (uiop:getenv "DEADLINE_WARNING_MINUTES")))
60)))
(setf *deadline-warning-minutes* warning-min)
(let ((now (get-universal-time))
(deadlines nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let ((attrs (memory-object-attributes obj)))
(let ((deadline (getf attrs :DEADLINE))
(scheduled (getf attrs :SCHEDULED))
(title (getf attrs :TITLE)))
(dolist (prop (list deadline scheduled))
(when prop
(handler-case
(let* ((parsed (parse-integer prop :junk-allowed t))
(d-minutes (if parsed
(- (round (/ (- parsed now) 60))
warning-min)
nil)))
(when (and d-minutes (< d-minutes warning-min))
(push (list :title title
:minutes (- (round (/ (- (or parsed 0) now) 60))))
deadlines)))
(error () nil)))))))
*memory-store*)
(when deadlines
(let* ((sorted (sort deadlines #'< :key (lambda (d) (getf d :minutes))))
(parts (loop for d in sorted collect
(let* ((mins (getf d :minutes))
(label (cond
((< mins 0) (format nil "~dmin overdue" (- mins)))
((= mins 0) "now")
(t (format nil "~dmin" mins)))))
(format nil "~a (~a)" (getf d :title) label)))))
(format nil "~d deadlines approaching: ~{~a; ~}" (length parts) parts))))))
(sensor-time-initialize)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-sensor-time-tests
(:use :cl :fiveam :passepartout)
(:export #:sensor-time-suite))
(in-package :passepartout-sensor-time-tests)
(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
(in-suite sensor-time-suite)
(test test-format-time-for-llm-includes-year
"Contract 1: format-time-for-llm returns a string with the current year."
(let ((result (passepartout::format-time-for-llm)))
(is (stringp result))
(is (search "202" result))
(is (search "TIME" result))))
(test test-format-time-for-llm-utc
"Contract 1: iso format includes Z suffix."
(let ((result (passepartout::format-time-for-llm)))
(is (stringp result))
(is (search "Z" result))))
(test test-format-time-for-llm-natural
"Contract 1: natural format produces human-readable date."
(let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
(unwind-protect
(progn
(setf (uiop:getenv "TIME_FORMAT") "natural")
(let ((result (passepartout::format-time-for-llm)))
(is (stringp result))
(is (search "UTC" result))))
(setf (uiop:getenv "TIME_FORMAT") old-env))))
(test test-format-time-for-llm-with-session
"Contract 1: with session duration, includes session info."
(let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
(is (search "1h 2m" result))))
(test test-session-duration
"Contract 2: session-duration returns a positive number after init."
(passepartout::sensor-time-initialize)
(let ((dur (passepartout::session-duration)))
(is (numberp dur))
(is (>= dur 0))))
(test test-sensor-time-tick-empty
"Contract 3: sensor-time-tick returns nil when no deadlines are near."
(clrhash passepartout::*memory-store*)
(let ((result (passepartout::sensor-time-tick)))
(is (null result))))
(test test-sensor-time-tick-detects-deadline
"Contract 3: sensor-time-tick detects a deadline close in time."
(clrhash passepartout::*memory-store*)
(setf passepartout::*deadline-warning-minutes* 120)
(let ((near-future-time (- (get-universal-time) 60))) ; 1 minute ago
(ingest-ast (list :type :HEADLINE
:properties (list :ID "deadline-test"
:TITLE "Submit report"
:DEADLINE (write-to-string near-future-time))
:contents nil)))
(let ((result (passepartout::sensor-time-tick)))
(is (not (null result)))
(is (search "Submit report" result))))