From d5f01e48e0810147c4f304a0e5c661e5a61e08ff Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 26 Mar 2015 17:25:09 -0400 Subject: guix package: Add '--do-not-upgrade' option. * guix/scripts/package.scm (%options): Add the '--do-not-upgrade' option. (show-help): Document it. (options->installable): Add 'do-not-upgrade-regexps' variable. Use it in 'packages-to-upgrade'. * doc/guix.texi (Invoking guix package): Document the '--do-not-upgrade' option. --- guix/scripts/package.scm | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 09ae782751..53813c14ab 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov -;;; Copyright © 2013 Mark H Weaver +;;; Copyright © 2013, 2015 Mark H Weaver ;;; Copyright © 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. @@ -464,6 +464,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) -r, --remove=PACKAGE remove PACKAGE")) (display (_ " -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP")) + (display (_ " + --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP")) (display (_ " --roll-back roll back to the previous generation")) (display (_ " @@ -543,6 +545,13 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) ;; would upgrade everything. (delete '(upgrade . #f) result)) arg-handler)))) + (option '("do-not-upgrade") #f #t + (lambda (opt name arg result arg-handler) + (let arg-handler ((arg arg) (result result)) + (values (if arg + (alist-cons 'do-not-upgrade arg result) + result) + arg-handler)))) (option '("roll-back") #f #f (lambda (opt name arg result arg-handler) (values (alist-cons 'roll-back? #t result) @@ -621,6 +630,13 @@ return the new list of manifest entries." (_ #f)) opts)) + (define do-not-upgrade-regexps + (filter-map (match-lambda + (('do-not-upgrade . regexp) + (make-regexp regexp)) + (_ #f)) + opts)) + (define packages-to-upgrade (match upgrade-regexps (() @@ -630,6 +646,8 @@ return the new list of manifest entries." (($ name version output path _) (and (any (cut regexp-exec <> name) upgrade-regexps) + (not (any (cut regexp-exec <> name) + do-not-upgrade-regexps)) (upgradeable? name version path) (let ((output (or output "out"))) (call-with-values -- cgit v1.2.3 From aa46a028c4ff46e3f2e6866921866d2ed6373ba3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 Apr 2015 22:44:51 +0200 Subject: profiles: Generalize "hooks" for 'profile-derivation'. * guix/profiles.scm (info-dir-file): Remove (null? (manifest-entries manifest)) test. (ca-certificate-bundle): Likewise. (ghc-package-cache-file): Turn 'if' into 'and', and remove second arm. (%default-profile-hooks): New variable. (profile-derivation): Remove #:info-dir?, #:ghc-package-cache?, and #:ca-certificate-bundle?. Add #:hooks. Iterate over HOOKS. Adjust 'inputs' accordingly. * guix/scripts/package.scm (guix-package): Adjust 'profile-derivation' call accordingly. * tests/packages.scm ("--search-paths with pattern"): Likewise. * tests/profiles.scm ("profile-derivation", "profile-derivation, inputs"): Likewise. --- guix/profiles.scm | 72 +++++++++++++++++++----------------------------- guix/scripts/package.scm | 6 ++-- tests/packages.scm | 4 +-- tests/profiles.scm | 8 ++---- 4 files changed, 35 insertions(+), 55 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index a2f63d1cca..620feff97e 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -78,6 +78,7 @@ profile-manifest package->manifest-entry + %default-profile-hooks profile-derivation generation-number generation-numbers @@ -398,15 +399,12 @@ MANIFEST." (append-map info-files '#$(manifest-inputs manifest))))) - ;; Don't depend on Texinfo when there's nothing to do. - (if (null? (manifest-entries manifest)) - (gexp->derivation "info-dir" #~(mkdir #$output)) - (gexp->derivation "info-dir" build - #:modules '((guix build utils))))) + (gexp->derivation "info-dir" build + #:modules '((guix build utils)))) (define (ghc-package-cache-file manifest) "Return a derivation that builds the GHC 'package.cache' file for all the -entries of MANIFEST." +entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (define ghc ;lazy reference (module-ref (resolve-interface '(gnu packages haskell)) 'ghc)) @@ -446,12 +444,11 @@ entries of MANIFEST." success))) ;; Don't depend on GHC when there's nothing to do. - (if (any (cut string-prefix? "ghc" <>) - (map manifest-entry-name (manifest-entries manifest))) - (gexp->derivation "ghc-package-cache" build - #:modules '((guix build utils)) - #:local-build? #t) - (gexp->derivation "ghc-package-cache" #~(mkdir #$output)))) + (and (any (cut string-prefix? "ghc" <>) + (map manifest-entry-name (manifest-entries manifest))) + (gexp->derivation "ghc-package-cache" build + #:modules '((guix build utils)) + #:local-build? #t))) (define (ca-certificate-bundle manifest) "Return a derivation that builds a single-file bundle containing the CA @@ -503,42 +500,31 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." (string-append result "/ca-certificates.crt"))))) - ;; Don't depend on 'glibc-utf8-locales' and its dependencies when there's - ;; nothing to do. - (if (null? (manifest-entries manifest)) - (gexp->derivation "ca-certificate-bundle" #~(mkdir #$output)) - (gexp->derivation "ca-certificate-bundle" build - #:modules '((guix build utils)) - #:local-build? #t))) + (gexp->derivation "ca-certificate-bundle" build + #:modules '((guix build utils)) + #:local-build? #t)) + +(define %default-profile-hooks + ;; This is the list of derivation-returning procedures that are called by + ;; default when making a non-empty profile. + (list info-dir-file + ghc-package-cache-file + ca-certificate-bundle)) (define* (profile-derivation manifest #:key - (info-dir? #t) - (ghc-package-cache? #t) - (ca-certificate-bundle? #t)) + (hooks %default-profile-hooks)) "Return a derivation that builds a profile (aka. 'user environment') with -the given MANIFEST. The profile includes a top-level Info 'dir' file unless -INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f -and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f." - (mlet %store-monad ((info-dir (if info-dir? - (info-dir-file manifest) - (return #f))) - (ghc-package-cache (if ghc-package-cache? - (ghc-package-cache-file manifest) - (return #f))) - (ca-cert-bundle (if ca-certificate-bundle? - (ca-certificate-bundle manifest) - (return #f)))) +the given MANIFEST. The profile includes additional derivations returned by +the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc." + (mlet %store-monad ((extras (if (null? (manifest-entries manifest)) + (return '()) + (sequence %store-monad + (filter-map (lambda (hook) + (hook manifest)) + hooks))))) (define inputs - (append (if info-dir - (list (gexp-input info-dir)) - '()) - (if ghc-package-cache - (list (gexp-input ghc-package-cache)) - '()) - (if ca-cert-bundle - (list (gexp-input ca-cert-bundle)) - '()) + (append (map gexp-input extras) (manifest-inputs manifest))) (define builder diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 53813c14ab..5ee3a89ba6 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -855,9 +855,9 @@ more information.~%")) (let* ((prof-drv (run-with-store (%store) (profile-derivation new - #:info-dir? (not bootstrap?) - #:ghc-package-cache? (not bootstrap?) - #:ca-certificate-bundle? (not bootstrap?)))) + #:hooks (if bootstrap? + '() + %default-profile-hooks)))) (prof (derivation->output-path prof-drv))) (show-manifest-transaction (%store) manifest transaction #:dry-run? dry-run?) diff --git a/tests/packages.scm b/tests/packages.scm index 4e3a116cb8..d7c169a585 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -599,9 +599,7 @@ (profile-derivation (manifest (map package->manifest-entry (list p1 p2))) - #:info-dir? #f - #:ghc-package-cache? #f - #:ca-certificate-bundle? #f) + #:hooks '()) #:guile-for-build (%guile-for-build)))) (build-derivations %store (list prof)) (string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n" diff --git a/tests/profiles.scm b/tests/profiles.scm index d20cb9d808..54fbaea864 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -183,9 +183,7 @@ ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) - #:info-dir? #f - #:ghc-package-cache? #f - #:ca-certificate-bundle? #f)) + #:hooks '())) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) @@ -197,9 +195,7 @@ (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) (drv (profile-derivation (manifest (list entry)) - #:info-dir? #f - #:ghc-package-cache? #f - #:ca-certificate-bundle? #f))) + #:hooks '()))) (return (derivation-inputs drv)))) (test-end "profiles") -- cgit v1.2.3