discoursel/discoursel.el

;;; Code:

(require 'json)
(require 'plz)
(require 'message)
(require 'rx)
(require 'markdown-mode)

(defgroup discoursel nil
  "Discourse TODO")

(defcustom discoursel-instances
  '((ubuntu
     :url "https://discourse.ubuntu.com"
     :name "Ubuntu")
    (fedora
     :url "https://discussion.fedoraproject.org"
     :name "Fedora"))
  "The Discourse instance."
  :group 'discoursel
  :type 'string)

(defcustom discoursel-fetch-all-posts-from-topic t
  "Whether to fetch all posts from a certain topic.

If t, the default, all posts are fetched (which may take a while
depending on the topic's length).

If nil, pagination is enabled and the user needs to ask for more
posts manually and incrementally."
  :group 'discoursel
  :type 'boolean)

(defvar discoursel-buffer-list nil
  "List of discoursel buffers.")

(defface discoursel-topic-face
  '((((class color) (background light)) (:foreground "#000"))
    (((class color) (background dark)) (:foreground "#fff")))
  "Face used for topics."
  :group 'discoursel)

(defface discoursel-username-face
  '((((class color) (background light)) (:foreground "#aa0"))
    (((class color) (background dark)) (:foreground "#ff0")))
  "Face used for usernames."
  :group 'discoursel)

(defface discoursel-code-face
  '((((class color) (background light)) (:background "#cdcecc" :extend t))
    (((class color) (background dark)) (:background "#17211c" :extend t)))
  "Face used for code blocks."
  :group 'discoursel)

(defun discoursel--parse-pre (tag)
  (let ((p (point))
	(shr-folding-mode 'none))
    (shr-ensure-newline)
    (shr-generic tag)
    (shr-ensure-newline)
    (add-text-properties p (point)
			 '(pre-tag t face discoursel-code-face))))

(defun discoursel--get (instance endpoint &optional args)
  (condition-case plzerror
      (let* ((instance-url (plist-get (cdr instance) ':url))
	     (full-url (concat instance-url "/" endpoint ".json")))
	(plz 'get (concat full-url
			  (when args
			    (concat "?"
				    (mapconcat (lambda (elt)
						 (concat (car elt) "=" (cdr elt)))
					       args "&"))))
	  :as #'json-read))
    (plz-error
     (error "Could not query endpoint '%s': '%s'"
	    endpoint (plz-error-message plzerror)))))

(defun discoursel--get-invisibility-spec (instance &optional section)
  (let* ((instance-name (symbol-name (car instance)))
	 (spec-str (concat "discoursel-visibility-" instance-name
			   (when section
			     (concat "-" section)))))
    (intern spec-str)))

(defun discoursel--latest-topics (instance)
  (let* ((r (discoursel--get instance "latest"))
	 (instance-symbol (car instance))
	 (topics (alist-get 'topics (alist-get 'topic_list r)))
	 (users (alist-get 'users r))
	 (initial-point (point)))
    (insert (propertize ">> Latest topics" 'invisible (discoursel--get-invisibility-spec instance)))
    (insert
     (with-temp-buffer
       (insert "\n")
       (cl-map 'vector
	       (lambda (topic)
		 (let* ((userid (alist-get 'user_id (aref (alist-get 'posters topic) 0)))
			(username (seq-find
				   (lambda (v)
				     (= (alist-get 'id v) userid))
				   users))
			(inhibit-read-only t))
		   (insert
		    (propertize (format "    %s (by %s)\n"
					(propertize (alist-get 'title topic)
						    'face 'discoursel-topic-face)
					(propertize (alist-get 'name username)
						    'face 'discoursel-username-face))
				'discoursel-topic-slug (alist-get 'slug topic)
				'discoursel-topic-id (alist-get 'id topic)))))
	       topics)
       (put-text-property (point-min) (point-max)
			  'invisible `(,(discoursel--get-invisibility-spec instance "latest")
				       ,(discoursel--get-invisibility-spec instance)))
       (buffer-string)))
    (add-text-properties (1- initial-point) (point-max)
			 `(discoursel-section "latest"
			   discoursel-instance ,instance-symbol))))

(defun discoursel-update ()
  (interactive)
  (with-current-buffer (discoursel-get-create-buffer)
    (save-excursion
      (let ((inhibit-read-only t))
	(erase-buffer)
	(dolist (instance discoursel-instances)
	  (let* ((instance-symbol (car instance))
		 (instance-plist (cdr instance))
		 (instance-name (plist-get instance-plist ':name)))
	    (insert (propertize (format "💻 %s" instance-name)
				'discoursel-instance instance-symbol))
	    (insert (propertize "\n" 'invisible (discoursel--get-invisibility-spec instance)))
	;; (let ((latest-topic-initial-point (point))
	;;       (latest-topic-final-point))
	;;   (insert ">> Latest topics")
	;;   (setq latest-topic-final-point (point))
	;;   (insert "\n")
	    (discoursel--latest-topics instance)
	    (insert "\n")))
	(kill-line -2)))))
;	  (put-text-property latest-topic-final-point (point) 'invisible 'latest-topics))))))
	  ;; (put-text-property latest-topic-initial-point
	  ;; 		     latest-topic-final-point
	  ;; 		     'overlay (make-overlay (1+ latest-topic-final-point) (point-max))))))))

(defun discoursel-toggle-heading ()
  (interactive)
  (when-let* ((instance-to-toggle (get-text-property (point) 'discoursel-instance))
	      (instance (assoc instance-to-toggle discoursel-instances)))
    (let* ((section-to-toggle (get-text-property (point) 'discoursel-section))
	   (spec (cons (discoursel--get-invisibility-spec instance
							  section-to-toggle)
		       t))
	   (invisible-p (and (listp buffer-invisibility-spec)
			     (member spec buffer-invisibility-spec))))
      (if invisible-p
	  (remove-from-invisibility-spec spec)
	(add-to-invisibility-spec spec)))))

(defun discoursel--get-name-or-username (post)
  (let ((name (alist-get 'display_username post)))
    (if (and name (not (string-empty-p name)))
	name
      (alist-get 'username post))))

(defun discoursel--parse-heading (dom)
  "Prepend <hN> tag (DOM) with the equivalent number of sharp (#)
characters."
  (let* ((idx (1- (length dom)))
	 ;; This is a bit hacky and assumes that the text will always
	 ;; be available as the last item in the list.
	 (tagname (symbol-name (car dom)))
	 (level (string-to-number
		 (string-remove-prefix "h" tagname)))
	 (sharps (make-string level ?#))
	 (face (intern (concat "shr-" tagname)))
	 (possible-text (nth idx dom)))
    (when (stringp possible-text)
      (setf (nth idx dom) (concat sharps " " possible-text)))
    (shr-heading dom face)))

(defun discoursel-topic-next-entry ()
  (interactive)
  (let ((pos (point)))
    (save-excursion
      (setq pos (next-single-char-property-change pos 'discoursel-post-id))
      (goto-char pos)
      (while (and (not (eobp))
		  (not (looking-at-p (rx line-start "Author:"))))
	(setq pos (next-single-char-property-change pos 'discoursel-post-id))
	(goto-char pos))
      (when (eobp)
	(setq pos nil)))
    (when pos
      (goto-char pos))))

(defun discoursel-topic-previous-entry ()
  (interactive)
  (let ((pos (point)))
    (setq pos (or (previous-single-property-change pos 'discoursel-post-id)
		  (point-min)))
    (goto-char pos)
    (while (and (not (bobp))
		(not (looking-at-p (rx line-start (or "Author:" "Title:")))))
      (setq pos (or (previous-single-property-change pos 'discoursel-post-id)
		    (point-min)))
      (goto-char pos))))

(defun discoursel--insert-post (instance post &optional post-title)
  (let* ((post-slug (alist-get 'topic_slug post))
	 (post-id (alist-get 'id post))
	 (post-number (alist-get 'post_number post))
	 (post-date (alist-get 'created_at post))
	 (post-date-string
	  (format-time-string "%c"
			      (encode-time
			       (parse-time-string post-date))))
	 (post-author-name (discoursel--get-name-or-username post))
	 (post-author-username (alist-get 'username post))
	 (post-html-content (alist-get 'cooked post))
	 (instance-symbol (car instance)))
    (save-excursion
      (insert
       (with-temp-buffer
	 (when post-title
	   (insert (format (propertize "Title: %s\n" 'face 'message-header-name)
			   (propertize post-title 'face 'message-header-subject))))
	 (insert (format (propertize "Author: %s\n" 'face 'message-header-name)
			 (propertize post-author-name 'face 'message-header-to)))
	 (insert (format (propertize "Date: %s\n" 'face 'message-header-name)
			 (propertize post-date-string 'face 'message-header-other)))
	 (insert "\n")
	 (save-excursion
	   (insert post-html-content))
	 (let ((shr-use-fonts nil)
	       (shr-external-rendering-functions
		'((pre . discoursel--parse-pre)
		  (h1 . discoursel--parse-heading)
		  (h2 . discoursel--parse-heading)
		  (h3 . discoursel--parse-heading)
		  (h4 . discoursel--parse-heading)
		  (h5 . discoursel--parse-heading)
		  (h6 . discoursel--parse-heading))))
	   (shr-render-region (point) (point-max)))
	 (add-text-properties (point-min) (point-max)
			      `(discoursel-post-id ,post-id
				discoursel-post-number ,post-number
				discoursel-post-author-username ,post-author-username
				discoursel-post-author-name ,post-author-name
				discoursel-instance ,instance-symbol))
	 (buffer-string))))))

(defun discoursel-render-posts-from-topic (instance topic &optional start-idx)
  (let* ((posts (alist-get 'posts (alist-get 'post_stream topic)))
	 (topic-slug (alist-get 'slug topic))
	 (buf (discoursel-get-create-buffer topic-slug))
	 (startidx (or start-idx 0)))
    (with-current-buffer buf
      (save-excursion
	(let ((inhibit-read-only t))
	  (cl-loop for idx from startidx to (1- (length posts)) do
		   (goto-char (point-max))
		   (insert
		    "\n"
		    (with-temp-buffer
		      (insert "<hr>")
		      (shr-render-region (point-min) (point-max))
		      (buffer-string)))
		   (discoursel--insert-post instance (aref posts idx))))))))

(defun discoursel--fetch-all-posts-from-topic (instance topic-id number-of-pages)
  (cl-loop for page from 2 to number-of-pages do
	   (with-delayed-message (2 (format "Rendering page %d out of %d..." page number-of-pages))
	     (let ((topic (discoursel--get instance
					   (concat "t/" topic-id)
					   `(("page" . ,(number-to-string page))))))
	       (discoursel-render-posts-from-topic instance topic)))))

(defun discoursel--open-topic (&optional instance id)
  (interactive)
  (when (and (not (eq major-mode 'discoursel-mode))
	     (not id))
    (user-error "You must be in a discoursel buffer"))
  (let* ((instance-name (or instance
			    (get-text-property (point) 'discoursel-instance)
			    (user-error "You must select a topic to open")))
	 (instance-data (assoc instance-name discoursel-instances))
	 (topic-id (number-to-string
		    (or id (get-text-property (point) 'discoursel-topic-id))))
	 (topic (discoursel--get instance-data (concat "t/" topic-id)))
	 (posts (alist-get 'posts (alist-get 'post_stream topic)))
	 (first-post (aref posts 0))
	 (topic-slug (alist-get 'slug topic))
	 (topic-title (alist-get 'title topic))
	 (buf (discoursel-get-create-buffer topic-slug))
	 (number-of-pages (ceiling (/ (float (alist-get 'posts_count topic))
				      (float (alist-get 'chunk_size topic))))))
    (switch-to-buffer buf)
    (with-current-buffer buf
      (discoursel-topic-mode)
      (save-excursion
	(let ((inhibit-read-only t))
	  (erase-buffer)
	  (discoursel--insert-post instance-data first-post topic-title)
	  (discoursel-render-posts-from-topic instance-data topic 1)
	  (when (> number-of-pages 1)
	    (if discoursel-fetch-all-posts-from-topic
		(discoursel--fetch-all-posts-from-topic instance-data
							topic-id
							number-of-pages)
	      (message "TODO")))
	  (put-text-property (point-min) (point-max)
			     'discoursel-topic-id (string-to-number topic-id)))))))

(defun discoursel-reply-to-post (&optional arg)
  (interactive "P")
  (let* ((post-id (or (get-text-property (point) 'discoursel-post-id)
		      (user-error "You must choose a post to reply to")))
	 (instance (assoc (get-text-property (point) 'discoursel-instance)
			  discoursel-instances))
	 (buf (discoursel-get-create-buffer (number-to-string post-id)))
	 (original-topic-point (point))
	 (original-topic-buffer (current-buffer)))
    (switch-to-buffer-other-window buf)
    (with-current-buffer buf
      (when arg
	(let ((post-raw-contents
	       (alist-get 'raw
			  (discoursel--get instance (concat "posts/"
							    (number-to-string post-id)))))
	      (post-author-username (get-text-property original-topic-point
						       'discoursel-post-author-username
						       original-topic-buffer))
	      (post-number (get-text-property original-topic-point
					      'discoursel-post-number
					      original-topic-buffer))
	      (topic-id (get-text-property original-topic-point
					   'discoursel-topic-id
					   original-topic-buffer)))
	  (insert (format "[quote=\"%s, post:%d, topic:%d\"]\n"
			  post-author-username
			  post-number
			  topic-id))
	  (insert post-raw-contents)
	  (goto-char (point-min))
	  ;; We can't quote the [quote...] tag.
	  (next-line)
	  (while (re-search-forward (rx line-start) nil t)
	    (replace-match "> " t t))
	  (goto-char (point-max))
	  (insert "\n\n")))
      (discoursel-post-reply-mode))
    (message "Type C-c C-c to post reply, C-c C-k to discard it")))

(defun discoursel-open-topic (instance id)
  (interactive "nInstance: \nnTopic ID: ")
  (discoursel--open-topic instance id))

(defun discoursel-get-create-buffer (&optional name)
  (let* ((bufname (concat "*discoursel"
			  (when name (concat "-" name))
			  "*"))
	 (buf (get-buffer-create bufname)))
    (prog1 buf
      (unless (memq buf discoursel-buffer-list)
	(add-to-list 'discoursel-buffer-list buf)))))

(defun discoursel-kill-buffer (&optional buf)
  (interactive)
  (let* ((tmpb (or buf (current-buffer)))
	 (b (get-buffer tmpb)))
    (unless b
      (error "Invalid buffer %s" b))
    (with-current-buffer b
      (unless (derived-mode-p 'discoursel-mode)
	(error "Cannot kill buffer %s: not a discoursel buffer" (buffer-name))))
    (kill-buffer b)
    (setq discoursel-buffer-list (remove b discoursel-buffer-list))))

(defun discoursel-exit ()
  (interactive)
  (dolist (buf discoursel-buffer-list)
    (kill-buffer buf))
  (setq discoursel-buffer-list nil))

(defvar discoursel-mode-map
  (let ((map (make-sparse-keymap)))
    (prog1 map
      (suppress-keymap map)
      (define-key map "n" #'next-line)
      (define-key map "p" #'previous-line)
      (define-key map (kbd "RET") #'discoursel--open-topic)
      (define-key map "j" #'discoursel-open-topic)
      (define-key map (kbd "TAB") #'discoursel-toggle-heading)
      (define-key map "q" #'discoursel-exit)
      (define-key map "g" #'discoursel-update)))
  "Keymap for `discoursel-mode'.")

(defvar discoursel-topic-mode-map
  (let ((map (make-sparse-keymap)))
    (prog1 map
      (suppress-keymap map)
      (define-key map "n" #'next-line)
      (define-key map "p" #'previous-line)
      (define-key map (kbd "M-n") #'discoursel-topic-next-entry)
      (define-key map (kbd "M-p") #'discoursel-topic-previous-entry)
      (define-key map (kbd "C-c C-r") #'discoursel-reply-to-post)
      (define-key map "q" #'discoursel-kill-buffer)))
  "Keymap for `discoursel-topic-mode'.")

(defvar discoursel-post-reply-mode-map
  (let ((map (make-sparse-keymap)))
    (prog1 map
      (define-key map (kbd "C-c C-k") #'kill-buffer-and-window)))
  "Keymap for `discoursel-post-reply-mode.")

(define-derived-mode discoursel-mode special-mode "Discourse client"
  "Major mode for interacting with Discourse instances.
\\{discoursel-mode-map}"
  (use-local-map discoursel-mode-map))

(define-derived-mode discoursel-topic-mode discoursel-mode "Discoursel topic"
  "Major mode for interacting with Discourse topics.
\\{discoursel-topic-mode-map}"
  (use-local-map discoursel-topic-mode-map))

(define-derived-mode discoursel-post-reply-mode markdown-mode "Discoursel post reply"
  "Major mode for replying to Discourse posts.
\\{discoursel-post-reply-mode-map}"
  (use-local-map discoursel-post-reply-mode-map))

(defun discoursel ()
  "Enter discoursel."
  (interactive)
  (switch-to-buffer (discoursel-get-create-buffer))
  (unless (eq major-mode 'discoursel-mode)
    (discoursel-mode))
  (setq buffer-invisibility-spec nil)
  (discoursel-update))


;; TODO
;; (with-current-buffer (get-buffer-create "test-discourse")
;; 	 (insert (plz 'get "https://discourse.ubuntu.com/raw/39765"))
;; 	 (markdown-mode)
;; 	 (setq buffer-read-only t))

;; (with-current-buffer (get-buffer-create "test-discourse4")
;; 	 (let* ((ttt (plz 'get "https://discourse.ubuntu.com/latest.json" :as #'json-read))
;; 		(topics (alist-get 'topics (alist-get 'topic_list ttt)))
;; 		(users (alist-get 'users ttt)))
;; 	   (cl-map 'vector
;; 	    (lambda (topic)
;; 	      (let* ((uid (alist-get 'user_id (aref (alist-get 'posters topic) 0)))
;; 		     (user (seq-find (lambda (v) (= (alist-get 'id v) uid))
;; 				     users)))
;; 		(insert
;; 		 (propertize (format "%s [%s]\n" (alist-get 'title topic) (alist-get 'name user))
;; 			     'discoursel-slug (alist-get 'slug topic)))))
;; 	    topics)))



(provide 'discoursel)

;;; discoursel.el ends here