diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-09-02 15:39:50 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-09-02 15:39:50 +0200 |
commit | 072e10615fc786db02dc44f3cd5f25aed2969111 (patch) | |
tree | dbae10eaf8cf13a28c0151a418971fb770243eda /guix | |
parent | 3964e358ab65dfd157427560bfb44de8a150068b (diff) | |
parent | 135ba811c6f55c22bfa8969143d83e7fdf166763 (diff) | |
download | guix-patches-072e10615fc786db02dc44f3cd5f25aed2969111.tar guix-patches-072e10615fc786db02dc44f3cd5f25aed2969111.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/qt-utils.scm | 40 | ||||
-rw-r--r-- | guix/import/cpan.scm | 4 | ||||
-rw-r--r-- | guix/import/hackage.scm | 7 | ||||
-rw-r--r-- | guix/packages.scm | 30 | ||||
-rw-r--r-- | guix/scripts/build.scm | 30 | ||||
-rw-r--r-- | guix/scripts/system.scm | 41 |
6 files changed, 94 insertions, 58 deletions
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm new file mode 100644 index 0000000000..48a32674e9 --- /dev/null +++ b/guix/build/qt-utils.scm @@ -0,0 +1,40 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 David Craven <david@craven.ch> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build qt-utils) + #:use-module (guix build utils) + #:export (wrap-qt-program)) + +(define (wrap-qt-program out program) + (define (suffix env-var path) + (let ((env-val (getenv env-var))) + (if env-val (string-append env-val ":" path) path))) + + (let ((qml-path (suffix "QML2_IMPORT_PATH" + (string-append out "/qml"))) + (plugin-path (suffix "QT_PLUGIN_PATH" + (string-append out "/plugins"))) + (xdg-data-path (suffix "XDG_DATA_DIRS" + (string-append out "/share"))) + (xdg-config-path (suffix "XDG_CONFIG_DIRS" + (string-append out "/etc/xdg")))) + (wrap-program (string-append out "/bin/" program) + `("QML2_IMPORT_PATH" = (,qml-path)) + `("QT_PLUGIN_PATH" = (,plugin-path)) + `("XDG_DATA_DIRS" = (,xdg-data-path)) + `("XDG_CONFIG_DIRS" = (,xdg-config-path))))) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 213a155fd6..5b7c47554a 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -83,7 +83,7 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (assoc-ref (json-fetch (string-append "http://api.metacpan.org/module/" + (assoc-ref (json-fetch (string-append "https://api.metacpan.org/module/" module)) "distribution")) @@ -91,7 +91,7 @@ return \"Test-Simple\"" "Return an alist representation of the CPAN metadata for the perl module MODULE, or #f on failure. MODULE should be e.g. \"Test::Script\"" ;; This API always returns the latest release of the module. - (json-fetch (string-append "http://api.metacpan.org/release/" + (json-fetch (string-append "https://api.metacpan.org/release/" ;; XXX: The 'release' api requires the "release" ;; name of the package. This substitution seems ;; reasonably consistent across packages. diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index f07f453e11..9af78ea888 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org> +;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; ;;; This file is part of GNU Guix. ;;; @@ -74,7 +75,7 @@ (define (hackage-source-url name version) "Given a Hackage package NAME and VERSION, return a url to the source tarball." - (string-append "http://hackage.haskell.org/package/" name + (string-append "https://hackage.haskell.org/package/" name "/" name "-" version ".tar.gz")) (define* (hackage-cabal-url name #:optional version) @@ -82,9 +83,9 @@ tarball." .cabal file on Hackage. If VERSION is #f or missing, the url for the latest version is returned." (if version - (string-append "http://hackage.haskell.org/package/" + (string-append "https://hackage.haskell.org/package/" name "-" version "/" name ".cabal") - (string-append "http://hackage.haskell.org/package/" + (string-append "https://hackage.haskell.org/package/" name "/" name ".cabal"))) (define (hackage-name->package-name name) diff --git a/guix/packages.scm b/guix/packages.scm index 728b3afcae..52204b1e09 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -95,6 +95,7 @@ package-transitive-propagated-inputs package-transitive-native-search-paths package-transitive-supported-systems + package-input-rewriting package-source-derivation package-derivation package-cross-derivation @@ -735,6 +736,35 @@ dependencies are known to build on SYSTEM." "Return the \"target inputs\" of BAG, recursively." (transitive-inputs (bag-target-inputs bag))) +(define* (package-input-rewriting replacements + #:optional (rewrite-name identity)) + "Return a procedure that, when passed a package, replaces its direct and +indirect dependencies (but not its implicit inputs) according to REPLACEMENTS. +REPLACEMENTS is a list of package pairs; the first element of each pair is the +package to replace, and the second one is the replacement. + +Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a +package and returns its new name after rewrite." + (define (rewrite input) + (match input + ((label (? package? package) outputs ...) + (match (assq-ref replacements package) + (#f (cons* label (replace package) outputs)) + (new (cons* label new outputs)))) + (_ + input))) + + (define-memoized/v (replace p) + "Return a variant of P with its inputs rewritten." + (package + (inherit p) + (name (rewrite-name (package-name p))) + (inputs (map rewrite (package-inputs p))) + (native-inputs (map rewrite (package-native-inputs p))) + (propagated-inputs (map rewrite (package-propagated-inputs p))))) + + replace) + ;;; ;;; Package derivations. diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 9a113b4ebe..86b95b4075 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -193,33 +193,17 @@ of \"guile\"." (map (lambda (spec) (match (string-tokenize spec not-equal) ((old new) - (cons old (specification->package new))) + (cons (specification->package old) + (specification->package new))) (_ (leave (_ "invalid replacement specification: ~s~%") spec)))) replacement-specs)) - (define (rewrite input) - (match input - ((label (? package? package) outputs ...) - (match (assoc-ref replacements (package-name package)) - (#f (cons* label (replace package) outputs)) - (new (cons* label new outputs)))) - (_ - input))) - - (define replace - (memoize ;XXX: use eq? - (lambda (p) - (package - (inherit p) - (inputs (map rewrite (package-inputs p))) - (native-inputs (map rewrite (package-native-inputs p))) - (propagated-inputs (map rewrite (package-propagated-inputs p))))))) - - (lambda (store obj) - (if (package? obj) - (replace obj) - obj))) + (let ((rewrite (package-input-rewriting replacements))) + (lambda (store obj) + (if (package? obj) + (rewrite obj) + obj)))) (define %transformations ;; Transformations that can be applied to things to build. The car is the diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index a9fe7d5975..953c6243ed 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -276,36 +276,17 @@ on service '~a':~%") "Call MPROC, a monadic procedure in %STORE-MONAD, passing it the list of names of services to load (upgrade), and the list of names of services to unload." - (define (essential? service) - (memq service '(root shepherd))) - - (define new-service-names - (map (compose first shepherd-service-provision) - new-services)) - - (let-values (((running stopped) (current-services))) - (if (and running stopped) - (let* ((to-load - ;; Only load services that are either new or currently stopped. - (remove (lambda (service) - (memq (first (shepherd-service-provision service)) - running)) - new-services)) - (to-unload - ;; Unload services that are (1) no longer required, or (2) are - ;; in TO-LOAD. - (remove essential? - (append (remove (lambda (service) - (memq service new-service-names)) - (append running stopped)) - (filter (lambda (service) - (memq service stopped)) - (map shepherd-service-canonical-name - to-load)))))) - (mproc to-load to-unload)) - (with-monad %store-monad - (warning (_ "failed to obtain list of shepherd services~%")) - (return #f))))) + (match (current-services) + ((services ...) + (let-values (((to-unload to-load) + (shepherd-service-upgrade services new-services))) + (mproc to-load + (map (compose first live-service-provision) + to-unload)))) + (#f + (with-monad %store-monad + (warning (_ "failed to obtain list of shepherd services~%")) + (return #f))))) (define (upgrade-shepherd-services os) "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new |