renderer.clj

(defn- compound-rule [r1 r2]
  (fn [type]
  	(fn [part]
  	  (fn [x v]
  	  	(((r2 type) part) x (((r1 type) part) x v))))))

(defn- apply-rule [r x]
  (if-let [f (r (:type x))]
  	(assoc x :contents
  		   (mapcat (fn [[p v]] [p (or ((f p) x v) v)])
  		   	       (:contents x)))
  	x))

(declare render-nodes)

(defmulti ^:private prepare :type)

(defmethod prepare :whitespaces [r x]
  [:raw (:raw x)])

(defmethod prepare :symbol [r x]
  [:symbol (:symbol x)])

(defmethod prepare :number [r x]
  [:number (:number x)])

(defmethod prepare :list [r x]
  [:rparen "(" :nodes (render-nodes r (:nodes x)) :lparen ")"])

(defmethod prepare :vector [r x]
  [:rbracket "[" :nodes (render-nodes r (:nodes x)) :lbracket "]"])

(defn render [r x]
  (->> (prepare r x)
  	   (assoc x :contents)
  	   (apply-rule r)
  	   :contents
  	   (partition 2)
  	   (map second)
  	   (apply str))

(defn- render-nodes [r nodes]
  (apply str (map #(render r %) nodes)))

(def fadeout-parens-rule
  (letfn [(count-preceding-parens [x]
            (loop [x x n 0]
              (if (#{:list :vector :map} (:type x))
                (recur (last (:nodes x)) (inc n))
                n)))
          (fadeout-parens [x v]
            (let [colors {1 10, 2 10, 3 20, 4 30, 5 40}
                  color (or (colors (count-preceding-parens x)) 50)]
              (terminal-256-color color v)))]
    {:list {:rparen fadeout-parens}
     :vector {:rbracket fadeout-parens}
     :map {:rbrace fadeout-parens}}))

(def rainbow-parens-rule
  (let [colors (atom (cycle (range 31 38)))
        color-stack (atom nil)
        open-fn (fn [x v]
                  (let [[color] @colors]
                    (swap! colors rest)
                    (swap! color-stack conj color)
                    (terminal-ansi-color color v)))
        close-fn (fn [x v]
                   (let [[color] @color-stack]
                     (swap! color-stack rest)
                     (terminal-ansi-color color v)))]
    {:list {:lparen open-fn, :rparen close-fn}
     :vector {:lbracket open-fn, :rbracket close-fn}
     :map {:lbrace open-fn, :rbrace close-fn}}))