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