From 60029204eebada88063c2d3e2727e255ded22159 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 14 Jan 2019 17:20:28 +0100 Subject: pull: Don't prepend "origin/" to branch names. This is a followup to 37a6cdbf1b3503d3e60840a176318284b1f7ca25. * guix/scripts/pull.scm (%options): Don't prepend "origin/" to branch names. --- guix/scripts/pull.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix/scripts/pull.scm') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 6d1914f7c2..0339b149fa 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -125,8 +125,7 @@ Download and deploy the latest version of Guix.\n")) (alist-cons 'ref `(commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(branch . ,(string-append "origin/" arg)) - result))) + (alist-cons 'ref `(branch . ,arg) result))) (option '(#\p "profile") #t #f (lambda (opt name arg result) (alist-cons 'profile (canonicalize-profile arg) -- cgit v1.2.3 From 5fbdc9a5aa63fd51c65d30fe3d30608d01fe1bc8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 11 Jan 2019 17:23:39 +0100 Subject: channels: Compute a package cache and use it. * gnu/packages.scm (cache-is-authoritative?, load-package-cache) (cache-lookup, generate-package-cache): New procedures. (%package-cache-file): New variable. (find-packages-by-name): Rename to... (find-packages-by-name/direct): ... this. (find-packages-by-name): Rewrite to use the package cache when 'cache-is-authoritative?' returns true. * tests/packages.scm ("find-packages-by-name + version, with cache") ("find-packages-by-name with cache"): New tests. * guix/channels.scm (package-cache-file): New procedure. (%channel-profile-hooks): New variable. (channel-instances->derivation): Use it in #:hooks. * guix/scripts/package.scm (build-and-use-profile): Add #:hooks and honor it. * guix/scripts/pull.scm (build-and-install): Pass #:hooks to UPDATE-PROFILE. --- gnu/packages.scm | 127 +++++++++++++++++++++++++++++++++++++++++++++-- guix/channels.scm | 36 +++++++++++++- guix/scripts/package.scm | 8 +-- guix/scripts/pull.scm | 1 + tests/packages.scm | 18 +++++++ 5 files changed, 181 insertions(+), 9 deletions(-) (limited to 'guix/scripts/pull.scm') diff --git a/gnu/packages.scm b/gnu/packages.scm index 4a85cf4b87..6796db80a4 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -28,11 +28,14 @@ #:use-module (guix memoization) #:use-module ((guix build utils) #:select ((package-name->name+version - . hyphen-separated-name->name+version))) + . hyphen-separated-name->name+version) + mkdir-p)) #:autoload (guix profiles) (packages->manifest) #:use-module (guix describe) #:use-module (ice-9 vlist) #:use-module (ice-9 match) + #:autoload (ice-9 binary-ports) (put-bytevector) + #:autoload (system base compile) (compile) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -56,7 +59,9 @@ specification->package specification->package+output - specifications->manifest)) + specifications->manifest + + generate-package-cache)) ;;; Commentary: ;;; @@ -135,6 +140,14 @@ for system '~a'") ;; Default search path for package modules. `((,%distro-root-directory . "gnu/packages"))) +(define (cache-is-authoritative?) + "Return true if the pre-computed package cache is authoritative. It is not +authoritative when entries have been added via GUIX_PACKAGE_PATH or '-L' +flags." + (equal? (%package-module-path) + (append %default-package-module-path + (package-path-entries)))) + (define %package-module-path ;; Search path for package modules. Each item must be either a directory ;; name or a pair whose car is a directory and whose cdr is a sub-directory @@ -183,7 +196,35 @@ is guaranteed to never traverse the same package twice." init modules)) -(define find-packages-by-name +(define %package-cache-file + ;; Location of the package cache. + "/lib/guix/package.cache") + +(define load-package-cache + (mlambda (profile) + "Attempt to load the package cache. On success return a vhash keyed by +package names. Return #f on failure." + (match profile + (#f #f) + (profile + (catch 'system-error + (lambda () + (define lst + (load-compiled (string-append profile %package-cache-file))) + (fold (lambda (item vhash) + (match item + (#(name version module symbol outputs + supported? deprecated? + file line column) + (vhash-cons name item vhash)))) + vlist-null + lst)) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args)))))))) + +(define find-packages-by-name/direct ;bypass the cache (let ((packages (delay (fold-packages (lambda (p r) (vhash-cons (package-name p) p r)) @@ -202,6 +243,37 @@ decreasing version order." matching) matching))))) +(define (cache-lookup cache name) + "Lookup package NAME in CACHE. Return a list sorted in increasing version +order." + (define (package-version? (vector-ref v2 1) (vector-ref v1 1))) + + (sort (vhash-fold* cons '() name cache) + package-versionbool (member (%current-system) + (package-supported-systems package))) + ,(->bool (package-superseded package)) + ,@(let ((loc (package-location package))) + (if loc + `(,(location-file loc) + ,(location-line loc) + ,(location-column loc)) + '(#f #f #f)))) + result))) + (_ + result))) + + (define exp + (fold-module-public-variables* expand-cache '() + (all-modules (%package-module-path) + #:warn + warn-about-load-error))) + + (mkdir-p (dirname cache-file)) + (call-with-output-file cache-file + (lambda (port) + ;; Store the cache as a '.go' file. This makes loading fast and reduces + ;; heap usage since some of the static data is directly mmapped. + (put-bytevector port + (compile `'(,@exp) + #:to 'bytecode + #:opts '(#:to-file? #t))))) + cache-file) + (define %sigint-prompt ;; The prompt to jump to upon SIGINT. diff --git a/guix/channels.scm b/guix/channels.scm index 6b860f3bd8..cd8a0131bd 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -21,6 +21,7 @@ #:use-module (guix git) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix discovery) #:use-module (guix monads) #:use-module (guix profiles) @@ -31,7 +32,8 @@ #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) - #:autoload (guix self) (whole-package) + #:autoload (guix self) (whole-package make-config.scm) + #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep #:use-module (ice-9 match) #:export (channel channel? @@ -52,6 +54,7 @@ checkout->channel-instance latest-channel-derivation channel-instances->manifest + %channel-profile-hooks channel-instances->derivation)) ;;; Commentary: @@ -416,11 +419,40 @@ channel instances." (zip instances derivations)))) (return (manifest entries)))) +(define (package-cache-file manifest) + "Build a package cache file for the instance in MANIFEST. This is meant to +be used as a profile hook." + (mlet %store-monad ((profile (profile-derivation manifest + #:hooks '()))) + + (define build + #~(begin + (use-modules (gnu packages)) + + (if (defined? 'generate-package-cache) + (begin + ;; Delegate package cache generation to the inferior. + (format (current-error-port) + "Generating package cache for '~a'...~%" + #$profile) + (generate-package-cache #$output)) + (mkdir #$output)))) + + (gexp->derivation-in-inferior "guix-package-cache" build + profile + #:properties '((type . profile-hook) + (hook . package-cache))))) + +(define %channel-profile-hooks + ;; The default channel profile hooks. + (cons package-cache-file %default-profile-hooks)) + (define (channel-instances->derivation instances) "Return the derivation of the profile containing INSTANCES, a list of channel instances." (mlet %store-monad ((manifest (channel-instances->manifest instances))) - (profile-derivation manifest))) + (profile-derivation manifest + #:hooks %channel-profile-hooks))) (define latest-channel-instances* (store-lift latest-channel-instances)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index ba33790eda..e9bed0be1e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -120,21 +120,21 @@ denote ranges as interpreted by 'matching-generations'." (define* (build-and-use-profile store profile manifest #:key + (hooks %default-profile-hooks) allow-collisions? bootstrap? use-substitutes? dry-run?) "Build a new generation of PROFILE, a file name, using the packages specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true, -do not treat collisions in MANIFEST as an error." +do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile +hooks\" run when building the profile." (when (equal? profile %current-profile) (ensure-default-profile)) (let* ((prof-drv (run-with-store store (profile-derivation manifest #:allow-collisions? allow-collisions? - #:hooks (if bootstrap? - '() - %default-profile-hooks) + #:hooks (if bootstrap? '() hooks) #:locales? (not bootstrap?)))) (prof (derivation->output-path prof-drv))) (show-what-to-build store (list prof-drv) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 0339b149fa..513434c5f1 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -188,6 +188,7 @@ true, display what would be built without actually building it." (mlet %store-monad ((manifest (channel-instances->manifest instances))) (mbegin %store-monad (update-profile profile manifest + #:hooks %channel-profile-hooks #:dry-run? dry-run?) (munless dry-run? (return (display-profile-news profile)))))) diff --git a/tests/packages.scm b/tests/packages.scm index eb8ede3207..2720ba5a15 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1005,6 +1005,24 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-equal "find-packages-by-name with cache" + (find-packages-by-name "guile") + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (find-packages-by-name "guile")))))) + +(test-equal "find-packages-by-name + version, with cache" + (find-packages-by-name "guile" "2") + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (find-packages-by-name "guile" "2")))))) + (test-assert "--search-paths with pattern" ;; Make sure 'guix package --search-paths' correctly reports environment ;; variables when file patterns are used (in particular, it must follow -- cgit v1.2.3 From 3bbd6919bd84b76686d1aa626ba861faf3fc8ceb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 18 Jan 2019 14:59:59 +0100 Subject: pull: Suggest running 'hash guix' if needed. Fixes . Suggested by Diego Nicola Barbato . * guix/scripts/pull.scm (build-and-install): Before returning, display a hint if (which "guix") is not in PROFILE. --- guix/scripts/pull.scm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) (limited to 'guix/scripts/pull.scm') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 513434c5f1..d3a4401a01 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -34,11 +34,12 @@ #:use-module (guix channels) #:autoload (guix inferior) (open-inferior) #:use-module (guix scripts build) + #:autoload (guix build utils) (which) #:use-module (guix git) #:use-module (git) #:use-module (gnu packages) #:use-module ((guix scripts package) #:select (build-and-use-profile)) - #:use-module (gnu packages base) + #:use-module ((gnu packages base) #:select (canonical-package)) #:use-module (gnu packages guile) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) @@ -191,7 +192,16 @@ true, display what would be built without actually building it." #:hooks %channel-profile-hooks #:dry-run? dry-run?) (munless dry-run? - (return (display-profile-news profile)))))) + (return (display-profile-news profile)) + (match (which "guix") + (#f (return #f)) + (str + (let ((command (string-append profile "/bin/guix"))) + (unless (string=? command str) + (display-hint (format #f (G_ "After setting @code{PATH}, run +@command{hash guix} to make sure your shell refers to @file{~a}.") + command))) + (return #f)))))))) (define (honor-lets-encrypt-certificates! store) "Tell Guile-Git to use the Let's Encrypt certificates." -- cgit v1.2.3