Some refactoring

* Don't export record field setters (unless required)
* Remove get- prefix from record getters
* Introduce handlers (simplified tasks)

modules/ordo/action/filesystem.scm

@@ -32,7 +32,7 @@
 ;; Helper not intended for use outside of this module
 (define (upload-tmp-file conn ctx)
   (lambda (input-port)
-    (let ((tmp-path (car (connection-must conn "mktemp" `("-p" ,(get-context-scratch-dir ctx))))))
+    (let ((tmp-path (car (connection-must conn "mktemp" `("-p" ,(context-scratch-dir ctx))))))
       (connection-call-with-output-file conn tmp-path
                                         (lambda (output-port)
                                           (let loop ((data (get-bytevector-some input-port)))

modules/ordo/context.scm

@@ -2,26 +2,26 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
-  #:export (make-context
+  #:export (context
             context?
-            get-context-scratch-dir
+            context-scratch-dir
-            set-context-scratch-dir!
             add-context-triggers!
             get-context-triggers
-            set-context-triggers!
+            context-triggered?
-            get-context-vars
-            set-context-vars!
             register-context-var!
             context-ref
             resolve-context-ref
             resolve-context-refs))
 
 (define-record-type <context>
-  (make-context)
+  (make-context scratch-dir vars)
   context?
-  (scratch-dir get-context-scratch-dir set-context-scratch-dir!)
+  (scratch-dir context-scratch-dir set-context-scratch-dir!)
-  (vars get-context-vars set-context-vars!)
+  (vars context-vars set-context-vars!)
-  (triggers get-context-triggers set-context-triggers!))
+  (triggers context-triggers set-context-triggers!))
+
+(define* (context #:key scratch-dir init-vars)
+  (make-context scratch-dir init-vars))
 
 (define-record-type <context-ref>
   (context-ref name)
@@ -30,7 +30,7 @@
 
 (define (resolve-context-ref ctx v)
   (if (context-ref? v)
-      (assoc-ref (get-context-vars ctx) (var-name v))
+      (assoc-ref (context-vars ctx) (var-name v))
       v))
 
 (define (resolve-context-refs ctx args)
@@ -38,7 +38,11 @@
 
 (define (add-context-triggers! ctx triggers)
   (when triggers
-    (set-context-triggers! ctx (fold cons (or (get-context-triggers ctx) '()) triggers))))
+    (set-context-triggers! ctx
+                           (apply lset-adjoin equal? (or (context-triggers ctx) '()) triggers))))
+
+(define (context-triggered? ctx trigger)
+  (find (lambda (t) (equal? t trigger)) (context-triggers ctx)))
 
 (define (register-context-var! ctx var-name val)
-  (set-context-vars! ctx (assoc-set! (get-context-vars ctx) var-name val)))
+  (set-context-vars! ctx (assoc-set! (context-vars ctx) var-name val)))

modules/ordo/handler.scm

@@ -0,0 +1,26 @@
+(define-module (ordo handler)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1) ; list utils
+  #:use-module (srfi srfi-9) ; records
+  #:use-module (srfi srfi-26) ; cut
+  #:use-module (ordo context)
+  #:export (handler
+            handler?
+            handler-description
+            handler-action
+            run-handler))
+
+(define-record-type <handler>
+  (make-handler description action)
+  handler?
+  (description handler-description)
+  (action handler-action))
+
+(define* (handler description action)
+  (make-handler description action))
+
+(define (run-handler conn ctx handler)
+  (match handler
+    (($ <handler> description action)
+     (format #t "RUNNING HANDLER ~a~%" description)
+     (action conn ctx))))

modules/ordo/play.scm

@@ -1,51 +1,58 @@
 (define-module (ordo play)
+  #:use-module (ice-9 match)
   #: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)
+  #:use-module (ordo handler)
   #:export (play run-play))
 
 (define-record-type <play>
-  (make-play description connection tasks handlers)
+  (make-play description connection vars tasks handlers)
   play?
-  (connection get-play-connection)
+  (connection play-connection)
-  (description get-play-description)
+  (vars play-vars)
-  (tasks get-play-tasks)
+  (description play-description)
-  (handlers get-play-handlers))
+  (tasks play-tasks)
+  (handlers play-handlers))
 
-(define* (play description #:key connection tasks (handlers '()))
+(define* (play description #:key connection tasks (vars '()) (handlers '()))
+  ;; TODO: validation could be better - check for non-empty tasks list, check
+  ;; type of connection, tasks, and handlers, etc.
   (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)
+                                           (task-description task)
                                            trigger))))
-                        (get-task-triggers task)))
+                        (task-triggers task)))
             tasks)
-  (make-play description connection tasks handlers))
+  (make-play description connection vars tasks handlers))
 
 (define (run-trigger conn ctx handlers trigger)
-  (let ((handler (assoc-ref handlers trigger)))
+  (let ((h (assoc-ref handlers trigger)))
-    (unless handler
+    (unless h
       (error (format #f "no handler defined for trigger ~a" trigger)))
-    (run-task conn ctx handler)))
+    (run-handler conn ctx h)))
 
 (define (run-play play)
-  (format #t "Running play ~a~%" (get-play-description play))
+  (format #t "RUNNING PLAY ~a~%" (play-description play))
   (call-with-connection
-   (get-play-connection play)
+   (play-connection play)
    (lambda (c)
-     (let ((tmp-dir (car (connection-must c "mktemp" '("--directory"))))
+     (let* ((tmp-dir (car (connection-must c "mktemp" '("--directory"))))
-           (ctx (make-context)))
+            (ctx (context #:scratch-dir tmp-dir #:init-vars (play-vars play))))
-       (set-context-scratch-dir! ctx tmp-dir)
        (dynamic-wind
          (const #t)
          (lambda ()
-           (for-each (cut run-task c ctx <>) (get-play-tasks play))
+           (for-each (cut run-task c ctx <>) (play-tasks play))
-           (for-each (cut run-trigger c ctx (get-play-handlers play) <>)
+           (for-each (match-lambda
-                     (delete-duplicates (get-context-triggers ctx))))
+                       ((name . handler)
+                        (when (context-triggered? ctx name)
+                          (run-handler c ctx handler))))
+                     (play-handlers play)))
          (lambda () (connection-must c "rm" `("-rf" ,tmp-dir))))))))

modules/ordo/task.scm

@@ -6,21 +6,19 @@
   #:use-module (ordo context)
   #:export (task
             task?
-            get-task-description
+            task-description
-            set-task-description!
+            task-action
-            get-task-register
+            task-register
-            set-task-register!
+            task-triggers
-            get-task-triggers
-            set-task-triggers!
             run-task))
 
 (define-record-type <task>
   (make-task description action register triggers)
   task?
-  (description get-task-description set-task-description!)
+  (description task-description)
-  (action get-task-action set-task-action!)
+  (action task-action)
-  (register get-task-register set-task-regiseter!)
+  (register task-register)
-  (triggers get-task-triggers set-task-triggers!))
+  (triggers task-triggers))
 
 (define* (task description action #:key (register #f) (triggers '()))
   (make-task description action register triggers))
@@ -28,10 +26,9 @@
 (define (run-task conn ctx task)
   (match task
     (($ <task> description action register triggers)
-     (format #t "START ~a~%" description)
+     (format #t "RUNNING TASK ~a~%" description)
      (let ((result (action conn ctx)))
        (when register
          (register-context-var! ctx register result))
        (when triggers
-         (add-context-triggers! ctx triggers))
+         (add-context-triggers! ctx triggers))))))
-       (format #t "END~%")))))

tryme.scm

@@ -2,7 +2,8 @@
  (ordo connection)
  (ordo action filesystem)
  (ordo play)
- (ordo task))
+ (ordo task)
+ (ordo handler))
 
 (define test-play
   (play "Test play"
@@ -13,10 +14,13 @@
                  (task "Create test file from string content"
                        (install-file "/home/ray/ordo-test/foo" #:content "Hello, world!\n"))
                  (task "Create test file from local source"
-                       (install-file "/home/ray/ordo-test/bar" #:local-src "/home/ray/ordo-test/foo"))
+                       (install-file "/home/ray/ordo-test/bar" #:local-src "/home/ray/ordo-test/foo")
+                       #:triggers '(fritz))
                  (task "Create test file from remote source"
                        (install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar")
-                       #:triggers `(frobnicate)))
+                       #:triggers '(frobnicate)))
-        #:handlers `((frobnicate . ,(task "Frobnicate" (const #t))))))
+        #:handlers `((frobnicate . ,(handler "Frobnicate" (const #t)))
+                     (fritz . ,(handler "Fritz" (const #t)))
+                     (frotz . ,(handler "Frotz" (const #t))))))
 
 ;;(run-play test-play)