Implement trigger handlers

modules/ordo/context.scm

@@ -7,6 +7,10 @@
             get-context-scratch-dir
             set-context-scratch-dir!
             add-context-triggers!
+            get-context-triggers
+            set-context-triggers!
+            get-context-vars
+            set-context-vars!
             register-context-var!
             context-ref
             resolve-context-ref

modules/ordo/play.scm

@@ -1,18 +1,51 @@
 (define-module (ordo play)
+  #:use-module (srfi srfi-1) ; list utils
+  #:use-module (srfi srfi-9) ; records
   #:use-module (srfi srfi-26) ; cut
   #:use-module (ordo connection)
   #:use-module (ordo context)
   #:use-module (ordo task)
-  #:export (play))
+  #:export (play run-play))
 
-(define (play conn tasks)
+(define-record-type <play>
+  (make-play description connection tasks handlers)
+  play?
+  (connection get-play-connection)
+  (description get-play-description)
+  (tasks get-play-tasks)
+  (handlers get-play-handlers))
+
+(define* (play description #:key connection tasks (handlers '()))
+  (unless connection (error "connection is required"))
+  (unless tasks (error "tasks are required"))
+  (for-each (lambda (task)
+              (for-each (lambda (trigger)
+                          (unless (assoc-ref handlers trigger)
+                            (error (format #f "task \"~a\" references an undefined trigger: ~a"
+                                           (get-task-description task)
+                                           trigger))))
+                        (get-task-triggers task)))
+            tasks)
+  (make-play description connection tasks handlers))
+
+(define (run-trigger conn ctx handlers trigger)
+  (let ((handler (assoc-ref handlers trigger)))
+    (unless handler
+      (error (format #f "no handler defined for trigger ~a" trigger)))
+    (run-task conn ctx handler)))
+
+(define (run-play play)
+  (format #t "Running play ~a~%" (get-play-description play))
   (call-with-connection
-   conn
+   (get-play-connection play)
    (lambda (c)
      (let ((tmp-dir (car (connection-must c "mktemp" '("--directory"))))
            (ctx (make-context)))
        (set-context-scratch-dir! ctx tmp-dir)
        (dynamic-wind
          (const #t)
-         (lambda () (for-each (cut run-task c ctx <>) tasks))
+         (lambda ()
+           (for-each (cut run-task c ctx <>) (get-play-tasks play))
+           (for-each (cut run-trigger c ctx (get-play-handlers play) <>)
+                     (delete-duplicates (get-context-triggers ctx))))
          (lambda () (connection-must c "rm" `("-rf" ,tmp-dir))))))))

modules/ordo/task.scm

@@ -4,17 +4,25 @@
   #:use-module (srfi srfi-9) ; records
   #:use-module (srfi srfi-26) ; cut
   #:use-module (ordo context)
-  #:export (task run-task))
+  #:export (task
+            task?
+            get-task-description
+            set-task-description!
+            get-task-register
+            set-task-register!
+            get-task-triggers
+            set-task-triggers!
+            run-task))
 
 (define-record-type <task>
   (make-task description action register triggers)
   task?
-  (description get-description set-description!)
+  (description get-task-description set-task-description!)
-  (action get-action set-action!)
+  (action get-task-action set-task-action!)
-  (register get-register set-regiseter!)
+  (register get-task-register set-task-regiseter!)
-  (triggers get-triggers set-triggers!))
+  (triggers get-task-triggers set-task-triggers!))
 
-(define* (task description action #:key register triggers)
+(define* (task description action #:key (register #f) (triggers '()))
   (make-task description action register triggers))
 
 (define (run-task conn ctx task)

tryme.scm

@@ -4,18 +4,19 @@
  (ordo play)
  (ordo task))
 
-(define (tryme)
+(define test-play
-  (play (local-connection)
+  (play "Test play"
-        (list
+        #:connection (local-connection)
-         (task "Create test directory"
+        #:tasks (list
-               (install-directory "/home/ray/ordo-test"))
+                 (task "Create test directory"
-         (task "Create test file from string content"
+                       (install-directory "/home/ray/ordo-test"))
-               (install-file "/home/ray/ordo-test/foo" #:content "Hello, world!\n"))
+                 (task "Create test file from string content"
-         (task "Create test file from local source"
+                       (install-file "/home/ray/ordo-test/foo" #:content "Hello, world!\n"))
-               (install-file "/home/ray/ordo-test/bar" #:local-src "/home/ray/ordo-test/foo"))
+                 (task "Create test file from local source"
-         (task "Create test file from remote source"
+                       (install-file "/home/ray/ordo-test/bar" #:local-src "/home/ray/ordo-test/foo"))
-               (install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar"))
+                 (task "Create test file from remote source"
-         (task "Expect this to fail"
+                       (install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar")
-               (install-file "/root/ordo.txt" #:content "Hello from Ordo!")))))
+                       #:triggers `(frobnicate)))
+        #:handlers `((frobnicate . ,(task "Frobnicate" (const #t))))))
 
-(tryme)
+;;(run-play test-play)