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

@ -0,0 +1,38 @@
(define-module (ordo condition)
#:use-moudle (ordo context)
#:use-module (ordo action filesystem))
(define (cond:any preds)
(lambda (ctx)
(let loop ((preds preds))
(if (null? preds)
#f
(let ((p (car preds)))
(if (p ctx)
#t
(loop (cdr preds))))))))
(define (cond:every preds)
(lambda (ctx)
(let loop ((preds preds))
(if (null? preds)
#t
(let ((p (car preds)))
(if (p ctx)
(loop (cdr preds))
#f))))))
(define (cond:command-available? cmd-name)
(lambda (ctx)
(let ((_ rc) (run "which" `(,cmd-name)))
(zero? rc))))
(define (cond:directory? path)
(lambda (ctx)
(let ((st ((action:stat path) ctx)))
(and st (string=? "directory" (assoc-ref st 'file-type))))))
(define (cond:regular-file? path)
(lambda (ctx)
(let ((st ((action:stat path) ctx)))
(and st (string=? "regular-file" (assoc-ref st 'file-type))))))

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))))))))