| Message ID | 20230608171453.14788-2-arunisaac@systemreboot.net |
|---|---|
| State | New |
| Headers | show |
| Series | [bug#63802,1/3] client: Separate serialize-email-address into a function. | expand |
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.
Hi Maxim, > 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. Exactly, that was my intuition too. Maybe, we should break with tradition! :-) In any case, I have changed all instances of "function" to "procedure". >> + git-send-email-headers >> + compose)) > > I think you've exported 'compose' erroneously here. Good catch! compose is part of a new "mumi compose" feature I am working on. I had accidentally committed it. I have removed it from this commit. Now that you mention it, maybe I should call it compose-email so as to not conflict with compose from guile core. >> +(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, Good point! I was not aware of false-if-exception. I have changed to using it now. > 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. call-with-input-pipe* and call-with-input-pipe are both defined in mumi/client.scm. They are not part of guile. The only difference between them is whether they accept the command as a string or as a list of arguments---thus, they parallel open-pipe and open-pipe*. > Otherwise you'd get header-command set to the empty string, which > seems like it'd be a problem... call-with-input-pipe* does raise an exception when git is available but sendemail.headerCmd is not set. I checked. So, this is not 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. sendemail.headerCmd is only available to us as a string, and not as a list of arguments. It is quite non-trivial to correctly split the string back into a list of arguments. That would require correct handling of quotes like the shell does. So, we use call-with-input-pipe to handle this case. But everywhere else (such as when invoking "git config sendemail.headerCmd"), we prefer to pass commands as a list of arguments. So, we need call-with-input-pipe*. I understand it's a bit confusing to have two very similar functions. But, the only possible compromise is to use call-with-input-pipe everywhere. Should I make that compromise? WDYT? Thanks for the review! Regards, Arun
Hello, Arun Isaac <arunisaac@systemreboot.net> writes: [...] >>> + git-send-email-headers >>> + compose)) >> >> I think you've exported 'compose' erroneously here. > > Good catch! compose is part of a new "mumi compose" feature I am working > on. I had accidentally committed it. I have removed it from this commit. > > Now that you mention it, maybe I should call it compose-email so as to > not conflict with compose from guile core. Good idea! Shadowing builtins should be avoided; the warnings are annoying and require the use of #:hide on imports (and the code more confusing to read). [...] >> 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. > > call-with-input-pipe* and call-with-input-pipe are both defined in > mumi/client.scm. They are not part of guile. The only difference between > them is whether they accept the command as a string or as a list of > arguments---thus, they parallel open-pipe and open-pipe*. > >> Otherwise you'd get header-command set to the empty string, which >> seems like it'd be a problem... > > call-with-input-pipe* does raise an exception when git is available but > sendemail.headerCmd is not set. I checked. So, this is not a problem. Good, thanks for checking. >>> + (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. > > sendemail.headerCmd is only available to us as a string, and not as a > list of arguments. It is quite non-trivial to correctly split the string > back into a list of arguments. That would require correct handling of > quotes like the shell does. So, we use call-with-input-pipe to handle > this case. Ah, I see. It's reasonable then to use it as is. > But everywhere else (such as when invoking "git config > sendemail.headerCmd"), we prefer to pass commands as a list of > arguments. So, we need call-with-input-pipe*. > > I understand it's a bit confusing to have two very similar > functions. But, the only possible compromise is to use > call-with-input-pipe everywhere. Should I make that compromise? WDYT? No, just the explanation here (and a possible comment in the source mirroring it) is enough! LGTM.
> Good idea! Shadowing builtins should be avoided; the warnings are > annoying and require the use of #:hide on imports (and the code more > confusing to read). I definitely agree. I was engrossed in writing mumi-compose, and quite forgot about the builtin compose. > No, just the explanation here (and a possible comment in the source > mirroring it) is enough! Done, and pushed! Thanks!
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)) (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))) + (headers + (if header-command + (call-with-input-pipe (string-append header-command " " patch) + 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"))
* mumi/client.scm: Import (rnrs exceptions). (git-send-email-headers): New public function. (split-cc): New function. * 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(-)