unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Christopher Baines <mail@cbaines.net>
To: Holger Peters <holger.peters@posteo.de>
Cc: 44367@debbugs.gnu.org
Subject: [bug#44367] [PATCH 1/2] guix: hg-download: Add hg-predicate
Date: Sat, 14 Nov 2020 10:31:03 +0000	[thread overview]
Message-ID: <87o8k0cjrs.fsf@cbaines.net> (raw)
In-Reply-To: <9169d111edc807df292fe0566ce72f84e6d5dd44.1604223741.git.holger.peters@posteo.de>

[-- Attachment #1: Type: text/plain, Size: 2926 bytes --]


Holger Peters <holger.peters@posteo.de> 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))
>  
>  ;;; 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)))
>  
> +(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" directory)))
> +         (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 given 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 given
> +  @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


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

  parent reply	other threads:[~2020-11-14 10:32 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-11-01  9:47 [bug#44367] [PATCH 0/2] hg-predicate Holger Peters
2020-11-01  9:50 ` [bug#44367] [PATCH 1/2] guix: hg-download: Add hg-predicate Holger Peters
2020-11-01  9:50   ` [bug#44367] [PATCH 2/2] doc: Document hg-fetch Holger Peters
2020-11-14 10:33     ` Christopher Baines
2020-11-14 10:31   ` Christopher Baines [this message]
2020-11-07 22:16 ` [bug#44367] Rationale for hg-predicate Dr. Arne Babenhauserheide
2020-11-13 18:02   ` Holger Peters
2020-11-14 10:29     ` bug#44367: " Christopher Baines

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87o8k0cjrs.fsf@cbaines.net \
    --to=mail@cbaines.net \
    --cc=44367@debbugs.gnu.org \
    --cc=holger.peters@posteo.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).