From patchwork Thu Nov 28 00:16:50 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Martin Becze X-Patchwork-Id: 16258 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 140F7177DE; Thu, 28 Nov 2019 00:19:03 +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 A7CFC177DA for ; Thu, 28 Nov 2019 00:19:02 +0000 (GMT) Received: from localhost ([::1]:44330 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ia7WQ-0008U9-3N for patchwork@mira.cbaines.net; Wed, 27 Nov 2019 19:19:02 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:43063) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ia7VU-0007gQ-Ch for guix-patches@gnu.org; Wed, 27 Nov 2019 19:18:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ia7VS-0003xt-TQ for guix-patches@gnu.org; Wed, 27 Nov 2019 19:18:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:50450) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ia7VS-0003x0-KZ for guix-patches@gnu.org; Wed, 27 Nov 2019 19:18:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ia7VS-0005LI-EX for guix-patches@gnu.org; Wed, 27 Nov 2019 19:18:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38408] [PATCH 1/3] 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, 28 Nov 2019 00:18: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: efraim@flashner.co.il, Martin Becze Received: via spool by 38408-submit@debbugs.gnu.org id=B38408.157490022520449 (code B ref 38408); Thu, 28 Nov 2019 00:18:02 +0000 Received: (at 38408) by debbugs.gnu.org; 28 Nov 2019 00:17:05 +0000 Received: from localhost ([127.0.0.1]:56419 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ia7UW-0005JY-QC for submit@debbugs.gnu.org; Wed, 27 Nov 2019 19:17:05 -0500 Received: from mx1.riseup.net ([198.252.153.129]:60806) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ia7UU-0005JH-LB for 38408@debbugs.gnu.org; Wed, 27 Nov 2019 19:17:03 -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 47NdVk1w9QzFc8p; Wed, 27 Nov 2019 16:17:02 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=riseup.net; s=squak; t=1574900222; bh=chL81QND2PvQrUFrNgy/ahQ3nrmiGlgQD4PnAhtyUtw=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=PqhDxkrY3u3kuHFUgkX39ZKYtYFiNgvKCL5S7MmfX5ns+i4+4bojCOYeT+cewS/g5 v855dAKU/n4STOlXCYsc48XWec62P7T6G9BCK6w79U+Y2laWYnxQcFDnNwXtz61UOE Rdu35lC9DhRnJfkBONz4JN5FRVbuQ0T1OnonFmDA= X-Riseup-User-ID: 9C21D360A06A3FAEB4F20C58D4B4B6FF7FCEA12DBFA00B16D9ADA81B32F22821 Received: from [127.0.0.1] (localhost [127.0.0.1]) by capuchin.riseup.net (Postfix) with ESMTPSA id 47NdVj4JWDz8tTD; Wed, 27 Nov 2019 16:17:01 -0800 (PST) From: Martin Becze Date: Wed, 27 Nov 2019 19:16:50 -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