[bug#39258] [PATCH v3 1/3] guix: Generate package metadata cache.

[Arun Isaac <arunisaac@systemreboot.net>]

* gnu/packages.scm (%package-metadata-cache-file): New variable.
(generate-package-metadata-cache): New function.
* guix/channels.scm (package-metadata-cache-file): New function.
(%channel-profile-hooks): Add package-metadata-cache-file.
---
 gnu/packages.scm  | 50 ++++++++++++++++++++++++++++++++++++++++++++++-
 guix/channels.scm | 34 +++++++++++++++++++++++++++++++-
 2 files changed, 82 insertions(+), 2 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index d22c992bb1..c0b527acf0 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,7 +65,8 @@
             specification->location
             specifications->manifest
 
-            generate-package-cache))
+            generate-package-cache
+            generate-package-metadata-cache))
 
 ;;; Commentary:
 ;;;
@@ -426,6 +428,52 @@ reducing the memory footprint."
                                #:opts '(#:to-file? #t)))))
   cache-file)
 
+(define %package-metadata-cache-file
+  ;; Location of the package metadata cache.
+  "/lib/guix/package-metadata.cache")
+
+(define (generate-package-metadata-cache directory)
+  "Generate under DIRECTORY a cache of the metadata of all available packages.
+
+The primary purpose of this cache is to speed up package metadata lookup
+during package search so that we don't have to traverse and load all the
+package modules."
+  (define cache-file
+    (string-append directory %package-metadata-cache-file))
+
+  (define (package<? p1 p2)
+    (string<? (package-full-name p1) (package-full-name p2)))
+
+  (define (expand-cache package result)
+    (cons `#(,(package-name package)
+             ,(package-version package)
+             ,(delete-duplicates
+               (map package-full-name
+                    (sort (filter package? (package-direct-inputs package))
+                          package<?)))
+             ,(package-outputs package)
+             ,(package-supported-systems package)
+             ,(package-synopsis package)
+             ,(package-description package)
+             ,(package-home-page package)
+             ,(let ((location (package-location package)))
+                (list (location-file location)
+                      (location-line location)
+                      (location-column location))))
+          result))
+
+  (define exp
+    (fold-packages expand-cache '()))
+
+  (mkdir-p (dirname cache-file))
+  (call-with-output-file cache-file
+    (lambda (port)
+      (put-bytevector port
+                      (compile `'(,@exp)
+                               #:to 'bytecode
+                               #:opts '(#:to-file? #t)))))
+  cache-file)
+
 \f
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
diff --git a/guix/channels.scm b/guix/channels.scm
index f0261dc2da..c4efaa7300 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -581,9 +582,40 @@ be used as a profile hook."
                                                  (hook . package-cache))
                                   #:local-build? #t)))
 
+(define (package-metadata-cache-file manifest)
+  "Build a package metadata 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-metadata-cache)
+              (begin
+                ;; Delegate package cache generation to the inferior.
+                (format (current-error-port)
+                        "Generating package metadata cache for '~a'...~%"
+                        #$profile)
+                (generate-package-metadata-cache #$output))
+              (mkdir #$output))))
+
+    (gexp->derivation-in-inferior "guix-package-metadata-cache" build
+                                  profile
+
+                                  ;; If the Guix in PROFILE is too old and
+                                  ;; lacks 'guix repl', don't build the cache
+                                  ;; instead of failing.
+                                  #:silent-failure? #t
+
+                                  #:properties '((type . profile-hook)
+                                                 (hook . package-cache))
+                                  #:local-build? #t)))
+
 (define %channel-profile-hooks
   ;; The default channel profile hooks.
-  (cons package-cache-file %default-profile-hooks))
+  (cons* package-cache-file package-metadata-cache-file %default-profile-hooks))
 
 (define (channel-instances->derivation instances)
   "Return the derivation of the profile containing INSTANCES, a list of
-- 
2.25.1