Package: guix-patches;
Reported by: Antero Mejr <antero <at> mailbox.org>
Date: Wed, 16 Nov 2022 19:00:02 UTC
Severity: normal
Tags: moreinfo, patch
Message #8 received at 59318 <at> debbugs.gnu.org (full text, mbox):
From: Liliana Marie Prikler <liliana.prikler <at> ist.tugraz.at> To: Antero Mejr <antero <at> mailbox.org>, 59318 <at> debbugs.gnu.org Subject: Re: [PATCH] etc: committer: Add --package-directory flag. Date: Thu, 17 Nov 2022 13:27:39 +0100
Am Mittwoch, dem 16.11.2022 um 18:58 +0000 schrieb Antero Mejr:
> * etc/committer.scm.in (main)[pkg-dir]: New variable.
> (main): Use it.
> (diff-info)[package-dir]: New argument.
> (change-commit-message)[package-dir]: New argument.
> (add-commit-message)[package-dir]: New argument.
> (remove-commit-message)[package-dir]: New argument.
> (custom-commit-message)[package-dir]: New argument.
This could be simplified to (diff-info, change-commit-message, ...):
Honour package-dir.
> ---
> Make the hard-coded "gnu" part of the package directory path into a
> flag.
> This allows committer.scm to be used for channels where the package
> directory is not "gnu".
Note that instead of forwarding as you did, you could also make
package-dir a parameter and (parameterize ) it. This has the advantage
that you don't need to forward it in places where it's not immediately
clear to be relevant.
>
> etc/committer.scm.in | 46 +++++++++++++++++++++++++++---------------
> --
> 1 file changed, 28 insertions(+), 18 deletions(-)
>
> diff --git a/etc/committer.scm.in b/etc/committer.scm.in
> index e7f1ca8c45..13021891aa 100755
> --- a/etc/committer.scm.in
> +++ b/etc/committer.scm.in
> @@ -129,7 +129,7 @@ (define* (hunk->patch hunk #:optional (port
> (current-output-port)))
> file-name file-name file-name file-name
> (string-join (hunk-diff-lines hunk) ""))))
>
> -(define (diff-info)
> +(define (diff-info package-dir)
> "Read the diff and return a list of <hunk> values."
> (let ((port (open-pipe* OPEN_READ
> "git" "diff-files"
> @@ -138,7 +138,7 @@ (define (diff-info)
> ;; new definitions with changes to
> existing
> ;; definitions.
> "--unified=1"
> - "--" "gnu")))
> + "--" package-dir)))
> (define (extract-line-number line-tag)
> (abs (string->number
> (car (string-split line-tag #\,)))))
> @@ -221,7 +221,8 @@ (define (new-sexp hunk)
> (+ (lines-to-first-change hunk)
> (hunk-new-line-number hunk))))))
>
> -(define* (change-commit-message file-name old new #:optional (port
> (current-output-port)))
> +(define* (change-commit-message file-name old new package-dir
> + #:optional (port (current-output-
> port)))
> "Print ChangeLog commit message for changes between OLD and NEW."
> (define (get-values expr field)
> (match ((xpath:sxpath `(// ,field quasiquote *)) expr)
> @@ -247,8 +248,8 @@ (define version
> (and=> ((xpath:sxpath '(// version *any*)) new)
> first))
> (format port
> - "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
> - variable-name version file-name variable-name version)
> + "~a: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
> + package-dir variable-name version file-name variable-name
> version)
> (for-each (lambda (field)
> (let ((old-values (get-values old field))
> (new-values (get-values new field)))
> @@ -272,21 +273,22 @@ (define version
> (listify added))))))))))
> '(inputs propagated-inputs native-inputs)))
>
> -(define* (add-commit-message file-name variable-name
> +(define* (add-commit-message file-name variable-name package-dir
> #:optional (port (current-output-
> port)))
> "Print ChangeLog commit message for a change to FILE-NAME adding a
> definition."
> - (format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
> - variable-name file-name variable-name))
> + (format port "~a: Add ~a.~%~%* ~a (~a): New variable.~%"
> + package-dir variable-name file-name variable-name))
>
> -(define* (remove-commit-message file-name variable-name
> +(define* (remove-commit-message file-name variable-name package-dir
> #:optional (port (current-output-
> port)))
> "Print ChangeLog commit message for a change to FILE-NAME removing
> a
> definition."
> - (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
> - variable-name file-name variable-name))
> + (format port "~a: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
> + package-dir variable-name file-name variable-name))
>
> (define* (custom-commit-message file-name variable-name message
> changelog
> + package-dir
> #:optional (port (current-output-
> port)))
> "Print custom commit message for a change to VARIABLE-NAME in
> FILE-NAME, using
> MESSAGE as the commit message and CHANGELOG as the body of the
> ChangeLog
> @@ -301,7 +303,7 @@ (define (changelog-has-location? changelog)
>
> (let* ((message (trim message))
> (changelog (if changelog (trim changelog) message))
> - (message/f (format #f "gnu: ~a: ~a." variable-name
> message))
> + (message/f (format #f "~a: ~a: ~a." package-dir variable-
> name message))
> (changelog/f (if (changelog-has-location? changelog)
> (format #f "* ~a (~a)~a."
> file-name variable-name changelog)
You're repeating the same work with each message style. IMHO it would
make more sense to have a procedure or syntax that prepends it instead.
> @@ -349,16 +351,23 @@ (define (new+old+hunks hunks)
> (define %delay 1000)
>
> (define (main . args)
> + (define pkg-dir
> + (match args
> + (("--package-directory" pkg-dir ...)
> + (begin (set! args (cddr args))
> + (car pkg-dir)))
> + (_ "gnu")))
> +
Using a proper option grammar in combination with getopt-long is
probably a better idea ;)
> (define* (change-commit-message* file-name old new #:rest rest)
> (let ((changelog #f))
> (match args
> ((or (message changelog) (message))
> (apply custom-commit-message
> - file-name (second old) message changelog rest))
> + file-name (second old) message changelog pkg-dir
> rest))
> (_
> - (apply change-commit-message file-name old new rest)))))
> + (apply change-commit-message file-name old new pkg-dir
> rest)))))
>
> - (match (diff-info)
> + (match (diff-info pkg-dir)
> (()
> (display "Nothing to be done.\n" (current-error-port)))
> (hunks
> @@ -373,7 +382,7 @@ (define* (change-commit-message* file-name old
> new #:rest rest)
> (commit-message-proc (match (hunk-type hunk)
> ('addition add-commit-
> message)
> ('removal remove-commit-
> message))))
> - (commit-message-proc (hunk-file-name hunk) variable-
> name)
> + (commit-message-proc (hunk-file-name hunk) variable-name
> pkg-dir)
> (let ((port (open-pipe* OPEN_WRITE
> "git" "apply"
> "--cached"
> @@ -383,7 +392,8 @@ (define* (change-commit-message* file-name old
> new #:rest rest)
> (error "Cannot apply")))
>
> (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F"
> "-")))
> - (commit-message-proc (hunk-file-name hunk) variable-
> name port)
> + (commit-message-proc (hunk-file-name hunk) variable-
> name pkg-dir
> + port)
> (usleep %delay)
> (unless (eqv? 0 (status:exit-val (close-pipe port)))
> (error "Cannot commit"))))
> @@ -423,6 +433,6 @@ (define copyright-line
> (error "Cannot commit")))))))
> ;; XXX: we recompute the hunks here because previous
> ;; insertions lead to offsets.
> - (new+old+hunks (diff-info))))))
> + (new+old+hunks (diff-info pkg-dir))))))
>
> (apply main (cdr (command-line)))
Cheers
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.