diff --git a/modules/ordo/context.scm b/modules/ordo/context.scm index b9ff1b6..c106e3e 100644 --- a/modules/ordo/context.scm +++ b/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 diff --git a/modules/ordo/play.scm b/modules/ordo/play.scm index c805926..99f14f1 100644 --- a/modules/ordo/play.scm +++ b/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 + (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)))))))) diff --git a/modules/ordo/task.scm b/modules/ordo/task.scm index b93ff8f..b20073e 100644 --- a/modules/ordo/task.scm +++ b/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 (make-task description action register triggers) task? - (description get-description set-description!) - (action get-action set-action!) - (register get-register set-regiseter!) - (triggers get-triggers set-triggers!)) + (description get-task-description set-task-description!) + (action get-task-action set-task-action!) + (register get-task-register set-task-regiseter!) + (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) diff --git a/tryme.scm b/tryme.scm index a321bc4..1199a63 100644 --- a/tryme.scm +++ b/tryme.scm @@ -4,18 +4,19 @@ (ordo play) (ordo task)) -(define (tryme) - (play (local-connection) - (list - (task "Create test directory" - (install-directory "/home/ray/ordo-test")) - (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")) - (task "Create test file from remote source" - (install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar")) - (task "Expect this to fail" - (install-file "/root/ordo.txt" #:content "Hello from Ordo!"))))) +(define test-play + (play "Test play" + #:connection (local-connection) + #:tasks (list + (task "Create test directory" + (install-directory "/home/ray/ordo-test")) + (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")) + (task "Create test file from remote source" + (install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar") + #:triggers `(frobnicate))) + #:handlers `((frobnicate . ,(task "Frobnicate" (const #t)))))) -(tryme) +;;(run-play test-play)