(ns net.deertopia.doerg.render
  (:require [net.deertopia.doerg.element :as element]
            [clojure.stacktrace]
            [clojure.string :as str]
            [clojure.tools.logging :as l]
            [clojure.core.match :refer [match]]
            [clojure.tools.logging.readable :as lr]
            [com.rpl.specter :as sp]
            [net.deertopia.doerg.html :as doerg-html]
            [hiccup2.core :as hiccup]
            [clojure.pprint]
            [net.deertopia.doerg.tex :as tex]
            [net.deertopia.doerg.tex.temml :as tex-temml]
            [clojure.zip :as z]
            [babashka.fs :as fs]
            [clojure.edn :as edn]))

;;; Top-level API

(defmulti org-element
  "Render an Org element to Hiccup."
  #(do (assert (element/org-element? %)
               "Not an org-node!")
       (:type %)))

(defmulti org-link
  "Render an Org-mode link element to Hiccup.  Dispatches on link
  type/protocol."
  #(do (assert (element/of-type? % "link"))
       (:link-type %)))

(defmulti org-special-block
  "Render an Org-mode special block to Hiccup.  Dispatches on special
  block type (as in #+begin_«type» … #+end_«type»)."
  #(do (assert (element/of-type? % "special-block"))
       (:block-type %)))

(defmulti org-keyword
  "Render an Org-mode keyword."
  #(do (assert (element/of-type? % "keyword"))
       (:key %)))

(def ^:dynamic ^:private *opts*)

(declare ^:private gather-footnotes render-renderer-error
         view-children-as-seq render-tex-snippets)

(defn org-element-recursive
  "Recursively render an Org-mode element to Hiccup."
  [e]
  (->> e
       (sp/transform
        [element/postorder-walker view-children-as-seq]
        (fn [node]
          (try (org-element node)
               (catch Throwable e
                 (lr/error e "Error in renderer" {:node node})
                 (render-renderer-error e)))))))

(def default-language
  "Default language, used in the lang attribute of the body tag."
  "en")

(defn org-document
  "Recursively render an Org-mode document to Hiccup."
  [doc & {:as opts :keys [postamble header title]}]
  (binding [*opts* opts]
    (tex-temml/binding-worker
      (let [rendered (-> doc gather-footnotes render-tex-snippets
                         org-element-recursive)]
        [:html
         [:head
          (when title
            [:title title])
          doerg-html/head]
         [:body {:lang default-language}
          (when header
            [:header header])
          [:article
           rendered
           (when postamble
             [:footer
              [:hr]
              postamble])]]]))))

(defn to-html
  "Read `f` with `slurp` as an Org document and return a string of
  rendered HTML.  See `org-document` for opts."
  [f & {:as opts}]
  (str (hiccup/html {} (-> f slurp element/read-string (org-document opts)))))


;;; Further dispatching on `org-element`

(defmethod org-element "keyword" [e]
  (org-keyword e))

(defmethod org-element "link" [e]
  (org-link e))

(defmethod org-element "special-block" [e]
  (org-special-block e))



(def view-children-as-seq
  "Specter path that converts any vectors of :children to lists so
  Hiccup correctly interprets children as lists of elements rather
  than a single malformed element."
  (sp/if-path element/greater-element?
              (sp/view #(update % :children seq))
              sp/STAY))

(defn center [& es]
  [:div.center es])

(defn doerg-attrs [e]
  (->> e :affiliated :attr_doerg (str/join " ")
       (format "{%s}") edn/read-string))

(defn em [x]
  (format "%.4fem" x))

(defn wrap-if [x c f]
  (if c (f x) x))

(defn- contains-footnote-refs? [node]
  (some #(element/of-type? % "footnote-reference")
        (:children node)))

(defn- gather-footnotes
  "Traverse document and reposition footnote-definitions to
  immediately follow their first references. Removes the footnotes
  section from the document."
  [doc]
  (let [fn-defs (->> doc
                     (sp/select
                      [element/children-walker element/footnotes-section?
                       element/children-walker
                       #(element/of-type? % "footnote-definition")
                       (sp/view (fn [d]
                                  {(:label d) d}))])
                     (apply merge))
        encountered (atom #{})]
    (->> doc
         (sp/transform
          [element/postorder-walker
           contains-footnote-refs?]
          (fn [node]
            (assoc node :children
                   (->> (for [n (:children node)]
                          (let [label (:label n)]
                            (if (and (element/of-type? n "footnote-reference")
                                     (not (@encountered label)))
                              (do (swap! encountered #(conj % label))
                                  (list n (get fn-defs label)))
                              (list n))))
                        (apply concat)))))
         (sp/setval [element/children-walker
                     element/footnotes-section?]
                    sp/NONE))))

(defn- collect-latex-headers [doc]
  (->> doc
       (sp/select
        [element/postorder-walker
         #(element/of-keyword-type? % "LATEX_HEADER")
         (sp/view :value)])))

(defn- timeout-snippet-promises [snippet-promises fut]
  ;; Time out after twenty seconds. With all the LaTeX and IPC, there
  ;; are so many opportunities for things to go wrong </3.
  (let [ms (* 20 1000)
        fut-res (deref fut ms ::timed-out)]
    (if (= fut-res ::timed-out)
      (do (l/warnf "Giving up on rendering TeX snippets after %.3f seconds."
                   (/ ms 1000))
          (future-cancel fut)
          (doseq [[_snippet p] snippet-promises]
            (deliver p ::timed-out)))
      fut-res)))

(defn render-tex-snippets
  "Traverse doc, adorning each LaTeX node with a promise resolving to,
  optimistically, Hiccup-rendered SVG or MathML code."
  [doc]
  (let [snippet-promises (atom [])
        r (->> doc (sp/transform
                    [element/postorder-walker
                     #(element/of-type?
                       % "latex-fragment" "latex-environment")]
                    (fn [node]
                      (let [p (promise)]
                        (swap! snippet-promises #(conj % [(:value node) p]))
                        (assoc node ::rendered p)))))
        sp @snippet-promises
        fut (-> #(tex/render-snippets sp)
                bound-fn* future-call)]
    (timeout-snippet-promises sp fut)
    r))



(defn render-pprint
  "Render the argument inline as `clojure.pprint/pprint` output."
  [x & {:keys [text]
        :or {text "debug!"}}]
  [:details
   [:summary {:style {:font-family "IBM Plex Sans"}}
    (if (:type x)
      (list text " (" [:code (:type x)] ")")
      text)]
   [:samp {:style {:overflow "scroll"
                   :display "block"
                   :white-space "pre"}}
    (with-out-str
      (clojure.pprint/pprint x))]])

(defn- level->tag
  "Convert a number 1–5 to a hiccup :h1, :h2, :h3, … tag."
  [level]
  (cond (<= 1 level 5) (keyword (str \h (+ level 1)))
        :else :h5))

(defn- descriptive-list-item-components
  "If `e` is an Org-mode descriptive list item, return a map {:dt x
  :dd y} with the corresponding dt and dd tags. Otherwise, return
  nil."
  [e]
  (match (:children e)
    ([[:dt & dts] & dds] :seq) {:dt (apply vector :dt dts)
                                :dd (apply vector :dd dds)}
    _ nil))

(defn- same-tag? [x y]
  (let [x* (-> x name (str/replace #"^([^\.#]).*" "$1") keyword)]
    (= x* y)))

;; In HTML5, </p> tags cannot be nested for… reasons.  In fact, no
;; block-level elements are allowed within paragraphs.  This stupid
;; hack works around that restriction by stripping </p> tags }:).
(defn- strip-paragraphs [elements]
  (apply concat
         (for [x elements]
           (match x
             [(_ :guard #(same-tag? % :p)) (_ :guard map?) & xs]
             (seq xs)
             [(_ :guard #(same-tag? % :p)) & xs]
             (seq xs)
             _ x))))



(defn- render-renderer-error
  "Render a `Throwable` to display within the document."
  [e]
  [:details
   [:summary {:style {:font-family "IBM Plex Sans"}}
    "Renderer error!"]
   [:samp {:style {:overflow "scroll"
                   :display "block"
                   :white-space "pre"}}
    (with-out-str
      (clojure.stacktrace/print-stack-trace e))]])

(defmethod org-element "org-data"
  [{:keys [children]}]
  children)

(defmethod org-element "paragraph" [{:keys [children]}]
  [:p children])

(defmethod org-element "text" [{:keys [value]}]
  value)

(defmethod org-element "bold" [{:keys [children]}]
  [:b children])

(defmethod org-element "strike-through" [{:keys [children]}]
  [:s children])

(defmethod org-element "subscript" [{:keys [children]}]
  [:sub children])

(defmethod org-element "superscript" [{:keys [children]}]
  [:super children])

(defmethod org-element "italic" [{:keys [children]}]
  [:em children])

(defmethod org-element "verbatim" [{:keys [value]}]
  value)

(defmethod org-element "code" [{:keys [value]}]
  [:code value])

(defmethod org-element "section" [{:keys [children]
                                   :as section}]
  (when-not (element/footnotes-section? section)
    [:section
     (or (seq children)
         [:div.empty-section-message "This section is empty…"])]))

(defmethod org-element "headline" [{:keys [children level]}]
  [(level->tag level) children])

(defmethod org-element "footnote-reference"
  [{:keys [label]}]
  ;; FIXME: This will break if there are multiple references to a
  ;; single footnote, since `label` is assumed to be unique.
  (list [:label.margin-toggle.sidenote-number {:for label}]
        [:input.margin-toggle {:type "checkbox"
                               :id label}]))

(defmethod org-element "footnote-definition" [{:keys [children]}]
  [:span.sidenote (strip-paragraphs children)])

(defmethod org-element "plain-list" [{:keys [list-type children]}]
  (let [tag (case list-type
              "descriptive" :dl
              "unordered" :ul
              "ordered" :ol)]
    [tag children]))

(defmethod org-element "list-item" [{:keys [children] :as e}]
  (if-some [{:keys [dt dd]} (descriptive-list-item-components e)]
    (list dt dd)
    [:li children]))

(defmethod org-element "list-item-tag" [{:keys [children]}]
  [:dt children])

(defmethod org-element "property-drawer" [{:keys [children]}]
  [:table.property-drawer {:hidden true}
   [:tbody children]])

(defmethod org-element "node-property" [{:keys [key value]}]
  [:tr [:th key] [:td value]])

(defmethod org-element "citation" [{:keys [prefix suffix children] :as e}]
  ;; TODO: Real citations.
  [:span "[cite:" prefix children suffix "]"])

(defmethod org-element "citation-reference" [{:keys [key]}]
  (str "@" key))

(defmethod org-element "latex-fragment" [{:keys [contents value] :as e}]
  [:span {:class (if (element/display-math? e)
                   "latex-fragment display-math"
                   "latex-fragment")}
   (-> e ::rendered deref)])

(defmethod org-element "latex-environment" [{:keys [value] :as e}]
  [:span.latex-fragment.display-math
   (-> e ::rendered deref)])

(defmethod org-element "example-block" [{:keys [value] :as e}]
  (let [{:keys [center? alt scale img?]} (doerg-attrs e)]
    (-> [:pre (merge (and img? {:role "img"
                                :aria-label alt
                                :title alt})
                     (and scale {:style {:font-size (em scale)}}))
         value]
        (wrap-if center? center))))

(defmethod org-element "src-block" [{:keys [value]}]
  [:pre [:code value]])

(defn- split-quote-block-children [children]
  (match (split-with #(not= % [:hr]) children)
    [x ([[:hr] & ys] :seq)] [x (strip-paragraphs ys)]
    x x))

(defmethod org-element "quote-block" [{:keys [children] :as e}]
  (let [{:keys [epigraph?]} (doerg-attrs e)
        [content footer] (split-quote-block-children children)]
    (-> [:blockquote
         content
         (when footer
           [:footer footer])]
        (wrap-if epigraph? (fn [c] [:div.epigraph c])))))

(defmethod org-element "horizontal-rule" [_]
  [:hr])

(defmethod org-element "comment" [_] nil)

(defmethod org-keyword "TITLE" [{:keys [value]}]
  [:h1 value])

(defmethod org-keyword "LATEX_COMPILER" [_] nil)
(defmethod org-keyword "LATEX_HEADER" [_] nil)

;; Not sure how to deal with this one yet.
(defmethod org-keyword "AUTHOR" [_] nil)

(defmethod org-element :default [x]
  (render-pprint x :text "unimplemented!"))

(defmethod org-keyword :default [x]
  (render-pprint x :text "unimplemented!"))

(defmethod org-special-block "margin-note" [{:keys [children]}]
  [:p [:span.marginnote (strip-paragraphs children)]])

#_
(defmethod org-special-block :default [x]
  (render-pprint x :text "unimplemented!"))

(defmethod org-link :default [{:keys [raw-link children]}]
  [:span.org-link.external
   [:a {:href raw-link}
    (or (seq children) raw-link)]])