Message ID | 4be63ddf12bd6143b43e87951e164dc93c585bb8.1699225200.git.zimon.toutoune@gmail.com |
---|---|
State | New |
Headers | show |
Series | [bug#66961] scripts: hash: Handle repository with different VCS folders. | expand |
Hi! Simon Tournier <zimon.toutoune@gmail.com> skribis: > Fixes <https://issues.guix.gnu.org/issue/65979>. > Reported by Simon Tournier <zimon.toutoune@gmail.com> > > * guix/hash.scm (vcs-file?): Add optional argument for passing VCS kind of the > file/repository. > (file-hash*): Adjust accordingly. > * guix/scripts/hash.scm (guix-hash)[file-hash]: Detect VCS kind of the > file/repository and passes it. > > Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa [...] > +(define* (vcs-file? file stat > + #:optional > + (vcses (list ".bzr" ".git" ".hg" ".svn" "CVS"))) > + "Returns true if FILE matches a version control system from the list VCSES." How about ‘vcs-directories’ rather than ‘vcses’? Also, you can add: (define %known-vcs-directories '(".bzr" …)) and use it to avoid repeating it. > + (let* ((vcses (fold (lambda (vcs result) > + (if (file-exists? (string-append file "/" vcs)) > + (cons vcs result) > + result)) > + '() > + (list ".bzr" ".git" ".hg" ".svn" "CVS"))) > + (select? (if (assq-ref opts 'exclude-vcs?) > + (negate (lambda (file stat) > + (vcs-file? file stat > + vcses))) > + (const #t)))) Maybe you can have: (define (vcs-predicate directory) (define directories (filter (lambda (metadata-directory) (file-exists? (in-vicinity directory metadata-directory))) %known-vcs-directories)) (lambda (file stat) (vcs-file? file stat directories))) and then use that above? (That way we don’t stat these things when ‘exclude-vcs?’ is #false.) Thanks, Ludo’.
Hi Ludo, On mar., 14 nov. 2023 at 14:44, Ludovic Courtès <ludo@gnu.org> wrote: > How about ‘vcs-directories’ rather than ‘vcses’? > > Also, you can add: > > (define %known-vcs-directories > '(".bzr" …)) > > and use it to avoid repeating it. [...] > Maybe you can have: > > (define (vcs-predicate directory) > (define directories > (filter (lambda (metadata-directory) > (file-exists? (in-vicinity directory metadata-directory))) > %known-vcs-directories)) > > (lambda (file stat) > (vcs-file? file stat directories))) > > and then use that above? (That way we don’t stat these things when > ‘exclude-vcs?’ is #false.) Thanks for the feedback. See v2. Cheers, simon PS: Sorry, I have sent twice v2; missed an option with my new experimental setup. :-)
On mer., 29 nov. 2023 at 21:36, Simon Tournier <zimon.toutoune@gmail.com> wrote: > Thanks for the feedback. See v2. [...] > PS: Sorry, I have sent twice v2; missed an option with my new > experimental setup. :-) Sorry for the mess. I have sent the correct one; v2 is obviously- broken. Therefore, please see v3. Again sorry for the mess. Cheers, simon
diff --git a/guix/hash.scm b/guix/hash.scm index 3cb68e5c44..8fff51e8f1 100644 --- a/guix/hash.scm +++ b/guix/hash.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,21 +26,26 @@ (define-module (guix hash) #:export (vcs-file? file-hash*)) -(define (vcs-file? file stat) - "Returns true if FILE is a version control system file." +(define* (vcs-file? file stat + #:optional + (vcses (list ".bzr" ".git" ".hg" ".svn" "CVS"))) + "Returns true if FILE matches a version control system from the list VCSES." (case (stat:type stat) ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + (member (basename file) vcses)) ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) + (if (member ".git" vcses) + ;; Git sub-modules have a '.git' file that is a regular text file. + (string=? (basename file) ".git") + #f)) (else #f))) (define* (file-hash* file #:key (algorithm (hash-algorithm sha256)) (recursive? 'auto) - (select? (negate vcs-file?))) + (select? (negate (lambda (file stat) + (vcs-file? file stat))))) "Compute the hash of FILE with ALGORITHM. Symbolic links are only dereferenced if RECURSIVE? is false. diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 7197d3965c..ed96e6a7e1 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de> -;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2021, 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; ;;; This file is part of GNU Guix. @@ -181,9 +181,6 @@ (define-command (guix-hash . args) (_ #f)) (reverse opts))) (fmt (assq-ref opts 'format)) - (select? (if (assq-ref opts 'exclude-vcs?) - (negate vcs-file?) - (const #t))) (algorithm (assoc-ref opts 'hash-algorithm)) (serializer (assoc-ref opts 'serializer))) @@ -193,7 +190,18 @@ (define-command (guix-hash . args) (catch 'system-error (lambda _ (with-error-handling - (serializer file algorithm select?))) + (let* ((vcses (fold (lambda (vcs result) + (if (file-exists? (string-append file "/" vcs)) + (cons vcs result) + result)) + '() + (list ".bzr" ".git" ".hg" ".svn" "CVS"))) + (select? (if (assq-ref opts 'exclude-vcs?) + (negate (lambda (file stat) + (vcs-file? file stat + vcses))) + (const #t)))) + (serializer file algorithm select?)))) (lambda args (leave (G_ "~a ~a~%") file