ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor, implement inventory, add examples

Browse source
This commit is contained in:
Ray Miller 2025-01-19 19:21:35 +00:00
parent d16df7616f
commit 54b6fd0377
Signed by: ray
GPG key ID: 043F786C4CD681B8
17 changed files with 373 additions and 483 deletions
Download patch file Download diff file Expand all files Collapse all files

55
modules/ordo/task.scm
View file

@ -1,42 +1,41 @@
(define-module (ordo task)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#: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)
#:use-module (ordo vars)
#:export (task
task?
task-description
task-condition
task-name
task-tags
task-action
task-register
task-condition
task-register-play-var
task-register-playbook-var
task-triggers
run-task))
(define-record-type <task>
(make-task description condition action register triggers)
(make-task name tags action condition register-play-var register-playbook-var triggers)
task?
(description task-description)
(condition task-condition)
(name task-name)
(tags task-tags)
(action task-action)
(register task-register)
(condition task-condition)
(register-play-var task-register-play-var)
(register-playbook-var task-register-playbook-var)
(triggers task-triggers))
(define* (task description action #:key (condition (const #t)) (register #f) (triggers '()))
(make-task description condition action register triggers))
(define* (task name action #:key (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '()))
(make-task name tags action condition register-play-var register-playbook-var 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))))))))
(define (run-task t c)
(when (check-filter-tags (task-tags t))
(if (not ((task-condition t) c))
(log-msg 'NOTICE "Skipping task: " (task-name t) " (precondition not met)")
(begin
(log-msg 'NOTICE "Running task: " (task-name t))
(let ((result ((task-action t) c)))
(when (task-register-play-var t)
(set-play-var! (task-register-play-var t) result))
(when (task-register-playbook-var t)
(set-playbook-var! (task-register-playbook-var t) result))
(add-play-triggers! (task-triggers t)))))))