Review tagmail

2 files changed, 31 insertions, 34 deletions

diff --git a/bin/tagmail b/bin/tagmail
index 02e5d6e..611d2f6 100755
--- a/bin/tagmail
+++ b/bin/tagmail
@@ -18,7 +18,6 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
  (ice-9 ftw)
  (ice-9 format)
  (ice-9 getopt-long)
- (ice-9 match)
  (ice-9 popen)
  (ice-9 ports)
  (ice-9 rdelim)
@@ -31,26 +30,20 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
  (system foreign)
  (term ansi-color))
 
-(define (pcmd dry-run str)
-  (apply colorize-string
-         (if dry-run
-             `(,str BOLD)
-             `(,str RED BOLD))))
-
-(define (on-all-messages-filenames query proc proc-name dry-run)
+(define (on-all-messages-filenames query proc)
   (nm-iter messages (nm-result-messages query)
            (lambda (message*)
-             (let ((subject (nm-header message* "subject"))
-                   (files (nm-iter filenames (notmuch_message_get_filenames message*)
-                                   pointer->string)))
-               (simple-format #t "~a~a~%"
-                              (pcmd dry-run (simple-format #f " [~a] " proc-name))
-                              subject)
-               (unless dry-run
-                 (map proc files))
-               (list subject files)))))
+             (simple-format #t " ~a~%" (nm-header message* "subject"))
+             (map proc (nm-iter filenames (notmuch_message_get_filenames message*)
+                                pointer->string)))))
 
 (define (delete-email-files! options)
+  (define (logged-delete file-path)
+    (let ((do? (not (option-ref options 'dry-run #f))))
+      (simple-format #t " [~a] ~a~%"
+                     (colorize-string "rm" 'BOLD (if do? 'RED 'NONE))
+                     file-path)
+      (if do? (delete-file file-path))))
   (with-nm-database
    (ffi-db (assq-ref options 'mail-repo) 0)
    (with-nm-query
@@ -59,14 +52,15 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
               (colorize-string "[DELETE] " 'BOLD 'YELLOW)
               (number->string (nm-count-messages to-delete))
               " files marked\n"))
-    (on-all-messages-filenames to-delete delete-file "rm" (option-ref options 'dry-run #f)))))
+    (on-all-messages-filenames to-delete logged-delete))))
 
 (define (move-mail! options account query start-dir end-dir)
   (define (move-file uidvalidity target-folder)
     (lambda (file)
       (let* ((target-file (new-path (rename-higher file uidvalidity) target-folder))
              (sub-len (string-prefix-length file target-file)))
-        (simple-format #t "    ~a -> ~a~%"
+        (simple-format #t " [~a]   ~a -> ~a~%"
+                       (colorize-string "mv" 'BOLD (if do? 'RED 'NONE))
                        (substring file sub-len)
                        (substring target-file sub-len))
         (unless (option-ref options 'dry-run #f)
@@ -85,8 +79,7 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
                   " messages marked in "
                   (colorize-string account 'GREEN 'BOLD)
                   "\n"))
-        (on-all-messages-filenames to-move (move-file uidvalidity target-folder) "mv"
-                                   (option-ref options 'dry-run #f)))))))
+        (on-all-messages-filenames to-move (move-file uidvalidity target-folder)))))))
 
 (define (apply-tags-to-message options tags)
   (lambda (message)
@@ -96,8 +89,9 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
 
 (define (notmuch-tag options ffi-db rules new)
   (map (lambda (rule)
-         (match-let* (((tags query-str) (with-new rule new))
-                      (info (if (null? (cddr rule)) query-str (caddr rule))))
+         (let* ((query-str (query-with-new rule new))
+                (tags (tags-with-new rule new))
+                (info (if (null? (cddr rule)) query-str (caddr rule))))
            (with-nm-query
             (ffi-db query query-str)
             (simple-format #t " ~a messages: ~a~a~%"
@@ -110,8 +104,9 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
 
 (define (list-tag options ffi-db new)
   (display (colorize-string "[LISTS filters]\n" 'BOLD 'YELLOW))
-  (match-let* (((tags-str query-str) (with-new '("+lists" "not tag:lists") new))
-               (reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase)))
+  (let ((query-str (query-with-new '("+lists" "not tag:lists") new))
+        (tags-str (tags-with-new '("+lists" "not tag:lists") new))
+        (reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase)))
     (with-nm-query
      (ffi-db query query-str)
      (->> (lambda (msg*)
diff --git a/lib/guile/mail-tools.scm b/lib/guile/mail-tools.scm
index d496c5b..b158d93 100644
--- a/lib/guile/mail-tools.scm
+++ b/lib/guile/mail-tools.scm
@@ -9,7 +9,8 @@
             get-uidvalidity
             get-folder-uidvalidity
             new-path
-            with-new
+            tags-with-new
+            query-with-new
             nm-open-database
             nm-query-db
             nm-result-messages
@@ -39,14 +40,15 @@
     (string-join (list destination submaildir filename)
                  file-name-separator-string)))
 
-(define (with-new rule new)
-  (list
-   (if new (string-append (car rule) " -new") (car rule))
-   (if new
-       (if (string=? (cadr rule) "*")
-           "tag:new"
-           (simple-format #f "(~a) and ~a" (cadr rule) "tag:new"))
-       (cadr rule))))
+(define (tags-with-new rule new)
+  (if new (string-append (car rule) " -new") (car rule)))
+
+(define (query-with-new rule new)
+  (if new
+      (if (string=? (cadr rule) "*")
+          "tag:new"
+          (simple-format #f "(~a) and ~a" (cadr rule) "tag:new"))
+      (cadr rule)))
 
 ;; NOTMUCH interface
 (define (nm-open-database path mode)