packages: Support 'patches' and 'snippets' for sources that are directories.

* guix/packages.scm (patch-and-repack)[numeric-extension?, tarxz-name]:
  New procedures.
  [builder]: Adjust to deal with SOURCE when it's a directory.
  <body>: Use 'tarxz-name'.  Always add (guix build utils) to
  IMPORTED-MODULES.
This commit is contained in:
Ludovic Courtès 2014-02-28 10:42:09 +01:00
parent 284c004613
commit 3ca00bb51e
1 changed files with 48 additions and 19 deletions

View File

@ -315,6 +315,20 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(dash (string-index sans #\-))) (dash (string-index sans #\-)))
(string-drop sans (+ 1 dash)))) (string-drop sans (+ 1 dash))))
(define (numeric-extension? file-name)
;; Return true if FILE-NAME ends with digits.
(string-every char-set:hex-digit (file-extension file-name)))
(define (tarxz-name file-name)
;; Return a '.tar.xz' file name based on FILE-NAME.
(let ((base (if (numeric-extension? file-name)
original-file-name
(file-sans-extension file-name))))
(string-append base
(if (equal? (file-extension base) "tar")
".xz"
".tar.xz"))))
(define patch-inputs (define patch-inputs
(map (lambda (number patch) (map (lambda (number patch)
(list (string-append "patch" (number->string number)) (list (string-append "patch" (number->string number))
@ -327,7 +341,8 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(define builder (define builder
`(begin `(begin
(use-modules (ice-9 ftw) (use-modules (ice-9 ftw)
(srfi srfi-1)) (srfi srfi-1)
(guix build utils))
(let ((out (assoc-ref %outputs "out")) (let ((out (assoc-ref %outputs "out"))
(xz (assoc-ref %build-inputs "xz")) (xz (assoc-ref %build-inputs "xz"))
@ -342,14 +357,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(format (current-error-port) "applying '~a'...~%" patch*) (format (current-error-port) "applying '~a'...~%" patch*)
(zero? (system* patch "--batch" ,@flags "--input" patch*)))) (zero? (system* patch "--batch" ,@flags "--input" patch*))))
(define (first-file directory)
;; Return the name of the first file in DIRECTORY.
(car (scandir directory
(lambda (name)
(not (member name '("." "..")))))))
(setenv "PATH" (string-append xz "/bin" ":" (setenv "PATH" (string-append xz "/bin" ":"
decomp "/bin")) decomp "/bin"))
(and (zero? (system* tar "xvf" source))
(let ((directory (car (scandir "." ;; SOURCE may be either a directory or a tarball.
(lambda (name) (and (if (file-is-directory? source)
(not (let* ((store (or (getenv "NIX_STORE")
(member name "/nix/store"))
'("." "..")))))))) (len (+ 1 (string-length store)))
(base (string-drop source len))
(dash (string-index base #\-))
(directory (string-drop base (+ 1 dash))))
(mkdir directory)
(copy-recursively source directory)
#t)
(zero? (system* tar "xvf" source)))
(let ((directory (first-file ".")))
(format (current-error-port) (format (current-error-port)
"source is under '~a'~%" directory) "source is under '~a'~%" directory)
(chdir directory) (chdir directory)
@ -375,23 +404,23 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(zero? (system* tar "cvfa" out directory)))))))) (zero? (system* tar "cvfa" out directory))))))))
(let ((name (string-append (file-sans-extension original-file-name) (let ((name (tarxz-name original-file-name))
".xz")) (inputs (filter-map (match-lambda
(inputs (filter-map (match-lambda ((name (? package? p))
((name (? package? p)) (and (member name (cons decompression-type
(and (member name (cons decompression-type '("tar" "xz" "patch")))
'("tar" "xz" "patch"))) (list name
(list name (package-derivation store p
(package-derivation store p system)))))
system))))) (or inputs (%standard-patch-inputs))))
(or inputs (%standard-patch-inputs))))) (modules (delete-duplicates (cons '(guix build utils) modules))))
(build-expression->derivation store name builder (build-expression->derivation store name builder
#:inputs `(("source" ,source) #:inputs `(("source" ,source)
,@inputs ,@inputs
,@patch-inputs) ,@patch-inputs)
#:system system #:system system
#:modules imported-modules #:modules modules
#:guile-for-build guile-for-build))) #:guile-for-build guile-for-build)))
(define* (package-source-derivation store source (define* (package-source-derivation store source