;; -*- 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 (when-let (author (plist-get metadata :author))
(funcall export (first 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 (when-let (summary (plist-get metadata :summary))
(funcall export (first 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)
(let ((link-publish-operations
(seq-mapcat 'ennu-publish-link (seq-mapcat 'ennu-post-links posts)))
(input-post-files (seq-map 'ennu-post-filename posts)))
(append
(list
(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)
(let ((system-time-locale (map-elt (ennu-setting :locale-alist)
(ennu-post-language post) nil 'string=)))
(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))))
(ennu--filter-map
(lambda (post)
(when (ennu-post-tangle post)
(ennu-make-operation
:inputs (list (ennu-post-filename post))
:outputs (seq-map (lambda (tangle-output)
(ennu--expand-relative tangle-output
(ennu-setting :static-directory)))
(ennu-post-tangle post))
:publish (lambda (&rest output-files)
(org-babel-tangle-publish
nil (ennu-post-filename post)
(file-name-directory (first output-files)))))))
posts)
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)
(let ((system-time-locale (map-elt (ennu-setting :locale-alist) tongue nil 'string=)))
(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)))
,@(when org-export-with-author
`((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
((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)))
((or :atom-feed-number-of-posts :atom-feed-file
:blog-scheme :default-image-width
:image-link-width :index-posts-per-page
:locale-alist :other-files-directory
:tag-directory :thumbnail-image-width)
(plist-get (org-combine-plists
(list :atom-feed-number-of-posts 12
:atom-feed-file "blog.atom"
:blog-scheme "https"
:default-image-width 640
:image-link-width 1024
:index-posts-per-page 12
:locale-alist '(("en" . "C"))
:tag-directory "tag"
:thumbnail-image-width 320)
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)
(list
(ennu-publish-image
(list (ennu-setting :default-image-width)
(ennu-setting :image-link-width))
(ennu--expand-relative path (ennu-setting :images-directory)))))
(`("static" . ,path)
(list
(ennu-publish-copy (ennu--expand-relative path (ennu-setting :static-directory)))))
(`("video" . ,path)
(list
(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)))
(chmod ,temporary-directory #o755)
(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-server-start ()
(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))
(file-path (httpd-gen-path uri-path)))
(cond
((and (not (string= (file-name-nondirectory file-path) "index.html"))
(string= (file-name-extension file-path) "html"))
(httpd-error proc 404))
((= (httpd-status file-path) 200)
(httpd-serve-root proc httpd-root uri-path request))
(t (httpd-serve-root proc httpd-root (concat uri-path ".html") request)))))
(httpd-start)
(message "Ennu web server listening at http://localhost:%d" httpd-port))
(defun ennu-server-stop ()
(interactive)
(httpd-stop)
(message "Ennu web server stopped"))
(provide 'ennu)