From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id cKe+BkCyr18uXgAA0tVLHw (envelope-from ) for ; Sat, 14 Nov 2020 10:32:32 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id aP+QAkCyr188XQAAbx9fmQ (envelope-from ) for ; Sat, 14 Nov 2020 10:32:32 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.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 89A959402C8 for ; Sat, 14 Nov 2020 10:32:31 +0000 (UTC) Received: from localhost ([::1]:44884 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kdsr7-0004I5-Jv for larch@yhetil.org; Sat, 14 Nov 2020 05:32:29 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:57746) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kdsqg-0004Hz-Rv for guix-patches@gnu.org; Sat, 14 Nov 2020 05:32:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:38276) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kdsqg-0007m5-I6 for guix-patches@gnu.org; Sat, 14 Nov 2020 05:32:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kdsqg-0006Qp-FQ for guix-patches@gnu.org; Sat, 14 Nov 2020 05:32:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#44367] [PATCH 1/2] guix: hg-download: Add hg-predicate Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 14 Nov 2020 10:32:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 44367 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Holger Peters Cc: 44367@debbugs.gnu.org Received: via spool by 44367-submit@debbugs.gnu.org id=B44367.160534986924664 (code B ref 44367); Sat, 14 Nov 2020 10:32:02 +0000 Received: (at 44367) by debbugs.gnu.org; 14 Nov 2020 10:31:09 +0000 Received: from localhost ([127.0.0.1]:49822 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kdspo-0006Pj-LC for submit@debbugs.gnu.org; Sat, 14 Nov 2020 05:31:08 -0500 Received: from mira.cbaines.net ([212.71.252.8]:50504) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kdspm-0006Pb-Mz for 44367@debbugs.gnu.org; Sat, 14 Nov 2020 05:31:07 -0500 Received: from localhost (188.28.119.104.threembb.co.uk [188.28.119.104]) by mira.cbaines.net (Postfix) with ESMTPSA id 2880027BBF4; Sat, 14 Nov 2020 10:31:06 +0000 (GMT) Received: from capella (localhost [127.0.0.1]) by localhost (OpenSMTPD) with ESMTP id ac161d48; Sat, 14 Nov 2020 10:31:03 +0000 (UTC) References: <9169d111edc807df292fe0566ce72f84e6d5dd44.1604223741.git.holger.peters@posteo.de> User-agent: mu4e 1.4.13; emacs 27.1 From: Christopher Baines In-reply-to: <9169d111edc807df292fe0566ce72f84e6d5dd44.1604223741.git.holger.peters@posteo.de> Date: Sat, 14 Nov 2020 10:31:03 +0000 Message-ID: <87o8k0cjrs.fsf@cbaines.net> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" 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: ns3122888.ip-94-23-21.eu Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: -0.61 X-TUID: 0oaL/RX38RI4 --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Holger Peters writes: > `hg-predicate' acts for mercurial repositories as `git-predicate' acts > for git-repositories. > > * guix/hg-download.scm (hg-predicate): New variable. hg-predicate is a procedure, so it's more appropriate to put "New procedure" here. > guix/hg-download.scm | 38 +++++++++++++++++++++++++++++++++++++- > 1 file changed, 37 insertions(+), 1 deletion(-) > > diff --git a/guix/hg-download.scm b/guix/hg-download.scm > index 694105ceba..44212e295e 100644 > --- a/guix/hg-download.scm > +++ b/guix/hg-download.scm > @@ -26,12 +26,14 @@ > #:use-module (guix packages) > #:autoload (guix build-system gnu) (standard-packages) > #:use-module (ice-9 match) > + #:use-module (ice-9 popen) > + #:use-module (ice-9 rdelim) > #:export (hg-reference > hg-reference? > hg-reference-url > hg-reference-changeset > hg-reference-recursive? > - > + hg-predicate > hg-fetch)) >=20=20 > ;;; Commentary: > @@ -93,4 +95,38 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a= generic name if #f." > #:recursive? #t > #:guile-for-build guile))) >=20=20 > +(define (hg-file-list directory) > + "Evaluates to a list of files contained in the repository at path > + @var{directory}" > + (let* ((port (open-input-pipe (format #f "hg files --repository ~s" di= rectory))) > + (files (let loop ((files '())) > + (let ((line (read-line port))) > + (cond > + ((eof-object? line) files) > + (else > + (loop (cons line files)))))))) > + (close-pipe port) > + (map canonicalize-path files))) > + > +(define (should-select? pth-lst candidate) > + "Returns #t in case that @var{candidate} is a file is part of the give= n file > + list @var{path-list}." I changed pth-lst to match path-list in the docstring. > + (let ((canon-candidate (canonicalize-path candidate))) > + (let loop ((xs pth-lst)) > + (cond > + ((null? xs) > + ;; Directories are not part of `hg files', but `local-file' will= not > + ;; recurse if we don't return #t for directories. > + (equal? (array-ref (lstat candidate) 13) 'directory)) > + ((string-contains candidate (car xs)) #t) > + (else (loop (cdr xs))))))) > + > +(define (hg-predicate directory) > + "This procedure evaluates to a predicate that reports back whether a g= iven > + @var{file} - @var{stat} combination is part of the files tracked by > + mercurial." I tweaked the indentation here, and capitalised Mercurial, as that seems better. > + (let ((files (hg-file-list directory))) > + (lambda (file stat) > + (should-select? files file)))) > + > ;;; hg-download.scm ends here --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl+vsedfFIAAAAAALgAo aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh aW5lcy5uZXQACgkQXiijOwuE9XcAoBAAhnMZr4PONYO2we8/OCAcaRBmJiw8uXnp s8WBXq6ZxrK/pnCaiRpsltM4xyJA011ZtEIAzpe48R5xUyrbMvgKGlTGAnvFZDyO XaPNVs8VrPIb4ODBAPu2X4/nUGaxBBHyI9WW4dJ9qaW3kDDR/nUi30nNkh2H4St5 uOwEqXGYHzAxyWNO2V7FrzYJdAJWJxzgtVWa4CS3fZ2Dq5BjXTbrpV96zfeeJG4W QE1H5hvFlEOvweGY5pxIzXjE4X1HsnC3JjEFogI5/gF40lLZQBnrYGE2Ools8XFI RjlxRCx16PPnppkWrwrkQieIUcF8wnh/NBtAy03w0m7PUMIeKpJAEIjS4QNKCIIy OK+AEPKD64+Dp++7H+uldmifn/uabSLTIAkc1HQH0Rapz62wft5p58Yv6fRu1frQ GOMz6nEuz1x3ofqMTtmci4u5JuOcs2AS7dKifthBY1wqqE504KEUOirzrtgO5GUt PqFFutIuSsB9rPit7F+qJLmUqv35MHfJ/GLKv6O1nbU6kA/vctqwAcUsAydHBH9L O+0xfjyMdQYRi7peeJyStaPhOANY7mR3YjZ4nECcXMfCh9/t9SWkWwagkXHIL9XP uLN3y0QbJ+cw+9QRCQYWkcfBCadJg6OSFkJozIlXKjnjpMLcNKZiYbpLq4fDpQBC k/HRBnQML0A= =PMEZ -----END PGP SIGNATURE----- --=-=-=--