;; external dependencies:
;; - simple-httpd

;;; utils

(defun string-replace-> (alist string)
  "Return a string after a list of string replacements '((from-string
to-string)) have been applied to IN-STRING. Applied oned after the other."
  (let ((string (copy-sequence string)))
    (pcase-dolist (`(,from-string ,to-string) alist)
      (setq string (string-replace from-string to-string string)))
    string))

(defun file (path)
  (expand-file-name
   (if (file-directory-p path)
       (file-name-as-directory path)
     (concat (file-name-directory path)
             (file-name-nondirectory path)))))

(defun files (dir &optional regex)
  (seq-remove
   #'file-directory-p
   (directory-files dir t (or regex directory-files-no-dot-files-regexp) t)))

(defun dirs-in (dir &optional regex)
  (seq-filter
   #'file-directory-p
   (mapcar
    #'file-name-as-directory
    (directory-files dir t (or regex directory-files-no-dot-files-regexp) t))))

(defun all-files (dir &optional regex)
  (directory-files-recursively dir (or regex directory-files-no-dot-files-regexp) nil))

(defmacro with-temp-file-buffer (file &rest body)
  "If FILE exists, insert its contents in a temp buffer and call BODY."
  (declare (indent 1))
  `(cl-flet ((get-buffer-or-file (file)
               (let* ((buffer (get-file-buffer file))
                      (file-exists (file-exists-p file))
                      (buffer-modified (buffer-modified-p buffer)))
                 (cond
                  ((or (and file-exists
                            buffer
                            (not buffer-modified)
                            (not (eq buffer-modified 'autosaved)))
                       (and file-exists (not buffer)))
                   (cons #'insert-file-contents file))
                  (buffer
                   (cons #'insert-buffer buffer))))))
     (when-let* ((file-and-function (get-buffer-or-file ,file)))
       (with-temp-buffer
         (funcall (car file-and-function) (cdr file-and-function))
         (goto-char (point-min))
         ,@body))))

(defun ensure-plist (thing)
  (let ((plist (ensure-list thing)))
    (if (plistp plist) plist
      (user-error "Malformed plist: %S" plist))))

(defmacro defplist (var &rest plist)
  (declare (indent 1))
  `(,(if (boundp var) 'setq 'defvar) ,var
    ',(ensure-plist plist)))

(defmacro nah (&rest args)
  "Ignore all arguments without evaluating."
  ())

;;; simple export

(defcustom *preprocess-functions* '()
  "Functions to call on unprocessed org files, should accept the org buffer
as argument."
  :type 'hook)

(defcustom *postprocess-functions* '()
  "Functions to call on org->html exported files, should accept HTML buffer
path as argument."
  :type 'hook)

(defcustom html-head
  "<link rel=\"stylesheet\" type=\"text/css\" href=\"/assets/style.css\"/>
   <link rel=\"icon\" type=\"image/x-icon\" href=\"/assets/favicon.jpg\" />"
  "Org-wide head definitions for exported HTML files.
See `org-html-head'"
  :type 'string)

(defcustom html-footnotes-section
  "<!--%s-->%s"
  "Format for the footnotes section. Stuffed in a comment to hide it
entirely. See `org-html-footnotes-section'"
  :type 'string)

(defun filter-org-html-links (fn &rest args)
  "Hack to replace file:// protocol links and index.html"
  (string-replace->
   '(("file://" "")
     ("/index.html" "/")
     ("../" "/")
     ("./" "/"))
   (apply fn args)))

(advice-add 'org-html-link :around 'filter-org-html-links)

(cl-defun simple-export (file &optional (directory "~/www"))
  (interactive "fFile: \nDDir: ")
  (require 'ox-html)
  (let ((org-html-head-include-default-style nil)
        (org-export-with-section-numbers     nil)
        (org-html-head-include-scripts       nil)
        (org-html-htmlize-output-type        nil)
        (org-export-with-broken-links        t)
        (org-html-self-link-headlines        t)
        (org-html-style-default              nil)
        (org-export-with-author              nil)
        (org-export-with-title               nil)
        (org-html-html5-fancy                t)
        (org-export-with-toc                 nil)
        (org-html-postamble                  nil)
        (org-html-style                      nil)
        (org-html-validation-link "")
        (org-html-doctype "html5")
        (org-html-footnotes-section html-footnotes-section)
        (org-html-head html-head)
        (org (file file)))
    (with-current-buffer (get-buffer (find-file-noselect org))
      (run-hook-with-args '*preprocess-functions* (current-buffer))
      (org-export-to-file 'html (org-export-output-file-name ".html" nil directory)
        nil nil nil nil nil
        '(lambda (file)
           (with-temp-file-buffer file
             (save-excursion
               (while (not (eq (point) (point-max)))
                 (when (re-search-forward "^<[/]?div.*$" nil t 1)
                   (delete-char (1- (- (pos-bol) (pos-eol)))))
                 (goto-char (1+ (pos-eol)))))
             (run-hook-with-args '*postprocess-functions* (current-buffer))
             (write-file file nil)))))))

;;; shortname

(defvar *shortnames* (make-hash-table :test 'equal))

(defun retreive-shortname (file)
  (with-temp-file-buffer file
    (when (re-search-forward "^#\\+shortname\\s-*:" nil t 1)
      (string-clean-whitespace (buffer-substring-no-properties (point) (pos-eol))))))

(defun get-shortname (link)
  (gethash link *shortnames*))

(defun set-shortname (file)
  (let* ((key (file-name-sans-extension (file-name-nondirectory file)))
         (value (retreive-shortname file)))
    (when value
      (puthash key value *shortnames*))))

(defun use-shortnames (buffer)
  (save-excursion
    (while (not (eq (point) (point-max)))
      (when-let* ((beg (re-search-forward "href=\"" nil t 1))
                  (end (save-excursion
                         (when (re-search-forward "\"" nil t 1)
                           (backward-char 1)
                           (point))))
                  (link (file-name-sans-extension
                         (buffer-substring-no-properties beg end)))
                  (shortname (get-shortname link)))
        (delete-char (- end beg))
        (insert (concat shortname) ".html"))
      (goto-char (1+ (pos-eol))))))

(defun rename-to-shortname (file)
  (when-let ((file (file file))
             (shortname (get-shortname (file-name-base file))))
    (rename-file file (string-join
                       `(,(file-name-directory file)
                         ,shortname
                         ".html")))))

(defun rename-to-shortnames (files)
  (mapcar #'rename-to-shortname files))

(add-hook '*postprocess-functions* 'use-shortnames)

;;; site accessors

(defun site->include (plist)
  (funcall (plist-get plist :include)))

(defun site->source (plist)
  (funcall (plist-get plist :source)))

(defun site->templates (plist)
  (funcall (plist-get plist :templates)))

(defun site->template (plist template)
  (seq-find
   (lambda (e)
     (string= template (file-name-base e)))
   (site->templates plist)))

(defun site->out (plist)
  (plist-get plist :out))

(defun site->url (plist)
  (plist-get plist :url))

(defun site->tar (plist)
  (plist-get plist :tar))

(defun site->config (plist)
  (plist-get plist :config))

;;; simple-build

(defcustom *simple-build-functions* '()
  "Functions to call at the end of the build process just before serving
all the files and killing all associated org buffers. Functions should
accept one argument, site, which is a plist containing the various
components of the site being built."
  :type 'hook)

(defun simple-build/drop (site)
  (mapcar #'delete-file (all-files (site->out site)))
  (mapcar
   (lambda (dir)
     (delete-directory dir t))
   (dirs-in (site->out site))))

(defun simple-build/copy (site)
  (let ((output-directory (site->out site)))
    (mapcar
     (lambda (include)
       (let ((dir (file-name-as-directory include)))
         (if (file-exists-p dir)
             (copy-directory dir (file-name-as-directory output-directory) t)
           (copy-file include (file-name-as-directory output-directory) t))))
     (site->include site))))

(defun simple-build/make (site)
  (let ((output-directory (site->out site)))
    (mapcar #'set-shortname (site->source site))
    (mapcar
     (lambda (org-file)
       (simple-export org-file output-directory))
     (site->source site))))

(defun simple-build/slug (site)
  (rename-to-shortnames
   (all-files (site->out site) "\\.html$")))

(defun simple-build/hook (site)
  (run-hook-with-args '*simple-build-functions* site))

(defun simple-build/demo (site &optional stop)
  (if (null stop)
      (httpd-serve-directory (site->out site))
    (httpd-stop)))

(defun simple-build/kill (site)
  (dolist (buffer (mapcar #'get-file-buffer (site->source site)))
    (when buffer
      (with-current-buffer buffer
        (save-buffer))
      (kill-buffer buffer))))

(defun simple-push (site)
  (let* ((inhibit-message t)
         (tarball (format "%s/%s--%s.tar.gz"
                          (site->tar site)
                          (site->url site)
                          (format-time-string "%F@%T.%3N"))))
    (simple-build site t)
    (shell-command
     (format "cd %s && tar -cvz * > %s" (site->out site) tarball))
    (async-shell-command
     (format "hut pages publish -d %s --site-config %s %s" (site->url site) (site->config site) tarball))))

(defun simple-build (site &optional stop-server)
  (interactive "P")
  (let ((inhibit-message t)
        (messages-buffer-max-lines nil))
    (when stop-server (simple-build/demo site t))
    (unwind-protect (progn (simple-build/drop site)
                           (simple-build/make site)
                           (simple-build/copy site)
                           (simple-build/slug site)
                           (simple-build/hook site)
                           (simple-build/demo site))
      (simple-build/kill site)))
  (message "Built website to: %s" (site->out site)))

;;; zyd.lol

(defvar *categories* '("gamedev" "lisp"))

(defun links (category)
  (let ((links '()))
    (maphash (lambda (longname shortname)
               (when (string-search (concat "_" category) longname)
                 (push (concat shortname ".html") links)))
             *shortnames*)
    links))

(defun gethashv (value table &optional test)
  (cl-block nil
    (maphash (lambda (key val)
               (when (funcall (or test #'string=) value val)
                 (cl-return key)))
             table)))

(defun org-file (shortname site)
  (seq-find
   (lambda (source)
     (string= (file-name-base source)
              (gethashv (file-name-sans-extension shortname) *shortnames*)))
   (site->source site)))

(defun org-title (link site)
  (when-let ((org-file (org-file link site)))
    (with-temp-file-buffer org-file
      (when (re-search-forward "^#\\+title\\s-*:" nil t 1)
        (string-clean-whitespace (buffer-substring-no-properties (point) (pos-eol)))))))

(defun insert-links (links site)
  (dolist (link links)
    (insert "- ")
    (org-insert-link nil (concat "/" link) (org-title link site))
    (newline)
    (forward-line 1)))

(defun insert-category (category)
  (newline)
  (forward-line 1)
  (insert "* ")
  (goto-char (pos-eol))
  (insert (capitalize category))
  (goto-char (pos-eol))
  (newline 1)
  (forward-line 1))

(defun generate-index (site)
  (let ((file (make-temp-file "index" nil ".org")))
    (with-temp-file-buffer (site->template site "index")
      (goto-char (point-max))
      (dolist (category *categories*)
        (insert-category category)
        (insert-links (links category) site))
      (newline)
      (forward-line 1)
      (insert "* Other")
      (newline)
      (forward-line 1)
      (insert-links (seq-difference (links "") (mapcan #'links *categories*))
                    site)
      (write-file file))
    file))

(defun make-index (site)
  (let ((index (generate-index site)))
    (set-shortname index)
    (rename-to-shortname (simple-export index (site->out site)))))

(defun disable-headline-links-for-index (buffer)
  (when (string-search "index" (buffer-name buffer))
    (with-current-buffer buffer
      (setq-local org-html-self-link-headlines nil))))

(add-hook '*preprocess-functions* 'disable-headline-links-for-index)
(add-hook '*simple-build-functions* 'make-index)

(defplist zyd.lol
  :url
  "zyd.lol"
  :out
  "~/zyd.lol"
  :tar
  "~/.config/hut/backups"
  :config
  "~/.config/hut/site-config.json"
  :source
  (lambda ()
    (files "~/memex" "_push.*"))
  :include
  (lambda ()
    `(,@(files "~/dotfiles/hut/static")
      ,@(dirs-in "~/dotfiles/hut/static")))
  :templates
  (lambda ()
    (files "~/.config/hut/templates/")))

(defun zyd/build-site ()
  (interactive)
  (simple-build zyd.lol))

(defun zyd/push-site ()
  (interactive)
  (simple-build zyd.lol t)
  (simple-push zyd.lol))

;;; testing

(nah
 (simple-build/drop zyd.lol)
 (simple-build/make zyd.lol)
 (simple-build/copy zyd.lol)
 (simple-build/slug zyd.lol)
 (simple-build/hook zyd.lol)
 (simple-build/demo zyd.lol)
 (simple-build/demo zyd.lol t)
 (simple-build/kill zyd.lol)
 (simple-build zyd.lol t)
 (simple-push zyd.lol))