Refactor to support a dynamic "style container" to render CSS into

See #12

project.clj

@@ -8,7 +8,8 @@
 
   :dependencies [[org.clojure/clojure "1.10.0"]
                  [org.clojure/clojurescript "1.10.520"]
-                 [garden "1.3.10"]]
+                 [garden "1.3.10"]
+                 [net.cgrand/macrovich "0.2.1"]]
 
   :plugins [[lein-figwheel "0.5.19"]
             [lein-cljsbuild "1.1.7" :exclusions [[org.clojure/clojure]]]]
@@ -24,7 +25,7 @@
 
   :jar-exclusions [#"(?:^|\/)public\/"]
 
-  :aliases {"test" ["do" ; "test"
+  :aliases {"test" ["do" "test"
                     ["doo" "chrome-headless" "test" "once"]]}
 
   :cljsbuild {:builds

src/spade/core.cljc

@@ -1,6 +1,8 @@
 (ns spade.core
+  #?(:cljs (:require-macros [net.cgrand.macrovich :as macros]))
   (:require [clojure.string :as str]
             [clojure.walk :refer [postwalk prewalk]]
+            #?(:clj [net.cgrand.macrovich :as macros])
             [spade.util :refer [factory->name build-style-name]]))
 
 (defn- extract-key [style]
@@ -255,7 +257,9 @@
        (defn ~factory-fn-name ~factory-params
          ~(transform-style mode style params style-name-var params-var))
 
-       (let [~factory-name-var (factory->name ~factory-fn-name)]
+       (let [~factory-name-var (factory->name
+                                #? (:cljs ~factory-fn-name
+                                    :clj (var ~factory-fn-name)))]
          ~(declare-style mode class-name params factory-name-var factory-fn-name)))))
 
 (defmacro defclass
@@ -321,3 +325,10 @@
          {:animation [[(anim-frames) \"560ms\" 'ease-in-out]]})"
   [keyframes-name params & style]
   (declare-style-fns :keyframes keyframes-name params style))
+
+(defmacro with-styles-container [container & body]
+  (macros/case
+    :cljs `(binding [spade.runtime/*style-container* ~container]
+             ~@body)
+    :clj `(with-bindings {#'spade.runtime/*style-container* ~container}
+            ~@body)))

src/spade/runtime.cljc

@@ -0,0 +1,51 @@
+(ns spade.runtime
+  (:require [clojure.string :as str]
+            [garden.core :as garden]
+            [garden.types :refer [->CSSFunction]]
+            [spade.runtime.shared :as container]
+            [spade.runtime.defaults :as defaults]))
+
+(defonce ^:dynamic *css-compile-flags*
+  {:pretty-print? #? (:cljs goog.DEBUG
+                      :clj false)})
+
+(defonce ^:dynamic *style-container* (defaults/create-container))
+
+(defn ->css-var [n]
+  (->CSSFunction "var" n))
+
+(defn compile-css [elements]
+  (garden/css *css-compile-flags* elements))
+
+(defn- compose-names [{style-name :name composed :composes}]
+  (if-not composed
+    style-name
+    (str/join " "
+              (->>
+                (if (seq? composed)
+                  (into composed style-name)
+                  [composed style-name])
+                (map (fn [item]
+                       (cond
+                         (string? item) item
+
+                         ; unpack a defattrs
+                         (and (map? item)
+                              (string? (:class item)))
+                         (:class item)
+
+                         :else
+                         (throw (ex-info
+                                  (str "Invalid argument to :composes key:"
+                                       item)
+                                  {})))))))))
+
+(defn ensure-style! [mode base-style-name factory params]
+  (let [{css :css style-name :name :as info} (apply factory base-style-name params params)]
+
+    (container/mount-style! *style-container* style-name css)
+
+    (case mode
+      :attrs {:class (compose-names info)}
+      (:class :keyframes) (compose-names info)
+      :global css)))

src/spade/runtime/atom.cljc

@@ -0,0 +1,8 @@
+(ns spade.runtime.atom
+  (:require [spade.runtime.shared :refer [IStyleContainer]]))
+
+(deftype AtomStyleContainer [styles-atom]
+  IStyleContainer
+  (mount-style! [_ style-name css]
+    (swap! styles-atom assoc style-name css)))
+

src/spade/runtime/defaults.clj

@@ -0,0 +1,7 @@
+(ns spade.runtime.defaults
+  (:require [spade.runtime.atom :refer [->AtomStyleContainer]]))
+
+(defonce shared-styles-atom (atom nil))
+
+(defn create-container []
+  (->AtomStyleContainer shared-styles-atom))

src/spade/runtime/defaults.cljs

@@ -0,0 +1,5 @@
+(ns spade.runtime.defaults
+  (:require [spade.runtime.dom :as dom]))
+
+(defn create-container []
+  (dom/create-container))

src/spade/runtime/dom.cljs

@@ -0,0 +1,49 @@
+(ns spade.runtime.dom
+  (:require [spade.runtime.shared :as container :refer [IStyleContainer]]))
+
+(defonce ^:dynamic *injected-styles* (atom nil))
+(defonce ^:dynamic *dom* nil)
+
+(defn- perform-update! [obj css]
+  (set! (.-innerHTML (:element obj)) css))
+
+(defn update! [styles-container id css]
+  (swap! styles-container update id
+         (fn update-injected-style [obj]
+           (when-not (= (:source obj) css)
+             (perform-update! obj css))
+           (assoc obj :source css))))
+
+(defn inject! [target-dom styles-container id css]
+  (let [destination (or (when (ifn? target-dom)
+                   (target-dom))
+                 target-dom
+                 (.-head js/document))
+        element (doto (js/document.createElement "style")
+                  (.setAttribute "spade-id" (str id)))
+        obj {:element element
+             :source css
+             :id id}]
+    (assert (some? destination)
+            "An <head> element or target *dom* is required to inject the style.")
+
+    (.appendChild destination element)
+
+    (swap! styles-container assoc id obj)
+    (perform-update! obj css)))
+
+(deftype DomStyleContainer [target-dom styles-container]
+  IStyleContainer
+  (mount-style! [_ style-name css]
+    (let [resolved-container (or styles-container
+                                 *injected-styles*)]
+      (if (contains? @resolved-container style-name)
+        (update! resolved-container style-name css)
+        (inject! target-dom resolved-container style-name css)))))
+
+(defn create-container
+  ([] (create-container nil))
+  ([target-dom] (create-container target-dom (when target-dom
+                                               (atom nil))))
+  ([target-dom styles-container]
+   (->DomStyleContainer target-dom styles-container)))

src/spade/runtime/shared.cljc

@@ -0,0 +1,6 @@
+(ns spade.runtime.shared)
+
+(defprotocol IStyleContainer
+  (mount-style!
+    [this style-name css]
+    "Ensure the style with the given name and CSS is available"))

src/spade/util.cljc

@@ -7,7 +7,8 @@
    factory; subsequent calls for the same factory *may not* return the
    same value (especially under :simple optimizations)."
   [factory]
-  (let [given-name (.-name factory)]
+  (let [given-name #?(:cljs (.-name factory)
+                      :clj (-> factory meta :name str))]
     (if (empty? given-name)
       ; under :simple optimizations, the way the function is declared does
       ; not leave any value for its name. so... generate one!
@@ -17,7 +18,7 @@
       ; this lets us have descriptive names in dev, and concise names in
       ; prod, without having to embed anything extra in the file
       (-> given-name
-          (str/replace "_factory$" "")
+          (str/replace #"[_-]factory\$" "")
           (str/replace #"[_$]" "-")
           (str/replace #"^-" "_")))))
 

test/spade/jvm_test.clj

@@ -0,0 +1,19 @@
+(ns spade.jvm-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [spade.runtime.atom :refer [->AtomStyleContainer]]
+            [spade.runtime]
+            [spade.core :refer [defclass with-styles-container]]))
+
+(defclass blue-class []
+  {:color "blue"})
+
+(deftest with-styles-container-test
+  (testing "Render styles to dynamically-provided Atom container"
+    (let [styles (atom nil)
+          container (->AtomStyleContainer styles)
+          style-name (with-styles-container container
+                       (blue-class))]
+      (is (= "blue-class" style-name))
+      (is (= ".blue-class{color:blue}"
+             (get @styles style-name))))))
+