104 lines
3 KiB
Scheme
104 lines
3 KiB
Scheme
(define-module (ordo vars)
|
|
#:use-module (ice-9 exceptions)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-69)
|
|
#:export (init-playbook-vars!
|
|
get-playbook-var
|
|
set-playbook-var!
|
|
reset-playbook-vars!
|
|
init-play-vars!
|
|
get-play-var
|
|
set-play-var!
|
|
reset-play-vars!
|
|
init-command-line-vars!
|
|
get-command-line-var
|
|
set-command-line-var!
|
|
$
|
|
reset-play-triggers!
|
|
add-play-triggers!
|
|
play-triggered?
|
|
set-filter-tag!
|
|
reset-filter-tags!
|
|
check-filter-tags))
|
|
|
|
(define not-found (cons 'not-found '()))
|
|
|
|
(define (not-found? x) (eq? x not-found))
|
|
|
|
(define *playbook-vars* #f)
|
|
|
|
(define (init-playbook-vars! alist)
|
|
(set! *playbook-vars* (alist->hash-table alist equal?)))
|
|
|
|
(define (get-playbook-var var-name)
|
|
(hash-table-ref/default *playbook-vars* var-name not-found))
|
|
|
|
(define (set-playbook-var! var-name val)
|
|
(hash-table-set! *playbook-vars* var-name val))
|
|
|
|
(define (reset-playbook-vars!)
|
|
(set! *playbook-vars* #f))
|
|
|
|
(define *play-vars* #f)
|
|
|
|
(define (init-play-vars! alist)
|
|
(set! *play-vars* (alist->hash-table alist equal?)))
|
|
|
|
(define (get-play-var var-name)
|
|
(hash-table-ref/default *play-vars* var-name not-found))
|
|
|
|
(define (set-play-var! var-name val)
|
|
(hash-table-set! *play-vars* var-name val))
|
|
|
|
(define (reset-play-vars!)
|
|
(set! *play-vars* #f))
|
|
|
|
(define *command-line-vars* #f)
|
|
|
|
(define (init-command-line-vars! alist)
|
|
(set! *command-line-vars* (alist->hash-table alist equal?)))
|
|
|
|
(define (get-command-line-var var-name)
|
|
(hash-table-ref/default *command-line-vars* var-name not-found))
|
|
|
|
(define (set-command-line-var var-name val)
|
|
(hash-table-set! *command-line-vars* var-name val))
|
|
|
|
(define ($ var-name)
|
|
"Try to resolve var-name as a command-line variable, a play variable or a
|
|
playbook variable (in that order). Raise an exception if the variable is not
|
|
found."
|
|
(define (lookup-var procs)
|
|
(if (null? procs)
|
|
(raise-exception (make-exception
|
|
(make-undefined-variable-error)
|
|
(make-exception-with-irritants var-name)))
|
|
(let ((v ((car procs) var-name)))
|
|
(if (not-found? v)
|
|
(lookup-var (cdr procs))
|
|
v))))
|
|
(lookup-var (list get-command-line-var get-play-var get-playbook-var)))
|
|
|
|
(define *play-triggers* '())
|
|
|
|
(define (reset-play-triggers!)
|
|
(set! *play-triggers* '()))
|
|
|
|
(define (add-play-triggers! triggers)
|
|
(set! *play-triggers* (apply lset-adjoin equal? (or *play-triggers* '())
|
|
triggers)))
|
|
|
|
(define (play-triggered? trigger)
|
|
(member trigger *play-triggers*))
|
|
|
|
(define *filter-tags* '())
|
|
|
|
(define (set-filter-tag! tag)
|
|
(set! *filter-tags* (lset-adjoin equal? *filter-tags* tag)))
|
|
|
|
(define (reset-filter-tags!)
|
|
(set! *filter-tags* '()))
|
|
|
|
(define (check-filter-tags tags)
|
|
(or (null? *filter-tags*)
|
|
(not (null? (lset-intersection eqv? *filter-tags* tags)))))
|