Temporary directories and the start of play.

bin/play.scm

@@ -0,0 +1,42 @@
+#!/usr/bin/env -S guile --no-auto-compile -e main -s
+!#
+(use-modules (srfi srfi-11)
+             (ice-9 getopt-long)
+             (ice-9 format)
+             (ordo util tmpdir))
+
+(define (collect-files tarball dir . files)
+  (let* ((mode (if (file-exists? tarball) "--append" "--create"))
+         (rc (apply system* "tar" mode "--gzip" "--directory" dir "--file" tarball files)))
+    (unless (zero? rc)
+      (error (string-append "Error collecting files")))))
+
+(define* (usage #:optional errmsg)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (when errmsg
+        (format #t "Error: ~a~%~%" errmsg))
+      (display "Usage: play -t TARGET PLAYBOOK")
+      (newline)))
+  (exit (if errmsg EXIT_FAILURE EXIT_SUCCESS)))
+
+(define (process-options args)
+  (let* ((option-spec '((help   (single-char #\h) (value #f))
+                        (target (single-char #\t) (value #t) (required? #t))))
+         (options (getopt-long args option-spec))
+         (help-wanted (option-ref options 'help #f))
+         (target (option-ref options 'target #f))
+         (args   (option-ref options '() '())))
+    (cond
+     (help-wanted (usage))
+     ((not (= 1 (length args)))
+      (usage "Expected exactly one playbook")))
+    (values (car args) target)))
+
+(define (main args)
+  (let-values (((playbook-path target) (process-options args)))
+    (define playbook (load (canonicalize-path playbook-path)))
+    (define top-dir (dirname (dirname (current-filename))))
+    (define tmp-dir (create-temporary-directory))
+    (define tarball (string-append tmp-dir "/payload.tar.gz"))
+    (collect-files tarball top-dir "modules" "bin")))

modules/ordo/task.scm

@@ -0,0 +1,60 @@
+(define-module (ordo task)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (make-task task? task-name task-prerequisite-data task-want-skip task-action task-seq))
+
+;; Task
+;; name - a descriptive name for the task
+;; prerequisite-data - list of prerequisite data (local data
+;;                     that must be copied to the remote host
+;;                     in order for the task to run)
+;; want-skip - function of no args that should return #t if the
+;;             the task should be skipped
+;; action    - function of no args that runs the task
+(define-record-type <task>
+  (make-task name prerequisite-data want-skip action)
+  task?
+  (want-skip task-want-skip)
+  (name task-name)
+  (prerequisite-data task-prerequisite-data)
+  (action task-action))
+
+(define (combine-prerequisite-data tasks)
+  ;; TODO: work out what the equality operator should be, which
+  ;; will depend on how we represent prerequisite data
+  (apply lset-union = (map task-prerequisite-data tasks)))
+
+;; Combine the want-skips functions from a sequence of tasks.
+;; If any task has no want-skip function, the combined task cannot
+;; be skipped, so simply return #f. Otherwise, return a function that
+;; will only return #t if every task's want-skip function returns true.
+;; TODO: With this approach, if the top-level want-skip funciton returns
+;; #f (so the task action sequence runs), some of the tests will be repeated.
+;; Is it preferable always to have the top-level return #f and simply run
+;; the subtasks?
+(define (combine-want-skips tasks)
+  (let ((skips (map task-want-skip tasks)))
+    (if (every identity skips)
+        (lambda () (every identity (map (lambda (f) (f)) skips)))
+        #f)))
+
+;; Return a function that will apply each of the task actions
+;; in order.
+;; TODO: would it be better to store the list of actions and
+;; implement a task runner that would run either a single task
+;; or a sequence of tasks with appropriate logging?
+;; TODO: the implementation below does not handle skipping
+;; tasks in the sequence, this would be handled by a task runner.
+(define (combine-actions tasks)
+  (let ((actions (map task-action tasks)))
+    (lambda ()
+      (for-each (lambda (f) (f)) actions))))
+
+;; Return a task consists of a sequence of other tasks.
+(define (task-seq name task . task*)
+  (let ((tasks (cons task task*)))
+    (make-task
+     name
+     (combine-prerequisite-data tasks)
+     (combine-want-skips tasks)
+     (combine-actions tasks))))

modules/ordo/task/command.scm

@@ -3,13 +3,13 @@
   #:use-module (srfi srfi-11)
   #:use-module (ordo task)
   #:use-module (ordo util run)
-  #:export (task-command))
+  #:export (command))
 
-
-(define* (task-command name cmd #:optional (args '())
-                       #:key (fail-ok? #f) (stdin #f) (cwd #f) (env #f))
+(define* (command name cmd #:optional (args '())
+                  #:key (fail-ok? #f) (stdin #f) (cwd #f) (env #f) (skip? #f))
   (make-task name
-             #f
+             '()
+             skip?
              (lambda ()
                (let-values (((exit-code output) (run cmd args #:stdin stdin #:cwd cwd #:env env #:combine-output #t)))
                  (if (or fail-ok? (zero? exit-code))

modules/ordo/task/file.scm

@@ -0,0 +1,4 @@
+(define-module (ordo task file)
+  #:use-module (ordo task))
+
+(define (file ))

modules/ordo/util/tmpdir.scm

@@ -0,0 +1,36 @@
+(define-module (ordo util tmpdir)
+  #:use-module (system foreign)
+  #:use-module (srfi srfi-11)
+  #:use-module (ice-9 format)
+  #:export (create-temporary-directory))
+
+;; This is based on reading guix/build/syscalls.scm but less general
+;; than their implementation.
+(define mkdtemp!
+  (let* ((ptr (dynamic-func "mkdtemp" (dynamic-link)))
+         (proc (pointer->procedure '* ptr '(*) #:return-errno? #t)))
+    (lambda (tmpl)
+      (let-values (((result err) (proc (string->pointer tmpl))))
+        (when (null-pointer? result)
+          (error (format #f "mkdtemp! ~a: ~a" tmpl (strerror err))))
+        (pointer->string result)))))
+
+(define (create-temporary-directory)
+  (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+         (template (string-append directory "/ordo.XXXXXX")))
+    (mkdtemp! template)))
+
+;; This is borrowed from guix/util.scm
+;; TODO: we also need to borrow their delete-file-recursively
+;; (define (call-with-temporary-directory proc)
+;;   "Call PROC with a name of a temporary directory; close the directory and
+;; delete it when leaving the dynamic extent of this call."
+;;   (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+;;          (template  (string-append directory "/ordo.XXXXXX"))
+;;          (tmp-dir   (mkdtemp! template)))
+;;     (dynamic-wind
+;;       (const #t)
+;;       (lambda ()
+;;         (proc tmp-dir))
+;;       (lambda ()
+;;         (false-if-exception (delete-file-recursively tmp-dir))))))

ordo/task.scm

@@ -1,10 +0,0 @@
-(define-module (ordo task)
-  #:use-module (srfi srfi-9)
-  #:export (make-task task? task-name task-prerequisite-data set-task-prerequisite-data! task-action set-task-action!))
-
-(define-record-type <task>
-  (make-task name prerequisite-data action)
-  task?
-  (name task-name)
-  (prerequisite-data task-prerequisite-data set-task-prerequisite-data!)
-  (action task-action set-task-action!))

playbooks/tryme.scm

@@ -0,0 +1,3 @@
+(define x 7)
+
+(lambda () (* x x))