From 5a675b2c67825e581cd8193f643f66c4cb1ea1e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 3 Mar 2020 10:34:35 +0100 Subject: guix build: Allow non-package objects in manifest. * guix/scripts/build.scm (options->things-to-build)[manifest->packages]: Remove. Inline map of 'manifest-entry-item'. * tests/guix-build.sh: Add test for "guix build -m" with non-package object. --- guix/scripts/build.scm | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index eedf6bf6a8..5c690cb99d 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -812,14 +812,6 @@ build---packages, gexps, derivations, and so on." (for-each validate-type lst) lst)) - ;; Note: Taken from (guix scripts refresh). - (define (manifest->packages manifest) - "Return the list of packages in MANIFEST." - (filter-map (lambda (entry) - (let ((item (manifest-entry-item entry))) - (if (package? item) item #f))) - (manifest-entries manifest))) - (append-map (match-lambda (('argument . (? string? spec)) (cond ((derivation-path? spec) @@ -844,8 +836,10 @@ build---packages, gexps, derivations, and so on." (('file . file) (ensure-list (load* file (make-user-module '())))) (('manifest . manifest) - (manifest->packages - (load* manifest (make-user-module '((guix profiles) (gnu)))))) + (map manifest-entry-item + (manifest-entries + (load* manifest + (make-user-module '((guix profiles) (gnu))))))) (('expression . str) (ensure-list (read/eval str))) (('argument . (? derivation? drv)) -- cgit v1.2.3 From d37b5a1b58824dafbe6f32b1c183661c147c660c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 3 Mar 2020 10:48:09 +0100 Subject: weather: Allow non-package objects in manifest. * guix/scripts/weather.scm (package-outputs)[lower-object/no-grafts]: New procedure. Use it instead of 'package->derivation'. --- guix/scripts/weather.scm | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 1701772bc1..7bfa786358 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2018 Kyle Meyer ;;; @@ -28,6 +28,7 @@ #:use-module (guix monads) #:use-module (guix store) #:use-module (guix grafts) + #:use-module (guix gexp) #:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module (guix scripts substitute) #:use-module (guix http-client) @@ -75,7 +76,16 @@ scope." (define* (package-outputs packages #:optional (system (%current-system))) "Return the list of outputs of all of PACKAGES for the given SYSTEM." - (let ((packages (filter (cut supported-package? <> system) packages))) + (define (lower-object/no-grafts obj system) + (mlet* %store-monad ((previous (set-grafting #f)) + (drv (lower-object obj system)) + (_ (set-grafting previous))) + (return drv))) + + (let ((packages (filter (lambda (package) + (or (not (package? package)) + (supported-package? package system))) + packages))) (format (current-error-port) (G_ "computing ~h package derivations for ~a...~%") (length packages) system) @@ -84,8 +94,11 @@ scope." (lambda (report) (foldm %store-monad (lambda (package result) - (mlet %store-monad ((drv (package->derivation package system - #:graft? #f))) + ;; PACKAGE could in fact be a non-package object, for example + ;; coming from a user-specified manifest. Thus, use + ;; 'lower-object' rather than 'package->derivation' here. + (mlet %store-monad ((drv (lower-object/no-grafts package + system))) (report) (match (derivation->output-paths drv) (((names . items) ...) -- cgit v1.2.3 From f42f39ad68354d19c63222a9630c6e340843aa86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 5 Mar 2020 15:52:37 +0100 Subject: guix build: Parameterize '%graft?' upfront. * guix/scripts/build.scm (guix-build): Add 'graft?' variable and parameterize %GRAFT?. --- guix/scripts/build.scm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 5c690cb99d..da2a675ce2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -943,13 +943,21 @@ needed." (parse-command-line args %options (list %default-options))) + (define graft? + (assoc-ref opts 'graft?)) + (with-error-handling (with-status-verbosity (assoc-ref opts 'verbosity) (with-store store ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) - (parameterize ((current-terminal-columns (terminal-columns))) + (parameterize ((current-terminal-columns (terminal-columns)) + + ;; Set grafting upfront in case the user's input + ;; depends on it (e.g., a manifest or code snippet that + ;; calls 'gexp->derivation'). + (%graft? graft?)) (let* ((mode (assoc-ref opts 'build-mode)) (drv (options->derivations store opts)) (urls (map (cut string-append <> "/log") -- cgit v1.2.3 From e7671685a882a2269718c3949b7f2cd995cb85e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 5 Mar 2020 16:09:52 +0100 Subject: weather: Parameterize '%graft?' upfront. * guix/scripts/weather.scm (guix-weather): Parameterize %GRAFT? upfront. --- guix/scripts/weather.scm | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 7bfa786358..629844768a 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -500,7 +500,12 @@ SERVER. Display information for packages with at least THRESHOLD dependents." (if file (load-manifest file) '()))))) (with-error-handling - (parameterize ((current-terminal-columns (terminal-columns))) + (parameterize ((current-terminal-columns (terminal-columns)) + + ;; Set grafting upfront in case the user's input depends on + ;; it (e.g., a manifest or code snippet that calls + ;; 'gexp->derivation'). + (%graft? #f)) (let* ((opts (parse-command-line args %options (list %default-options) #:build-options? #f)) @@ -513,13 +518,12 @@ SERVER. Display information for packages with at least THRESHOLD dependents." (systems systems))) (packages (package-list opts)) (items (with-store store - (parameterize ((%graft? #f)) - (concatenate - (run-with-store store - (mapm %store-monad - (lambda (system) - (package-outputs packages system)) - systems))))))) + (concatenate + (run-with-store store + (mapm %store-monad + (lambda (system) + (package-outputs packages system)) + systems)))))) (for-each (lambda (server) (report-server-coverage server items) (match (assoc-ref opts 'coverage) -- cgit v1.2.3 From 1d24cc6de674ff8cd6321eb373ab86c8028e2281 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 6 Mar 2020 08:29:09 +0100 Subject: scripts: Show disk-space warning when under the min of the thresholds. Follow-up to 71c3c3df92375ca9b4bd28b2be90dda67288fa5c which got the logic wrong. * guix/scripts.scm (warn-about-disk-space): Compare AVAILABLE to the min of RELATIVE-THRESHOLD-IN-BYTES and ABSOLUTE-THRESHOLD-IN-BYTES, not the max. --- guix/scripts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts.scm b/guix/scripts.scm index e235c8d4c3..3e19e38957 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -237,7 +237,7 @@ THRESHOLDS is a pair (ABSOLUTE-THRESHOLD . RELATIVE-THRESHOLD)." (total (* block-size (file-system-block-count stats))) (relative-threshold-in-bytes (* total (cadr thresholds))) (absolute-threshold-in-bytes (car thresholds))) - (when (< available (max relative-threshold-in-bytes + (when (< available (min relative-threshold-in-bytes absolute-threshold-in-bytes)) (warning (G_ "only ~,1f GiB of free space available on ~a~%") (/ available 1. GiB) (%store-prefix)) -- cgit v1.2.3 From c363722e81a8aa54f64468db9fcc42ef8dd74944 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sat, 7 Mar 2020 19:30:51 +0100 Subject: import/cran: Add vignette builder to native inputs. * guix/import/cran.scm (needs-knitr?): New procedure. (description->package): Use it. --- guix/import/cran.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index bcb37ed250..bb8226f714 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus +;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; @@ -385,6 +385,9 @@ reference the pkg-config tool." (tarball-needs-pkg-config? thing) (directory-needs-pkg-config? thing))) +(define (needs-knitr? meta) + (member "knitr" (listify meta "VignetteBuilder"))) + ;; XXX adapted from (guix scripts hash) (define (file-hash file select? recursive?) ;; Compute the hash of FILE. @@ -486,7 +489,9 @@ from the alist META, which was derived from the R package's DESCRIPTION file." `(,@(if (needs-fortran? source (not git?)) '("gfortran") '()) ,@(if (needs-pkg-config? source (not git?)) - '("pkg-config") '())) + '("pkg-config") '()) + ,@(if (needs-knitr? meta) + '("r-knitr") '())) 'native-inputs) (home-page ,(if (string-null? home-page) (string-append base-url name) -- cgit v1.2.3 From 5d52d10661635ece0db9ffb89ab57f5f937221aa Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 6 Mar 2020 10:06:02 +0100 Subject: store: Add set-current-target procedure. * guix/store.scm (set-current-target): New exported procedure. --- guix/store.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index f99fa581a8..5768a2ba7a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Jan Nieuwenhuizen -;;; Copyright © 2019 Mathieu Othacehe +;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -161,6 +161,7 @@ current-system set-current-system current-target-system + set-current-target text-file interned-file interned-file-tree @@ -1823,6 +1824,11 @@ the store." (lambda (state) (values (%current-target-system) state))) +(define-inlinable (set-current-target target) + ;; Set the %CURRENT-TARGET-SYSTEM fluid at bind time. + (lambda (state) + (values (%current-target-system target) state))) + (define %guile-for-build ;; The derivation of the Guile to be used within the build environment, ;; when using 'gexp->derivation' and co. -- cgit v1.2.3 From 9a2f99f42fdd19ac379ac85be2a8c2a34a345aa5 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 6 Mar 2020 10:06:54 +0100 Subject: gexp: Default to current target. * guix/gexp.scm (lower-object): Set target argument to 'current by default and look for the current target system at bind time if needed, (gexp->file): ditto, (gexp->script): ditto, (lower-gexp): make sure lowered extensions are not cross-compiled. * tests/gexp.scm: Add cross-compilation test-cases for gexp->script and gexp->file with a target passed explicitely and with a default target. --- guix/gexp.scm | 91 ++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 53 insertions(+), 38 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index c4f4e80209..a657921741 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2018 Jan Nieuwenhuizen -;;; Copyright © 2019 Mathieu Othacehe +;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -218,7 +218,7 @@ procedure to expand it; otherwise return #f." (define* (lower-object obj #:optional (system (%current-system)) - #:key target) + #:key (target 'current)) "Return as a value in %STORE-MONAD the derivation or store item corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true. OBJ must be an object that has an associated gexp compiler, such as a @@ -228,7 +228,10 @@ OBJ must be an object that has an associated gexp compiler, such as a (raise (condition (&gexp-input-error (input obj))))) (lower ;; Cache in STORE the result of lowering OBJ. - (mlet %store-monad ((graft? (grafting?))) + (mlet %store-monad ((target (if (eq? target 'current) + (current-target-system) + (return target))) + (graft? (grafting?))) (mcached (let ((lower (lookup-compiler obj))) (lower obj system target)) obj @@ -779,7 +782,8 @@ derivations--e.g., code evaluated for its side effects." (extensions -> (gexp-extensions exp)) (exts (mapm %store-monad (lambda (obj) - (lower-object obj system)) + (lower-object obj system + #:target #f)) extensions)) (modules+compiled (imported+compiled-modules %modules system @@ -1597,16 +1601,19 @@ are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty." #:key (guile (default-guile)) (module-path %load-path) (system (%current-system)) - target) + (target 'current)) "Return an executable script NAME that runs EXP using GUILE, with EXP's imported modules in its search path. Look up EXP's modules in MODULE-PATH." - (mlet %store-monad ((set-load-path - (load-path-expression (gexp-modules exp) - module-path - #:extensions - (gexp-extensions exp) - #:system system - #:target target))) + (mlet* %store-monad ((target (if (eq? target 'current) + (current-target-system) + (return target))) + (set-load-path + (load-path-expression (gexp-modules exp) + module-path + #:extensions + (gexp-extensions exp) + #:system system + #:target target))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) @@ -1640,7 +1647,7 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH." (module-path %load-path) (splice? #f) (system (%current-system)) - target) + (target 'current)) "Return a derivation that builds a file NAME containing EXP. When SPLICE? is true, EXP is considered to be a list of expressions that will be spliced in the resulting file. @@ -1651,36 +1658,44 @@ Lookup EXP's modules in MODULE-PATH." (define modules (gexp-modules exp)) (define extensions (gexp-extensions exp)) - (if (or (not set-load-path?) - (and (null? modules) (null? extensions))) - (gexp->derivation name - (gexp - (call-with-output-file (ungexp output) - (lambda (port) - (for-each (lambda (exp) - (write exp port)) - '(ungexp (if splice? - exp - (gexp ((ungexp exp))))))))) - #:local-build? #t - #:substitutable? #f - #:system system - #:target target) - (mlet %store-monad ((set-load-path - (load-path-expression modules module-path - #:extensions extensions - #:system system - #:target target))) + (mlet* %store-monad + ((target (if (eq? target 'current) + (current-target-system) + (return target))) + (no-load-path? -> (or (not set-load-path?) + (and (null? modules) + (null? extensions)))) + (set-load-path + (load-path-expression modules module-path + #:extensions extensions + #:system system + #:target target))) + (if no-load-path? + (gexp->derivation name + (gexp + (call-with-output-file (ungexp output) + (lambda (port) + (for-each + (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) + #:local-build? #t + #:substitutable? #f + #:system system + #:target target) (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) (write '(ungexp set-load-path) port) - (for-each (lambda (exp) - (write exp port)) - '(ungexp (if splice? - exp - (gexp ((ungexp exp))))))))) + (for-each + (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) #:module-path module-path #:local-build? #t #:substitutable? #f -- cgit v1.2.3 From df0bb509c2ef876e4d204fb322b18879bc9a3b08 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Mon, 9 Mar 2020 14:15:47 +0100 Subject: download: Remove misbehaving kvin.lv mirror. It issues bogus redirections instead of returning 404. * guix/download.scm (%mirrors): Remove kvin.lv from CPAN. --- guix/download.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index b6b4812fa7..91a2b4ce5f 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -183,7 +183,6 @@ "http://mirrors.nic.cz/CPAN/" "http://mirror.ibcp.fr/pub/CPAN/" "http://ftp.ntua.gr/pub/lang/perl/" - "http://kvin.lv/pub/CPAN/" "http://mirror.as43289.net/pub/CPAN/" "http://cpan.cs.uu.nl/" "http://cpan.uib.no/" -- cgit v1.2.3