Use context instead of global vars

modules/ordo/context.scm

@@ -0,0 +1,152 @@
+(define-module (ordo context)
+  #:use-module (ice-9 exceptions)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-69)
+  #:use-module (logging logger)
+  #:use-module (ordo host)
+  #:export (init-context!
+            set-current-connection!
+            current-connection
+            current-host
+            set-current-host!
+            init-playbook-vars!
+            get-playbook-var
+            set-playbook-var!
+            reset-playbook-vars!
+            init-play-vars!
+            get-play-var
+            set-play-var!
+            reset-play-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
+            add-host!
+            current-inventory))
+
+(define *current-context* #f)
+
+(define-record-type <context>
+  (make-context)
+  context?
+  (connection connection set-connection!)
+  (hostname hostname set-hostname!)
+  (command-line-vars command-line-vars set-command-line-vars!)
+  (play-vars play-vars set-play-vars!)
+  (play-triggers play-triggers set-play-triggers!)
+  (playbook-vars playbook-vars set-playbook-vars!)
+  (filter-tags filter-tags set-filter-tags!)
+  (inventory inventory set-inventory!))
+
+(define (init-context!)
+  (set! *current-context* (make-context)))
+
+(define not-found (cons 'not-found '()))
+
+(define (not-found? x) (eq? x not-found))
+
+(define (set-current-connection! conn)
+  (set-connection! *current-context* conn))
+
+(define (current-connection)
+  (connection *current-context*))
+
+(define (set-current-host! hostname)
+  (set-hostname! *current-context* hostname))
+
+(define (current-host)
+  (hostname *current-context*))
+
+(define (init-playbook-vars! alist)
+  (set-playbook-vars! *current-context* (alist->hash-table alist eqv?)))
+
+(define (get-playbook-var var-name)
+  (if (playbook-vars *current-context*)
+      (hash-table-ref/default (playbook-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-playbook-var! var-name val)
+  (unless (playbook-vars *current-context*)
+    (set-playbook-vars! *current-context* (make-hash-table eqv?)))
+  (hash-table-set! (playbook-vars *current-context*) var-name val))
+
+(define (reset-playbook-vars!)
+  (set-playbook-vars! *current-context* #f))
+
+(define (init-play-vars! alist)
+  (set-play-vars! *current-context* (alist->hash-table alist eqv?)))
+
+(define (get-play-var var-name)
+  (if (play-vars *current-context*)
+      (hash-table-ref/default (play-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-play-var! var-name val)
+  (unless (play-vars *current-context*)
+    (set-play-vars! *current-context* (make-hash-table equal?)))
+  (hash-table-set! (play-vars *current-context*) var-name val))
+
+(define (reset-play-vars!)
+  (set-play-vars! *current-context* #f))
+
+(define (get-command-line-var var-name)
+  (if (command-line-vars *current-context*)
+      (hash-table-ref/default (command-line-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-command-line-var! var-name val)
+  (unless (command-line-vars *current-context*)
+    (set-command-line-vars! *current-context* (make-hash-table eqv?)))
+  (hash-table-set! (command-line-vars *current-context*) 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 (reset-play-triggers!)
+  (set-play-triggers! *current-context* #f))
+
+(define (add-play-triggers! triggers)
+  (set-play-triggers! *current-context*
+                      (apply lset-adjoin equal? (or (play-triggers *current-context*) '())
+                             triggers)))
+
+(define (play-triggered? trigger)
+  (and=> (play-triggers *current-context*) (cut member trigger <>)))
+
+(define (set-filter-tag! tag)
+  (set-filter-tags! *current-context*
+                    (lset-adjoin equal? (or (filter-tags *current-context*) '()) tag)))
+
+(define (reset-filter-tags!)
+  (set-filter-tags! *current-context* #f))
+
+(define (check-filter-tags tags)
+  (or (not (filter-tags *current-context*))
+      (not (null? (lset-intersection eqv? (filter-tags *current-context*) tags)))))
+
+(define (current-inventory)
+  (or (inventory *current-context*) '()))
+
+(define (add-host! hostname connection . tags)
+  (log-msg 'DEBUG "Adding host to inventory: " hostname)
+  (set-inventory! *current-context* (cons (make-host hostname connection tags)
+                                          (or (inventory *current-context*) '()))))