futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

build-system/gnu: Copy license files to all the outputs.

Browse Source 
Fixes <https://bugs.gnu.org/34702>.
Reported by Leo Famulari <leo@famulari.name>.

* guix/build/gnu-build-system.scm (install-license-files)[copy-to-directories]:
New procedure.
Call it to copy license files to all the outputs.
This commit is contained in:
Ludovic Courtès 2019-03-10 22:16:14 +01:00
parent 278409e7e9
commit 6db044db45
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
guix/build/gnu-build-system.scm
View File

@ -758,13 +758,23 @@ which cannot be found~%"
(string-append "../" directory))) (string-append "../" directory)))
directories)))) directories))))
(define (copy-to-directories directories sub-directory)
(lambda (file)
(for-each (if (file-is-directory? file)
(cut copy-recursively file <>)
(cut install-file file <>))
(map (cut string-append <> "/" sub-directory)
directories))))
(let* ((regexp (make-regexp license-file-regexp)) (let* ((regexp (make-regexp license-file-regexp))
(out (or (assoc-ref outputs "out") (out (or (assoc-ref outputs "out")
(match outputs (match outputs
(((_ . output) _ ...) (((_ . output) _ ...)
output)))) output))))
(package (strip-store-file-name out)) (package (strip-store-file-name out))
(directory (string-append out "/share/doc/" package)) (outputs (match outputs
(((_ . outputs) ...)
outputs)))
(source (if out-of-source? (source (if out-of-source?
(find-source-directory (find-source-directory
(package-name->name+version package)) (package-name->name+version package))
@ -777,10 +787,9 @@ which cannot be found~%"
(begin (begin
(format #t "installing ~a license files from '~a'~%" (format #t "installing ~a license files from '~a'~%"
(length files) source) (length files) source)
(for-each (lambda (file) (for-each (copy-to-directories outputs
(if (file-is-directory? file) (string-append "share/doc/"
(copy-recursively file directory) package))
(install-file file directory)))
(map (cut string-append source "/" <>) files))) (map (cut string-append source "/" <>) files)))
(format (current-error-port) (format (current-error-port)
"failed to find license files~%")) "failed to find license files~%"))