From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id GKqIIzzdrl5lFgAA0tVLHw (envelope-from ) for ; Sun, 03 May 2020 15:03:24 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id eN4GG0bdrl4zJgAA1q6Kng (envelope-from ) for ; Sun, 03 May 2020 15:03:34 +0000 Received: from lists.gnu.org (lists.gnu.org [IPv6:2001:470:142::17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 8ECEA9445DB for ; Sun, 3 May 2020 15:03:33 +0000 (UTC) Received: from localhost ([::1]:38214 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jVG9V-0006VH-Uy for larch@yhetil.org; Sun, 03 May 2020 11:03:33 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:46040) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jVG92-0005o7-0A for guix-patches@gnu.org; Sun, 03 May 2020 11:03:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46104) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jVG91-0000lK-7c for guix-patches@gnu.org; Sun, 03 May 2020 11:03:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jVG91-0005CY-4I for guix-patches@gnu.org; Sun, 03 May 2020 11:03:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#39258] [PATCH v4 2/3] DRAFT packages: Add new procedure 'fold-packages*'. Resent-From: zimoun Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 03 May 2020 15:03:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 39258 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 39258@debbugs.gnu.org Cc: arunisaac@systemreboot.net, mail@ambrevar.xyz, ludo@gnu.org, zimoun Received: via spool by 39258-submit@debbugs.gnu.org id=B39258.158851814819902 (code B ref 39258); Sun, 03 May 2020 15:03:03 +0000 Received: (at 39258) by debbugs.gnu.org; 3 May 2020 15:02:28 +0000 Received: from localhost ([127.0.0.1]:57640 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jVG8R-0005An-8T for submit@debbugs.gnu.org; Sun, 03 May 2020 11:02:27 -0400 Received: from mail-wr1-f67.google.com ([209.85.221.67]:34924) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jVG8P-0005AN-DX for 39258@debbugs.gnu.org; Sun, 03 May 2020 11:02:25 -0400 Received: by mail-wr1-f67.google.com with SMTP id x18so17833251wrq.2 for <39258@debbugs.gnu.org>; Sun, 03 May 2020 08:02:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=g/Ap+DsFXX88hbi+Yvm1efNAcOgiB+00QdKk0X55xTc=; b=h8CE3txtoW2DMHQVxDWhhGVIKkbsKKPieGNdtY4LGffYuTGeRMJZ8nQqIO5QAc8WX9 eNHfn0F+VY3qD6BDUM1nYno5isLWW7nnk1NqzL5edC2yDspUR5PcW7xADD3w301CHS+3 EeuuoLEwWa7scP/1Eb1mVS3o2bPzCPwuvjS2CniWBBsEzx9cikBdb4n5/t1DhWYsovfT 5TVLROpFiVQK3MS3AJqCeJT1b9CPdPkBCatjAsNCOe6HgGihtJ5ExuXHZ0BQNEJJ7nMo xKUe30c0hH6hlR9Vd4wRVGA9qE0eSB1nP7xvDXd9bG36OR3kHPxduJzbY48iiUiKkiz2 9ShQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=g/Ap+DsFXX88hbi+Yvm1efNAcOgiB+00QdKk0X55xTc=; b=Q/fbeGgqtvtX6oqH67Fc5tj/eR6e7xrzcZKTHHRa8HaKTUhj00cueX4LlIAvXKt3iX iBa1AmG5x9B6h6anU1OTU5pQqMw17BgkQxMX0wbl5tHkPFDcS3T2w99n1DiflTSpzHhW 2MNr2PDx4gBEDDqaulfgcS63uGRPa4qE0JhHnMwdZnnC1q7yzwWxYloZPZ+VaxmeV+kQ uPs5JYbn/6s6p0Xak+eArtFIhSUyaRZpIBBrTg+k6Nc7Xaz6vNMEY1/CyZ5U76Mtny5q 5tH3nwPJnnS7o7HsXPmSpT6TzKwBA0WjxEBJQPAPa9npvjrfiZZ4EWrtVVXRBZTM81DW 6w+w== X-Gm-Message-State: AGi0PuZNvOzZbOh4xz1DSZIh920u3OE6hM2nIFEXegCa9mHdtUDAN+eG DZ9/L2k2wQu4C2vzq6XwSA+1AAqq X-Google-Smtp-Source: APiQypI+C5VHCpwASn0z9sOBkb905oUanZs6V+nM8elFaB1cKtUSw6gI/znRc2Ce3she9ZtYcZCcbA== X-Received: by 2002:adf:fcc8:: with SMTP id f8mr14213653wrs.230.1588518139268; Sun, 03 May 2020 08:02:19 -0700 (PDT) Received: from localhost.localdomain (57.246.195.77.rev.sfr.net. [77.195.246.57]) by smtp.gmail.com with ESMTPSA id x13sm9787829wmc.5.2020.05.03.08.02.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 03 May 2020 08:02:18 -0700 (PDT) From: zimoun Date: Sun, 3 May 2020 17:01:53 +0200 Message-Id: <20200503150154.26532-3-zimon.toutoune@gmail.com> X-Mailer: git-send-email 2.26.1 In-Reply-To: <20200503150154.26532-1-zimon.toutoune@gmail.com> References: <20200503150154.26532-1-zimon.toutoune@gmail.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.0 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 X-Spam-Score: 5.59 Authentication-Results: aspmx1.migadu.com; dkim=fail (rsa verify failed) header.d=gmail.com header.s=20161025 header.b=h8CE3txt; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 2001:470:142::17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Scan-Result: default: False [5.59 / 13.00]; RCVD_VIA_SMTP_AUTH(0.00)[]; GENERIC_REPUTATION(0.00)[-0.49374072251323]; FORGED_SENDER_MAILLIST(0.00)[]; TO_DN_SOME(0.00)[]; R_SPF_ALLOW(-0.20)[+ip6:2001:470:142::/48:c]; R_DKIM_REJECT(1.00)[gmail.com:s=20161025]; DWL_DNSWL_FAIL(0.00)[2001:470:142::17:server fail]; FREEMAIL_FROM(0.00)[gmail.com]; BROKEN_CONTENT_TYPE(1.50)[]; RCPT_COUNT_FIVE(0.00)[5]; R_MISSING_CHARSET(2.50)[]; DKIM_TRACE(0.00)[gmail.com:-]; MX_GOOD(-0.50)[cached: eggs.gnu.org]; MAILLIST(-0.20)[mailman]; FORGED_RECIPIENTS_MAILLIST(0.00)[]; RCVD_IN_DNSWL_FAIL(0.00)[2001:470:142::17:server fail]; MIME_TRACE(0.00)[0:+]; RCVD_TLS_LAST(0.00)[]; ASN(0.00)[asn:22989, ipnet:2001:470:142::/48, country:US]; MID_RHS_MATCH_FROM(0.00)[]; TAGGED_FROM(0.00)[larch=yhetil.org]; ARC_NA(0.00)[]; IP_REPUTATION_HAM(0.00)[asn: 22989(0.14), country: US(-0.00), ip: 2001:470:142::17(-0.49)]; FROM_NEQ_ENVFROM(0.00)[zimontoutoune@gmail.com,guix-patches-bounces@gnu.org]; FROM_HAS_DN(0.00)[]; TAGGED_RCPT(0.00)[]; PREVIOUSLY_DELIVERED(0.00)[39258@debbugs.gnu.org]; MIME_GOOD(-0.10)[text/plain]; HAS_LIST_UNSUB(-0.01)[]; FREEMAIL_CC(0.00)[systemreboot.net,ambrevar.xyz,gnu.org,gmail.com]; RCVD_COUNT_SEVEN(0.00)[9]; SUSPICIOUS_RECIPS(1.50)[]; DMARC_POLICY_SOFTFAIL(0.10)[gmail.com : SPF not aligned (relaxed),none] X-TUID: gfeLRFK6ePZo --- 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 packagerecutils - (fill-paragraph list width* - (string-length "dependencies: "))))) + (define (dependencies->string packages) + (string-join (delete-duplicates + (map package-full-name + (sort packages packagerecutils (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