From patchwork Thu Dec 5 20:05:31 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Martin Becze X-Patchwork-Id: 16388 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B94D317851; Thu, 5 Dec 2019 20:07:22 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 6B70D1784F for ; Thu, 5 Dec 2019 20:07:22 +0000 (GMT) Received: from localhost ([::1]:60468 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icxPF-0003Ap-Uy for patchwork@mira.cbaines.net; Thu, 05 Dec 2019 15:07:21 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:55498) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icxP0-00037y-79 for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:07 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1icxOx-0007Bj-Vx for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:39295) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icxOx-0007A5-M5 for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1icxOx-0002nc-F6 for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38408] [PATCH v2 1/5] gnu: added new function, find-packages-by-name*/direct Resent-From: Martin Becze Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Dec 2019 20:07:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38408 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38408@debbugs.gnu.org Cc: Martin Becze Received: via spool by 38408-submit@debbugs.gnu.org id=B38408.157557638610659 (code B ref 38408); Thu, 05 Dec 2019 20:07:03 +0000 Received: (at 38408) by debbugs.gnu.org; 5 Dec 2019 20:06:26 +0000 Received: from localhost ([127.0.0.1]:45256 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icxOM-0002lq-Cu for submit@debbugs.gnu.org; Thu, 05 Dec 2019 15:06:26 -0500 Received: from mx1.riseup.net ([198.252.153.129]:45934) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icxOJ-0002lP-Gv for 38408@debbugs.gnu.org; Thu, 05 Dec 2019 15:06:24 -0500 Received: from capuchin.riseup.net (capuchin-pn.riseup.net [10.0.1.176]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (Client CN "*.riseup.net", Issuer "Sectigo RSA Domain Validation Secure Server CA" (not verified)) by mx1.riseup.net (Postfix) with ESMTPS id 47TRYF5s62zFcnM for <38408@debbugs.gnu.org>; Thu, 5 Dec 2019 12:05:53 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=riseup.net; s=squak; t=1575576382; bh=chL81QND2PvQrUFrNgy/ahQ3nrmiGlgQD4PnAhtyUtw=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=HcvsT5uexe44jL3VtAD76d87SNIiGQkVGukh/cNQKPbaqR049CCAfT1K3n6mVd20L a2aayjoRE+9IZB1jAjBx9zWa5idrryWh7/86MAzvSwjeM8Vez0P3Kg6UkpCmDs6lQ4 Qf6l87yN7I5nMVoE1dt74hK7HnYmVwgKfzhfdK44= X-Riseup-User-ID: 4351C390B81D62A3F9245E9F82CF0110BD72FA28F11E4CAF48F4468A3D26B8D2 Received: from [127.0.0.1] (localhost [127.0.0.1]) by capuchin.riseup.net (Postfix) with ESMTPSA id 47TRYF0d49z8tZ1; Thu, 5 Dec 2019 12:05:52 -0800 (PST) From: Martin Becze Date: Thu, 5 Dec 2019 15:05:31 -0500 Message-Id: In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/packages.scm (find-packages-by-naem*/direct) --- gnu/packages.scm | 41 +++++++++++++++++++++++++++++++++++++++++ tests/packages.scm | 13 +++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gnu/packages.scm b/gnu/packages.scm index 959777ff8f..cca2a393e5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost ;;; Copyright © 2016 Mathieu Lirzin +;;; Copyright © 2019 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,9 @@ %default-package-module-path fold-packages + fold-packages* fold-available-packages + find-packages-by-name*/direct find-newest-available-packages find-packages-by-name @@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice." init modules)) +(define* (fold-packages* proc init + #:optional + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) + #:key (select? (negate hidden-package?))) + "Call (PROC PACKAGE RESULT) for each available package defined in one of +MODULES that matches SELECT?, using INIT as the initial value of RESULT. It +is guaranteed to never traverse the same package twice." + (fold-module-public-variables* (lambda (module symbol var result) + (let ((object (variable-ref var))) + (if (and (package? object) (select? object)) + (proc module symbol object result) + result))) + init + modules)) + (define %package-cache-file ;; Location of the package cache. "/lib/guix/package.cache") @@ -297,6 +317,27 @@ decreasing version order." matching) matching))))) +(define find-packages-by-name*/direct ;bypass the cache + (let ((packages (delay + (fold-packages* (lambda (mod sym p r) + (vhash-cons (package-name p) (list mod sym p) r)) + vlist-null))) + (version>? (match-lambda* + (((_ _ versions) ..1) + (apply version>? (map package-version versions)))))) + (lambda* (name #:optional version) + "Return the list of ( ) with the given NAME. If + VERSION is not #f, then only return packages whose version is prefixed by + VERSION, sorted in decreasing version order." + (let ((matching (sort (vhash-fold* cons '() name (force packages)) + version>?))) + (if version + (filter (match-lambda + ((_ _ package) + (version-prefix? version (package-version package)))) + matching) + matching))))) + (define (cache-lookup cache name) "Lookup package NAME in CACHE. Return a list sorted in increasing version order." diff --git a/tests/packages.scm b/tests/packages.scm index 423c5061aa..9f02b0d5d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © Jan (janneke) Nieuwenhuizen +;;; Copyright © 2019 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -1135,11 +1136,23 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct" + (match (find-packages-by-name*/direct "hello") + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-assert "find-packages-by-name*/direct with version" + (match (find-packages-by-name*/direct "hello" (package-version hello)) + ((((? (cut eq? (resolve-interface '(gnu packages base)) <>)) + (? (cut eq? 'hello <>)) + (? (cut eq? hello <>)))) #t))) + (test-equal "find-packages-by-name with cache" (find-packages-by-name "guile") (call-with-temporary-directory