;;; nnnotmuch.el --- Gnus backend for notmuch        -*- lexical-binding: t; -*-

;; Copyright (C) 2021  jao

;; Author: jao <mail@jao.io>
;; Keywords: mail

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A Gnus mail backend using notmuch.

;;; Code:

(require 'gnus)
(require 'nnheader)
(require 'nnmail)
(require 'nnoo)
(require 'notmuch)

(nnoo-declare nnnotmuch)

(defvoo nnnotmuch-directory message-directory
  "Spool directory for the nnnotmuch mail backend.")

(defvoo nnnotmuch-inhibit-expiry nil
  "If non-nil, inhibit expiry.")

(defvoo nnnotmuch-saved-searches nil)



;;; Interface functions.

(nnoo-define-basics nnnotmuch)

(deffoo nnnotmuch-open-server (server &optional defs)
  (nnoo-change-server 'nnnotmuch server defs)
  (setq nnnotmuch-article-files nil)
  (cond
   ((not (file-exists-p nnnotmuch-directory))
    (nnnotmuch-close-server)
    (nnheader-report 'nnnotmuch "Directory doesn't exist: %s" nnnotmuch-directory))
   ((not (file-directory-p (file-truename nnnotmuch-directory)))
    (nnnotmuch-close-server)
    (nnheader-report 'nnnotmuch "Not a directory: %s" nnnotmuch-directory))
   (t
    (nnheader-report 'nnnotmuch "Opened server %s using directory %s"
		     server nnnotmuch-directory)
    t)))

(deffoo nnnotmuch-close-server (server)
  (setq nnnotmuch-article-files nil))

(deffoo nnnotmuch-request-regenerate (server)
  (setq nnnotmuch-article-files nil)
  (nnnotmuch--tag "*" "-nnnotmuch")
  t)

(deffoo nnnotmuch-request-list (&optional _server)
  (with-current-buffer nntp-server-buffer
    (erase-buffer)
    (dolist (s nnnotmuch-saved-searches)
      (when-let (q (plist-get s :query))
        (let ((name (plist-get s :name))
              (total (nnnotmuch--count q)))
          (insert (format "%s %d 1 y\n" name total))))))
  t)

(deffoo nnnotmuch-retrieve-headers (sequence &optional group server _fetch-old)
  (message "retrieving headers for sequence %s" sequence)
  (when (nnnotmuch-set-group-context group server)
    (with-current-buffer nntp-server-buffer
      (erase-buffer)
      (let* ((file nil)
	     (number (length sequence))
	     (count 0)
	     (file-name-coding-system nnmail-pathname-coding-system)
	     beg article)
	(if (stringp (car sequence))
	    'headers
	  (while sequence
	    (setq article (car sequence))
	    (setq file (nnnotmuch-article-to-file article group))
	    (when (and file
		       (file-exists-p file)
		       (not (file-directory-p file)))
	      (insert (format "221 %d Article retrieved.\n" article))
	      (setq beg (point))
	      (nnheader-insert-head file)
	      (goto-char beg)
	      (if (re-search-forward "\n\r?\n" nil t)
		  (forward-char -1)
		(goto-char (point-max))
		(insert "\n\n"))
	      (insert ".\n")
	      (delete-region (point) (point-max)))
	    (setq sequence (cdr sequence))
	    (setq count (1+ count))
	    (and (numberp nnmail-large-newsgroup)
		 (> number nnmail-large-newsgroup)
		 (zerop (% count 20))
		 (nnheader-message 6 "nnnotmuch: Receiving headers... %d%%"
				   (floor (* count 100.0) number))))
          (and (numberp nnmail-large-newsgroup)
		 (> number nnmail-large-newsgroup)
		 (nnheader-message 6 "nnml: Receiving headers...done"))
	  (nnheader-fold-continuation-lines)
	  'headers)))))

(deffoo nnnotmuch-request-article (id &optional group _server buffer)
  ;; (nnnotmuch-set-group-context group server)
  (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
	 (file-name-coding-system nnmail-pathname-coding-system)
	 (d (nnnotmuch--article-data id group))
         (id (car d))
         (file (or (cadr d) (nnnotmuch--find-message-file id))))
    (cond
     ((not file)
      (nnheader-report 'nnnotmuch "No such article: %s" id))
     ((not (file-exists-p file))
      (nnheader-report 'nnnotmuch "No such file: %s" file))
     ((file-directory-p file)
      (nnheader-report 'nnnotmuch "File is a directory: %s" file))
     ((not (save-excursion (nnmail-find-file file)))
      (nnheader-report 'nnnotmuch "Couldn't read file: %s" file))
     (t
      (nnnotmuch--tag id "+nnnotmuch")
      (nnheader-report 'nnnotmuch "Article %s retrieved" id)
      (cons group id)))))

(deffoo nnnotmuch-request-expire-articles (articles group &optional _server _force)
  (let ((excluded) (ids))
    (dolist (a articles)
      (if-let (id (car (nnnotmuch--article-data a group)))
          (push id ids)
        (push a excluded)))
    (when ids
      (nnnotmuch--tag (mapconcat #'identity ids " OR ") "+deleted +nnnotmuch"))
    excluded))

;; (deffoo nnnotmuch-request-move-article
;;     (article group server accept-form &optional last _move-is-internal)
;;   (error "Not implemented yet"))

(deffoo nnnotmuch-request-group (group &optional server _dont-check _info)
  (message "opening %s" group)
  (if (nnnotmuch-set-group-context group server)
      (let ((n (length (cdr (assoc group nnnotmuch-article-files)))))
        (message "we found here %s articles" n)
        (with-current-buffer nntp-server-buffer
          (erase-buffer)
          (nnheader-insert "211 %d %d %d %s\n" n 1 n group)
          n))
    (message "we didn't find anything!!")
    (nnheader-report 'nnnotmuch "Invalid group")))

(deffoo nnnotmuch-request-group-scan (group &optional server _info)
  (nnnotmuch-set-group-context group server))

(deffoo nnnotmuch-request-scan (&optional group server)
  (nnnotmuch-set-group-context group server))

(deffoo nnnotmuch-close-group (_group &optional _server)
  t)

(deffoo nnnotmuch-request-create-group (group &optional _server _args)
  (let ((query (read-string "Query: ")))
    (add-to-list 'nnnotmuch-saved-searches `(:name ,group :query ,query))))

(deffoo nnnotmuch-request-newgroups (_date &optional server)
  (nnnotmuch-request-list server))

;; (deffoo nnnotmuch-request-rename-group (group new-name &optional _server)
;;   (error "Not implemented yet"))



(defvar nnnotmuch-article-files nil)

(defun nnnotmuch--find-query (name)
  (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
                         nnnotmuch-saved-searches))
    (plist-get s :query)))

(defun nnnotmuch--find-message-file (id)
  (car (split-string
        (shell-command-to-string
         (format "notmuch search --output=files %s"
                 (if (string-prefix-p "id:" id) id (concat "id:" id)))))))

(defun nnnotmuch--article-data (article group)
  (cond ((stringp article) (list article))
        ((numberp article)
         (when-let (data (cdr (assoc group nnnotmuch-article-files)))
           (elt data (1- article))))))

(defun nnnotmuch-article-to-file (article group)
  (when-let (d (nnnotmuch--article-data article group))
    (or (cadr d) (nnnotmuch--find-message-file (car d)))))

(defun nnnotmuch--count (query &optional context)
  (let ((cmd (format "notmuch count -- '(%s)%s'"
                     query
                     (if context (concat " AND " context) ""))))
    (string-to-number (shell-command-to-string cmd))))

(defun nnnotmuch--search (query &optional context)
  (let ((cmd (format "notmuch search --sort=oldest-first --output=messages -- %s%s"
                     (shell-quote-argument (format "(%s)" query))
                     (if context (concat " AND " context) ""))))
    (split-string (shell-command-to-string cmd))))

(defun nnnotmuch--tag (query tags)
  (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query)))
    (shell-command-to-string cmd)))

(defun nnnotmuch--ids-query (ids) (mapconcat #'identity ids " OR "))

(defun nnnotmuch--init-data (full-group query)
  (nnnotmuch--tag (concat query " AND NOT tag:new AND not tag:nnnotmuch")
                  "+nnnotmuch")
  (let* ((ids (nnnotmuch--search query "tag:nnnotmuch"))
         (info (gnus-get-info full-group))
         (read (when (> (length ids) 0) (list (cons 1 (length ids)))))
         (marks (list (cons 'seen read))))
    (gnus-info-set-marks info marks)
    (setf (gnus-info-read info) read)
    (gnus-set-info full-group info)
    (message "group %s - %s" full-group (gnus-get-info full-group))
    (mapcar #'list ids)))

(defun nnnotmuch--set-group-data (group data)
  (setf (alist-get group nnnotmuch-article-files nil t #'string=) data))

(defun nnnotmuch-set-group-context (group &optional server)
  (when (and server (not (nnnotmuch-server-opened server)))
    (nnnotmuch-open-server server))
  (when-let (query (nnnotmuch--find-query group))
    (setq nnnotmuch-current-group group)
    (let* ((full-group (gnus-group-prefixed-name group `(nnnotmuch ,server)))
           (data (or (cdr (assoc group nnnotmuch-article-files))
                     (nnnotmuch--init-data full-group query)))
           (ids (nnnotmuch--search query "tag:new AND NOT tag:nnnotmuch"))
           (new-data (mapcar (lambda (id)
                               (list id (nnnotmuch--find-message-file id)))
                             ids)))
      (when (> (length ids) 0)
        (nnnotmuch--tag (nnnotmuch--ids-query ids) "-new"))
      (nnnotmuch--set-group-data group (append data new-data))
      (gnus-set-active (gnus-group-prefixed-name group `(nnnotmuch ,server))
                       (cons 1 (+ (length new-data) (length data)))))))



(provide 'nnnotmuch)
;;; nnnotmuch.el ends here