common.cljc

(ns markdown.common
  (:require [clojure.string :as str]
            [clojure.string :as string])
  #?(:clj (:import (java.net URLEncoder))))

(def ^{:dynamic true} *substring*)

(def ^:dynamic *inhibit-separator* nil)

(def escape-delimiter (str (char 254) (char 491)))

(defn gen-token [n]
  (str escape-delimiter n escape-delimiter))

(defn freeze-string
  "Freezes an output string.  Converts to a placeholder token and puts that into the output.
  Returns the [text, state] pair.  Adds it into the state, the 'frozen-strings' hashmap
  So that it can be unfrozen later."
  [& args]
  (let [state (last args)
        token (gen-token (count (:frozen-strings state)))]
    [token (assoc-in state
                     [:frozen-strings token]
                     (reduce str (flatten (drop-last args))))]))

(defn thaw-string
  "Recursively replaces the frozen strings in the output with the original text."
  [text state]
  (if-let [matches (re-seq (re-pattern (str escape-delimiter "\\d+" escape-delimiter)) text)]
    (recur
      (reduce
        (fn [s r]
          (string/replace s (re-pattern r) #(get (:frozen-strings state) % %)))
        text matches)
      (update state :frozen-strings #(apply dissoc % matches)))
    [text state]))

(defn thaw-strings
  "Terminally encoded strings are ones that we've determined should no longer be processed or evaluated"
  [text state]
  (if-not (empty? (:frozen-strings state))
    (thaw-string text state)
    [text state]))

(defn escape-code [s]
  (-> s
      (string/replace #"&" "&")
      (string/replace #"\*" "*")
      (string/replace #"\^" "^")
      (string/replace #"\_" "_")
      (string/replace #"\~" "~")
      (string/replace #"\<" "&lt;")
      (string/replace #"\>" "&gt;")
      ;(string/replace #"\/" "&frasl;") ;screws up ClojureScript compiling
      (string/replace #"\[" "&#91;")
      (string/replace #"\]" "&#93;")
      (string/replace #"\(" "&#40;")
      (string/replace #"\)" "&#41;")
      (string/replace #"\"" "&quot;")))

(defn escaped-chars [text state]
  [(if (or (:code state) (:codeblock state))
     text
     (-> text
         (string/replace #"\\\\" "&#92;")
         (string/replace #"\\`" "&#8216;")
         (string/replace #"\\\*" "&#42;")
         (string/replace #"\\_" "&#95;")
         (string/replace #"\\\{" "&#123;")
         (string/replace #"\\\}" "&#125;")
         (string/replace #"\\\[" "&#91;")
         (string/replace #"\\\]" "&#93;")
         (string/replace #"\\\(" "&#40;")
         (string/replace #"\\\)" "&#41;")
         (string/replace #"\\#" "&#35;")
         (string/replace #"\\\+" "&#43;")
         (string/replace #"\\-" "&#45;")
         (string/replace #"\\\." "&#46;")
         (string/replace #"\\!" "&#33;")
         (string/replace #"\\\^" "&#94;")))
   state])

(defn open-html-tags [open? token-seq]
  (= :open (reduce (fn [state token]
                     (case token
                       \< :open
                       \> :closed
                       state))
                   (if open? :open :closed)
                   token-seq)))

(defn make-separator
  "Return a transformer to
   - find all the chunks of the string delimited by the `separator',
   - wrap the output with the `open' and `close' markers, and
   - apply the `transformer' to the text inside the chunk."
  ([separator open close]
   (make-separator separator open close identity))
  ([separator open close transformer]
   (let [separator (seq separator)]  ;; allow char seq or string
     (fn [text state]
       (if (:code state)
         [text state]
         (loop [out       []
                buf       []
                tokens    (partition-by (partial = (first separator)) (seq text))
                cur-state (assoc state :found-token false :in-tag? false)]
           (cond
             (empty? tokens)
             [(string/join (into (if (:found-token cur-state) (into out separator) out) buf))
              (dissoc cur-state :found-token)]

             (:found-token cur-state)
             (if (= (first tokens) separator)
               (let [[new-buf new-state]
                     (if (identical? transformer identity)
                       ;; Skip the buf->string->buf conversions in the common
                       ;; case.
                       [buf cur-state]
                       (let [[s new-state] (transformer (string/join buf) cur-state)]
                         [(seq s) new-state]))]
                 (recur (vec (concat out (seq open) new-buf (seq close)))
                        []
                        (rest tokens)
                        (assoc new-state :found-token false)))
               (recur out
                      (into buf (first tokens))
                      (rest tokens)
                      cur-state))

             (and (= (first tokens) separator) (not (:in-tag? cur-state)))
             (recur out buf (rest tokens) (assoc cur-state :found-token true))

             :default
             (recur (into out (first tokens)) buf (rest tokens) (assoc cur-state :in-tag? (open-html-tags (:in-tag? cur-state) (first tokens)))))))))))

(defn escape-code-transformer [text state]
  [(escape-code text) state])

;; Not used any more internally; kept around just in case third party code
;; depends on this.
(defn separator [escape? text open close separator state]
  ((make-separator separator open close (if escape? escape-code-transformer identity))
   text state))

(def strong (make-separator "**" "<strong>" "</strong>"))

(def bold-italic (make-separator "***" "<b><i>" "</i></b>"))

(def bold (make-separator "__" "<b>" "</b>"))

(def em (make-separator "*" "<em>" "</em>"))

(def italics (make-separator "_" "<i>" "</i>"))

(def strikethrough (make-separator "~~" "<del>" "</del>"))

(def inline-code (make-separator "`" "<code>" "</code>" escape-code-transformer))

(defn inhibit [text state]
  (if *inhibit-separator*
    ((make-separator *inhibit-separator* "" "" freeze-string)
     text state)
    [text state]))

(defn escape-inhibit-separator [text state]
  [(if *inhibit-separator*
     (string/replace text
                     (string/join (concat *inhibit-separator* *inhibit-separator*))
                     (string/join *inhibit-separator*))
     text)
   state])

(defn heading-text [text]
  (-> (clojure.string/replace text #"^([ ]+)?[#]+" "")
      (clojure.string/replace #"[#]+$" "")
      ;; Strip out Hugo style anchor links
      (clojure.string/replace #"\{(#|id=)?.*\}$" "")
      string/trim))

(defn hugo-anchor
  "Extract Hugo markdown anchor links from the `text`.

  See: https://gohugo.io/content-management/cross-references/#heading-ids"
  [text]
  (when-let [groups (seq (re-find #"\{(#|id=)?(.*)\}$" text))]
    (last groups)))

(defn default-anchor
  "Build a default anchor based on a heading's text content"
  [text]
  (-> text
    heading-text
    (string/replace #"\s+" "_")
    string/lower-case
    (as-> $
      #?(:clj  (URLEncoder/encode ^String $ "UTF-8")
         :cljs (js/encodeURIComponent $)))))

(defn heading-level [text]
  (let [num-hashes (count (filter #(not= \space %) (take-while #(or (= \# %) (= \space %)) (seq text))))]
    (when (pos? num-hashes) num-hashes)))

(defn make-heading [text heading-anchors]
  (when-let [heading (heading-level text)]
    (let [htext (heading-text text)
          anchor (when heading-anchors
                   (or (hugo-anchor text)
                     (default-anchor text)))]
      ;; We do not need to process the id string, HTML5 ids can contain anything except the space character.
      ;; (https://www.w3.org/TR/html5/dom.html#the-id-attribute)
      (str "<h" heading (when anchor (str " id=\"" anchor "\"")) ">"
           htext "</h" heading ">"))))

(defn dashes [text state]
  [(if (or (:code state) (:codeblock state))
     text
     (-> text
         (string/replace #"\-\-\-" "&mdash;")
         (string/replace #"\-\-" "&ndash;")
         (string/replace #"<code>.*</code>"
                         (fn [s](-> s
                                    (string/replace #"&mdash;" "---")
                                    (string/replace #"&ndash;" "--"))))))
   state])