path: root/ennu.el

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

(require 'ennu-html)
(require 'ennu-image)
(require 'ox)
(require 'seq)
(require 'cl)
(require 'map)
(require 'memoize)
(require 'simple-httpd)

(defvar ennu-version "0.1.0"
  "Ennu version string")

(cl-defstruct (ennu-post (:constructor ennu-make-post)
                         (:copier nil))
  filename slug author date language links tangle
  summary tags thumbnail title translation-group)

(cl-defstruct (ennu-operation (:constructor ennu-make-operation)
                              (:copier nil))
  inputs outputs publish)

(defun ennu-posts (posts-directory)
  (sort (seq-map 'ennu-read-post
                 (file-expand-wildcards
                  (concat (file-name-as-directory
                           (ennu-setting :posts-directory))
                          "*.org")))
        'ennu-later-post-p))

(defun ennu-later-post-p (post1 post2)
  (time-less-p (ennu-post-date post2)
               (ennu-post-date post1)))

(defun ennu-read-post (filename)
  (ennu--read-post
   filename (file-attribute-modification-time
             (file-attributes filename))))

(defmemoize ennu--read-post (filename last-modified)
  (ennu-with-file-contents filename
    (let ((metadata (org-export-get-environment 'ennu-html))
          (export (apply-partially 'org-export-with-backend 'ennu-html)))
      (seq-do (lambda (key)
                (unless (plist-member metadata key)
                  (user-error "Metadata %s not specified" key)))
              ennu-mandatory-metadata)
      (let* ((tree (org-element-parse-buffer))
             (links (org-element-map tree 'link
                      (lambda (link)
                        (pcase link
                          (`(link ,properties . ,_)
                           (let ((link-type (org-element-property :type link)))
                             (when (member link-type (list "image" "static" "video"))
                               (cons link-type (org-element-property :path link))))))))))
        (ennu-make-post
         :filename filename
         :slug (file-name-base filename)
         :author (funcall export (first (plist-get metadata :author)))
         :date (org-timestamp-to-time (first (plist-get metadata :date)))
         :language (plist-get metadata :language)
         :links links
         ;; TODO: Deal with cases when the :tangle parameter is "yes"
         :tangle (seq-uniq
                  (org-element-map tree 'src-block
                    (lambda (src-block)
                      (pcase (org-babel-get-src-block-info nil src-block)
                        (`(,_ ,_ ,arguments ,_ ,_ ,_ ,_)
                         (let ((tangle-output-file (map-elt arguments :tangle)))
                           (pcase tangle-output-file
                             ("no" nil)
                             (_ tangle-output-file))))))))
         :summary (funcall export (first (plist-get metadata :summary)))
         :tags (plist-get metadata :filetags)
         :thumbnail (or (plist-get metadata :thumbnail)
                        (seq-some (lambda (link)
                                    (pcase link
                                      (`("image" . ,path) path)
                                      (`("video" . ,path) (ennu-video-poster path))))
                                  links))
         :title (funcall export (first (plist-get metadata :title)))
         :translation-group (or (plist-get metadata :translation-group)
                                (file-name-base filename)))))))

(defvar ennu-mandatory-metadata
  (list :title :date))

(defmacro ennu-with-file-contents (file &rest body)
  "Create a temporary buffer, insert contents of FILE into that
buffer and evaluate BODY. The value returned is the value of the
last form in BODY."
  (declare (indent defun))
  `(with-temp-buffer
     (insert-file-contents ,file)
     ,@body))

(defun ennu--org-output-filename (filename)
  (concat (file-name-sans-extension filename) ".html"))

(defun ennu-publish-post (posts)
  ;; TODO: Tangle post
       ;; (when-let (tangle-dir (or (plist-get posts-plist :valai-tangle-directory)
       ;;                           valai-tangle-directory))
       ;;   (dolist (tangled-file
       ;;            (org-babel-tangle-file post-path))
       ;;     (when (member (file-name-extension tangled-file) '("sh" "py"))
       ;;       (chmod tangled-file (string-to-number "755" 8)))
       ;;     (make-directory tangle-dir t)
       ;;     (rename-file tangled-file
       ;;                  (expand-file-name (file-name-nondirectory tangled-file)
       ;;                                    tangle-dir)
       ;;                  t)))
  (let ((link-publish-operations
         (seq-map 'ennu-publish-link (seq-mapcat 'ennu-post-links posts)))
        (input-post-files (seq-map 'ennu-post-filename posts)))
    (cons
     (ennu-make-operation
      :inputs (append input-post-files
                      (seq-mapcat 'ennu-operation-inputs link-publish-operations))
      :outputs (seq-map 'ennu--org-output-filename input-post-files)
      :publish
      (lambda (&rest output-files)
        (seq-mapn
         (lambda (post output-file)
           (ennu-with-file-contents (ennu-post-filename post)
             (org-export-to-file
                 'ennu-html output-file nil nil nil nil
                 (list :translations (seq-remove (apply-partially 'equal post) posts)))))
         posts
         output-files)))
     link-publish-operations)))

(defun ennu-publish-generic (other-files-directory file)
  (ennu-make-operation
   :inputs (list file)
   :outputs
   (list (string-remove-prefix
          (file-name-as-directory other-files-directory)
          (pcase (file-name-extension file)
            ("org" (ennu--org-output-filename file))
            (_ file))))
   :publish (lambda (output-file)
              (pcase (file-name-extension file)
                ("org" (ennu-with-file-contents file
                         (org-export-to-file 'html output-file)))
                (_ (ennu-copy file output-file))))))

(defun ennu-video-poster (video)
  (pcase (directory-files (ennu-setting :images-directory) nil
                          (concat (file-name-sans-extension video)
                                  "\\.\\(jpg\\|png\\)$"))
    (`(,poster . ,_) poster)
    (`() (user-error "Poster for %s not found" video))))

(defun ennu-add-tongue-suffix (filename tongue)
  (pcase tongue
    ("en" filename)
    (_ (format "%s.%s%s"
               (file-name-sans-extension filename)
               tongue
               (file-name-extension filename t)))))

(defun ennu-index-filename (filename-prefix tongue &optional extension page-number)
  (let ((extension (if extension (concat "." extension) "")))
    (ennu-add-tongue-suffix
     (if page-number
         (format "%s-%s%s" filename-prefix page-number extension)
       (concat filename-prefix extension))
     tongue)))

(defun ennu-publish-index (filename-prefix title posts-per-page posts)
  (let* ((tongue (ennu-post-language (first posts)))
         (number-of-pages (ceiling (length posts) posts-per-page))
         (page-numbers (number-sequence 1 number-of-pages)))
    (ennu-make-operation
     :inputs (seq-map 'ennu-post-filename posts)
     :outputs (cons (ennu-add-tongue-suffix (format "%s.html" filename-prefix) tongue)
                    (seq-map (apply-partially 'ennu-index-filename filename-prefix tongue "html")
                             page-numbers))
     :publish
     (lambda (home-page &rest output-files)
       (seq-mapn
        (lambda (posts page-number output-file)
          (with-temp-buffer
            (insert (format "#+TITLE: %s\n" title))
            (insert (format "#+LANGUAGE: %s\n" tongue))
            (insert "#+OPTIONS: num:nil toc:nil\n\n")
            (seq-do (lambda (post)
                      (insert (format "* [[post:%s]]\n" (ennu-post-slug post)))
                      (insert (format-time-string
                               "/%b %e, %Y/\n\n"
                               (ennu-post-date post)))
                      (when-let ((thumbnail (ennu-post-thumbnail post)))
                        (insert (format "[[thumbnail:%s]]\n\n" thumbnail)))
                      (when-let ((summary (ennu-post-summary post)))
                        (insert summary)
                        (insert "\n\n"))
                      (when-let ((tags (ennu-post-tags post)))
                        (insert "Tags: ")
                        (insert
                         (string-join
                          (seq-map (lambda (tag)
                                     (format "[[tag:%s][%s]]" (ennu-add-tongue-suffix tag tongue) tag))
                                   tags)
                          ", "))
                        (insert "\n\n")))
                    posts)
            (unless (= page-number 1)
              (insert (format "[[./%s][Newer posts]]\n"
                              (ennu-index-filename (file-name-nondirectory filename-prefix)
                                                   tongue nil (1- page-number)))))
            (unless (= page-number number-of-pages)
              (insert (format "[[./%s][Older posts]]\n"
                              (ennu-index-filename (file-name-nondirectory filename-prefix)
                                                   tongue nil (1+ page-number)))))
            (org-export-to-file 'html output-file)))
        (seq-partition posts posts-per-page)
        page-numbers
        output-files)
       (copy-file (first output-files) home-page)))))

(defun ennu--absolute-uri (path)
  (format "%s://%s/%s"
          (ennu-setting :blog-scheme)
          (ennu-setting :blog-domain)
          path))

(defun ennu--atom-date (date)
  (format-time-string "%Y-%m-%dT%H:%M:%SZ" date))

(defun ennu-publish-feed (feed-file title rights posts)
  (ennu-make-operation
   :inputs (seq-map 'ennu-post-filename posts)
   :outputs (list feed-file)
   :publish
   (lambda (output-file)
     (with-temp-file output-file
       (insert
        (xmlgen
         `(feed :xmlns "http://www.w3.org/2005/Atom"
                (id ,(ennu--absolute-uri ""))
                (title ,title)
                (updated ,(ennu--atom-date (ennu-post-date (first posts))))
                (link :rel "self" :href ,(ennu--absolute-uri feed-file))
                (generator
                 ,(format "Emacs %d.%d Org-mode %s ennu %s"
                          emacs-major-version emacs-minor-version (org-version) ennu-version))
                (rights ,rights)
                ,@(seq-map 'ennu--feed-entry posts))))))))

(defun ennu--feed-entry (post)
  (let ((link (ennu--absolute-uri (ennu--org-output-filename
                                   (ennu-post-filename post)))))
    `(entry (id ,link)
            (title :xml:lang ,(ennu-post-language post) ,(ennu-post-title post))
            (updated ,(ennu--atom-date (ennu-post-date post)))
            (author
             (name ,(ennu-post-author post))
             (email ,user-mail-address))
            (content :type "html" :xml:lang ,(ennu-post-language post)
                     ,(ennu-with-file-contents (ennu-post-filename post)
                        (org-export-as 'ennu-html nil nil t)))
            (link :rel "alternate" :href ,link)
            ,@(seq-map (lambda (tag) `(category :term ,tag))
                       (ennu-post-tags post)))))

(defun ennu-setting (property)
  (pcase property
    (:blog-scheme
     (or (plist-get ennu-blog :blog-scheme)
         "https"))
    (:atom-feed-file
     (or (plist-get ennu-blog :atom-feed-file)
         "blog.atom"))
    (:index-posts-per-page
     (or (plist-get ennu-blog :index-posts-per-page)
         12))
    (:atom-feed-number-of-posts
     (or (plist-get ennu-blog :atom-feed-number-of-posts)
         12))
    (:thumbnail-image-width
     (or (plist-get ennu-blog :thumbnail-image-width)
         320))
    (:default-image-width
     (or (plist-get ennu-blog :default-image-width)
         640))
    (:image-link-width
     (or (plist-get ennu-blog :image-link-width)
         1024))
    (:tag-directory
     (or (plist-get ennu-blog :tag-directory)
         "tag"))
    ((or :blog-domain :blog-license :blog-title
         :images-directory :output-directory :posts-directory
         :static-directory :tag-directory :video-directory
         :working-directory)
     (or (plist-get ennu-blog property)
         (user-error "Property %s not defined" property)))
    (:other-files-directory
     (plist-get ennu-blog property))
    (_ (error "Unknown property %s" property))))

(defun ennu-image-output-filename (image width)
  (format "%s-%spx.%s"
          (file-name-sans-extension image)
          width (file-name-extension image)))

(defun ennu--expand-relative (name directory)
  (concat (file-name-as-directory directory) name))

(defun ennu-publish-image (widths image)
  (ennu-make-operation
   :inputs (list image)
   :outputs (seq-map (apply-partially 'ennu-image-output-filename image)
                     widths)
   :publish
   (lambda (&rest output-files)
     (seq-mapn (lambda (output-file width)
                 (ennu-image-optimize-image
                  (ennu-image-resize-image image output-file width)))
               output-files widths))))

(defun ennu-publish-copy (file)
  (ennu-make-operation
   :inputs (list file)
   :outputs (list file)
   :publish (apply-partially 'ennu-copy file)))

(defun newest-file (files)
  (pcase files
    (`(,head . ,tail)
     (seq-reduce (lambda (file1 file2)
                   (if (file-newer-than-file-p file1 file2)
                       file1 file2))
                 tail head))))

(defun ennu-mkdir-p (directory)
  (make-directory directory t))

(defun ennu-copy (source destination)
  "Copy file or directory from SOURCE to DESTINATION. Overwrite
if DESTINATION already exists."
  (if (file-directory-p source)
      (copy-directory source destination)
    (make-directory (file-name-directory destination) t)
    (copy-file source destination t)))

(defun ennu--filter-map (function sequence)
  (seq-filter 'identity (seq-map function sequence)))

(defun ennu--do-operation (temporary-directory operation)
  (let* ((expand (lambda (directory file)
                   (expand-file-name file directory)))
         (inputs (ennu-operation-inputs operation))
         (outputs (ennu-operation-outputs operation))
         (absolute-outputs
          (seq-map (apply-partially expand temporary-directory)
                   outputs))
         (previous-outputs
          (seq-map (apply-partially expand (ennu-setting :output-directory))
                   outputs)))
    (cond
     ((and (seq-every-p 'file-exists-p previous-outputs)
           (file-newer-than-file-p (newest-file previous-outputs)
                                   (newest-file inputs)))
      (message "Skipping publishing %s to %s" inputs outputs)
      (seq-mapn 'ennu-copy previous-outputs absolute-outputs))
     (t (message "Publishing %s to %s" inputs outputs)
        (seq-do 'ennu-mkdir-p
                (seq-uniq
                 (seq-map 'file-name-directory absolute-outputs)))
        (apply (ennu-operation-publish operation) absolute-outputs)))))

(defun ennu-publish-static-file (file)
  (ennu-make-operation
   :inputs (list file)
   :outputs (list file)
   :publish (apply-partially 'ennu-copy file)))

(defun ennu-publish-link (link)
  (pcase link
    (`("image" . ,path)
     (ennu-publish-image
      (list (ennu-setting :default-image-width)
            (ennu-setting :image-link-width))
      (ennu--expand-relative path (ennu-setting :images-directory))))
    (`("static" . ,path)
     (ennu-publish-copy (ennu--expand-relative path (ennu-setting :static-directory))))
    (`("video" . ,path)
     (ennu-publish-copy (ennu--expand-relative path (ennu-setting :video-directory)))
     (ennu-publish-copy (ennu--expand-relative (ennu-video-poster path)
                                               (ennu-setting :images-directory))))))

(defmacro ennu-with-current-directory (directory &rest body)
  "Change to DIRECTORY, evaluate BODY and restore the current
working directory. The value returned is the value of the last
form in BODY."
  (declare (indent defun))
  (let ((current-directory-symbol (make-symbol "current-directory")))
    `(let ((,current-directory-symbol default-directory))
       (unwind-protect (progn (cd ,directory) ,@body)
         (cd ,current-directory-symbol)))))

(defmacro ennu-with-temporary-directory (temporary-directory &rest body)
  "Create temporary directory, evaluate BODY with the absolute
path of that directory assigned to TEMPORARY-DIRECTORY and
finally delete the temporary directory. The value returned is the
value of the last form in BODY."
  (declare (indent defun))
  `(let ((,temporary-directory (make-temp-file "ennu" t)))
     (unwind-protect
         (progn ,@body)
       (delete-directory ,temporary-directory t))))

(defun ennu-many-to-many-group-by (function sequence)
  "Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results
as keys. Keys are compared using `equal'."
  (seq-reduce
   (lambda (result element)
     (seq-do
      (lambda (key)
        (map-put result key
                 (cons element (map-elt result key nil 'equal))
                 'equal))
      (funcall function element))
     result)
   (seq-reverse sequence)
   nil))

(defun ennu-publish ()
  (interactive)
  (let ((make-backup-files nil)
        (blog-title (ennu-setting :blog-title))
        (posts-per-page (ennu-setting :index-posts-per-page)))
    (ennu-with-current-directory (ennu-setting :working-directory)
      (ennu-with-temporary-directory temporary-directory
        (seq-do
         (apply-partially 'ennu--do-operation temporary-directory)
         (append
          (let ((posts (ennu-posts (ennu-setting :posts-directory))))
            (append
             ;; Publish posts
             (seq-mapcat (pcase-lambda (`(,translation-group . ,posts))
                           (ennu-publish-post posts))
                         (seq-group-by 'ennu-post-translation-group posts))
             ;; Publish feed
             (list (ennu-publish-feed (ennu-setting :atom-feed-file)
                                      blog-title
                                      (ennu-setting :blog-license)
                                      (seq-take posts (ennu-setting :atom-feed-number-of-posts))))
             ;; Publish indices
             (seq-map
              (pcase-lambda (`(,tongue . ,posts))
                (ennu-publish-index "index" blog-title posts-per-page posts))
              (seq-group-by 'ennu-post-language posts))
             (seq-mapcat
              (pcase-lambda (`(,tag . ,posts))
                (seq-map
                 (pcase-lambda (`(,tongue . ,posts))
                   (ennu-publish-index
                    (ennu--expand-relative tag (ennu-setting :tag-directory))
                    tag posts-per-page posts))
                 (seq-group-by 'ennu-post-language posts)))
              (ennu-many-to-many-group-by 'ennu-post-tags posts))
             ;; Publish thumbnails
             (seq-map
              (apply-partially 'ennu-publish-image (list (ennu-setting :thumbnail-image-width)))
              (seq-map (lambda (image)
                         (ennu--expand-relative image (ennu-setting :images-directory)))
                       (seq-uniq (ennu--filter-map 'ennu-post-thumbnail posts))))))
          ;; Publish other files
          (when-let ((other-files-directory (ennu-setting :other-files-directory)))
            (seq-map (apply-partially 'ennu-publish-generic other-files-directory)
                     (seq-map (apply-partially 'string-remove-prefix
                                               (file-name-as-directory (expand-file-name default-directory)))
                              (directory-files-recursively other-files-directory "."))))))
        ;; Replace old output directory
        (let ((output (ennu-setting :output-directory)))
          (delete-directory output t)
          (rename-file temporary-directory output t))))))

;;; Server
;;;
;;; Test HTTP server to serve the blog locally

(defun ennu-serve ()
  (interactive)
  (setq httpd-root (expand-file-name (ennu-setting :output-directory)
                                     (ennu-setting :working-directory)))
  (defun httpd/ (proc uri-path query request)
    (let ((uri-path (httpd-unhex uri-path)))
      (pcase (httpd-status (httpd-gen-path uri-path))
        (200 (httpd-serve-root proc httpd-root uri-path request))
        (_ (httpd-serve-root proc httpd-root (concat uri-path ".html") request)))))
  (httpd-start))

(provide 'ennu)