#!/usr/bin/guile \
-e main -s
!#
;; 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/helpful_scripts/guile/" ))

(use-modules
 (ffi notmuch)
 (ice-9 and-let-star)
 (ice-9 ftw)
 (ice-9 getopt-long)
 (ice-9 match)
 (ice-9 popen)
 (ice-9 ports)
 (ice-9 rdelim)
 (ice-9 regex)
 (mail-tools)
 (srfi srfi-1)
 (system ffi-help-rt)
 (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)
  (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)))
               (display (string-append
                         (pcmd dry-run (format #f " [~a] " proc-name))
                         subject
                         "\n"))
               (unless dry-run
                 (map proc files))
               (list subject files)))))

(define (delete-email-files! options)
  (let* ((ffi-db (nm-open-database (assq-ref options 'mail-repo) 0))
         (to-delete (nm-query-db ffi-db "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 delete-file "rm" (option-ref options 'dry-run #f))
    (notmuch_query_destroy to-delete)
    (notmuch_database_destroy ffi-db)))

(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~%"
                       (substring file sub-len)
                       (substring target-file sub-len))
        (unless (option-ref options 'dry-run #f)
          (rename-file file target-file)))))

  (let* ((mail-repo (assq-ref options 'mail-repo))
         (ffi-db (nm-open-database mail-repo 0))
         (target-folder (format #f "~a~a/~a" mail-repo account end-dir))
         (uidvalidity (get-folder-uidvalidity target-folder))
         (to-move (nm-query-db ffi-db
                            (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) "mv"
                               (option-ref options 'dry-run #f))
    (notmuch_query_destroy to-move)
    (notmuch_database_destroy ffi-db)))

(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 (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)))
                      (query (nm-query-db ffi-db query-str)))
           (simple-format #t " ~a messages: ~a~a~%"
                          (nm-count-messages query)
                          (if (string=? info query-str) ""
                              (string-append info " | "))
                          tags)
           (nm-iter messages (nm-result-messages query) (apply-tags-to-message options tags))
           (notmuch_query_destroy query)))
       rules))

(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))
               (query (nm-query-db ffi-db query-str))
               (result (nm-iter
                        messages (nm-result-messages query)
                        (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*))))))
    (simple-format #t " ~a messages belonging to lists~%"
                   (length (filter identity result)))
    (notmuch_query_destroy query)))

(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)))))
    (call-with-values
        (lambda ()
          (proc (cdr p2c) port))
      (lambda vals
        (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))
            (query (nm-query-db ffi-db query-str))
            (result (nm-iter messages (nm-result-messages query)
                             (lambda (message)
                               (when (spam? (pointer->string (notmuch_message_get_filename message)))
                                 ((apply-tags-to-message options "+spam -inbox") message))))))
       (format #t " ~a messages added to spam~%"
               (length (filter boolean? result)))
       (notmuch_query_destroy query)))))

(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")
    ("+CMK-JIRA -inbox" "from:infra@mathias-kettner.de or (from:jira and not subject:\"mentioned you\")")
    ("+slack" "from:slack.com")
    ("+alle-mk" "to:alle@mathias-kettner.de to:technik@tribe29.com")
    ("+cmk-commits" "to:cmk-internal-commits@mathias-kettner.de")
    ("+cma-commits" "to:cma-commits@mathias-kettner.de")
    ("+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")
    ("+toastmasters" "toastmaster NOT from:info@meetup.com")
    ("+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"
                          "on@mathias-kettner.de" "oscar.najera@tribe29.com"))
         (sent (format #f "(~A) AND NOT (~A)"
                       (format #f "~{from:~a~^ OR ~}" my-emails)
                       (format #f "~{to:~a~^ OR ~}" my-emails))))
    (notmuch-tag options ffi-db `(("+sent" ,sent "Emails I have sent")
                                  ("+inbox" "*" "Inbox for the rest")) #t)))

(define (main args)
  (let* ((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 (string-append
                                          (passwd:dir (getpwuid (geteuid)))
                                          "/.mail/" ))
                        (getopt-long args option-spec)))
         (account  (if (null? (assq-ref options '())) "hi_pers" (car (assq-ref options '())))))
    (delete-email-files! options)
    (if (string=? account "hi_pers")
        (move-mail! options account "tag:spam" "Inbox" "Junk"))


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

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