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

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

(defvar ennum-version "0.1.0"
  "Ennum version string")

(defvar ennum-blog nil
  "Property list specifying ennum publish settings")

;; TODO: Should the store have an absolute path to deal with directory
;; changes? Yes, since we ask for an absolute working directory, we
;; should.
(defun ennum-intern (filename)
  (let* ((store-item
          (expand-file-name (ennum-file-hash filename)
                            (ennum-setting :store)))
         (interned-path (expand-file-name (file-name-nondirectory filename)
                                          store-item)))
    (unless (file-exists-p store-item)
      (ennum-copy filename interned-path)
      (ennum--set-file-modes-recursively store-item #o555 #o444 #o555))
    interned-path))

(defun ennum--hash ()
  "Return SHA256 hash of buffer contents encoded using
filename-safe base64 encoding. See RFC 4648§5. Briefly, this is a
variant of base64 encoding where characters + and / are replaced
respectively by - and _, and the pad character = is optional."
  (replace-regexp-in-string
   (rx (any ?+ ?/ ?=))
   (lambda (str)
     (pcase str
       ("+" "-")
       ("/" "_")
       ("=" "")))
   (base64-encode-string
    (secure-hash 'sha256 (current-buffer) nil nil t))))

(defun ennum-file-hash (file)
  (ennum--file-hash file (file-attribute-modification-time
                          (file-attributes file))))

(defmemoize ennum--file-hash (file last-modified)
  (with-temp-buffer
    ;; TODO: Use ennum-with-file-contents
    (set-buffer-multibyte nil)
    (insert-file-contents-literally file)
    (ennum--hash)))

(defun ennum--set-file-modes-recursively (directory directory-mode file-mode executable-file-mode)
  (chmod directory directory-mode)
  (seq-do (lambda (file)
            (cond
             ((file-directory-p file) (chmod file directory-mode))
             ((file-executable-p file) (chmod file executable-file-mode))
             (t (chmod file file-mode))))
          (ennum-directory-files directory t t)))

(cl-defstruct (ennum-exp (:constructor ennum-make-exp)
                         (:copier nil))
  inputs proc)

(defun ennum--rewrite-inputs (exp)
  (pcase exp
    (`(ennum-input ,arg)
     (let ((input-identifier (gensym "input")))
       (vector input-identifier (list arg) (list input-identifier))))
    (`(,parent . ,childern)
     (seq-reduce (pcase-lambda (`[,result ,inputs ,input-identifiers] node)
                   (pcase (ennum--rewrite-inputs node)
                     (`[,modified-tree ,new-inputs ,new-input-identifiers]
                      (vector (append result (list modified-tree))
                              (append inputs new-inputs)
                              (append input-identifiers new-input-identifiers)))))
                 exp
                 (vector nil nil nil)))
    (leaf (vector exp nil nil))))

(defmacro ennum-exp (&rest body)
  (let ((raw-expression `(progn ,@body)))
    (pcase (ennum--rewrite-inputs raw-expression)
      (`[,rewritten-body ,inputs ,input-identifiers]
       `(ennum-eval
         (ennum-make-exp
          :inputs (list ,@inputs)
          :proc (lambda ,input-identifiers ,rewritten-body)))))))

(defun ennum-eval (exp)
  (let ((output
         (expand-file-name
          (with-temp-buffer
            (let ((print-length nil)
                  (print-level nil))
              (print exp (current-buffer)))
            (ennum--hash))
          (ennum-setting :store))))
    ;; Create store if it doesn't exist
    (ennum-mkdir-p (ennum-setting :store))
    ;; Create store item if it doesn't already exist
    (if (file-exists-p output)
        (message "Skipping build of %s" output)
      (message "Building %s" output)
      (ennum-with-temporary-directory temporary-directory
        (ennum-with-current-directory temporary-directory
          (apply (ennum-exp-proc exp)
                 (ennum-exp-inputs exp)))
        (rename-file temporary-directory output))
      (ennum--set-file-modes-recursively output #o555 #o444 #o555))
    output))

(defun ennum-store-item-union (items)
  "Return a store item that is the union of ITEMS."
  (ennum-exp
   (seq-do (lambda (item)
             (seq-do (lambda (destination)
                       ;; TODO: Print warning about overwriting files?
                       (let ((source (expand-file-name destination item)))
                         (unless (file-exists-p destination)
                           (if (file-directory-p source)
                               (make-directory destination)
                             (copy-file source destination t)))))
                     (reverse (ennum-directory-files item nil t))))
           (ennum-input items))))

(cl-defstruct (ennum-post (:constructor ennum-make-post)
                          (:copier ennum-copy-post))
  filename slug author date language links tangle
  summary tags thumbnail title translation-group translations
  video-posters)

(defun ennum-posts (posts-directory)
  (sort (seq-mapcat
         ;; Set translations slot of post objects.
         (pcase-lambda (`(,_ . ,posts))
           (let ((translations
                  (seq-map (lambda (post)
                             (cons (ennum-post-language post)
                                   (ennum-post-slug post)))
                           posts)))
             (seq-map (lambda (post)
                        (let ((post-copy (ennum-post-copy post)))
                          (setf (ennum-post-translations post-copy)
                                (seq-remove (pcase-lambda (`(,_ . ,slug))
                                              (string= (ennum-post-slug post)
                                                       slug))
                                            translations))
                          post-copy))
                      posts)))
         ;; Read posts from org files and group them by translation
         ;; group.
         (seq-group-by
          'ennum-post-translation-group
          (ennum--filter-map
           (lambda (file)
             (when (string= (file-name-extension file) "org")
               (ennum-read-post
                (ennum--expand-relative file (ennum-setting :posts-directory)))))
           (ennum-directory-files (ennum-setting :posts-directory)))))
        'ennum-later-post-p))

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

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

(defmemoize ennum--read-post (filename last-modified)
  (ennum-with-file-contents filename
    (let ((metadata (org-export-get-environment 'ennum-html))
          (export (apply-partially 'org-export-with-backend 'ennum-html)))
      (seq-do (lambda (key)
                (unless (plist-member metadata key)
                  (user-error "Metadata %s not specified" key)))
              ennum-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))))))))))
        (ennum-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) (ennum-video-poster path))))
                                  links))
         :title (funcall export (first (plist-get metadata :title)))
         :translation-group (or (plist-get metadata :translation-group)
                                (file-name-base filename))
         :video-posters (ennum--filter-map (lambda (link)
                                             (pcase link
                                               (`("video" . ,path)
                                                `(,path . ,(ennum-video-poster path)))))
                                           links))))))

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

(defmacro ennum-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 ennum-directory-files (directory &optional full include-directories)
  "Return recursively the list of all files under DIRECTORY. Files are
returned in depth first order.

If FULL is non-nil, absolute file names are returned. Else, the
file names are relative to DIRECTORY. If INCLUDE-DIRECTORIES is
non-nil, include directories in the output."
  (let ((files (directory-files-recursively
                directory (rx anything) include-directories)))
    (if full
        files
      (seq-map (apply-partially 'string-remove-prefix
                                ;; Expand directory in case it is a
                                ;; relative path.
                                (file-name-as-directory (expand-file-name directory)))
               files))))

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

(defun ennum-publish-post (post)
  (append
   (list
    (ennum-exp
     (let ((input-org-file (ennum-input (ennum-intern (ennum-post-filename post))))
           (output-file
            (ennum--org-output-filename (ennum-post-filename post))))
       (ennum-mkdir-p (file-name-directory output-file))
       (let ((system-time-locale (map-elt (ennum-setting :locale-alist)
                                          (ennum-post-language post) nil 'string=)))
         (ennum-with-file-contents input-org-file
           ;; TODO: Centralize these with feed generation
           (org-export-to-file
               'ennum-html output-file nil nil nil nil
               (list :ennum-translations (ennum-post-translations post)
                     :ennum-video-posters (ennum-post-video-posters post))))))))
   (when (ennum-post-tangle post)
     (list
      (ennum-exp
       ;; TODO: Handle tangle outputs that are nested
       ;; into directories, and when each tangle output
       ;; is nested into a different directory.
       (let* ((input-org-file (ennum-input (ennum-intern (ennum-post-filename post))))
              (post-file-copy
               (expand-file-name
                (file-name-nondirectory input-org-file)
                (ennum-setting :static-directory))))
         (ennum-copy input-org-file post-file-copy)
         (org-babel-tangle-file post-file-copy)
         (delete-file post-file-copy)))))
   (seq-mapcat 'ennum-publish-link (ennum-post-links post))))

(defun ennum-publish-generic (other-files-directory file)
  (ennum-exp
   (let ((interned-file (ennum-input (ennum-intern (ennum--expand-relative file other-files-directory))))
         (output-file
          (pcase (file-name-extension file)
            ("org" (ennum--org-output-filename file))
            (_ file))))
     (pcase (file-name-extension interned-file)
       ("org"
        (when (file-name-directory output-file)
          (ennum-mkdir-p (file-name-directory output-file)))
        (ennum-with-file-contents interned-file
          (org-export-to-file 'html output-file)))
       (_ (ennum-copy interned-file output-file))))))

(defun ennum-video-poster (video)
  (or (seq-find (lambda (file)
               (string= (file-name-base file)
                        (file-name-base video)))
                (ennum-directory-files (ennum-setting :images-directory)))
      (user-error "Poster for %s not found" video)))

(defun ennum-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 ennum-index-filename (filename-prefix tongue &optional extension page-number)
  (let ((extension (if extension (concat "." extension) "")))
    (ennum-add-tongue-suffix
     (if page-number
         (format "%s-%s%s" filename-prefix page-number extension)
       (concat filename-prefix extension))
     tongue)))

(defun ennum-publish-index (filename-prefix title posts-per-page posts)
  (let* ((tongue (ennum-post-language (first posts)))
         (number-of-pages (ceiling (length posts) posts-per-page))
         (page-numbers (number-sequence 1 number-of-pages)))
    (ennum-exp
     (ennum-input (seq-map (lambda (post)
                             (ennum-intern (ennum-post-filename post)))
                           posts))
     (let ((output-files (seq-map (apply-partially 'ennum-index-filename filename-prefix tongue "html")
                                  page-numbers))
           (system-time-locale (map-elt (ennum-setting :locale-alist) tongue nil 'string=)))
       (seq-mapn
        (lambda (posts page-number output-file)
          (when (file-name-directory output-file)
            (ennum-mkdir-p (file-name-directory 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][%s]]\n"
                                      (ennum-post-slug post)
                                      (ennum-post-title post)))
                      (insert (format-time-string "/%b %e, %Y/\n\n" (ennum-post-date post)))
                      (when-let ((thumbnail (ennum-post-thumbnail post)))
                        (insert (format "[[thumbnail:%s]]\n\n" thumbnail)))
                      (when-let ((summary (ennum-post-summary post)))
                        (insert summary)
                        (insert "\n\n"))
                      (when-let ((tags (ennum-post-tags post)))
                        (insert "Tags: ")
                        (insert
                         (string-join
                          (seq-map (lambda (tag)
                                     (format "[[tag:%s][%s]]" (ennum-add-tongue-suffix tag tongue) tag))
                                   tags)
                          ", "))
                        (insert "\n\n")))
                    posts)
            (unless (= page-number 1)
              (insert (format "[[./%s][Newer posts]]\n\n"
                              (ennum-index-filename (file-name-nondirectory filename-prefix)
                                                    tongue nil (1- page-number)))))
            (unless (= page-number number-of-pages)
              (insert (format "[[./%s][Older posts]]\n"
                              (ennum-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)
                  (ennum-add-tongue-suffix (format "%s.html" filename-prefix) tongue))))))

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

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

(defun ennum-publish-feed (feed-file title rights posts)
  (ennum-exp
   ;; TODO: Create ennu-mkdir-p-for-file
   (when (file-name-directory feed-file)
     (ennum-mkdir-p (file-name-directory feed-file)))
   (with-temp-file feed-file
     (insert
      (xmlgen
       `(feed :xmlns "http://www.w3.org/2005/Atom"
              (id ,(ennum--absolute-uri ""))
              (title ,title)
              (updated ,(ennum--atom-date (ennum-post-date (first posts))))
              (link :rel "self" :href ,(ennum--absolute-uri feed-file))
              (generator
               ,(format "Emacs %d.%d Org-mode %s ennum %s"
                        emacs-major-version emacs-minor-version (org-version) ennum-version))
              (rights ,rights)
              ,@(seq-mapn (lambda (post interned-post-file)
                            (ennum--feed-entry post interned-post-file))
                          posts
                          (ennum-input (seq-map (lambda (post)
                                                  (ennum-intern (ennum-post-filename post)))
                                                posts)))))))))

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

(defun ennum-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 ennum-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
         :store :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"))
                       :store ".ennum"
                       :tag-directory "tag"
                       :thumbnail-image-width 320)
                 ennum-blog)
                property))
    (_ (error "Unknown property %s" property))))

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

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

(defun ennum-publish-image (image width)
  (ennum-exp
   (let ((input-image (ennum-input (ennum-intern image))))
     (ennum-mkdir-p (ennum-setting :images-directory))
     (ennum-image-optimize-image
      (ennum-image-resize-image
       input-image
       (ennum--expand-relative
        (ennum-image-output-filename
         (file-name-nondirectory input-image) width)
        (ennum-setting :images-directory))
       width)))))

(defun ennum-publish-copy (file)
  (ennum-exp
   (ennum-copy (ennum-input (ennum-intern file)) 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 ennum-mkdir-p (directory)
  (make-directory directory t))

(defun ennum-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)
    (when (file-name-directory destination)
      (ennum-mkdir-p (file-name-directory destination)))
    (copy-file source destination t)))

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

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

(defmacro ennum-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 ennum-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 "ennum" t)))
     (unwind-protect
         (progn ,@body)
       (delete-directory ,temporary-directory t))))

(defun ennum-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 ennum-publish ()
  (interactive)
  (ennum-with-current-directory (ennum-setting :working-directory)
    (let* ((blog-title (ennum-setting :blog-title))
           (posts (ennum-posts (ennum-setting :posts-directory)))
           (posts-per-page (ennum-setting :index-posts-per-page))
           (other-files-directory (ennum-setting :other-files-directory))
           (result
            (ennum-store-item-union
             (append
              ;; Publish posts
              (seq-mapcat 'ennum-publish-post posts)
              ;; Publish feed
              (list (ennum-publish-feed (ennum-setting :atom-feed-file)
                                        blog-title
                                        (ennum-setting :blog-license)
                                        (seq-take posts (ennum-setting :atom-feed-number-of-posts))))
              ;; Publish indices
              (seq-map
               (pcase-lambda (`(,tongue . ,posts))
                 (ennum-publish-index "index" blog-title posts-per-page posts))
               (seq-group-by 'ennum-post-language posts))
              ;; Publish tag indices
              (seq-mapcat
               (pcase-lambda (`(,tag . ,posts))
                 (seq-map
                  (pcase-lambda (`(,tongue . ,posts))
                    (ennum-publish-index
                     (ennum--expand-relative tag (ennum-setting :tag-directory))
                     tag posts-per-page posts))
                  (seq-group-by 'ennum-post-language posts)))
               (ennum-many-to-many-group-by 'ennum-post-tags posts))
              ;; Publish thumbnails
              (seq-map (lambda (image)
                         (ennum-publish-image
                          (ennum--expand-relative image (ennum-setting :images-directory))
                          (ennum-setting :thumbnail-image-width)))
                       (ennum--filter-map 'ennum-post-thumbnail posts))
              ;; Publish other files
              (seq-map (apply-partially 'ennum-publish-generic other-files-directory)
                       (ennum-directory-files other-files-directory))))))
      ;; Replace old output directory
      (when (file-exists-p (ennum-setting :output-directory))
        (ennum--set-file-modes-recursively (ennum-setting :output-directory) #o755 #o644 #o755)
        (delete-directory (ennum-setting :output-directory) t))
      (copy-directory result (ennum-setting :output-directory))
      (message "Ennum published to %s" (expand-file-name (ennum-setting :output-directory))))))

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

;; TODO: Why can't simple-httpd itself handle the unhexing?
(defun ennum-server-start ()
  (interactive)
  (setq httpd-root (expand-file-name (ennum-setting :output-directory)
                                     (ennum-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
       ;; If a HTML file other than index.html was requested, reject
       ;; that request.
       ((and (not (string= (file-name-nondirectory file-path) "index.html"))
             (string= (file-name-extension file-path) "html"))
        (httpd-error proc 404))
       ;; If the requested file was found, serve it.
       ((= (httpd-status file-path) 200)
        (httpd-serve-root proc httpd-root uri-path request))
       ;; Perhaps, this is a post or other HTML file that is being
       ;; requested. Try serving a file with a .html extension
       ;; appended.
       (t (httpd-serve-root proc httpd-root (concat uri-path ".html") request)))))
  (httpd-start)
  (message "Ennum web server listening at http://localhost:%d" httpd-port))

(defun ennum-server-stop ()
  (interactive)
  (httpd-stop)
  (message "Ennum web server stopped"))

(provide 'ennum)