#!/usr/bin/env sh
LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
!#
;; TODO
;; - Check for bogofilter installation
;; - Check for compilation a notmuch dev package or package all or learn just to compile without the guild call
;; - Spam moving check on other folders like work
;; - individual tag-rules testing take the ones with [] subject

(add-to-load-path
 (string-append
  (passwd:dir (getpwuid (geteuid)))
  "/dev/dotfiles/lib/guile/" ))

(use-modules
 (ffi notmuch)
 (ice-9 and-let-star)
 (ice-9 ftw)
 (ice-9 format)
 (ice-9 getopt-long)
 (ice-9 popen)
 (ice-9 ports)
 (ice-9 rdelim)
 (ice-9 regex)
 (ice-9 receive)
 (mail-tools)
 (utils)
 (srfi srfi-1)
 (system ffi-help-rt)
 (system foreign)
 (term ansi-color))

(define (on-all-messages-filenames query proc)
  (nm-iter messages (nm-result-messages query)
           (lambda (message*)
             (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
    (ffi-db to-delete "tag:deleted")
    (display (string-append
              (colorize-string "[DELETE] " 'BOLD 'YELLOW)
              (number->string (nm-count-messages to-delete))
              " files marked\n"))
    (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))
             (do? (not (option-ref options 'dry-run #f))))
        (simple-format #t " [~a]   ~a -> ~a~%"
                       (colorize-string "mv" 'BOLD (if do? 'RED 'NONE))
                       (substring file sub-len)
                       (substring target-file sub-len))
        (when do? (rename-file file target-file)))))

  (let* ((mail-repo (assq-ref options 'mail-repo))
         (target-folder (format #f "~a~a/~a" mail-repo account end-dir))
         (uidvalidity (get-folder-uidvalidity target-folder)))
    (with-nm-database
     (ffi-db mail-repo 0)
     (with-nm-query
      (ffi-db to-move (format #f "~a and folder:~a/~a" query account start-dir))
      (display (string-append
                (colorize-string "[MOVE] " 'BOLD 'YELLOW)
                (number->string (nm-count-messages to-move))
                " messages marked in "
                (colorize-string account 'GREEN 'BOLD)
                "\n"))
      (on-all-messages-filenames to-move (move-file uidvalidity target-folder))))))

(define (apply-tags-to-message options tags)
  (lambda (message)
    (simple-format #t "  ~a~%" (nm-header message "subject"))
    (unless (option-ref options 'dry-run #f)
      (nm-apply-tags message tags)) #t))

(define (log-msg-tag count rule new)
  (let* ((query-str (query-with-new rule new))
         (tags (tags-with-new rule new))
         (info (if (null? (cddr rule)) query-str (caddr rule))))
    (when (< 0 count)
      (simple-format #t " ~a messages: ~a~a~%"
                     count
                     (if (string=? info query-str) ""
                         (string-append info " | "))
                     tags))))

(define (notmuch-tag options ffi-db new)
  (lambda (rule)
    (let ((query-str (query-with-new rule new))
          (tags (tags-with-new rule new)))
      (with-nm-query
       (ffi-db query query-str)
       (log-msg-tag (nm-count-messages query) rule new)
       (nm-iter messages (nm-result-messages query) (apply-tags-to-message options tags))))))

(define (list-tag options ffi-db new)
  (display (colorize-string "[LISTS filters]\n" 'BOLD 'YELLOW))
  (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*)
            (and-let* ((list-id (regexp-exec reg (nm-header msg* "list-id")))
                       (tags (format #f "~a +lists/~a" tags-str
                                     (string-downcase (match:substring list-id 1)))))
              ((apply-tags-to-message options tags) msg*)))
          (nm-iter messages (nm-result-messages query))
          (filter identity)
          length
          (simple-format #t " ~a messages belonging to lists~%")))))

(define (spam-channel push result)
  (setvbuf push 'line)
  (lambda (path)
    (display path push)
    (unless (string-suffix? "\n" path)
      (newline push))
    (string=? "S" (cadr (string-split (read-line result) #\space)))))

(define (call-with-pipe cmd proc)
  (let* ((p2c (pipe))
         (port (with-input-from-port (car p2c)
                 (lambda ()
                   (open-input-pipe cmd)))))
    (receive vals (proc (cdr p2c) port)
      (close-port (cdr p2c))
      (close-pipe port)
      (apply values vals))))

(define (tag-spam options ffi-db query-str)
  (call-with-pipe
   "bogofilter -bTv"
   (lambda (push result)
     (display (colorize-string "[SPAM Flag]\n" 'BOLD 'YELLOW))
     (let ((spam? (spam-channel push result)))
       (with-nm-query
        (ffi-db query query-str)
        (->> (lambda (message)
               (when (spam? (pointer->string (notmuch_message_get_filename message)))
                 ((apply-tags-to-message options "+spam -inbox") message)))
             (nm-iter messages (nm-result-messages query))
             (filter boolean?)
             length
             (format #t " ~a messages added to spam~%")))))))

(define tag-rules
  '(("+ci" "from:travis-ci.com or from:travis-ci.org or from:appveyor.com or from:circleci.com or from:mg.gitlab.com and subject:Pipeline")
    ("+slack" "from:slack.com")
    ("+immonews" "from:immobilienscout24.de")
    ("+immonews/communications" "from:nachrichten.immobilienscout24.de or subject:Kontaktaufnahme and tag:immonews")
    ("+socialnews" "from:facebookmail.com or from:mail.instagram.com")
    ("+promotions" "from:newsletter")
    ("+linkedin +socialnews" "from:linkedin.com" "Linkedin")
    ("+meetups" "from:info@meetup.com" "Meetups info mails")
    ("+ingrid" "from:postmaster@oscarnajera.com or from:root@oscarnajera.com" "Reports from ingrid")
    ("+fail2ban" "subject:Fail2Ban from:oscarnajera.com" "Fail2ban report")
    ("+Isar-Speak" "to:isarspeak@gmail.com")
    ("+toastmasters" "toastmaster NOT from:info@meetup.com")
    ("+iohk" "from:iohk.io" "IOHK Plutus")
    ("+sms" "folder:hi_pers/SMS")
    ("+calls" "folder:hi_pers/Calls")))

(define (clear-inbox options ffi-db)
  (display (colorize-string "[Inbox]\n" 'BOLD 'YELLOW))
  (let* ((my-emails (list "hi@oscarnajera.com" "hello@oscarnajera.com" "najera.oscar@gmail.com"))
         (sent (format #f "(~{from:~a~^ OR ~}) AND NOT (~:*~{to:~a~^ OR ~})" my-emails)))
    (map (notmuch-tag options ffi-db #t)
         `(("+sent" ,sent "Emails I have sent")
           ("+inbox" "*" "Inbox for the rest")))))


(define (main args)
  (let* ((mail-repo (string-append
                     (passwd:dir (getpwuid (geteuid)))
                     "/.mail/" ))
         (option-spec '((version (single-char #\V) (value #f))
                        (help    (single-char #\h) (value #f))
                        (all (value #f))
                        (dry-run (single-char #\n) (value #f))))
         (options (cons (cons 'mail-repo mail-repo)
                        (getopt-long args option-spec)))
         (account  (assq-ref options '()) ))
    (delete-email-files! options)

    (when (or (and (null? '())
                   (access? (string-append mail-repo "hi_pers") W_OK))
              (and (string? account)
                   (string=? account "hi_pers")))
      (move-mail! options "hi_pers" "tag:spam" "Inbox" "Junk"))


    (unless (option-ref options 'dry-run #f)
      (display (colorize-string "[SYNC]\n" 'BOLD 'YELLOW))
      (system (string-append "mbsync " (if (null? account) " -a" (car account))))
      (display (colorize-string "[notmuch new]\n" 'BOLD 'YELLOW))
      (system "notmuch new"))

    (with-nm-database
     (ffi-db (assq-ref options 'mail-repo) 1)
     (let ((new (not (option-ref options 'all #f))))
       (display (colorize-string "[TAG rules]\n" 'BOLD 'YELLOW))
       (map (notmuch-tag options ffi-db new) tag-rules)
       (list-tag options ffi-db new)
       (clear-inbox options ffi-db)
       (tag-spam options ffi-db "tag:inbox")))))


;; Local Variables:
;; mode: scheme
;; End: