nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

utils: Add `with-atomic-file-replacement'. 

* guix/build/utils.scm (with-atomic-file-replacement): New procedure.
  (substitute): Use it.
This commit is contained in:
Ludovic Courtès 2012-10-16 17:28:11 +02:00
parent df1fab5837
commit dcd7290654
1 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
guix/build/utils.scm
View File

@ -32,6 +32,7 @@
alist-cons-before alist-cons-before
alist-cons-after alist-cons-after
alist-replace alist-replace
with-atomic-file-replacement
substitute substitute
substitute* substitute*
dump-port dump-port
@ -157,45 +158,55 @@ An error is raised when no such pair exists."
;;; Text substitution (aka. sed). ;;; Text substitution (aka. sed).
;;; ;;;
(define (substitute file pattern+procs) (define (with-atomic-file-replacement file proc)
"PATTERN+PROCS is a list of regexp/two-argument procedure. For each line "Call PROC with two arguments: an input port for FILE, and an output
of FILE, and for each PATTERN that it matches, call the corresponding PROC port for the file that is going to replace FILE. Upon success, FILE is
as (PROC LINE MATCHES); PROC must return the line that will be written as a atomically replaced by what has been written to the output port, and
substitution of the original line." PROC's result is returned."
(let* ((rx+proc (map (match-lambda (let* ((template (string-append file ".XXXXXX"))
(((? regexp? pattern) . proc)
(cons pattern proc))
((pattern . proc)
(cons (make-regexp pattern regexp/extended)
proc)))
pattern+procs))
(template (string-append file ".XXXXXX"))
(out (mkstemp! template)) (out (mkstemp! template))
(mode (stat:mode (stat file)))) (mode (stat:mode (stat file))))
(with-throw-handler #t (with-throw-handler #t
(lambda () (lambda ()
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(let loop ((line (read-line in 'concat))) (let ((result (proc in out)))
(if (eof-object? line) (close out)
#t (chmod template mode)
(let ((line (fold (lambda (r+p line) (rename-file template file)
(match r+p result))))
((regexp . proc)
(match (list-matches regexp line)
((and m+ (_ _ ...))
(proc line m+))
(_ line)))))
line
rx+proc)))
(display line out)
(loop (read-line in 'concat)))))))
(close out)
(chmod template mode)
(rename-file template file))
(lambda (key . args) (lambda (key . args)
(false-if-exception (delete-file template)))))) (false-if-exception (delete-file template))))))
(define (substitute file pattern+procs)
"PATTERN+PROCS is a list of regexp/two-argument procedure. For each line
of FILE, and for each PATTERN that it matches, call the corresponding PROC
as (PROC LINE MATCHES); PROC must return the line that will be written as a
substitution of the original line."
(let ((rx+proc (map (match-lambda
(((? regexp? pattern) . proc)
(cons pattern proc))
((pattern . proc)
(cons (make-regexp pattern regexp/extended)
proc)))
pattern+procs)))
(with-atomic-file-replacement file
(lambda (in out)
(let loop ((line (read-line in 'concat)))
(if (eof-object? line)
#t
(let ((line (fold (lambda (r+p line)
(match r+p
((regexp . proc)
(match (list-matches regexp line)
((and m+ (_ _ ...))
(proc line m+))
(_ line)))))
line
rx+proc)))
(display line out)
(loop (read-line in 'concat)))))))))
(define-syntax let-matches (define-syntax let-matches
;; Helper macro for `substitute*'. ;; Helper macro for `substitute*'.
@ -329,4 +340,5 @@ patched, #f otherwise."
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1)
;;; eval: (put 'let-matches 'scheme-indent-function 3) ;;; eval: (put 'let-matches 'scheme-indent-function 3)
;;; eval: (put 'with-atomic-file-replacement 'scheme-indent-function 1)
;;; End: ;;; End: