;;; belf.el -- Bookshelf, ebook library management -*- lexical-binding: t -*-

;; Copyright (C) 2025  Free Software Foundation, Inc.

;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "29.4"))

;; This file is part of dotted.

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

;; dotted 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 Affero General
;; Public License for more details.

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

;;; Commentary:

;; Bookshelf, ebook library management.

;;; Code:

(require 'tabulated-list)
(require 'infobox)

(defvar-keymap belf-mode-map
  :parent tabulated-list-mode-map
  "F" #'belf-toggle-follow-mode
  "RET" #'belf-open-book
  "b" #'tabulated-list-previous-column
  "d" #'belf-show-in-dired
  "f" #'tabulated-list-next-column
  "i" #'belf-book-infobox-at-point
  "n" #'belf-next-line
  "o" #'belf-open-book-other-window
  "p" #'belf-previous-line
  "e" #'belf-set-field
  ;; "s" #'tabulated-list-col-sort
  )

(define-derived-mode belf-mode tabulated-list-mode "Bookshelf"
  "Major mode for browsing a list of books."
  (setq tabulated-list-format
        [("Authors" 25 belf-compare-authors)
         ("Title" 48 belf-compare-title)
         ("Year" 4 t)])
  (setq tabulated-list-padding 2)
  (tabulated-list-init-header)
  (setq revert-buffer-function #'belf-list-refresh-contents)
  (hl-line-mode))

(defun belf ()
  (interactive)
  (let ((buf (get-buffer-create "*Bookshelf*")))
    (with-current-buffer buf
      (belf-mode)
      (belf-list-refresh-contents))
    (pop-to-buffer-same-window buf)))

(defun belf-list-refresh-contents (&rest _)
  (setq-local tabulated-list-entries (belf-parse-all-file-names))
  (tabulated-list-print))

(defvar belf-dir "~/Documents" "Directory of books.")

(defun belf-parse-all-file-names ()
  (seq-filter
   #'identity
   (seq-map
    (lambda (f)
      (when-let ((parsed (belf-parse-file-name f)))
        (let-alist parsed
          (list f (vector .authors .title .year)))))
    (directory-files belf-dir t "\\.\\(epub\\|pdf\\|cbr\\|djvu\\)$"))))

(defun belf-fix-file-name (file-name)
  "Rename a file.

Change authors-sort to authors. Change title-sort to title.

Test:
foo bar
foo, bar
foo bar, quux baf
foo, bar & quux, baf
foo bar & quux, baf"
  (when-let ((parsed (belf-parse-file-name file-name)))
    (let* ((authors (string-split (alist-get 'authors parsed) " & " t " +"))
           (title (alist-get 'title parsed)))
      (setf
       (alist-get 'authors parsed)
       (mapconcat
        (lambda (author)
          (let ((comma-split (string-split author ", ")))
            (if (or ;; no comma or more than one comma
                 (/= (length comma-split) 2)
                 ;; at least one space before the comma
                 (string-match-p " " (car comma-split)))
                author
              ;; from author-sort to author
              (format "%s %s" (cadr comma-split) (car comma-split))
              )))
        authors
        ", ")
       (alist-get 'title parsed)
       (cond ((string-suffix-p ", The" title)
              (concat "The " (string-remove-suffix ", The" title)))
             ((string-suffix-p ", A" title)
              (concat "A " (string-remove-suffix ", A" title)))
             (t title))))
    (format "%s.%s" (belf-format-base-name parsed) (alist-get 'ext parsed))))

(defun belf-fix-rename-file (file-name)
  (when-let ((new-name (belf-fix-file-name file-name)))
    (unless (equal new-name file-name)
      (rename-file file-name new-name))))

(defun belf-fix-rename-files ()
  (interactive)
  (dolist (file-name
           (directory-files belf-dir t directory-files-no-dot-files-regexp))
    (belf-fix-rename-file file-name)))

(defun belf-parse-file-name (file-name)
  (let ((fn (file-name-nondirectory file-name)))
    (when (string-match "^\\(.*?\\) +- +\\(.*\\) +(\\([0-9]*\\)) +\\[\\(.*\\)\\]\\.\\([a-zA-Z0-9]+\\)$" fn)
      `((authors . ,(match-string 1 fn))
        (title . ,(match-string 2 fn))
        (year . ,(match-string 3 fn))
        (identifier . ,(match-string 4 fn))
        (ext . ,(match-string 5 fn))))))

(defun belf-format-base-name (info)
  (let-alist info
    (file-name-concat
     (expand-file-name belf-dir)
     (format "%s - %s (%s) [%s]" .authors .title .year .identifier))))

(defun belf-book-infobox (file-name)
  (interactive)
  (belf-book-render-info (belf-exiftool-info file-name) file-name))

(defvar belf-exiftool-program "exiftool" "The exiftool program.")

(defun belf-exiftool-info (file-name)
  "Given a video URL, return an alist of its properties."
  (with-temp-buffer
    (call-process belf-exiftool-program nil t nil "-j" file-name)
    (let ((start (point)))
      (call-process-region
       nil nil "jq" nil t nil
       ".[0]|pick(.Title, .Author, .Creator, .Keywords, .Subject, .Publisher, .Identifier, .Series, .Title_sort, .Author_sort, .PageCount, .FileSize, .ISBN, .Language, .FileType, .Description)")
      (goto-char start)
      (json-read)))
  )

(defun belf-epub-content-file-name (file-name)
  (with-temp-buffer
    (if (eq 0 (call-process "unzip" nil t nil
                            "-p" file-name "META-INF/container.xml"))
        (let ((dom (libxml-parse-xml-region (point-min) (point-max))))
          (dom-attr (dom-by-tag (dom-by-tag (dom-by-tag dom 'container) 'rootfiles) 'rootfile) 'full-path))
      (message "Failed to extract container.xml: %s" (buffer-string))
      nil)))

(defun belf-epub-cover-file-name (file-name content-file-name)
  (with-temp-buffer
    (call-process "unzip" nil t nil "-p" file-name content-file-name)
    (let* ((dom (libxml-parse-xml-region (point-min) (point-max)))
           (metas
            (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'metadata) 'meta))
           (items
            (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'manifest) 'item))
           cover-name
           cover-file
           cover-file-from-prop)
      (while (and metas (not cover-name))
        (let-alist (cadr (car metas))
          (when (equal .name "cover")
            (setq cover-name .content)))
        (setq metas (cdr metas)))
      (while (and items (not cover-file))
        (let-alist (cadr (car items))
          (when (equal .id cover-name)
            (setq cover-file .href))
          (when (equal .properties "cover-image")
            (setq cover-file-from-prop .href)))
        (setq items (cdr items)))
      (cond (cover-file
             (file-name-concat (file-name-directory content-file-name)
                               cover-file))
            (cover-file-from-prop
             (file-name-concat (file-name-directory content-file-name)
                               cover-file-from-prop))
            ((not cover-name)
             (message "Could not find cover in epub metadata.")
             nil)
            ;; If no cover-file, then try cover-name if it looks like
            ;; an image file path
            ((string-match-p belf-book-cover-re cover-name)
             (file-name-concat (file-name-directory content-file-name)
                               cover-name)))
      )))

(defvar belf-book-cover-exts '("jpg" "png" "jpeg"))
(defvar belf-book-cover-re
  (concat "^.*\\." (regexp-opt belf-book-cover-exts) "$"))

(defun belf-locate-book-cover (file-name)
  (let ((exts belf-book-cover-exts)
        cover-file-name
        found)
    (while (and exts (not found))
      (setq cover-file-name (file-name-with-extension file-name (car exts))
            exts (cdr exts)
            found (file-exists-p cover-file-name)))
    (when found cover-file-name)))

(defun belf-pdf-page-one-cover (file-name)
  "Extract the first page of a pdf file as cover."
  (let ((cover-file (file-name-with-extension file-name "jpg")))
    (with-temp-buffer
      (if (eq 0
              (call-process "gs" nil t t
                            "-dNOPAUSE" "-dBATCH" "-sDEVICE=jpeg" "-r300"
                            (format "-sOutputFile=%s" cover-file)
                            "-dFirstPage=1" "-dLastPage=1" file-name))
          cover-file
        (message "Failed to extract cover from PDF: %s" (buffer-string))
        nil))))

(defun belf-book-cover (file-name)
  "Get book cover.

First look for an image file with the same file name.
Then for PDF, extract the first page.
For EPUB, looks for a cover image in the file."
  (if-let ((cover-file-name (belf-locate-book-cover file-name)))
      (concat "file://" cover-file-name)
    (cond ((equal "epub" (file-name-extension file-name))
           (when-let* ((content-file-name (belf-epub-content-file-name file-name))
                       (cover-file
                        (belf-epub-cover-file-name file-name content-file-name))
                       (cover-file-name (file-name-with-extension
                                         file-name
                                         (file-name-extension cover-file))))
             (call-process "unzip" nil `(:file ,cover-file-name) nil
                           "-p" file-name cover-file)
             (format "file://%s" cover-file-name)))
          ((equal "pdf" (file-name-extension file-name))
           (when (setq cover-file-name (belf-pdf-page-one-cover file-name))
             (format "file://%s" cover-file-name))))))

(defun belf-set-field ()
  (interactive)
  (cond ((equal "Authors"
                (get-text-property (point) 'tabulated-list-column-name))
         (call-interactively 'belf-set-authors))))

(defun belf-set-authors (new-authors)
  (interactive
   (list
    (read-string "Set authors to: "
                 (alist-get 'authors (belf-parse-file-name
                                      (tabulated-list-get-id))))))
  (let* ((file-name (tabulated-list-get-id))
         (parsed (belf-parse-file-name file-name))
         new-base-name
         new-file)
    (setf (alist-get 'authors parsed) new-authors)
    (setq new-base-name (belf-format-base-name parsed))
    (dolist (file (directory-files belf-dir t
                                   (format "^%s\\.[a-zA-Z0-9]+$"
                                           (regexp-quote
                                            (file-name-base file-name)))))
      (setq new-file (format "%s.%s" new-base-name (file-name-extension file)))
      (message "%s -> %s" file new-file)
      (rename-file file new-file))
    (revert-buffer)))

(defun belf-parse-first-author-name (authors)
  "Returns (last-name . first-name) of the first author of AUTHORS."
  (when (string-match-p)))

(defun belf-compare-authors (x y)
  "Authors comparator.

Authors are in the format of
fname1 lname1, fname2 lname2, ..."
  (string<
   (car (last (string-split (car (string-split (elt (cadr x) 0) ", ")) " ")))
   (car (last (string-split (car (string-split (elt (cadr y) 0) ", ")) " ")))))

(defun belf-compare-title (x y)
  "Title comparator.

Compare without leading \"The \"."
  (string<
   (string-remove-prefix "The " (elt (cadr x) 1))
   (string-remove-prefix "The " (elt (cadr y) 1))))

(defun belf-book-infobox-at-point ()
  (interactive)
  (let ((help-window-select (not belf-follow-mode)))
    (belf-book-infobox (tabulated-list-get-id)))
  )

(defun belf-book-render-info (info file-name)
  (setf (alist-get 'Title info)
        (concat (alist-get 'Title info)
                " -- "
                (buttonize
                 "xdg-open"
                 (lambda (_) (call-process "xdg-open" nil 0 nil file-name)))
                " " (buttonize "find-file" (lambda (_) (find-file file-name))))
        (alist-get 'Thumbnail info)
        (belf-book-cover file-name)
        (alist-get 'Description info)
        (when-let ((text (alist-get 'Description info)))
          (with-temp-buffer
            (insert
             (if (stringp text) text (prin1-to-string text)))
            (shr-render-region (point-min) (point-max))
            (goto-char (point-min))
            (insert "\n")
            (buffer-string))))
  (infobox-render
   (infobox-translate info (infobox-default-specs info))
   `(belf-book-infobox ,file-name)
   (called-interactively-p 'interactive)))

(defvar belf-follow-mode nil "Whether follow mode is on.")

(defun belf-toggle-follow-mode ()
  (interactive)
  (setq belf-follow-mode (not belf-follow-mode)))


(defun belf-previous-line ()
  (interactive)
  (previous-line)
  (when belf-follow-mode
    (belf-book-infobox-at-point)))

(defun belf-next-line ()
  (interactive)
  (next-line)
  (when belf-follow-mode
    (belf-book-infobox-at-point)))

(defun belf-show-in-dired ()
  (interactive)
  (dired-jump-other-window (tabulated-list-get-id)))

(defun belf-open-book ()
  (interactive)
  (find-file (tabulated-list-get-id)))

(defun belf-open-book-other-window ()
  (interactive)
  (find-file-other-window (tabulated-list-get-id)))

(provide 'belf)