From: zimoun <zimon.toutoune@gmail.com>
To: 39258@debbugs.gnu.org
Cc: arunisaac@systemreboot.net, mail@ambrevar.xyz, ludo@gnu.org,
zimoun <zimon.toutoune@gmail.com>
Subject: [bug#39258] [PATCH v4 2/3] DRAFT packages: Add new procedure 'fold-packages*'.
Date: Sun, 3 May 2020 17:01:53 +0200 [thread overview]
Message-ID: <20200503150154.26532-3-zimon.toutoune@gmail.com> (raw)
In-Reply-To: <20200503150154.26532-1-zimon.toutoune@gmail.com>
---
gnu/packages.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++++
guix/ui.scm | 29 +++++++++++++++++-----------
tests/packages.scm | 31 ++++++++++++++++++++++++++++++
3 files changed, 96 insertions(+), 11 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index fa18f81487..a0c5835b8b 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -55,6 +55,7 @@
fold-packages
fold-available-packages
+ fold-packages*
find-newest-available-packages
find-packages-by-name
@@ -253,6 +254,52 @@ is guaranteed to never traverse the same package twice."
init
modules))
+(define (fold-packages* proc init)
+ "Fold (PROC PACKAGE RESULT) over the list of available packages. When a
+package cache is available, this procedure does not actually load any package
+module. Moreover when package cache is available, this procedure
+re-constructs a new package skipping some package record field. The usage of
+this procedure is User Interface (ui) only."
+ (define cache
+ (load-package-cache (current-profile)))
+
+ (define license (@@ (guix licenses) license))
+
+ (if (and cache (cache-is-authoritative?))
+ (vhash-fold (lambda (name vector result)
+ (match vector
+ (#(name version module symbol outputs
+ supported? deprecated?
+ file line column
+ synopsis description home-page
+ build-system-name build-system-description
+ supported-systems direct-inputs
+ license-name license-uri license-comment)
+ (proc (package
+ (name name)
+ (version version)
+ (source #f) ;TODO: ?
+ (build-system
+ (build-system
+ (name (string->symbol build-system-name))
+ (description build-system-description)
+ (lower #f))) ; never used by ui
+ (inputs ; list of "full-name@version"
+ (list 'cache direct-inputs))
+ (outputs outputs)
+ (synopsis synopsis)
+ (description description)
+ (license (license
+ license-name license-uri license-comment))
+ (home-page home-page)
+ (supported-systems (list 'cache supported-systems))
+ (location (location
+ file line column)))
+ result))))
+ init
+ cache)
+ (fold-packages proc init)))
+
(define %package-cache-file
;; Location of the package cache.
"/lib/guix/package.cache")
diff --git a/guix/ui.scm b/guix/ui.scm
index 1e24fe5dca..257d119798 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1416,13 +1416,10 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
;; the initial "+ " prefix.
(if (> width 2) (- width 2) width))
- (define (dependencies->recutils packages)
- (let ((list (string-join (delete-duplicates
- (map package-full-name
- (sort packages package<?))) " ")))
- (string->recutils
- (fill-paragraph list width*
- (string-length "dependencies: ")))))
+ (define (dependencies->string packages)
+ (string-join (delete-duplicates
+ (map package-full-name
+ (sort packages package<?))) " "))
(define (package<? p1 p2)
(string<? (package-full-name p1) (package-full-name p2)))
@@ -1432,11 +1429,21 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
(format port "version: ~a~%" (package-version p))
(format port "outputs: ~a~%" (string-join (package-outputs p)))
(format port "systems: ~a~%"
- (string-join (package-transitive-supported-systems p)))
+ (match (package-supported-systems p)
+ (('cache supported-systems)
+ (string-join supported-systems))
+ (_
+ (string-join (package-transitive-supported-systems p)))))
(format port "dependencies: ~a~%"
- (match (package-direct-inputs p)
- (((labels inputs . _) ...)
- (dependencies->recutils (filter package? inputs)))))
+ (let ((dependencies
+ (match (package-direct-inputs p)
+ (('cache inputs)
+ (string-join inputs))
+ (((labels inputs . _) ...)
+ (dependencies->string (filter package? inputs))))))
+ (string->recutils
+ (fill-paragraph dependencies width*
+ (string-length "dependencies: ")))))
(format port "location: ~a~%"
(or (and=> (package-location p)
(if hyperlinks? location->hyperlink location->string))
diff --git a/tests/packages.scm b/tests/packages.scm
index 7a8b5e4a2d..4504f6cf33 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1169,6 +1169,37 @@
((one)
(eq? one guile-2.0))))
+(test-assert "fold-packages* hello with/without cache"
+ (let ()
+ (define (equal-package? p1 p2)
+ ;; fold-package* re-constructs a new package skipping 'source' and 'lower'
+ ;; so equal? does not apply
+ (and (equal? (package-full-name p1) (package-full-name p2))
+ (equal? (package-description p1) (package-description p2))))
+
+ (define no-cache
+ (fold-packages* (lambda (p r)
+ (if (string=? (package-name p) "hello")
+ p
+ r))
+ #f))
+
+ (define from-cache
+ (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))
+ (fold-packages* (lambda (p r)
+ (if (string=? (package-name p) "hello")
+ p
+ r))
+ #f))))))
+
+ (and (equal? no-cache hello)
+ (equal-package? from-cache hello)
+ (equal-package? no-cache from-cache))))
+
(test-assert "fold-available-packages with/without cache"
(let ()
(define no-cache
--
2.26.1
next prev parent reply other threads:[~2020-05-03 15:03 UTC|newest]
Thread overview: 126+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-01-23 19:51 [bug#39258] Faster guix search using an sqlite cache Arun Isaac
2020-01-29 23:33 ` zimoun
2020-01-30 13:48 ` Arun Isaac
2020-01-31 12:48 ` zimoun
2020-02-02 21:16 ` Arun Isaac
2020-02-04 10:19 ` zimoun
2020-02-06 1:58 ` Arun Isaac
2020-02-11 16:29 ` Ludovic Courtès
2020-02-11 18:21 ` zimoun
2020-02-11 18:39 ` Ludovic Courtès
2020-02-11 19:07 ` Arun Isaac
2020-02-11 20:20 ` zimoun
2020-02-15 14:50 ` Arun Isaac
2020-02-11 20:13 ` zimoun
2020-02-27 20:41 ` [bug#39258] [PATCH 0/4] Xapian for Guix package search Arun Isaac
2020-02-27 20:41 ` [bug#39258] [PATCH 1/4] gnu: Add guile-xapian Arun Isaac
2020-03-03 16:29 ` zimoun
2020-02-27 20:41 ` [bug#39258] [PATCH 2/4] build-self: Add guile-xapian to Guix dependencies Arun Isaac
2020-02-27 20:41 ` [bug#39258] [PATCH 3/4] gnu: Generate xapian package search index Arun Isaac
2020-02-28 8:04 ` Pierre Neidhardt
2020-03-05 20:26 ` Arun Isaac
2020-03-03 18:29 ` zimoun
2020-02-27 20:41 ` [bug#39258] [PATCH 4/4] gnu: Use xapian index for package search Arun Isaac
2020-02-28 8:11 ` Pierre Neidhardt
2020-03-03 19:21 ` zimoun
2020-03-03 19:51 ` zimoun
2020-02-28 8:13 ` [bug#39258] [PATCH 0/4] Xapian for Guix " Pierre Neidhardt
2020-02-28 12:39 ` zimoun
2020-02-28 12:49 ` Pierre Neidhardt
2020-02-28 15:36 ` Arun Isaac
2020-02-28 16:04 ` Arun Isaac
2020-03-02 18:37 ` zimoun
2020-03-02 19:13 ` zimoun
2020-03-03 20:04 ` zimoun
2020-02-29 8:25 ` Arun Isaac
2020-03-02 18:27 ` zimoun
2020-02-28 12:36 ` zimoun
2020-03-05 16:46 ` Ludovic Courtès
2020-03-07 13:31 ` [bug#39258] [PATCH v2 0/3] " Arun Isaac
2020-03-07 13:31 ` [bug#39258] [PATCH v2 1/3] build-self: Add guile-xapian to Guix dependencies Arun Isaac
2020-03-09 18:14 ` zimoun
2020-03-09 23:40 ` Jonathan Brielmaier
2020-03-10 5:24 ` Arun Isaac
2020-03-07 13:31 ` [bug#39258] [PATCH v2 2/3] gnu: Generate Xapian package search index Arun Isaac
2020-03-09 18:19 ` zimoun
2020-03-07 13:31 ` [bug#39258] [PATCH v2 3/3] gnu: Use Xapian index for package search Arun Isaac
2020-03-07 20:33 ` [bug#39258] [PATCH v2 0/3] Xapian for Guix " Ludovic Courtès
2020-03-08 9:01 ` Arun Isaac
2020-03-08 11:33 ` Ludovic Courtès
2020-03-08 20:27 ` Arun Isaac
2020-03-09 7:42 ` Pierre Neidhardt
2020-03-09 12:50 ` zimoun
2020-03-09 10:35 ` Ludovic Courtès
2020-03-10 14:17 ` Arun Isaac
2020-03-10 14:33 ` zimoun
2020-03-11 13:50 ` Ludovic Courtès
2020-03-13 5:37 ` Arun Isaac
2020-03-15 20:40 ` Ludovic Courtès
2020-03-09 7:50 ` Pierre Neidhardt
2020-03-09 10:28 ` Ludovic Courtès
2020-03-09 13:03 ` zimoun
2020-03-09 12:53 ` zimoun
2020-03-09 12:47 ` zimoun
2020-03-09 12:40 ` zimoun
2020-03-09 12:34 ` zimoun
2020-03-08 20:27 ` zimoun
2020-03-08 20:40 ` Arun Isaac
2020-03-09 12:28 ` zimoun
2020-03-27 16:26 ` [bug#39258] [PATCH v3 0/3] Package metadata cache for guix search Arun Isaac
2020-03-27 16:26 ` [bug#39258] [PATCH v3 1/3] guix: Generate package metadata cache Arun Isaac
2020-04-24 20:48 ` Ludovic Courtès
2020-04-26 9:48 ` zimoun
2020-04-26 14:35 ` Ludovic Courtès
2020-04-26 14:54 ` Pierre Neidhardt
2020-04-26 15:33 ` Ludovic Courtès
2020-04-26 15:05 ` zimoun
2020-03-27 16:26 ` [bug#39258] [PATCH v3 2/3] guix: Search " Arun Isaac
2020-04-24 20:58 ` Ludovic Courtès
2020-03-27 16:26 ` [bug#39258] [PATCH v3 3/3] guix: Use package metadata cache for package search Arun Isaac
2020-04-24 21:03 ` Ludovic Courtès
2020-04-05 14:08 ` [bug#39258] [PATCH v3 0/3] Package metadata cache for guix search Ludovic Courtès
2020-04-24 21:05 ` Ludovic Courtès
2020-04-26 3:54 ` [bug#39258] benchmark search: default vs v2 vs v3 zimoun
2020-04-26 7:29 ` Pierre Neidhardt
2020-04-26 15:49 ` Ludovic Courtès
2020-04-26 17:01 ` zimoun
2020-04-26 20:22 ` Ludovic Courtès
2020-04-30 13:10 ` zimoun
2020-05-03 15:01 ` [bug#39258] [PATCH v4 0/3] Faster cache generation (similar as v3) zimoun
2020-05-03 15:01 ` [bug#39258] [PATCH v4 1/3] DRAFT packages: Add fields to packages cache zimoun
2020-05-03 15:01 ` zimoun [this message]
2020-05-03 15:01 ` [bug#39258] [PATCH v4 3/3] DRAFT guix package: Use cache in 'find-packages-by-description' zimoun
2020-05-03 16:43 ` [bug#39258] [PATCH v4 0/3] Faster cache generation (similar as v3) Ludovic Courtès
2020-05-03 18:10 ` zimoun
2020-05-03 19:49 ` Ludovic Courtès
2020-06-01 0:00 ` [bug#39258] [PATCH 0/4] Optimize guix search Arun Isaac
2020-06-01 0:00 ` [bug#39258] [PATCH 1/4] ui: Cut off search early if any regexp does not match Arun Isaac
2020-06-09 8:29 ` Ludovic Courtès
2020-06-01 0:00 ` [bug#39258] [PATCH 2/4] ui: Use string matching with literal search strings Arun Isaac
2020-06-09 8:33 ` Ludovic Courtès
2020-06-09 9:55 ` zimoun
2020-06-13 12:37 ` Arun Isaac
2020-06-13 13:36 ` zimoun
2020-06-13 17:21 ` Arun Isaac
2020-06-14 19:14 ` zimoun
2020-06-13 19:32 ` Ludovic Courtès
2020-06-15 20:18 ` Arun Isaac
2020-06-01 0:00 ` [bug#39258] [PATCH 3/4] ui: Do not translate package synopsis a second time Arun Isaac
2020-06-09 8:33 ` Ludovic Courtès
2020-06-01 0:00 ` [bug#39258] [PATCH 4/4] ui: Use package-description-string Arun Isaac
2020-06-09 8:34 ` Ludovic Courtès
2020-06-01 1:25 ` [bug#39258] [PATCH v5 0/4] Optimize guix search zimoun
2020-06-01 2:24 ` Arun Isaac
2020-06-01 10:01 ` zimoun
2020-06-01 10:11 ` [bug#39258] KMP string search algorithm? zimoun
2020-06-01 22:24 ` Leo Famulari
2020-06-01 23:48 ` Arun Isaac
2020-06-02 8:49 ` Ludovic Courtès
2021-07-15 7:33 ` [bug#39258] [PATCH v6 0/2] DRAFT "guix search" performances zimoun
2021-07-15 7:33 ` [bug#39258] [PATCH v6 1/2] DRAFT packages: Add fields to packages cache zimoun
2021-07-17 8:31 ` Arun Isaac
2021-07-23 15:30 ` Ludovic Courtès
2021-08-17 14:03 ` zimoun
2021-07-15 7:33 ` [bug#39258] [PATCH v6 2/2] DRAFT scripts: package: Use cache in 'find-packages-by-description' zimoun
2021-07-23 15:43 ` [bug#39258] [PATCH v6 0/2] DRAFT "guix search" performances Ludovic Courtès
2021-08-20 15:42 ` zimoun
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200503150154.26532-3-zimon.toutoune@gmail.com \
--to=zimon.toutoune@gmail.com \
--cc=39258@debbugs.gnu.org \
--cc=arunisaac@systemreboot.net \
--cc=ludo@gnu.org \
--cc=mail@ambrevar.xyz \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).