diff options
author | Mathieu Othacehe <m.othacehe@gmail.com> | 2017-07-01 12:23:23 +0200 |
---|---|---|
committer | Mathieu Othacehe <m.othacehe@gmail.com> | 2017-07-01 18:47:18 +0200 |
commit | f301378d943e9848df30805957d4933e0e894f2c (patch) | |
tree | 2904cc8097eef3816fc95146e6ee63211e678164 /src/cuirass/utils.scm | |
parent | 706c80c6a0e0ab32684d4ae9d8d11295bb70087a (diff) | |
download | cuirass-f301378d943e9848df30805957d4933e0e894f2c.tar cuirass-f301378d943e9848df30805957d4933e0e894f2c.tar.gz |
utils: Remove useless procedures.
* src/cuirass/utils.scm (mkdir-p, make-user-module,
call-with-temporary-directory, with-directory-excursion): Remove because
already defined in guix.
* tests/utils (with-directory-excursion): Remove associated test.
* src/cuirass/base.scm: Use (guix build utils) to provide procedure removed
from (cuirass utils).
* bin/evaluate.in: Ditto.
* bin/cuirass.in: Use "make-user-module" provided by (guix ui).
Diffstat (limited to 'src/cuirass/utils.scm')
-rw-r--r-- | src/cuirass/utils.scm | 69 |
1 files changed, 1 insertions, 68 deletions
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index bcd5e12..dbe00a0 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -23,12 +23,8 @@ #:use-module (srfi srfi-1) #:export (;; Procedures alist? - mkdir-p - make-user-module - call-with-temporary-directory ;; Macros. - λ* - with-directory-excursion)) + λ*)) (define-syntax-rule (λ* formals body ...) (lambda* formals body ...)) @@ -37,66 +33,3 @@ "Return #t if OBJ is an alist." (and (list? obj) (every pair? obj))) - -(define mkdir-p - (let ((not-slash (char-set-complement (char-set #\/)))) - (λ* (dir #:optional mode) - "Create directory DIR and all its ancestors." - (let ((absolute? (string-prefix? "/" dir))) - (let loop ((components (string-tokenize dir not-slash)) - (root (if absolute? "" "."))) - (match components - ((head tail ...) - (let ((dir-name (string-append root "/" head))) - (catch 'system-error - (λ () - (if mode - (mkdir dir-name mode) - (mkdir dir-name)) - (loop tail dir-name)) - (λ args - ;; On GNU/Hurd we can get EROFS instead of EEXIST here. - ;; Thus, if we get something other than EEXIST, check - ;; whether DIR-NAME exists. See - ;; <https://lists.gnu.org/archive/html/guix-devel/2016-02/msg00049.html>. - (if (or (= EEXIST (system-error-errno args)) - (let ((st (stat dir-name #f))) - (and st (eq? 'directory (stat:type st))))) - (loop tail dir-name) - (apply throw args)))))) - (() #t))))))) - -(define-syntax-rule (with-directory-excursion dir body ...) - "Run BODY with DIR as the process's current directory." - (let ((init (getcwd))) - (dynamic-wind - (λ () (chdir dir)) - (λ () body ...) - (λ () (chdir init))))) - -(define* (make-user-module #:optional (modules '())) - "Return a new user module with the additional MODULES loaded." - ;; Module in which the machine description file is loaded. - (let ((module (make-fresh-user-module))) - (for-each (lambda (iface) - (module-use! module (resolve-interface iface))) - modules) - module)) - - -;;; -;;; Temporary files. -;;; - -(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* ((parent (or (getenv "TMPDIR") "/tmp")) - (tmp-dir (string-append parent "/" (basename (tmpnam))))) - (mkdir-p tmp-dir) - (dynamic-wind - (const #t) - (lambda () - (proc tmp-dir)) - (lambda () - (false-if-exception (rmdir tmp-dir)))))) |