Add task conditions
This commit is contained in:
parent
09e4f6d806
commit
b19eaf1007
2 changed files with 53 additions and 10 deletions
38
modules/ordo/condition.scm
Normal file
38
modules/ordo/condition.scm
Normal 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))))))
|
|
@ -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))))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue