email: Deduplicate email address parsing.

* email/email.scm (post-process-mailbox): New function.
(parse-email-address): Call post-process-mailbox instead of
reimplementing address parsing using regular expressions.
(parse-email-headers): Call post-process-mailbox.

1 files changed, 23 insertions, 23 deletions

diff --git a/email/email.scm b/email/email.scm
index 6ad2d93..2c9dea4 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -562,6 +562,23 @@ explained in RFC2045), and return that list."
         (values headers
                 (read-while port get-line-with-delimiter identity))))))
 
+(define (post-process-mailbox . args)
+  (define (trim-address address)
+    (string-trim-right
+     (string-trim (string-trim-both address) #\<)
+     #\>))
+
+  (match args
+    ;; name-addr email address
+    (`(mailbox (display-name ,name) ,address)
+     `((name . ,(decode-mime-encoded-word
+                 (string-trim-both name)))
+       (address . ,(trim-address address))))
+    ;; addr-spec email address
+    (`(mailbox ,address)
+     `((address . ,(trim-address address))))
+    (_ (error "Failed to parse mailbox"))))
+
 (define (post-process-content-transfer-encoding _ value)
   (list 'content-transfer-encoding (string->lcase-symbol value)))
 
@@ -634,16 +651,11 @@ For example,
 => ((name . \"Foo\") (address . \"foo@example.org\"))
 (parse-email-address \"foo@example.org\")
 => ((address . \"foo@example.org\"))"
-  (cond
-   ((string-match "([^<]*)<([^>]*)>" address)
-    => (lambda (match-record)
-         (let ((name (string-trim-both (match:substring match-record 1)))
-               (address (match:substring match-record 2)))
-           (if (string-null? name)
-               `((address . ,address))
-               `((name . ,name)
-                 (address . ,address))))))
-   (else `((address . ,address)))))
+  (pre-post-order
+   (peg:tree (match-pattern mailbox address))
+   `((mailbox . ,post-process-mailbox)
+     (*text* . ,(lambda (_ text) text))
+     (*default* . ,(lambda tree tree)))))
 
 (define interpret-address
   (match-lambda
@@ -716,11 +728,6 @@ message. Else, return a single <mime-entity> record."
 (define (parse-email-headers headers)
   "Parse string HEADERS as email headers and return an association
 list of header keys and values."
-  (define (trim-address address)
-    (string-trim-right
-     (string-trim (string-trim-both address) #\<)
-     #\>))
-
   (pre-post-order
    (peg:tree
     (match-pattern fields headers))
@@ -749,14 +756,7 @@ list of header keys and values."
                                      (+ (* 60 60 (string->number zone-hours))
                                         (* 60 (string->number zone-minutes))))))))
      (orig-date . ,(lambda (_ date) (list 'date date)))
-     (mailbox . ,(match-lambda*
-                   (`(mailbox (display-name ,name) ,address)
-                    `((name . ,(decode-mime-encoded-word
-                                (string-trim-both name)))
-                      (address . ,(trim-address address))))
-                   (`(mailbox ,address)
-                    `((address . ,(trim-address address))))
-                   (_ (error "Failed to parse mailbox"))))
+     (mailbox . ,post-process-mailbox)
      (address-list *macro* . ,macro-process-address-list)
      (mailbox-list *macro* . ,macro-process-address-list)
      (optional-field . ,post-process-optional-field)