commit 3e1b3e3f374c784f673c75018a31af1beff2d9ac Author: Ray Miller Date: Sun Jul 14 17:11:24 2024 +0100 Initial check-in. diff --git a/ordo/task.scm b/ordo/task.scm new file mode 100644 index 0000000..2d10793 --- /dev/null +++ b/ordo/task.scm @@ -0,0 +1,10 @@ +(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 + (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!)) diff --git a/ordo/task/command.scm b/ordo/task/command.scm new file mode 100644 index 0000000..181d3cc --- /dev/null +++ b/ordo/task/command.scm @@ -0,0 +1,17 @@ +(define-module (ordo task command) + #:use-module (ice-9 format) + #:use-module (srfi srfi-11) + #:use-module (ordo task) + #:use-module (ordo util run) + #:export (task-command)) + + +(define* (task-command name cmd #:optional (args '()) + #:key (fail-ok? #f) (stdin #f) (cwd #f) (env #f)) + (make-task name + #f + (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)) + (values exit-code output) + (error (format #f "Error running ~a (exit ~d): ~a" cmd exit-code output))))))) diff --git a/ordo/util/run.scm b/ordo/util/run.scm new file mode 100644 index 0000000..c394bc7 --- /dev/null +++ b/ordo/util/run.scm @@ -0,0 +1,30 @@ +(define-module (ordo util run) + #:use-module (ice-9 textual-ports) + #:export (run with-cwd)) + +(define-syntax with-cwd + (syntax-rules () + ((_ new-dir body ...) + (let ((original-dir (getcwd))) + (dynamic-wind + (lambda () (chdir new-dir)) + (lambda () body ...) + (lambda () (chdir original-dir))))))) + +(define* (run cmd #:optional (args '()) #:key (combine-output #f) (env #f) (stdin #f) (cwd #f)) + (if cwd + (with-cwd cwd (run cmd args #:combine-output combine-output #:env env #:stdin stdin)) + (let* ((input-pipe (pipe)) + (output-pipe (pipe)) + (pid (spawn cmd (cons cmd args) + #:input (car input-pipe) + #:output (cdr output-pipe) + #:error (if combine-output (cdr output-pipe) (current-error-port)) + #:environment (or env (environ))))) + (close-port (cdr output-pipe)) + (close-port (car input-pipe)) + (when stdin (put-string (cdr input-pipe) stdin)) + (close-port (cdr input-pipe)) + (let ((output (get-string-all (car output-pipe)))) + (close-port (car output-pipe)) + (values (cdr (waitpid pid)) output)))))