[bug#44367] [PATCH 0/2] hg-predicate

[bug#44367] [PATCH 0/2] hg-predicate

[Holger Peters]

Provided are two mercurial-related patches.

Holger Peters (2):
  guix: hg-download: Add hg-predicate
  doc: Document hg-fetch

 doc/guix.texi        | 11 +++++++++++
 guix/hg-download.scm | 38 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 48 insertions(+), 1 deletion(-)

-- 
2.28.0

[bug#44367] [PATCH 1/2] guix: hg-download: Add hg-predicate

[Holger Peters]

`hg-predicate' acts for mercurial repositories as `git-predicate' acts
for git-repositories.

* guix/hg-download.scm (hg-predicate): New variable.
---
 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}."
+  (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."
+  (let ((files (hg-file-list directory)))
+    (lambda (file stat)
+      (should-select? files file))))
+
 ;;; hg-download.scm ends here
-- 
2.28.0

[bug#44367] [PATCH 2/2] doc: Document hg-fetch

[Holger Peters]

* doc/guix.texi (hg-fetch): Add documentation for scheme procedure.
---
 doc/guix.texi | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 69e7d5f85c..cb58ba85c6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6834,6 +6834,17 @@ commit:
 @end lisp
 @end deftp
 
+For mercurial repositories, the module @code{(guix hg-download)} defines the
+@code{hg-fetch} origin method and @code{hg-reference} data type for support of
+the mercurial version control system.
+
+@deffn {Scheme Procedure} hg-fetch @var{ref} @var{hash-algo} @var{hash}
+Return a fixed-output derivation that fetches @var{ref}, a
+@code{<hg-reference>} object.  @code{<git-reference>} object.  The output is
+expected to have recursive hash @var{hash} of type @var{hash-algo} (a symbol).
+Use @var{name} as the file name, or a generic name if @code{#false}.
+@end deffn
+
 @node Defining Package Variants
 @section Defining Package Variants
 
-- 
2.28.0

[bug#44367] Rationale for hg-predicate

[Dr. Arne Babenhauserheide]

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

Rationale for this patch: It can be used to reduce the number of files
pulled into the build when used as in the #:select? part of the source
clause.

Example:

(define-public example
  (package
    (name "example")
    ; …
    (source (local-file %source-dir
      #:recursive? #t
      #:select? hg-predicate))
    ; …
    ))

Best wishes,
Arne
-- 
Unpolitisch sein
heißt politisch sein
ohne es zu merken

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

[bug#44367] Rationale for hg-predicate

[Holger Peters]

Hi,


Thanks for making that clear. Anything preventing the patches to be
merged?  The functionality is already provided for `git' and this patch
just levels the playing field for `mercurial' repositories.


Holger

> Am 07.11.2020 um 23:16 schrieb Dr. Arne Babenhauserheide <arne_bab@web.de>:
> 
> Rationale for this patch: It can be used to reduce the number of files
> pulled into the build when used as in the #:select? part of the source
> clause.
> 
> Example:
> 
> (define-public example
>  (package
>    (name "example")
>    ; …
>    (source (local-file %source-dir
>      #:recursive? #t
>      #:select? hg-predicate))
>    ; …
>    ))
> 
> Best wishes,
> Arne
> -- 
> Unpolitisch sein
> heißt politisch sein
> ohne es zu merken

bug#44367: Rationale for hg-predicate

[Christopher Baines]

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


Holger Peters <holger.peters@posteo.de> writes:

> Thanks for making that clear. Anything preventing the patches to be
> merged?  The functionality is already provided for `git' and this
> patch just levels the playing field for `mercurial' repositories.

I've had a look at the patches now, and pushed them as
289b20ef62ce1d23befcf2593b191e2a686c7b6c with some tweaks. I'll make
some comments on the patches by email, but please also have a look at
the two commits.

Thanks,

Chris

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

[bug#44367] [PATCH 1/2] guix: hg-download: Add hg-predicate

[Christopher Baines]

[-- 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 --]

[bug#44367] [PATCH 2/2] doc: Document hg-fetch

[Christopher Baines]

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


Holger Peters <holger.peters@posteo.de> writes:

> * doc/guix.texi (hg-fetch): Add documentation for scheme procedure.

For the changelog for documentation, I normally put the section in the
round brackets, then describe the change after the colon. So, I changed
this to:

* doc/guix.texi (origin Reference): Add documentation for hg-fetch.

> ---
>  doc/guix.texi | 11 +++++++++++
>  1 file changed, 11 insertions(+)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 69e7d5f85c..cb58ba85c6 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -6834,6 +6834,17 @@ commit:
>  @end lisp
>  @end deftp
>  
> +For mercurial repositories, the module @code{(guix hg-download)} defines the
> +@code{hg-fetch} origin method and @code{hg-reference} data type for support of
> +the mercurial version control system.
> +
> +@deffn {Scheme Procedure} hg-fetch @var{ref} @var{hash-algo} @var{hash}

hg-fetch accepts an optional name parameter, so I added that here since
the text refers to it. Assuming you copied the git-fetch documentation,
that's maybe deficient as it doesn't mention all the parameters.

> +Return a fixed-output derivation that fetches @var{ref}, a
> +@code{<hg-reference>} object.  @code{<git-reference>} object.  The output is

There's a typo regarding git-reference here which I removed.

> +expected to have recursive hash @var{hash} of type @var{hash-algo} (a symbol).
> +Use @var{name} as the file name, or a generic name if @code{#false}.
> +@end deffn
> +
>  @node Defining Package Variants
>  @section Defining Package Variants


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