From 35651090718fc9458375abd0598816725ce4c231 Mon Sep 17 00:00:00 2001
From: Ray Miller <ray@1729.org.uk>
Date: Sat, 11 Jan 2025 21:21:48 +0000
Subject: [PATCH] Add trigger support

---
 modules/ordo.scm | 35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/modules/ordo.scm b/modules/ordo.scm
index 8a95faa..f68a2ff 100644
--- a/modules/ordo.scm
+++ b/modules/ordo.scm
@@ -2,10 +2,10 @@
   #:use-module (ice-9 exceptions)
   #:use-module (logging logger)
   #:use-module (oop goops)
+  #:use-module (ordo connection)
   #:use-module (srfi srfi-1)  ; list utils
   #:use-module (srfi srfi-26) ; cut
   #:use-module (srfi srfi-69) ; hash-tables
-  #:use-module (ordo connection)
   #:export (task
             act
             play
@@ -22,9 +22,11 @@
   (or (null? +filter-tags+)
       (not (null? (lset-intersection eqv? +filter-tags+ tags)))))
 
-(define +playbook-vars+ #f)
+(define +act-triggers+ #f)
 
-(define +play-vars+ #f)
+(define (add-act-triggers triggers)
+  (set! +act-triggers+ (apply lset-adjoin equal? (or +act-triggers+ '())
+                              triggers)))
 
 (define +act-vars+ #f)
 
@@ -33,11 +35,15 @@
     (log-msg 'DEBUG "Registering act variable " var-name)
     (hash-table-set! +act-vars+ var-name v)))
 
+(define +play-vars+ #f)
+
 (define (register-play-var var-name)
   (lambda (v)
     (log-msg 'DEBUG "Registering play variable " var-name)
     (hash-table-set! +play-vars+ var-name v)))
 
+(define +playbook-vars+ #f)
+
 (define (register-playbook-var var-name)
   (lambda (v)
     (log-msg 'DEBUG "Registering playbook variable " var-name)
@@ -85,7 +91,13 @@ variable (in that order). Raise an exception if the variable is not found."
             (when (slot-bound? t 'register)
               ((task-register t) result))
             (when (slot-bound? t 'triggers)
-              (for-each (lambda (f) (f)) (task-triggers t))))))))
+              (add-act-triggers (task-triggers t))))))))
+
+(define-class <handler> ()
+  (name #:init-keyword #:name #:getter handler-name)
+  (action #:init-keyword #:action #:getter handler-action))
+
+(define (handler . args) (apply make <handler> args))
 
 (define-class <act> ()
   (name #:init-keyword #:name #:getter act-name)
@@ -114,10 +126,15 @@ variable (in that order). Raise an exception if the variable is not found."
                 (set! +act-vars+ (alist->hash-table (act-vars a) equal?))))
             (lambda ()
               (for-each (cut perform <> c) (act-tasks a))
-              ;; TODO: run any triggered handlers
-              )
+              (when (slot-bound? a 'handlers)
+                (for-each (lambda (h)
+                            (when (member (handler-name h) +act-triggers+)
+                              (log-msg 'INFO "Running handler " (handler-name h))
+                              ((handler-action h) c)))
+                          (act-handlers a))))
             (lambda ()
-              (set! +act-vars+ #f)))))))
+              (set! +act-vars+ #f)
+              (set! +act-triggers+ #f)))))))
 
 (define-class <play> ()
   (name #:init-keyword #:name #:getter play-name)
@@ -137,9 +154,7 @@ variable (in that order). Raise an exception if the variable is not found."
           (set! +play-vars+ (alist->hash-table (play-vars p) equal?)))
         (init-connection! (play-connection p)))
       (lambda ()
-        (for-each (cut perform <> (play-connection p)) (play-acts p))
-        ;; TODO: run any triggered handlers
-        )
+        (for-each (cut perform <> (play-connection p)) (play-acts p)))
       (lambda ()
         (set! +play-vars+ #f)
         (close-connection! (play-connection p))))))