From 679d2552a9729bbbe3b1cc7ffe58d70689123a73 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sun, 5 Jan 2025 19:12:53 +0000 Subject: [PATCH] Delete obsolete implementation files --- modules/ordo/prerequisite-data.scm | 17 -------- modules/ordo/task/command.scm | 17 -------- modules/ordo/task/file.scm | 4 -- modules/ordo/util/filesystem.scm | 63 ------------------------------ modules/ordo/util/process.scm | 62 ----------------------------- playbooks/tryme.scm | 3 -- 6 files changed, 166 deletions(-) delete mode 100644 modules/ordo/prerequisite-data.scm delete mode 100644 modules/ordo/task/command.scm delete mode 100644 modules/ordo/task/file.scm delete mode 100644 modules/ordo/util/filesystem.scm delete mode 100644 modules/ordo/util/process.scm delete mode 100644 playbooks/tryme.scm diff --git a/modules/ordo/prerequisite-data.scm b/modules/ordo/prerequisite-data.scm deleted file mode 100644 index 6a8d5f4..0000000 --- a/modules/ordo/prerequisite-data.scm +++ /dev/null @@ -1,17 +0,0 @@ -(define-module (ordo prerequisite-data) - #:use-module (oop goops)) - -(define-class ()) - -(define-class () - (path #:init-keyword #:path #:getter get-path)) - -(define-method (equal? (x ) (y )) - (equal? (get-path x) (get-path y))) - -(define (local-file path) - (make #:path path)) - -(define-class () - (handler #:init-keyword #:handler #:getter get-handler) - (args #:init-keyword #:args :getter get-args)) diff --git a/modules/ordo/task/command.scm b/modules/ordo/task/command.scm deleted file mode 100644 index 52a68bf..0000000 --- a/modules/ordo/task/command.scm +++ /dev/null @@ -1,17 +0,0 @@ -(define-module (ordo task command) - #:use-module (ice-9 format) - #:use-module (srfi srfi-11) - #:use-module (ordo task) - #:use-module (ordo util process) - #:export (command)) - -(define* (command name cmd #:optional (args '()) - #:key (fail-ok? #f) (stdin #f) (cwd #f) (env #f) (skip? #f)) - (make-task name - '() - 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)) - (values exit-code output) - (error (format #f "Error running ~a (exit ~d): ~a" cmd exit-code output))))))) diff --git a/modules/ordo/task/file.scm b/modules/ordo/task/file.scm deleted file mode 100644 index c766485..0000000 --- a/modules/ordo/task/file.scm +++ /dev/null @@ -1,4 +0,0 @@ -(define-module (ordo task file) - #:use-module (ordo task)) - -(define (file )) diff --git a/modules/ordo/util/filesystem.scm b/modules/ordo/util/filesystem.scm deleted file mode 100644 index 3b70ffb..0000000 --- a/modules/ordo/util/filesystem.scm +++ /dev/null @@ -1,63 +0,0 @@ -(define-module (ordo util filesystem) - #:use-module (system foreign) - #:use-module (srfi srfi-11) - #:use-module (ice-9 format) - #:use-module (ice-9 ftw) - #:export (delete-file-recursively - create-temporary-directory - call-with-temporary-directory)) - -(define* (delete-file-recursively filename #:key (verbose #f)) - (define dev (stat:dev (stat filename))) - (define (enter? name stat result) - (= (stat:dev stat) dev)) - (define (leaf name stat result) - (if (false-if-exception (delete-file name)) - (and verbose (format #t "delete-file ~a OK~%" name)) - (format (current-error-port) "warning: delete-file ~a failed~%" name)) - result) - (define (down name stat result) - result) - (define (up name stat result) - (if (false-if-exception (rmdir name)) - (and verbose (format #t "rmdir ~a OK~%" name)) - (format (current-error-port) "warning: rmdir ~a failed~%" name)) - result) - (define (skip name state result) - result) - (define (error name stat errno result) - (format (current-error-port) "warning: ~a: ~a~%" - name (strerror errno)) - result) - (file-system-fold enter? leaf down up skip error #f filename)) - - -;; This is based on reading guix/build/syscalls.scm but less general -;; than their implementation. -;; TODO: why is this needed? The guile standard library has mkdtemp -;; that seems to do the same thing. -(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 -(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 ((tmp-dir (create-temporary-directory))) - (dynamic-wind - (const #t) - (lambda () - (proc tmp-dir)) - (lambda () - (false-if-exception (delete-file-recursively tmp-dir)))))) diff --git a/modules/ordo/util/process.scm b/modules/ordo/util/process.scm deleted file mode 100644 index 810a42f..0000000 --- a/modules/ordo/util/process.scm +++ /dev/null @@ -1,62 +0,0 @@ -(define-module (ordo util process) - #:use-module (ice-9 textual-ports) - #:export (with-cwd with-env capture)) - -(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))))))) - -;; Not needed for CAPTURE, which supports an environment override, -;; but might be useful for SYSTEM and SYSTEM* -(define-syntax with-env - (syntax-rules () - ((_ new-env body ...) - (let ((original-env (environ))) - (dynamic-wind - (lambda () (environ new-env)) - (lambda () body ...) - (lambda () (environ original-env))))))) - -;; Run a command and capture the output. Currently this only supports -;; text input and output. If necessary, we could use the (rnrs io ports) -;; module and use PUT-BYTEVECTOR / GET-BYTEVECTOR-ALL and examine the type -;; of STDIN to determine whether to call PUT-STRING or PUT-BYTEVECTOR. For -;; STDOUT, we'd need to add a #:binary argument so the caller could indicate -;; they are expecting binary output. Not implemented yet incase YAGNI. -(define* (capture 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))))) - -;; Possibly nicer way to do this, suggested by dsmith on IRC: https://bpa.st/3JYTA -;; (use-modules (ice-9 popen) -;; (ice-9 rdelim) -;; (ice-9 receive)) - -;; (define (filter text) -;; (receive (from to pids) (pipeline '(("the-command"))) -;; (write text to) -;; (close to) -;; (read-line from))) - -;; See also https://github.com/ray1729/ordo/blob/main/modules/ordo/util/process.scm diff --git a/playbooks/tryme.scm b/playbooks/tryme.scm deleted file mode 100644 index 72fd903..0000000 --- a/playbooks/tryme.scm +++ /dev/null @@ -1,3 +0,0 @@ -(define x 7) - -(lambda () (* x x))