42 lines
1.4 KiB
Scheme
42 lines
1.4 KiB
Scheme
(define-module (ordo task)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (logging logger)
|
|
#:use-module (srfi srfi-1) ; list utils
|
|
#:use-module (srfi srfi-9) ; records
|
|
#:use-module (srfi srfi-26) ; cut
|
|
#:use-module (ordo context)
|
|
#:export (task
|
|
task?
|
|
task-description
|
|
task-condition
|
|
task-action
|
|
task-register
|
|
task-triggers
|
|
run-task))
|
|
|
|
(define-record-type <task>
|
|
(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 (condition (const #t)) (register #f) (triggers '()))
|
|
(make-task description condition action register triggers))
|
|
|
|
(define (run-task ctx t)
|
|
(match t
|
|
(($ <task> description condition action register triggers)
|
|
(if (not (condition ctx))
|
|
(log-msg 'NOTICE "Skipping task: " description " (precondition not met)")
|
|
(begin
|
|
(log-msg 'NOTICE "Running task: " description)
|
|
(let ((result (action ctx)))
|
|
(when register
|
|
(log-msg 'INFO "Registering result " register)
|
|
(register-context-var! ctx register result))
|
|
(when (and triggers (not (null? triggers)))
|
|
(log-msg 'INFO "Scheduling triggers " triggers)
|
|
(add-context-triggers! ctx triggers))))))))
|