From patchwork Fri Dec 6 18:21:33 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Martin Becze X-Patchwork-Id: 16404 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 1A2251785E; Fri, 6 Dec 2019 18:59:00 +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 BC7F41785C for ; Fri, 6 Dec 2019 18:58:59 +0000 (GMT) Received: from localhost ([::1]:44078 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idIod-0006Yq-9v for patchwork@mira.cbaines.net; Fri, 06 Dec 2019 13:58:59 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:49962) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idIEu-0004MX-NS for guix-patches@gnu.org; Fri, 06 Dec 2019 13:22:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1idIEs-0003lT-Sm for guix-patches@gnu.org; Fri, 06 Dec 2019 13:22:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:41064) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1idIEs-0003kp-Ou for guix-patches@gnu.org; Fri, 06 Dec 2019 13:22:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1idIEs-00054a-KT for guix-patches@gnu.org; Fri, 06 Dec 2019 13:22:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38408] [PATCH v3 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: Fri, 06 Dec 2019 18:22:02 +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.157565651019443 (code B ref 38408); Fri, 06 Dec 2019 18:22:02 +0000 Received: (at 38408) by debbugs.gnu.org; 6 Dec 2019 18:21:50 +0000 Received: from localhost ([127.0.0.1]:47028 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1idIEf-00053Q-Me for submit@debbugs.gnu.org; Fri, 06 Dec 2019 13:21:50 -0500 Received: from mx1.riseup.net ([198.252.153.129]:41854) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1idIEc-00052b-6L for 38408@debbugs.gnu.org; Fri, 06 Dec 2019 13:21:47 -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 47V1Bd5my7zFc8L for <38408@debbugs.gnu.org>; Fri, 6 Dec 2019 10:21:45 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=riseup.net; s=squak; t=1575656505; bh=chL81QND2PvQrUFrNgy/ahQ3nrmiGlgQD4PnAhtyUtw=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=aNld9npm25JM9+J4r4ihVIdHTpUcWCSIpbto9QDHfSEetI/6kh3aTVh2xlfew8HPs WhqrGQ6xn5kJqFJac8MUhOel551uF8CZHCrydsMd/vT6xbavN3Po4w7P29gMgKOKbq Mk2il0VPvj3kD0Y9b7IhbMX12fp8PRmdxY6U4aYM= X-Riseup-User-ID: 01300253ABDCBE7EEBA63884393B1C8352BA0A1AC2E89DF5E50076C8AFE96C94 Received: from [127.0.0.1] (localhost [127.0.0.1]) by capuchin.riseup.net (Postfix) with ESMTPSA id 47V1Bd1lmvz8tYt; Fri, 6 Dec 2019 10:21:45 -0800 (PST) From: Martin Becze Date: Fri, 6 Dec 2019 13:21:33 -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