;; -*- lexical-binding: t -*-

(require 'ox)
(require 'dom)
(require 'cl-lib)

(org-export-define-backend 'jour-html
  '((bold . jour-html-bold)
    (code . jour-html-code)
    (example-block . jour-html-example)
    (footnote-reference . jour-html-footnote-reference)
    (headline . jour-html-headline)
    (horizontal-rule . jour-html-hr)
    (italic . jour-html-italic)
    (item . jour-html-item)
    (line-break . jour-html-line-break)
    (link . jour-html-link)
    (paragraph . jour-html-paragraph)
    (plain-list . jour-html-plain-list)
    (plain-text . jour-html-plain-text)
    (quote-block . jour-html-quote-block)
    (section . jour-html-section)
    (src-block . jour-src-block)
    (strike-through . jour-html-strike-through)
    (template . jour-html-template))
  :menu-entry
  '(?H "Export to My Custom HTML"
       (lambda (a s v b) (org-export-to-buffer 'jour-html "*jour-html-export*"))))

(defun jour-html-bold (bold-element contents info)
  (format "<b>%s</b>" contents))

(defun jour-html-code (code-element contents info)
  "org-export-format-code-default will append a newline to the text."
  (format "<code>%s</code>" (string-trim (org-export-format-code-default code-element info))))

(defun jour-html-example (example-element contents info)
  (format "<pre>%s</pre>"
          (org-html-encode-plain-text (org-export-format-code-default example-element info))))

(defun jour-html-footnote-reference (footnote-reference-element contents info)
  "Return HTML string for footnote reference.

If the post is in the index page, the reference will point to the
corresponding definition in the post page."
  (let* ((id (org-element-property :label footnote-reference-element))
         (def-id (format "#fn.%s" id))
         (post (plist-get info :post-metadata))
         (href (if (plist-get info :index-page-p)
                   (format "%s%s" (jour-post-url post) def-id)
                   def-id)))
    (jour-dom-to-html
     `(sup
       ()
       (a
        ((id . ,(format "fnr.%s" id)) (href . ,href))
        ,id)))))

(defun jour-html-headline (headline-element contents info)
  (let* ((level (org-element-property :level headline-element))
         (title (org-export-data (org-element-property :title headline-element) info))
         (index-page-p (plist-get info :index-page-p))
         (increase (if index-page-p 2 1)))
    (format-spec "<h%d class=\"%a\">%t</h%d>\n%c"
                 `((?t . ,title)
                   (?c . ,contents)
                   (?d . ,(+ level increase))
                   (?a . ,(format "level-%d-heading" level))))))

;; TODO Different <hr> styles?
(defun jour-html-hr (hr-element contents info)
  "Return HTML string for hr element."
  "<hr class=\"section-break\">")

(defun jour-html-italic (italic-element contents info)
  (format "<em>%s</em>" contents))

(defun jour-html-item (item-element contents info)
  (format "<li>%s</li>" (or contents "")))

(defun jour-html-line-break (br-element contents info)
  "Return HTML string for line break element."
  "<br>")

(defun image-p (ext)
  "Check if the extension is an image format."
  (member ext image-file-name-extensions))

(defun jour-html-link (link-element contents info)
  "Return HTML string for link object.

If it's an image, return an <img> tag; plus if it's a local image
file, copy the file to the output directory. Otherwise return an
<a> tag."
  (let* ((path (org-element-property :path link-element))
         (link-type (org-element-property :type link-element))
         (raw-link (org-element-property :raw-link link-element)))
    (cond ((and (image-p (file-name-extension path)) (string= link-type "file"))
           (let* ((post (plist-get info :post-metadata))
                  (output-dir (jour-post-output-dir post))
                  (post-url (jour-post-url post)))
             (copy-file path output-dir t)
             (format "<img src=\"%s\">" (jour-file-name-concat / post-url (file-name-nondirectory path)))))
          ((and (image-p (file-name-extension path)) (not contents)) (format "<img src=\"%s\">" raw-link))
          (t (format "<a href=\"%s\">%s</a>" raw-link (or contents raw-link))))))

(defun jour-html-paragraph (paragraph-element contents info)
  (let ((lang (org-export-read-attribute :attr_html paragraph-element :lang)))
    (if lang
        (format "<p lang=\"%s\">%s</p>" lang contents)
        (format "<p>%s</p>" contents))))

(defun jour-html-plain-list (plain-list-element contents info)
  (let ((type (org-element-property :type plain-list-element)))
    (format (if (eq type 'ordered) "<ol>%s</ol>" "<ul>%s</ul>")
            contents)))

(defun jour-html-plain-text (text info)
  "Remove \n character that's between two CJK characters in every
plain text string, and escape the string."
  (cl-labels ((loop (curr accu)
                (cond ((eq curr nil) (or accu ""))
                      ((jour-remove-space-p accu (car curr))
                       (loop (cdr curr) (concat accu (car curr))))
                      (t (loop (cdr curr) (concat accu " " (car curr)))))))

    (let* ((segs (seq-filter (lambda (s) (not (string-empty-p s)))
                             (string-split (org-html-encode-plain-text text) "\n"))))
      (loop (cdr segs) (car segs)))))

(defun jour-html-quote-block (quote-element contents info)
  (format "<blockquote>%s</blockquote>" contents))

(defun jour-html-section (section-element contents info)
  "Skip creating <section> element."
  contents)

(defun jour-src-block (src-block-element _contents info)
  (format "<pre class=\"code\">%s</pre>"
          (org-html-encode-plain-text (org-export-format-code-default src-block-element info))))

(defun jour-html-strike-through (strike-through-element contents info)
  (format "<del>%s</del>" contents))

(defun jour-html-template (contents info)
  "Render `CONTENTS' in post page layout.

This is the function which is called by org-export-* after
everything is transformed. When the argument `BODY-ONLY' of
org-export-* is true, this function is not called."
  (let* ((post (plist-get info :post-metadata))
         (date (jour-post-date-string post))
         (updated (jour-post-updated post)))
    (jour-render-post-page-layout
     (jour-render-post contents post 'post info)
     (if updated
         (ignore-errors (format " Last update at %s." (format-time-string "%b %-d, %Y" updated))))
     post)))

(defun jour-remove-space-p (a b)
  "Return true if the last character of `A' or the first character of `B'
is a CJK character."
  (and
   (stringp a)
   (stringp b)
   (not (string-empty-p a))
   (not (string-empty-p b))
   (or
    (jour-cjk-char-p (substring a -1))
    (jour-cjk-char-p (substring b 0 1)))))

;; TODO There're special cases like the link object where it's
;; possible to not have children in which case the text should be the
;; raw link value.
(defun jour-get-object-text (object &optional first-or-last)
  "Return the text of an Org object or nil if not found. `OBJECT' 'roughly
correspond to raw, possibly-formatted text.' See
`org-element-all-objects'. `FIRST-OR-LAST' is either 'first or 'last,
specifying which chunk of the text in a recursive object should be
retrieved."
  (let ((object-type (org-element-type object)))
    (cond
     ((eq object-type 'plain-text) object)
     ((memq object-type '(code verbatim)) (org-element-property :value object))
     ((memq object-type org-element-recursive-objects)
      (let* ((contents (org-element-contents object))
             (maybe-text (if (eq first-or-last 'last) (car (last contents)) (car contents))))
        (if (eq (org-element-type maybe-text) 'plain-text)
            maybe-text
          (jour-get-object-text maybe-text first-or-last))))
     ;; TODO footnote-reference is actually a recursive object. This branch is unreachable.
     ((memq object-type '(footnote-reference)) (org-element-property :label object)))))

(defun jour-clean-spaces-around-inline-markup (ast backend info)
  "Remove the spaces between the texts and the inline markup object,
if one of the characters around the space is a CJK character. The
preceding space is at the end of the previous text; the following
space is not in the text string but indicated by the :post-blank
property of the inline markup object."
  (cl-labels ((clean-pre-space (text object)
                (let* ((ends-with-space-p (string= (substring text -1) " "))
                       (last-char (if ends-with-space-p (substring text -2 -1) (substring text -1))))
                  (cond ((not ends-with-space-p) nil)
                        ((jour-remove-space-p last-char (jour-get-object-text object 'first))
                         (org-element-set-element text (substring text 0 -1))))))

              (clean-post-space (object text-or-object)
                (cond ((= (org-element-property :post-blank object) 0) nil)
                      ((jour-remove-space-p (jour-get-object-text object 'last)
                                            (jour-get-object-text text-or-object 'first))
                       (org-element-put-property object :post-blank 0))))

              (helper (contents)
                (cond ((or (null contents) (null (cdr contents))) '())
                      ((and (eq (org-element-type (car contents)) 'plain-text)
                            (memq (org-element-type (cadr contents)) org-element-all-objects))
                       (progn
                         (clean-pre-space (car contents) (cadr contents))
                         (helper (cdr contents))))
                      ((memq (org-element-type (car contents)) org-element-all-objects)
                       (progn
                         (clean-post-space (car contents) (cadr contents))
                         (helper (cdr contents))))
                      (t (helper (cdr contents))))))

    (org-element-map ast '(paragraph)
      (lambda (parent)
        (let ((contents (org-element-contents parent)))
          (helper contents))))

    ast))

(when (not (member #'jour-clean-spaces-around-inline-markup org-export-filter-parse-tree-functions))
  (add-hook 'org-export-filter-parse-tree-functions #'jour-clean-spaces-around-inline-markup))

(defvar jour-cjk-char-pat
  (rx (in "\u4E00-\u9FFF"         ; Unified Ideographs
          "\u3400-\u4DBF"         ; Unified Ideographs Extension A
          "\uF900-\uFAFF"         ; Compatibility Ideographs
          "\u3040-\u309F"         ; Hiragana
          "\u30A0-\u30FF"         ; Katakana
          "\u31F0-\u31FF"         ; Katakana Phonetic Extensions
          "\uAC00-\uD7AF"         ; Hangul
          "\u3000-\u303F"         ; Punctuation
          "\uFF00-\uFFEF")))      ; Halfwidth and Fullwidth Forms

(defun jour-cjk-char-p (string)
  "Check if `STRING' contains any CJK character."
  (string-match-p jour-cjk-char-pat string))

(defun jour-dom-site-nav (&optional active-nav)
  "Return a DOM tree for site navigation. `ACTIVE-NAV' is a string
or nil."
  `(nav
    ((aria-label . "Site"))
    ,@(mapcar
       (lambda (i)
         `(a
           ((href . ,(format "/%s/" i))
            ,@(if (string= i active-nav) '((aria-current . "page"))))
           ,(capitalize i)))
       '("quotes" "hypertexts" "archive" "about"))))

(defun jour-render-base-layout (title title-element active-nav body extra-footer)
  (jour-dom-to-html
   `(html
     ((lang . "zh"))
     (head
      ()
      (meta ((charset . "UTF-8")))
      (meta ((name . "viewport") (content . "width=device-width, initial-scale=1")))
      (link ((href . ,jour-css-url) (rel . "stylesheet")))
      (link ((href . "/rss.xml")
             (rel . "alternate")
             (type . "application/rss+xml")
             (title . "RSS")))
      (title () ,title))
     (body
      ()
      (header
       ()
       (,title-element () (a ((href . "/")) "时日"))
       ,(jour-dom-site-nav active-nav))
      (main () ,body)
      (hr ((class . "page-break") (aria-hidden . "true")))
      (footer
       ()
       ,(if extra-footer
            (format "Brought to you by Org mode. %s" extra-footer)
          "Brought to you by Org mode."))))
   t))

(defun jour-render-index-page-layout (contents &optional title active-nav)
  (jour-render-base-layout (or title "时日") "h1" active-nav contents nil))

(defun jour-render-post-page-layout (contents footer post)
  (jour-render-base-layout (jour-get-post-title post) "div" nil contents footer))

(defun jour-dom-post-nav (prev-post next-post)
  "Return a DOM tree for post navigation. `PREV-POST' and
`NEXT-POST' are the alist returned by `jour-post-nav-data'."
  `(nav
    ((aria-label . "Post"))
    ,(if prev-post
         `(a
           ((rel . "prev") (href . ,(alist-get 'url prev-post)))
           ,(format "←%s" (alist-get 'title prev-post))))
    ,(if next-post
         `(a
           ((rel . "next") (href . ,(alist-get 'url next-post)))
           ,(format "%s→" (alist-get 'title next-post))))))

(defun jour-dom-post-footer (post)
  "Return a DOM tree for post footer. `POST' is `jour-post'."
  `(footer
    ()
    ,(jour-dom-post-nav (jour-post-prev-post post) (jour-post-next-post post))))

(defun jour-dom-footnote-definitions (info)
  "Return a DOM tree for footnote definitions. `INFO' is the plist
passed around during Org export process, e.g. the second argument
to `jour-html-template', `EXT-PLIST' to org-export-*."
  (let* ((definitions (org-export-collect-footnote-definitions info))
         (footnotes-dom (mapcar
                         (lambda (definition)
                           (pcase definition
                             (`(,_ ,label ,def)
                              `(div
                                ((id . ,(format "fn.%s" label)))
                                (sup () (a ((href . ,(format "#fnr.%s" label))) ,label))
                                " "
                                ,(org-export-data def info)))))
                         definitions)))
    (if footnotes-dom
        `(section ((id . "footnotes")) ,@footnotes-dom)
      nil)))

(defun jour--render-post-helper (title heading-element heading-class
                                       permalink date-iso8601 date
                                       body footer &optional lang footnotes)
  (jour-dom-to-html
   `(article
     ,(if lang `((lang . ,lang)) '())
     (header
      ()
      (,heading-element
       ,(if heading-class `((class . ,heading-class)) '())
       (a ((href . ,permalink)) ,title))
      (time
       ((datetime . ,date-iso8601))
       (a
        ((href . ,permalink))
        ,date)))
     ,body
     ,@(if footnotes `((hr ((class . "section-break"))) ,footnotes))
     ,footer)))

(defun jour-render-post (body post page-type &optional info)
  "Render POST as HTML with BODY.

BODY is a valid HTML string. POST is `jour-post'. PAGE-TYPE is
either 'index or 'post.

When PAGE-TYPE is 'index, the title of the post will be rendered
in an <h2> tag, otherwise it is rendered in an <h1> tag. When
PAGE-TYPE is 'post, a footer containing nav links will be added.
If it's a micro post, the title will be visually hidden."
  (let ((title (jour-get-post-title post))
        (date-iso8601 (jour-iso8601-time-string (jour-post-date post)))
        (date-string (jour-post-date-string post))
        (heading (if (eq page-type 'index) "h2" "h1"))
        (href (jour-post-url post))
        (lang (jour-post-lang post))
        (footer (if (eq page-type 'post) (jour-dom-post-footer post) nil))
        (footnotes (if (eq page-type 'post) (jour-dom-footnote-definitions info) nil)))
    (if (jour-post-microp post)
        (jour--render-post-helper title heading "visually-hidden"
                                  href date-iso8601 date-string body
                                  footer lang footnotes)
      (jour--render-post-helper title heading nil
                                href date-iso8601 date-string body
                                footer lang footnotes))))

(defun jour-render-article-break ()
  (jour-dom-to-html
   `(div
     ((class . "article-break")
      (aria-hidden . "true"))
     (div () "❦")
     (div () "❦")
     (div () "❦"))))

(cl-defstruct (jour-post (:constructor jour-post--create) (:copier nil))
  (filename nil :documentation "Path of the current post in the filesystem.")
  (date nil :documentation "Elisp time, e.g. time returned by `encode-time'.")
  (slug nil :documentation "Pulled from the source file.")
  (title nil :documentation "Title of the post, nil if it's a micro post.")
  (updated nil :documentation "Update time. Pulled from the source file. Elisp time.")
  (prev-post nil :documentation "Previous post. See `jour-post-nav-data'.")
  (next-post nil :documentation "Next post. See `jour-post-nav-data'.")
  (lang nil :documentation "Language of the post. It will be set on the lang attr on the article element.")
  (publicp nil :documentation "Determine whether a post gets published. Pulled from the source file.")

  (url nil :documentation "Absolute URL for the post, e.g. /2026/02/hi/")
  (output-dir nil :documentation "Relative directory of the output HTML, e.g. build/2026/02/hi/")
  (output-html nil :documentation "Relative filename of the output HTML, e.g. build/2026/02/hi/index.html")
  (microp nil :documentation "Is it a micro post?")
  (date-string nil :documentation "Formatted time string, e.g. 2026.02.02"))

(defun jour-post-collect-keywords (filename)
  "Collect keywords from an Org file, and add filename as a keyword. Return
an alist with symbol keys. Repeated keywords are ignored."
  (let* ((keywords '("title" "date" "slug" "updated" "public" "lang"))
         (unique keywords))
    (with-temp-buffer
      (insert-file-contents filename)
      ;; This might slow things down.
      (org-mode)
      (append
       (list (cons 'filename filename))
       (mapcar (lambda (x) (pcase x (`(,k . ,v) (cons (intern (downcase k)) v))))
               (org-collect-keywords keywords unique))))))

(defun jour-post-parse-public (val)
  (pcase val ((or "t" "true") t) (_ nil)))

(defun jour-post-parse-time (time)
  (if (stringp time)
      (condition-case
          nil
          (encode-time (parse-time-string time))
        (wrong-type-argument (user-error "time `%s' is malformatted" time)))
    (user-error "time `%s' is not a string" time)))

(defun jour-post-parse-keyword (keyword)
  (pcase keyword
    (`(title . ,v) `(:title ,v))
    (`(date . ,v) `(:date ,(jour-post-parse-time v)))
    (`(slug . ,v) `(:slug ,v))
    (`(updated . ,v) `(:updated ,(jour-post-parse-time v)))
    (`(public . ,v) `(:publicp ,(jour-post-parse-public v)))
    (`(lang . ,v) `(:lang ,v))
    (`(filename . ,v) `(:filename ,v))))

(defun jour-post-parse-keywords (keywords)
  (mapcan #'jour-post-parse-keyword keywords))

(defun jour-post-check-required-keywords (keywords)
  (dolist (k '(date slug filename))
    (unless (alist-get k keywords)
      (user-error "field `%s' is missing" k))))

(defun jour-post-build-url (date slug microp)
  (jour-file-name-concat
   / (format-time-string (if microp "%Y/%m/%d" "%Y/%m") date) slug /))

;; TODO Org time may not include hours, minutes, and seconds. Maybe
;; support multiple time format?
(defun jour-post-create (keywords)
  (condition-case
      err
      (progn
        (jour-post-check-required-keywords keywords)
        (let* ((metadata (jour-post-parse-keywords keywords))
               (microp (pcase (plist-get metadata :title)
                         ((or (pred null) (and (pred stringp) (pred string-empty-p))) t)))
               (url (jour-post-build-url (plist-get metadata :date) (plist-get metadata :slug) microp))
               (date-string (format-time-string "%Y.%m.%d" (plist-get metadata :date)))
               (output-dir (jour-file-name-concat jour-output-directory url /))
               (output-html (jour-file-name-concat output-dir "index.html")))
          (apply #'jour-post--create
                 (append (list :microp microp
                               :url url
                               :date-string date-string
                               :output-dir output-dir
                               :output-html output-html)
                         metadata))))
    (error
     (user-error "%s: %s"
                 (file-name-nondirectory (alist-get 'filename keywords))
                 (error-message-string err)))))

(defun jour-get-post-title (post)
  (if (jour-post-microp post)
      (format "Posted on %s" (jour-post-date-string post))
    (jour-post-title post)))

(defun jour-post-nav-data (post)
  "Extract url and title for inter post navigation use. Return an
alist with symbol keys."
  (list (cons 'url (jour-post-url post))
        (cons 'title (jour-get-post-title post))))

(defconst jour-html-void-elements
  '(area base br col embed hr img input link meta param source track wbr))

(defun jour-dom-print (dom)
  (when (not (null (dom-tag dom)))
    (insert (format "<%s" (dom-tag dom)))
    (dolist (attr (dom-attributes dom))
      (insert (format " %s=\"%s\"" (car attr) (cdr attr))))
    (insert ">")
    (cond
     ((memq (dom-tag dom) jour-html-void-elements))
     (t
      (dolist (elem (dom-children dom))
        (cond
         ((stringp elem) (insert elem))
         (t (jour-dom-print elem))))
      (insert (format "</%s>" (dom-tag dom)))))))

(defun jour-dom-to-html (dom &optional doctype)
  (with-temp-buffer
    (when doctype
      (insert "<!doctype html>\n"))
    (jour-dom-print dom)
    (buffer-string)))

(defun jour-build-post-page (post)
  (letrec ((filename (jour-post-filename post))
           (output-dir (jour-post-output-dir post)))
    (make-directory output-dir t)
    (with-temp-buffer
      (insert-file-contents filename)
      (org-export-to-file
          'jour-html (jour-post-output-html post) nil nil nil nil (list :post-metadata post)))))

(defun jour--org-export-body (&optional plist)
  "Export current Org buffer into HTML without calling
`jour-html-template'."
  (org-export-as 'jour-html nil nil t plist))

(defun jour-export-post-body (post &optional index-page-p)
  "Export the body portion of `POST' to HTML by directly calling
`org-export-as' without stitching the HTML into base or article layout."
  (with-temp-buffer
    (insert-file-contents (jour-post-filename post))
    (jour--org-export-body (list :post-metadata post :index-page-p index-page-p))))

(defun jour-export-post-full (post)
  "Export `POST' to HTML as if it is in the index page."
  (jour-render-post (jour-export-post-body post t) post 'index))

(defun jour-build-main-index (posts prev-post)
  (let ((content (string-join (mapcar #'jour-export-post-full posts) (jour-render-article-break)))
        (post-nav (if prev-post
                      (jour-dom-to-html (jour-dom-post-nav (jour-post-nav-data prev-post)
                                                           nil))
                    "")))
    (with-temp-file (jour-file-name-concat jour-output-directory "index.html")
      (insert (jour-render-index-page-layout (concat content post-nav))))))

(defun jour-build-meta-page (name)
  "Build meta page `NAME' by converting the Org file into its own
directory."
  (let ((directory (jour-file-name-concat jour-output-directory name /)))
    (make-directory directory)
    (with-temp-file (jour-file-name-concat directory "index.html")
      (insert (jour-render-index-page-layout
               (with-temp-buffer
                 (insert-file-contents
                  (jour-file-name-concat jour-meta-directory (format "%s.org" name)))
                 (jour--org-export-body))
               (capitalize name)
               name)))))

(defun jour-build-quotes-page ()
  (jour-build-meta-page "quotes"))

(defun jour-build-hypertexts-page ()
  (jour-build-meta-page "hypertexts"))

(defun jour-build-about-page ()
  (jour-build-meta-page "about"))

(defun jour-render-archive-list (posts)
  (jour-dom-to-html
   `(ul
     ((id . "archive"))
     ,@(mapcar (lambda (p)
                 `(li
                   ()
                   (time
                    ((datetime . ,(jour-iso8601-time-string (jour-post-date p))))
                    ,(jour-post-date-string p))
                   (a
                    ((href . ,(jour-post-url p)))
                    ,(jour-post-title p))))
               posts))))

(defun jour-build-archive-page (posts)
  (let ((archive-directory (jour-file-name-concat jour-output-directory "archive" /)))
    (make-directory archive-directory)
    (with-temp-file (jour-file-name-concat archive-directory "index.html")
      (insert (jour-render-index-page-layout
               (concat
                (jour-dom-to-html
                 '(p
                   ((class . "text-center"))
                   (a
                    ((href . "/archive/micro/") (class . "color-initial"))
                    "\\(๑˃ᵐⁱᶜʳᵒ ᵖᵒˢᵗ ᵃʳᶜʰⁱᵛᵉ˂๑)/")))
                (jour-render-archive-list posts))
               "Archive"
               "archive")))))

(defun jour-build-micro-post-archive-page (posts)
  (let ((archive-directory (jour-file-name-concat jour-output-directory "archive" "micro" /))
        (content (string-join (mapcar #'jour-export-post-full posts) (jour-render-article-break))))
    (make-directory archive-directory)
    (with-temp-file (jour-file-name-concat archive-directory "index.html")
      (insert (jour-render-index-page-layout
               content
               "Micro Post Archive"
               "archive")))))

(defun jour-format-rss-time (time)
  (format-time-string "%a, %d %b %Y %H:%M:%S %z" time))

(defun jour-dom-rss-item (post)
  `(item
    ()
    ,@(if (jour-post-microp post) nil `((title () ,(jour-post-title post))))
    (description () ,(org-html-encode-plain-text (jour-export-post-body post)))
    (guid () ,(concat "https://jour.kitschy.moe" (jour-post-url post)))
    (pubDate () ,(jour-format-rss-time (jour-post-date post)))))

(defun jour-build-rss (posts)
  (with-temp-file (jour-file-name-concat jour-output-directory "rss.xml")
    (insert
     (shr-dom-to-xml
      `(rss
        ((version . "2.0"))
        (channel
         ()
         (title () "时日")
         (link () "https://jour.kitschy.moe")
         (description () "Pore over the excruciating minutiae of everyday life. after Elaine Benes")
         (language () "zh")
         ,@(mapcar #'jour-dom-rss-item posts)))))))

(defun jour-get-posts ()
  "Return public posts in descending date order."
  (let* ((filenames (directory-files jour-posts-directory t "^[^#\\.].+\\.org$"))
         (entries (mapcar #'jour-post-collect-keywords filenames))
         (public-entries (seq-filter (lambda (entry) (jour-post-parse-public (alist-get 'public entry))) entries))
         (posts (mapcar #'jour-post-create public-entries)))
    (sort posts (lambda (a b) (time-less-p (jour-post-date b) (jour-post-date a))))))

(defun jour-posts-add-neighbors (sorted-posts)
  "Add previous and next post data in-place. Elisp seems to be very
permissive in this regard that car/cdr like operations on an
empty list all return nil."
  (cl-labels ((helper (current rest prev-post next-post)
                (cond ((eq current nil) nil)
                      (t (ignore-error wrong-type-argument
                           (setf (jour-post-prev-post current) (jour-post-nav-data prev-post)))
                         (ignore-error wrong-type-argument
                           (setf (jour-post-next-post current) (jour-post-nav-data next-post)))
                         (helper (car rest) (cdr rest) (cadr rest) current)))))

    (helper (car sorted-posts) (cdr sorted-posts) (cadr sorted-posts) '())))

(defun jour-build-output-directory ()
  "Create the directory for output files. Tangle assets source
blocks, e.g. CSS and images, into files."
  (when (file-directory-p jour-output-directory)
    (move-file-to-trash jour-output-directory))
  (make-directory jour-assets-directory t)
  (org-babel-tangle-file current-file)
  (jour-cache-busting-css))

(defun jour-build ()
  (interactive)
  (with-temp-buffer
    (setq default-directory (file-name-directory current-file))
    (let ((posts (jour-get-posts)))
      (jour-build-output-directory)
      (jour-posts-add-neighbors posts)
      (mapc 'jour-build-post-page posts)
      (jour-build-main-index (take 10 posts) (nth 10 posts))
      (jour-build-rss (take 10 posts))
      (jour-build-quotes-page)
      (jour-build-hypertexts-page)
      (jour-build-archive-page (seq-filter (lambda (p) (not (jour-post-microp p))) posts))
      (jour-build-micro-post-archive-page (seq-filter (lambda (p) (jour-post-microp p)) posts))
      (jour-build-about-page))))

(defun jour-tangle-assets-filename (name &optional resolve-ref)
  "Return an asset file path for NAME. If RESOLVE-REF is non-nil, resolve
NAME as an Org Babel reference and use its value as the filename."
  (let ((filename (if resolve-ref (string-trim (org-babel-ref-resolve name)) name)))
    (jour-file-name-concat jour-assets-directory filename)))

(defun jour-cache-busting-css ()
  "Rename the tangled CSS file to include its content hash."
  (let ((css-file (jour-file-name-concat jour-assets-directory jour-css-filename)))
    (with-temp-buffer
      (insert-file-contents css-file)
      (let* ((hash (substring (secure-hash 'sha256 (current-buffer)) 0 8))
             (new-filename (format "style.%s.css" hash))
             (new-location (jour-file-name-concat jour-assets-directory new-filename)))
        (setq jour-css-url (jour-file-name-concat / assets-directory-name new-filename))
        (rename-file css-file new-location)
        new-location))))

(defun jour-iso8601-time-string (&optional time)
  (format-time-string "%FT%T" (or time (current-time))))

(defun jour--file-name-concat-helper (rootp dirp &rest names)
  (cl-flet ((helper (names0)
              (string-join (mapcan (lambda (s) (string-split s "/" t)) names0) "/")))
    (concat (if rootp "/" "")
            (helper names)
            (if dirp "/" ""))))

(defmacro jour-file-name-concat (&rest names)
  "Join file names, removing unnecessary slashes, adding leading or
ending slash."
  (let ((rootp (eq (car names) '/))
        (dirp (eq (car (last names)) '/))
        (names0 (remq '/ names)))
    `(jour--file-name-concat-helper ,rootp ,dirp ,@names0)))

(defun jour-write-micro-post ()
  (interactive)
  (let* ((current-directory (file-name-directory current-file))
         (datetime (current-time))
         (datetime-iso8601 (jour-iso8601-time-string datetime))
         (slug (format-time-string "%H%M" datetime)))
    (switch-to-buffer (make-temp-name "micro-post"))
    (org-mode)
    (insert (format "#+date: %s\n" datetime-iso8601))
    (insert (format "#+slug: %s\n" slug))
    (insert (format "#+public: false\n"))))

(defun jour-write-post (title)
  (interactive "sTitle: ")
  (let* ((current-directory (file-name-directory current-file))
         (datetime-iso8601 (jour-iso8601-time-string (current-time))))
    (switch-to-buffer (make-temp-name "post"))
    (org-mode)
    (insert (format "#+title: %s\n" title))
    (insert (format "#+date: %s\n" datetime-iso8601))
    (insert "#+slug: \n")
    (insert (format "#+public: false\n"))))

(defun jour-deploy ()
  (interactive)
  (org-babel-ref-resolve "deploy"))


(defvar jour-map (define-keymap
                   "m" #'jour-write-micro-post
                   "j" #'jour-write-post
                   "b" #'jour-build
                   "d" #'jour-deploy))

(global-set-key (kbd "C-x j") jour-map)

(setq jour-output-directory "build"
      jour-assets-directory "build/<<assets-directory-name>>"
      jour-posts-directory "posts"
      jour-meta-directory "posts/meta"
      jour-css-filename "style.css"
      jour-css-url "/<<assets-directory-name>>/style.css")