forked from krisajenkins/petrol
-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.cljs
132 lines (105 loc) · 3.8 KB
/
core.cljs
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
(ns petrol.core
(:require [cljs.core.async :as async :refer [alts! put! pipe chan <! >!]]
[clojure.set :as set])
(:require-macros [cljs.core.async.macros :refer [go-loop]]))
(defn wrap
"Apply a function to every element that comes out of a channel.
(This is fmap for channels)."
[f in]
(pipe in (chan 1 (map f))))
(defn forward
"Apply a function to every element that goes into a channel.
(This is contramap for channels)."
[f from]
(let [to (chan)]
(go-loop []
(>! from (f (<! to))))
to))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defprotocol Message
(process-message [message app]
"Given a message, take the current app state and
return the new one. In essense this is a reducing
function."))
(defprotocol EventSource
(watch-channels [message app]))
(defn process-submessage
[submessage app path]
(when (satisfies? Message submessage)
(update-in app path #(process-message submessage %))))
(defn watch-subchannels
[submessage app path wrapper]
(when (satisfies? EventSource submessage)
(->> (get-in app path)
(watch-channels submessage)
(map #(wrap wrapper %)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- get-event-value
"Given a DOM event, return the value it yields. This abstracts over
the needless inconsistencies of the DOM."
[event]
(let [target (.-target event)
type (.-type target)]
(condp contains? type
#{"checkbox"}
(.-checked target)
#{"text" "email" "password" "number" "radio" "textarea" "select-one" "select-multiple"
"date" "datetime" "datetime-local" "week" "month"
"range" "search" "tel" "time" "url" "color"}
(.-value target))))
(defn send!
"Send information from the user to the message queue.
The message must be a record which implements the Message protocol."
[channel message]
(fn [dom-event]
(put! channel message)
(.stopPropagation dom-event)))
(defn send-value!
"Send information from the user to the message queue.
Similar to `send!`, except the message-fn will be called with the message's value first."
[channel message-fn]
(fn [dom-event]
(->> dom-event
get-event-value
message-fn
(put! channel))
(.stopPropagation dom-event)))
(defn send-key!
"Send information from the user to the message queue.
Similar to `send-value!`, except the dom-event's `which` property retrieves the keycode,
and an additional filter function can be supplied by the caller to control which keycodes
are sent on the queue.
The filterfn returns the keycode if it should be sent, or nil if not."
[channel message-fn filter-fn]
(fn [dom-event]
(when-let [k (->> dom-event
.-which
filter-fn)]
(->> k
message-fn
(put! channel)))
(.stopPropagation dom-event)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private !channels
(atom #{}))
(defn start-message-loop!
([!app render-fn]
(start-message-loop! !app render-fn #{}))
([!app render-fn initial-channels]
(reset! !channels initial-channels)
(let [ui-channel (async/chan)]
(swap! !channels conj ui-channel)
(add-watch !app :render
(fn [_ _ _ app]
(render-fn ui-channel app)))
(swap! !app identity)
(go-loop []
(when-let [cs (seq @!channels)]
(let [[message channel] (alts! cs)]
(when (nil? message)
(swap! !channels disj channel))
(when (satisfies? Message message)
(swap! !app #(process-message message %)))
(when (satisfies? EventSource message)
(swap! !channels set/union (watch-channels message @!app))))
(recur))))))