-
Notifications
You must be signed in to change notification settings - Fork 3
/
server.clj
159 lines (133 loc) · 4.69 KB
/
server.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
(ns shadow.markup.css.impl.server
(:require [shadow.markup.css.impl.gen :as gen]
[clojure.string :as str]
[hiccup.util :as util]
[hiccup.compiler :as comp])
(:import (clojure.lang IFn)))
(def ^:dynamic *used-elements* nil)
;; this is directly from hiccup.compiler, it is private so it is copied here
;; https://github.com/weavejester/hiccup/blob/master/src/hiccup/compiler.clj
;; modified so we don't sort and apply
;; COPY
(defn- render-style-map [value]
(->> value
(map (fn [[k v]] (str (util/as-str k) ":" v ";")))
(str/join "")))
(defn- render-attr-value [value]
(cond
(map? value)
(render-style-map value)
(sequential? value)
(str/join " " value)
:else
value))
(defn- xml-attribute [name value]
(str " " (util/as-str name) "=\"" (util/escape-html (render-attr-value value)) "\""))
(defn- render-attribute [name value]
(cond
(true? value)
(str " " (util/as-str name))
(not value)
""
:else
(xml-attribute name value)))
(defn render-attr-map
"Render a map of attributes."
[attrs]
(reduce-kv #(str %1 (render-attribute %2 %3)) "" attrs))
;; // COPY
(defn merge-props-and-class [props class]
;; FIXME: should warn if :classes and :className is present
(let [class-from-props
(or (:className props)
(when-let [classes (:classes props)]
(if (map? classes)
;; {:selected boolean-ish}
(->> classes
(keys)
(filter
(fn [key]
(get classes key)))
(map name)
(str/join " "))
;; [(when x "selected") ...]
(->> classes
(remove nil?)
(str/join " ")))))
className
(if (nil? class-from-props)
class
(str class " " class-from-props))]
(-> props
(assoc :class className)
(dissoc :classes :className))))
(defn gen-nested-html [children]
(reduce
(fn [s child]
;; FIXME: I want to drop the assumption that we are within hiccup
;; but a large part of my templates are still hiccup
;; could maybe alter-var-root the gen-nested-html to remove the reliance on hiccup
(str s (comp/render-html child)))
""
children))
(defn gen-html [el props children]
;; FIXME: be more like hiccup and let props be optional
{:pre [(map? props)]}
(let [tag
(gen/el-type el)
props
(merge-props-and-class props (gen/el-selector el))
child-html
(gen-nested-html children)]
(when *used-elements*
(vswap! *used-elements* conj el))
(str "<" tag (render-attr-map props) ">"
child-html
"</" tag ">")))
(deftype StyledElement [el-type el-selector style-fn]
gen/IElement
(el-type [_]
el-type)
(el-selector [_]
el-selector)
(el-css [_ env]
(style-fn env))
IFn
(invoke [el]
(gen-html el {} []))
(invoke [el props]
(gen-html el props []))
(invoke [el props c1]
(gen-html el props [c1]))
(invoke [el props c1 c2]
(gen-html el props [c1 c2]))
(invoke [el props c1 c2 c3]
(gen-html el props [c1 c2 c3]))
(invoke [el props c1 c2 c3 c4]
(gen-html el props [c1 c2 c3 c4]))
(invoke [el props c1 c2 c3 c4 c5]
(gen-html el props [c1 c2 c3 c4 c5]))
(invoke [el props c1 c2 c3 c4 c5 c6]
(gen-html el props [c1 c2 c3 c4 c5 c6]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15]))
(invoke [el props c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15 c16]
(gen-html el props [c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15 c16]))
(applyTo [el s]
(gen-html el (first s) (rest s))))