Merge branch 'master' into core-updates

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