[bug#59318] etc: committer: Add --package-directory flag.

* 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.
---
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".

 etc/committer.scm.in | 46 +++++++++++++++++++++++++++-----------------
 1 file changed, 28 insertions(+), 18 deletions(-)

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

Hello Antero,

Liliana Marie Prikler <liliana.prikler@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?