Add task conditions

This commit is contained in:
Ray Miller 2025-01-10 16:53:35 +00:00
parent 09e4f6d806
commit b19eaf1007
Signed by: ray
GPG key ID: 043F786C4CD681B8
2 changed files with 53 additions and 10 deletions

View file

@ -7,28 +7,33 @@
#:export (task
task?
task-description
task-condition
task-action
task-register
task-triggers
run-task))
(define-record-type <task>
(make-task description action register triggers)
(make-task description condition action register triggers)
task?
(description task-description)
(condition task-condition)
(action task-action)
(register task-register)
(triggers task-triggers))
(define* (task description action #:key (register #f) (triggers '()))
(make-task description action register triggers))
(define* (task description action #:key (condition (const #t)) (register #f) (triggers '()))
(make-task description condition action register triggers))
(define (run-task ctx t)
(match t
(($ <task> description action register triggers)
(format #t "RUNNING TASK ~a~%" description)
(let ((result (action ctx)))
(when register
(register-context-var! ctx register result))
(when triggers
(add-context-triggers! ctx triggers))))))
(($ <task> description condition action register triggers)
(if (not (condition ctx))
(format #t "SKIPPING TASK ~a (precondition not met)~%" description)
(begin
(format #t "RUNNING TASK ~a~%" description)
(let ((result (action ctx)))
(when register
(register-context-var! ctx register result))
(when triggers
(add-context-triggers! ctx triggers))))))))