Support dynamic "Style Containers" for alternate style mounting

dev/spade/demo.cljs

@@ -1,7 +1,8 @@
 (ns spade.demo
   (:require [clojure.string :as str]
-            [reagent.core :as r]
-            [spade.core :refer [defclass defattrs defglobal defkeyframes]]))
+            [reagent.dom :as rdom]
+            [spade.core :refer [defclass defattrs defglobal defkeyframes]]
+            [spade.react :as spade]))
 
 (defkeyframes anim-frames []
   ["0%" {:opacity 0}]
@@ -50,7 +51,7 @@
 (defattrs composed-attrs []
   {:composes (flex)})
 
-(defn view []
+(defn demo []
   [:<>
    [:div {:class (serenity)}
     [:div.title "Test"]]
@@ -77,8 +78,16 @@
 
    ])
 
+(defn view []
+  [:div
+   [:style#styles]
+   [demo]])
+
 (defn mount-root []
-  (r/render [view] (.getElementById js/document "app")))
+  (rdom/render
+    [spade/with-dom #(.getElementById js/document "styles")
+     [view]]
+    (.getElementById js/document "app")))
 
 (defn init!  []
   (mount-root))

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
@@ -85,7 +86,7 @@
   :profiles {:dev {:dependencies [[binaryage/devtools "0.9.10"]
                                   [figwheel-sidecar "0.5.19"]
                                   [cider/piggieback "0.4.1"]
-                                  [reagent "0.8.1"]]
+                                  [reagent "1.0.0"]]
 
                    :plugins [[lein-doo "0.1.10"]]
 

resources/public/index.html

@@ -12,6 +12,7 @@
       <h2>Figwheel template</h2>
       <p>Checkout your developer console.</p>
     </div>
+    <div id="styles"></div>
     <script src="js/compiled/spade.js" type="text/javascript"></script>
   </body>
 </html>

src/spade/container.cljc

@@ -0,0 +1,8 @@
+(ns spade.container)
+
+(defprotocol IStyleContainer
+  "The IStyleContainer represents anything that can be used by Spade to
+   'mount' styles for access by Spade style components."
+  (mount-style!
+    [this style-name css]
+    "Ensure the style with the given name and CSS is available"))

src/spade/container/alternate.cljc

@@ -0,0 +1,12 @@
+(ns spade.container.alternate
+  "The AlternateStyleContainer may be used when a preferred container
+   is not always available."
+  (:require [spade.container :as sc :refer [IStyleContainer]]))
+
+(deftype AlternateStyleContainer [get-preferred fallback]
+  IStyleContainer
+  (mount-style!
+    [_ style-name css]
+    (or (when-let [preferred (get-preferred)]
+          (sc/mount-style! preferred style-name css))
+        (sc/mount-style! fallback style-name css))))

src/spade/container/atom.cljc

@@ -0,0 +1,9 @@
+(ns spade.container.atom
+  "The AtomStyleContainer renders styles into an atom it is provided with."
+  (:require [spade.container :refer [IStyleContainer]]))
+
+(deftype AtomStyleContainer [styles-atom]
+  IStyleContainer
+  (mount-style! [_ style-name css]
+    (swap! styles-atom assoc style-name css)))
+

src/spade/container/dom.cljs

@@ -0,0 +1,61 @@
+(ns spade.container.dom
+  "The DomStyleContainer renders styles into DOM elements. References to those
+   elements are stored in a `styles` atom, or `*injected-styles*` if that is
+   not provided. Similarly, if no `target-dom` is provided, the `document.head`
+   element is used."
+  (:require [spade.container :refer [IStyleContainer]]))
+
+(defonce ^:dynamic *injected-styles* (atom 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 [element (doto (js/document.createElement "style")
+                  (.setAttribute "spade-id" (str id)))
+        obj {:element element
+             :source css
+             :id id}]
+    (assert (some? target-dom)
+            "An <head> element or target DOM is required to inject the style.")
+
+    (.appendChild target-dom element)
+
+    (swap! styles-container assoc id obj)
+    (perform-update! obj css)))
+
+(deftype DomStyleContainer [target-dom styles]
+  IStyleContainer
+  (mount-style! [_ style-name css]
+    (let [resolved-container (or styles
+                                 *injected-styles*)]
+      (if (contains? @resolved-container style-name)
+        (update! resolved-container style-name css)
+
+        (let [resolved-dom (or (when (ifn? target-dom)
+                                 (target-dom))
+                               target-dom
+                               (.-head js/document))]
+          (inject! resolved-dom resolved-container style-name css))))))
+
+(defn create-container
+  "Create a DomStyleContainer. With no args, the default is created, which
+   renders into the `document.head` element. For rendering into a custom
+   target, such as when using Shadow DOM, you may provide a custom
+   `target-dom`: this may either be the element itself, or a function which
+   returns that element.
+
+   If you also wish to provide your own storage for the style references, you
+   may use the 3-arity version and provide an atom."
+  ([] (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/core.cljc

@@ -1,6 +1,9 @@
 (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.runtime]])
             [spade.util :refer [factory->name build-style-name]]))
 
 (defn- extract-key [style]
@@ -255,7 +258,10 @@
        (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
+                                 (macros/case
+                                   :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 +327,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/react.cljs

@@ -0,0 +1,49 @@
+(ns spade.react
+  (:require [react :as react]
+            [spade.container :refer [IStyleContainer]]
+            [spade.container.alternate :refer [->AlternateStyleContainer]]
+            [spade.container.dom :as dom]
+            [spade.runtime :refer [*style-container*]]))
+
+(defonce context (react/createContext nil))
+(defonce Provider (.-Provider context))
+
+(defn- provided-container []
+  ;; NOTE: This hack is inspired by ReactN:
+  ;; https://charles-stover.medium.com/how-reactn-hacks-react-context-9d112397f003
+  (or (.-_currentValue2 context)
+      (.-_currentValue context)))
+
+;; NOTE: As soon as this namespace is used, we "upgrade" the global style-container
+;; to also check the react context
+(set! *style-container*
+      (->AlternateStyleContainer
+        provided-container
+        *style-container*))
+
+(defn with-style-container
+  "Uses the provided IStyleContainer to render the styles of the children
+   elements. This is a reagent-style React component, meant to wrap whatever
+   part of your app needs to have its styled rendered elsewhere (often the
+   root of the app), eg:
+
+     [with-style-container container
+      [your-view]]
+
+   Note that behavior in the presence of a reactively changing `container` is
+   undefined. You should expect to declare one container per render."
+  [^IStyleContainer container & children]
+  (into [:> Provider {:value container}]
+        children))
+
+(defn with-dom
+  "A convenience for rendering Spade styles into an alternate dom target.
+   The first argument may either be an actual DOM element, or a function which
+   returns one.
+
+   See `with-style-container`, which this uses under the hood."
+  [get-dom-target & _children]
+  (let [container (dom/create-container get-dom-target)]
+    (fn with-dom-render [_ & children]
+      (into [with-style-container container]
+            children))))

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.container :as sc]
+            [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)]
+
+    (sc/mount-style! *style-container* style-name css)
+
+    (case mode
+      :attrs {:class (compose-names info)}
+      (:class :keyframes) (compose-names info)
+      :global css)))