[bug#63802] [mumi PATCH 0/3] Use consolidated X-Debbugs-Cc header

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

Hello,

Arun Isaac <arunisaac@systemreboot.net> writes:

> * mumi/client.scm: Import (rnrs exceptions).
> (git-send-email-headers): New public function.
> (split-cc): New function.

nitpick: I guess these should be called 'procedures', which seems to be
the preferred term in Scheme (ironically enough for a functional
language?  eh!).  CC'ing Ludovic in case they have some thoughts on the
matter, as I think they were the one originally teaching me that.

If that was just me, intuitively I'd use 'procedure' for something
involving side effects while 'function' as something taking an input and
always returning the same output, without side effects (pure function),
but that doesn't seem to be the prevalent style in the Scheme community.

> * scripts/mumi.in: Add git-send-email-headers subcommand.
> * tests/client.scm (split-cc): New variable.
> ("split Cc field"): New test.
> ---
>  mumi/client.scm  | 52 +++++++++++++++++++++++++++++++++++++++++++++++-
>  scripts/mumi.in  |  2 ++
>  tests/client.scm |  8 ++++++++
>  3 files changed, 61 insertions(+), 1 deletion(-)
>
> diff --git a/mumi/client.scm b/mumi/client.scm
> index c30429d..b89e608 100644
> --- a/mumi/client.scm
> +++ b/mumi/client.scm
> @@ -17,6 +17,7 @@
>  ;;; along with mumi.  If not, see <http://www.gnu.org/licenses/>.
>  
>  (define-module (mumi client)
> +  #:use-module (rnrs exceptions)
>    #:use-module (rnrs io ports)
>    #:use-module (srfi srfi-1)
>    #:use-module (srfi srfi-19)
> @@ -38,7 +39,9 @@
>              print-current-issue
>              set-current-issue!
>              clear-current-issue!
> -            send-email))
> +            send-email
> +            git-send-email-headers
> +            compose))

I think you've exported 'compose' erroneously here.

>  (define (git-top-level)
>    "Return the top-level directory of the current git repository."
> @@ -229,6 +232,13 @@ arguments."
>                       name)
>                   " <" address ">"))
>  
> +(define (split-cc cc)
> +  "Split CC into a list of email addresses."
> +  (map (lambda (address)
> +         (serialize-email-address (assq-ref address 'name)
> +                                  (assq-ref address 'address)))
> +       (assq-ref (parse-email-headers (string-append "Cc: " cc "\n"))
> +                 'cc)))
>  
>  (define* (git-send-email to patches #:optional (options '()))
>    "Send PATCHES using git send-email to the TO address with
> @@ -311,3 +321,43 @@ ISSUE-NUMBER."
>                           "@"
>                           (client-config 'debbugs-host))
>            other-patches)))))
> +
> +(define (git-send-email-headers patch)
> +  "Print send-email headers for PATCH."
> +  (let* (;; Compute headers if configured in git config.
> +         (header-command
> +          (guard (ex (#t #f))
> +            (call-with-input-pipe* (list "git" "config" "sendemail.headerCmd")
> +              get-line)))

Ain't this guard equivalent to '(false-if-exception
(call-with-input-pipe* ...))' ? I find the later more readable if yes,
but: does call-with-input-pipe* raise an exception when git is available
but 'sendemail.headerCmd' not set, thus exiting with status 1?  I wasn't
able to find its documentation in the Guile Reference manual.  Otherwise
you'd get header-command set to the empty string, which seems like it'd
be a problem...

> +         (headers
> +          (if header-command
> +              (call-with-input-pipe (string-append header-command " " patch)

                  ^ ... here.  Also, why the mixed use of
                  'call-with-input-pipe*' and 'call-with-input-pipe'?  I'd
                  stick with the former.
                  
> +                get-string-all)
> +              ""))
> +         (external-x-debbugs-cc
> +          (cond
> +           ((assq-ref (parse-email-headers (string-append headers "\n"))
> +                       'x-debbugs-cc)
> +            => split-cc)
> +           (else '())))
> +         ;; Fetch Cc addresses for current issue.
> +         (x-debbugs-cc
> +          (cond
> +           ((assq-ref (reply-email-headers (current-issue-number))
> +                       'cc)
> +            => split-cc)
> +           (else '()))))
> +    ;; Print X-Debbugs-Cc header.
> +    (display "X-Debbugs-Cc: ")
> +    (display (string-join (delete-duplicates
> +                           (append x-debbugs-cc external-x-debbugs-cc))
> +                          ", "))
> +    (newline)
> +    ;; Print headers other than X-Debbugs-Cc.
> +    ;; TODO: RFC5322 headers are not restricted to a single
> +    ;; line. "Folded" multi-line headers are allowed. Support them.
> +    (for-each (lambda (line)
> +                (unless (string-prefix-ci? "X-Debbugs-Cc:" line)
> +                  (display line)
> +                  (newline)))
> +              (string-split headers #\newline))))
> diff --git a/scripts/mumi.in b/scripts/mumi.in
> index 2295328..8fb7cd4 100644
> --- a/scripts/mumi.in
> +++ b/scripts/mumi.in
> @@ -163,6 +163,8 @@
>     (client:clear-current-issue!))
>    (("send-email" . patches)
>     (client:send-email patches))
> +  (("git-send-email-headers" patch)
> +   (client:git-send-email-headers patch))
>    (("mailer" . rest)
>     (let* ((opts (parse-options rest))
>            (sender (assoc-ref opts 'sender))
> diff --git a/tests/client.scm b/tests/client.scm
> index 2b2c1be..ced573b 100644
> --- a/tests/client.scm
> +++ b/tests/client.scm
> @@ -68,6 +68,9 @@ called with."
>  (define serialize-email-address
>    (@@ (mumi client) serialize-email-address))
>  
> +(define split-cc
> +  (@@ (mumi client) split-cc))
> +
>  (test-begin "client")
>  
>  (test-equal "serialize email address"
> @@ -78,6 +81,11 @@ called with."
>    "\"Bar, Foo\" <foobar@example.com>"
>    (serialize-email-address "Bar, Foo" "foobar@example.com"))
>  
> +(test-equal "split Cc field"
> +  (list "Foo <foo@example.com>"
> +        "\"Bar, Foo\" <foobar@example.com>")
> +  (split-cc "Foo <foo@example.com>, \"Bar, Foo\" <foobar@example.com>"))
> +
>  (test-equal "send patches to new issue"
>    '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
>      ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))

The rest LGTM.

-- 
Thanks,
Maxim