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 #11 received at 59318 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Liliana Marie Prikler <liliana.prikler <at> ist.tugraz.at> Cc: 59318 <at> debbugs.gnu.org, Antero Mejr <antero <at> mailbox.org> Subject: Re: bug#59318: [PATCH] etc: committer: Add --package-directory flag. Date: Tue, 21 Mar 2023 09:08:17 -0400
Hello Antero, Liliana Marie Prikler <liliana.prikler <at> ist.tugraz.at> writes: > 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 Gentle ping :-). Could you please address the above review comments and send a v2? -- Thanks, Maxim
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.