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:
		
							parent
							
								
									284c004613
								
							
						
					
					
						commit
						3ca00bb51e
					
				
					 1 changed files with 48 additions and 19 deletions
				
			
		|  | @ -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,8 +404,7 @@ 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 | ||||||
|  | @ -384,14 +412,15 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." | ||||||
|                                     (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 | ||||||
|  |  | ||||||
		Reference in a new issue