Recipes can be added

This commit is contained in:
Nicholas Kariniemi 2013-09-05 12:39:10 +03:00
parent e14fb90e0f
commit d4fbae9464
15 changed files with 432 additions and 318 deletions

1
.gitignore vendored
View file

@ -1,4 +1,5 @@
/target
/out
/lib
/classes
/checkouts

View file

@ -4,34 +4,29 @@
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.5.1"]
[org.clojure/clojurescript "0.0-1909"]
[core.async "0.1.0-SNAPSHOT"]
[http-kit "2.1.8"]
[compojure "1.1.5"]
[ring/ring-devel "1.2.0"]
[ring/ring-core "1.2.0"]
[hiccup "1.0.4"]
[prismatic/dommy "0.1.1"]
[org.clojure/core.async "0.1.0-SNAPSHOT"]
[com.novemberain/monger "1.5.0"]]
:repositories {"sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"}
:profiles {:dev {:dependencies [[speclj "2.5.0"]
[specljs "2.7.4"]
[clj-webdriver "0.6.0"]]}}
:plugins [[lein-cljsbuild "0.3.2"]
[lein-ring "0.8.6"]
[speclj "2.5.0"]
[specljs "2.7.4"]]
:cljsbuild ~(let [run-specs ["phantomjs"
"bin/specljs_runner.js"
"public/js/grub_dev.js"]]
{:builds {:dev {:source-paths ["src/cljs" "spec/cljs"]
:compiler {:output-to "public/js/grub_dev.js"
:optimizations :whitespace
:pretty-print true}
:notify-command run-specs}
:prod {:source-paths ["src/cljs"]
:compiler {:output-to "public/js/grub.js"
:optimizations :simple}}
:test-commands {"test" run-specs}}})
[speclj "2.5.0"]]
:cljsbuild {:builds {:dev {:source-paths ["src/cljs"]
:compiler {:output-dir "out"
:output-to "public/js/grub_dev.js"
:source-map "public/js/grub_dev.js.map"
:optimizations :whitespace
:pretty-print false}}
:prod {:source-paths ["src/cljs"]
:compiler {:output-to "public/js/grub.js"
:optimizations :simple}}}}
:source-paths ["src/clj" "integration"]
:test-paths ["spec/clj"]
:ring {:handler grub.core/app}

1
public/.gitignore vendored
View file

@ -1,2 +1,3 @@
js/grub.js
js/grub_dev.js
js/grub_dev.js.map

View file

@ -79,3 +79,52 @@ tr:hover .grub-close {
#clear-all-btn {
float: right;
}
.recipe-panel {
padding: 0px;
}
.recipe-header {
margin: 0px;
padding: 0px;
background-color: #ffffff;
border-bottom: none;
}
.recipe-header-input {
border: none;
box-shadow: none;
transition: none;
border-bottom: none;
}
.recipe-header-input:focus {
border: none;
box-shadow: none;
transition: none;
outline: none;
}
.recipe-done-btn {
margin-left: 290px;
margin-top: 10px;
margin-bottom: 10px;
}
.recipe-steps {
}
.recipe-steps-input {
border: none;
box-shadow: none;
transition: none;
border-bottom: none;
resize: none;
}
.recipe-steps-input:focus {
border: none;
box-shadow: none;
transition: none;
border-bottom: none;
}

View file

@ -1,59 +0,0 @@
(ns grub.state-spec
(:require [specljs.core]
[grub.state :as state])
(:require-macros [specljs.core :refer [describe it before
should= should-contain
should-not-be-nil]]
[grub.macros :refer [log logs]]))
(describe
"State"
(describe
"event handling:"
(before (reset! state/grubs []))
(describe "Add"
(it "should add a grub to the state when an add event comes"
(let [test-grub {:_id 12345 :grub "testgrub" :completed true}
add-event (assoc test-grub :event :add)]
(state/handle-event add-event)
(should-contain test-grub @state/grubs))))
(describe "Complete"
(it "should complete a grub in the state when a complete event comes"
(let [test-grub {:_id 234243 :grub "testgrub" :completed false}
expected-grub (assoc test-grub :completed true)
complete-event (-> test-grub
(select-keys [:_id])
(assoc :event :complete))]
(reset! state/grubs [test-grub])
(state/handle-event complete-event)
(should-contain expected-grub @state/grubs))))
(describe "Uncomplete"
(it "should uncomplete a grub in the state when an uncomplete event comes"
(let [test-grub {:_id 234243 :grub "testgrub" :completed true}
expected-grub (assoc test-grub :completed false)
complete-event (-> test-grub
(select-keys [:_id])
(assoc :event :uncomplete))]
(reset! state/grubs [test-grub])
(state/handle-event complete-event)
(should-contain expected-grub @state/grubs))))
(describe "Delete"
(it "should delete a grub from the state when a delete event comes"
(let [test-grub {:_id 234243 :grub "testgrub" :completed true}
delete-event {:_id (:_id test-grub) :event :delete}]
(reset! state/grubs [test-grub])
(state/handle-event delete-event)
(should= [] @state/grubs))))
(describe "Clear all"
(it "should delete all grubs"
(let [test-grub {:_id 234243 :grub "testgrub" :completed true}
clear-all-event {:event :clear-all}]
(reset! state/grubs [test-grub])
(state/handle-event clear-all-event)
(should= [] @state/grubs))))))

View file

@ -3,6 +3,8 @@
[grub.db :as db]
[grub.integration-test :as integration-test]
[ring.middleware.reload :as reload]
[ring.middleware.file :as file]
[ring.util.response :as resp]
[compojure.core :refer [defroutes GET POST]]
[compojure.handler :as handler]
[compojure.route :as route]
@ -28,6 +30,8 @@
(defroutes routes
(GET "/ws" [] ws/websocket-handler)
(GET "/" [] (index-page))
(GET "*/src/cljs/grub/:file" [file] (resp/file-response file {:root "src/cljs/grub"}))
(GET "/js/public/js/:file" [file] (resp/redirect (str "/js/" file)))
(route/files "/")
(route/not-found "<p>Page not found.</p>"))

View file

@ -6,6 +6,7 @@
[clojure.core.async :as async :refer [<! >! >!! chan go close! timeout]]))
(def grub-collection "grubs")
(def recipe-collection "recipes")
(defn clear-grubs []
(mc/drop grub-collection))
@ -40,6 +41,10 @@
(defmethod handle-event :clear-all [event]
(clear-grubs))
(defmethod handle-event :add-recipe [event]
(let [recipe (select-keys event [:_id :name :steps])]
(mc/insert recipe-collection recipe)))
(defmethod handle-event :unknown-event [event]
(println "Cannot handle unknown event:" event))
@ -59,6 +64,17 @@
(>! out grub-event))))
out))
(defn get-current-recipes-as-events []
(let [recipes (mc/find-maps recipe-collection)
sorted-recipes (sort-by :_id (vec recipes))
out (chan)]
(go (doseq [recipe sorted-recipes]
(let [recipe-event (-> recipe
(select-keys [:_id :name :steps])
(assoc :event :add-recipe))]
(>! out recipe-event))))
out))
(def default-db "grub")
(defn connect-and-handle-events

View file

@ -22,6 +22,9 @@
(defn push-current-grubs-to-client [c ws-channel]
(copy-chan c (db/get-current-grubs-as-events)))
(defn push-current-recipes-to-client [c ws-channel]
(copy-chan c (db/get-current-recipes-as-events)))
(defn push-received-events-to-client [c ws-channel]
(go-loop (let [event (<! c)
event-str (str event)]
@ -50,6 +53,7 @@
(println "Request:" request)
(httpkit/on-receive ws-channel #(add-incoming-event % ws-channel-id))
(push-current-grubs-to-client c ws-channel)
(push-current-recipes-to-client c ws-channel)
(push-received-events-to-client c ws-channel))))
(handle-incoming-events)

View file

@ -1,86 +0,0 @@
(ns grub.async-utils
(:refer-clojure :exclude [map filter])
(:require [cljs.core.async :as async :refer [<! >! chan put! alts! close!]])
(:require-macros [cljs.core.async.macros :refer [go]]
[grub.macros :refer [do-chan]]))
(defn log [in]
(let [out (chan)]
(do-chan [e in]
(.log js/console e)
(>! out e))
out))
(defn put-all! [cs x]
(doseq [c cs]
(put! c x)))
(defn fan-out [in cs-or-n]
(let [cs (if (number? cs-or-n)
(repeatedly cs-or-n chan)
cs-or-n)]
(go (loop []
(let [x (<! in)]
(if-not (nil? x)
(do
(put-all! cs x)
(recur))
:done))))
cs))
(defn fan-in
([ins] (fan-in (chan) ins))
([out ins]
(go (loop [ins (vec ins)]
(when (> (count ins) 0)
(let [[x in] (alts! ins)]
(when x
(>! out x)
(recur ins))
(recur (vec (disj (set ins) in))))))
(close! out))
out))
(defn copy
([c]
(first (fan-out c 1)))
([out c]
(first (fan-out c [out]))))
(defn map [f in]
(let [out (chan)]
(go (loop []
(if-let [x (<! in)]
(do (>! out (f x))
(recur))
(close! out))))
out))
(defn map-filter [f in]
(let [out (chan)]
(go (loop []
(if-let [x (<! in)]
(do
(when-let [val (f x)]
(>! out val))
(recur))
(close! out))))
out))
(defn filter [pred in]
(let [out (chan)]
(go (loop []
(if-let [x (<! in)]
(do (when (pred x) (>! out x))
(recur))
(close! out))))
out))
(defn siphon
([in] (siphon in []))
([in coll]
(go (loop [coll coll]
(if-let [v (<! in)]
(recur (conj coll v))
coll)))))

View file

@ -1,22 +1,22 @@
(ns grub.core
(:require [grub.async-utils :as a]
[grub.view :as view]
(:require [grub.view :as view]
[grub.websocket :as ws]
[grub.state :as state]
[cljs.core.async :refer [<! >! >!! chan close! timeout]]
[cljs.core.async :as a :refer [<! >! chan]]
[cljs.reader])
(:require-macros [grub.macros :refer [log logs go-loop]]
[cljs.core.async.macros :refer [go]]))
(defn handle-grub-events []
(a/fan-out view/outgoing-events [state/incoming-events ws/incoming-events])
(a/copy state/incoming-events ws/outgoing-events)
(a/copy ws/incoming-events state/outgoing-events))
(defn wire-channels-together []
(let [to-remote (chan)
to-state (chan)
to-view (chan)
from-remote (a/mult (ws/get-remote-chan to-remote))
from-view (a/mult (view/setup-and-get-view-events to-view))]
(state/handle-incoming-events to-state)
(a/tap from-view to-state)
(a/tap from-view to-remote)
(a/tap from-remote to-state)
(a/tap from-remote to-view)))
(defn init []
(ws/connect-to-server)
(state/init)
(view/init)
(handle-grub-events))
(init)
(wire-channels-together)

View file

@ -1,7 +1,6 @@
(ns grub.dom
(:require [grub.async-utils :as a]
[dommy.core :as dommy]
[cljs.core.async :refer [<! >! chan timeout close!]])
(:require [dommy.core :as dommy]
[cljs.core.async :as a :refer [<! >! chan]])
(:require-macros [grub.macros :refer [log logs go-loop]]
[dommy.macros :refer [deftemplate sel1 node]]
[cljs.core.async.macros :refer [go]]))
@ -12,7 +11,7 @@
([el type f out]
(let [push-fn (fn [e] (when f (f e)) (go (>! out e)))
unlisten #(do (dommy/unlisten! el type push-fn)
(close! out))]
(a/close! out))]
(dommy/listen! el type push-fn)
{:chan out :unlisten unlisten})))
@ -22,7 +21,7 @@
([el type f out]
(let [push-fn (fn [e] (when f (f e)) (go (>! out e)))
unlisten #(do (dommy/unlisten! el type push-fn)
(close! out))]
(a/close! out))]
(dommy/listen-once! el type push-fn)
{:chan out :unlisten unlisten})))
@ -49,10 +48,40 @@
(defn grubs-selector []
[(sel1 :#grub-list) :.grub-item])
(defn make-recipe-node [id name steps]
(node [:div.panel.panel-default.recipe-panel {:id id}
[:div.panel-heading.recipe-header
[:input.form-control.recipe-header-input
{:id "recipe-name"
:type "text"
:placeholder "Grub pie"
:value name}]]
[:div.panel-body.recipe-steps.hidden
[:textarea.form-control.recipe-steps-input
{:id "recipe-steps"
:rows 3
:placeholder "2 grubs"
:value steps}]]
[:button.btn.btn-primary.recipe-done-btn.hidden {:type "button"} "Done"]]))
(defn add-new-recipe [id name steps]
(log "add new recipe:" name)
(let [node (make-recipe-node id name steps)
recipe-list (sel1 :#recipe-list)]
(logs "node:" node)
(logs "recipe-list:" recipe-list)
(dommy/append! recipe-list node)
node))
(def new-recipe (make-recipe-node "new-recipe" "" ""))
(defn recipes-selector []
[(sel1 :#recipe-list) :.recipe-panel])
(deftemplate main-template []
[:div.container
[:div.row.show-grid
[:div.col-lg-4]
[:div.col-lg-2]
[:div.col-lg-4
[:h3 "Grub List"]
[:div.input-group
@ -61,7 +90,10 @@
add-grub-btn]]
[:ul#grub-list.list-group]
clear-all-btn]
[:div.col-lg-4]
[:div.col-lg-4
[:h3 "Recipes"]
new-recipe
[:ul#recipe-list.list-group.recipe-list]]
[:div.col-lg-2]]])
(defn render-body []
@ -94,6 +126,13 @@
(-set-editing! [view])
(-unset-editing! [view]))
(defprotocol IExpandable
(-expand! [view])
(-unexpand! [view]))
(defprotocol IClearable
(-clear! [view]))
(extend-type js/HTMLElement
IActivatable
(-activate! [view]
@ -117,4 +156,18 @@
(-unset-editing! [view]
(dommy/remove-class! view :edit)))
(extend-type js/HTMLDivElement
IExpandable
(-expand! [view]
(dommy/remove-class! (sel1 view ".recipe-steps") :hidden)
(dommy/remove-class! (sel1 view ".recipe-done-btn") :hidden))
(-unexpand! [view]
(dommy/add-class! (sel1 view ".recipe-steps") :hidden)
(dommy/add-class! (sel1 view ".recipe-done-btn") :hidden)))
(extend-type js/HTMLDivElement
IClearable
(-clear! [view]
(dommy/set-value! (sel1 view "#recipe-name") "")
(dommy/set-value! (sel1 view "#recipe-steps") "")))

View file

@ -6,18 +6,3 @@
(defmacro logs [& args]
(let [strings (map (fn [a] `(pr-str ~a)) args)]
`(.log js/console ~@strings)))
(defmacro go-loop [& body]
`(cljs.core.async.macros/go
(while true
~@body)))
(defmacro do-chan [[binding chan] & body]
`(let [chan# ~chan]
(cljs.core.async.macros/go
(loop []
(if-let [~binding (cljs.core.async/<! chan#)]
(do
~@body
(recur))
:done)))))

View file

@ -1,11 +1,8 @@
(ns grub.state
(:require [grub.async-utils :as a]
[cljs.core.async :refer [chan <!]])
(:require-macros [grub.macros :refer [log logs go-loop]]
[cljs.core.async.macros :refer [go]]))
(:require [cljs.core.async :as a :refer [chan <!]])
(:require-macros [grub.macros :refer [log logs]]
[cljs.core.async.macros :refer [go go-loop]]))
(def incoming-events (chan))
(def outgoing-events (chan))
(def grubs (atom []))
@ -56,9 +53,8 @@
(defmethod handle-event :unknown-event [event]
(logs "Cannot handle unknown event:" event))
(defn handle-incoming-events []
(go-loop (let [event (<! incoming-events)]
(handle-event event))))
(defn init []
(handle-incoming-events))
(defn handle-incoming-events [incoming-events]
(go-loop []
(let [event (<! incoming-events)]
(handle-event event)
(recur))))

View file

@ -1,30 +1,36 @@
(ns grub.view
(:require [grub.async-utils :as a]
[grub.state :as state]
(:require [grub.state :as state]
[grub.dom :as dom]
[dommy.core :as dommy]
[cljs.core.async :refer [<! >! chan timeout close!]])
(:require-macros [grub.macros :refer [log logs go-loop do-chan]]
[cljs.core.async :as a :refer [<! >! chan]])
(:require-macros [grub.macros :refer [log logs do-chan]]
[dommy.macros :refer [deftemplate sel1 node]]
[cljs.core.async.macros :refer [go]]))
[cljs.core.async.macros :refer [go go-loop]]))
(def outgoing-events (chan))
(defn re-render-when-state-changes []
(add-watch state/grubs
:grub-add-watch
(fn [key ref old new]
(if (empty? new)
(dom/-hide! dom/clear-all-btn)
(dom/-show! dom/clear-all-btn))
(dom/render-grub-list new))))
(defn get-grubs-from-clicks []
(->> (:chan (dom/listen dom/add-grub-btn :click))
(a/map #(dom/get-add-grub-text))))
(a/map< #(dom/get-add-grub-text))))
(defn get-grubs-from-enter []
(->> (:chan (dom/listen dom/add-grub-text :keyup))
(a/filter #(= (.-keyIdentifier %) "Enter"))
(a/map #(dom/get-add-grub-text))))
(a/filter< #(= (.-keyIdentifier %) "Enter"))
(a/map< #(dom/get-add-grub-text))))
(defn get-created-events []
(let [grubs (a/fan-in [(get-grubs-from-clicks)
(get-grubs-from-enter)])]
(let [grubs (a/merge [(get-grubs-from-clicks)
(get-grubs-from-enter)])]
(->> grubs
(a/filter #(not (empty? %)))
(a/map (fn [g] {:grub g})))))
(a/filter< #(not (empty? %)))
(a/map< (fn [g] {:grub g})))))
(defn get-clear-all-events []
(:chan (dom/listen dom/clear-all-btn :click)))
@ -43,7 +49,14 @@
(defn get-enters []
(->> (:chan (dom/listen (sel1 :body) :keyup))
(a/filter #(= (.-keyIdentifier %) "Enter"))))
(a/filter< #(= (.-keyIdentifier %) "Enter"))))
(defn get-new-recipe-clicks []
(:chan (dom/listen dom/new-recipe :click)))
(defn get-edit-recipe-clicks []
(->> (:chan (dom/listen (dom/recipes-selector) :click))
(a/map< (fn [e] (log "edit-recipe-click:" (.-selectedTarget e)) {:elem (.-selectedTarget e)}))))
(defn parse-completed-event [event]
(let [target (.-selectedTarget event)
@ -52,84 +65,226 @@
event-type (if completed :uncomplete :complete)]
{:_id id :event event-type}))
(defn re-render-when-state-changes []
(add-watch state/grubs
:grub-add-watch
(fn [key ref old new]
(if (empty? new)
(dom/-hide! dom/clear-all-btn)
(dom/-show! dom/clear-all-btn))
(dom/render-grub-list new))))
(defmulti enter-state
(fn [old-state new-state-name args]
new-state-name)
:default :unhandled)
(defn event-loop []
(defmethod enter-state :unhandled [old-state new-state-name args]
(logs "Unhandled enter transition from " (:name old-state) "to" new-state-name)
old-state)
(defmulti exit-state
(fn [state]
(:name state))
:default :unhandled)
(defmethod exit-state :unhandled [state]
(logs "Unhandled exit transition from " (:name state))
state)
(defn transition [state new-state-name & args]
(logs "transition from" (:name state) "to" new-state-name)
(-> state
(exit-state)
(enter-state new-state-name args)
(assoc :name new-state-name)))
(defmulti handle-event
(fn [state event]
[(:name state) (:event event)])
:default [:unhandled-state :unhandled-event])
(defmethod handle-event [:unhandled-state :unhandled-event] [state event]
(logs "Unhandled event [" (:name state) (:event event) "]")
state)
(defmethod handle-event [:default :created] [state event]
(let [add-event (-> event
(assoc :event :add)
(assoc :_id (str "grub-" (.now js/Date)))
(assoc :completed false))]
(go (>! (:out state) add-event))
(dom/clear-add-grub-text)
state))
(defmethod handle-event [:default :clear-all] [state event]
(go (>! (:out state) {:event :clear-all}))
state)
(defmethod handle-event [:default :mousedown] [state event]
(let [mouseevent (:data event)]
(dom/-activate! (.-selectedTarget mouseevent))
(let [now (.now js/Date)
new-state (assoc state :mousedown-time now)]
(go (<! (a/timeout 500))
(>! (:edit (:channels state))
{:mousedown-time now :elem (.-selectedTarget mouseevent)}))
new-state)))
(defmethod handle-event [:default :mouseup] [state event]
(dom/-deactivate! (.-selectedTarget (:data event)))
(go (>! (:out state) (parse-completed-event (:data event))))
(let [new-state (assoc state :mousedown-time nil)]
new-state))
(defmethod handle-event [:default :mouseleave] [state event]
(dom/-deactivate! (.-selectedTarget (:data event)))
state)
(defmethod handle-event [:default :edit] [state event]
(if (and (:mousedown-time state)
(= (:mousedown-time event)
(:mousedown-time state)))
(transition state :edit-grub (:elem event))
state))
(defmethod handle-event [:default :new-recipe-click] [state event]
(transition state :new-recipe))
(defmethod handle-event [:default :edit-recipe-click] [state event]
(transition state :edit-recipe (:elem event)))
(defmethod handle-event [:default :add-recipe] [state event]
(log "handle event add-recipe")
(dom/add-new-recipe (:_id event) (:name event) (:steps event))
state)
(defmethod enter-state :edit-grub [old-state new-state-name [edit-elem]]
(dom/-set-editing! edit-elem)
(assoc old-state :edit-elem edit-elem))
(defmethod exit-state :edit-grub [state]
(let [edit-elem (:edit-elem state)]
(dom/-unset-editing! edit-elem)
(let [grub-text (.-value (sel1 edit-elem :.grub-input))
id (.-id edit-elem)
update-event {:event :update :grub grub-text :_id id}
new-state (dissoc state :edit-elem)]
(go (>! (:out state) update-event))
new-state)))
(defmethod handle-event [:edit-grub :body-click] [state event]
(let [clicked-elem (.-target (:data event))
edit-elem (:edit-elem state)]
(if (dommy/descendant? clicked-elem edit-elem)
state
(transition state :default))))
(defmethod handle-event [:edit-grub :enter] [state event]
(transition state :default))
(defmethod enter-state :new-recipe [old-state new-state-name args]
(dom/-expand! dom/new-recipe)
old-state)
(defn get-new-recipe-info []
(let [name (.-value (sel1 dom/new-recipe "#recipe-name"))
steps (.-value (sel1 dom/new-recipe "#recipe-steps"))]
(when (not (or (empty? name) (empty? steps)))
(let [id (str "recipe-" (.now js/Date))]
{:name name :steps steps :_id id}))))
(defmethod exit-state :new-recipe [state]
(dom/-unexpand! dom/new-recipe)
(let [recipe-info (get-new-recipe-info)]
(if recipe-info
(let [recipe-node (dom/add-new-recipe (:_id recipe-info)
(:name recipe-info)
(:steps recipe-info))]
(log "new recipe name:" (:name recipe-info) "steps" (:steps recipe-info))
(dom/-clear! dom/new-recipe)
(go (>! (:out state) (assoc recipe-info :event :add-recipe)))
(assoc state
:recipes (assoc (:recipes state) (.-id recipe-node) recipe-node)))
state)))
(defmethod handle-event [:new-recipe :body-click] [state event]
(log "new-recipe body click")
(let [clicked-elem (.-target (:data event))
recipe-panel (sel1 ".recipe-panel")]
(if (dommy/descendant? clicked-elem recipe-panel)
state
(transition state :default))))
(defmethod enter-state :edit-recipe [old-state new-state-name [elem]]
(dom/-expand! elem)
(assoc old-state :edit-elem elem))
(defmethod exit-state :edit-recipe [state]
(let [recipe-node (:edit-elem state)
recipe-name (.-value (sel1 recipe-node "#recipe-name"))
recipe-steps (.-value (sel1 recipe-node "#recipe-steps"))]
(log "update recipe new name:" recipe-name "new steps:" recipe-steps)
(dom/-unexpand! recipe-node)
(-> state
(dissoc :edit-elem))))
(defmethod handle-event [:edit-recipe :body-click] [state event]
(log "edit-recipe body click")
(let [clicked-elem (.-target (:data event))
recipe-node (:edit-elem state)]
(if (dommy/descendant? clicked-elem recipe-node)
state
(transition state :default))))
(defn main-loop [channels]
(let [out (chan)
created (get-created-events)
clear-all (get-clear-all-events)
mousedown (get-grub-mousedown-events)
mouseup (get-grub-mouseup-events)
mouseleave (get-grub-mouseleave-events)
body-click (get-body-clicks)
edit (chan)
enter (get-enters)]
(go (loop [mousedown-time nil
edit-elem nil]
(let [[event c] (alts! [created clear-all mousedown
mouseup mouseleave edit body-click
enter])]
(if edit-elem
(cond
(or (and (= c body-click)
(not (dommy/descendant? (.-target event) edit-elem)))
(= c enter))
(do (dom/-unset-editing! edit-elem)
(let [grub-text (.-value (sel1 edit-elem :.grub-input))
id (.-id edit-elem)]
(>! out {:event :update
:grub grub-text
:_id id}))
(recur nil nil))
:else (recur nil edit-elem))
(cond
(= c created)
(let [add-event (-> event
(assoc :event :add)
(assoc :_id (str "grub-" (.now js/Date)))
(assoc :completed false))]
(>! out add-event)
(dom/clear-add-grub-text)
(recur mousedown-time edit-elem))
(= c clear-all)
(do (>! out {:event :clear-all})
(recur mousedown-time edit-elem))
(= c mousedown)
(do (dom/-activate! (.-selectedTarget event))
(let [now (.now js/Date)]
(go (<! (timeout 500))
(>! edit {:mousedown-time now :elem (.-selectedTarget event)}))
(recur now edit-elem)))
(= c mouseup)
(do (dom/-deactivate! (.-selectedTarget event))
(>! out (parse-completed-event event))
(recur nil edit-elem))
(= c mouseleave)
(do (dom/-deactivate! (.-selectedTarget event))
(recur nil edit-elem))
(= c edit)
(if (and mousedown-time (= (:mousedown-time event) mousedown-time))
(do (dom/-set-editing! (:elem event))
(recur nil (:elem event)))
(recur nil edit-elem))
:else (recur mousedown-time edit-elem))))))
events (chan)
event-mix (a/mix events)]
(doseq [[name c] (seq channels)] (a/admix event-mix c))
(go-loop [state {:name :default
:channels channels
:out out
:recipes {}}]
(let [event (<! events)]
(logs "handle event" (:name state) event)
(recur (handle-event state event))))
out))
(defn init []
(defn get-raw-view-channels []
{:created (get-created-events)
:clear-all (get-clear-all-events)
:mousedown (get-grub-mousedown-events)
:mouseup (get-grub-mouseup-events)
:mouseleave (get-grub-mouseleave-events)
:body-click (get-body-clicks)
:edit (chan)
:enter (get-enters)
:new-recipe-click (get-new-recipe-clicks)
:edit-recipe-click (get-edit-recipe-clicks)})
(defn append-event-name-to-channel-events [channels]
(into {}
(for [[name c] channels]
[name (a/map< (fn [e]
(if (map? e)
(assoc e :event name)
{:event name :data e}))
c)])))
(defn get-named-channels [remote-channel]
(let [raw-view-channels (get-raw-view-channels)
named-view-channels (append-event-name-to-channel-events raw-view-channels)]
(assoc named-view-channels :remote-channel remote-channel)))
(defn setup-and-get-view-events [remote-channel]
(dom/render-body)
(re-render-when-state-changes)
(a/copy outgoing-events (event-loop)))
(main-loop (get-named-channels remote-channel)))

View file

@ -1,31 +1,31 @@
(ns grub.websocket
(:require [grub.async-utils
:refer [fan-in fan-out event-chan filter-chan do-chan do-chan! map-chan]]
[cljs.core.async :refer [<! >! >!! chan close! timeout]]
(:require [cljs.core.async :as a :refer [<! >! chan]]
[cljs.reader])
(:require-macros [cljs.core.async.macros :refer [go]]
[grub.macros :refer [log logs go-loop]]))
(def incoming-events (chan))
(def outgoing-events (chan))
(:require-macros [cljs.core.async.macros :refer [go go-loop]]
[grub.macros :refer [log logs]]))
(def websocket* (atom nil))
(defn handle-incoming-events []
(go-loop
(let [event (<! incoming-events)]
(.send @websocket* event))))
(defn send-outgoing-events [ch]
(go-loop []
(let [event (<! ch)]
(.send @websocket* event)
(recur))))
(defn handle-outgoing-events []
(aset @websocket* "onmessage" (fn [event]
(let [grub-event (cljs.reader/read-string (.-data event))]
(go (>! outgoing-events grub-event))))))
(defn receive-remote-events []
(let [out (chan)]
(aset @websocket*
"onmessage"
(fn [event]
(let [grub-event (cljs.reader/read-string (.-data event))]
(go (>! out grub-event)))))
out))
(defn connect-to-server []
(defn get-remote-chan [to-remote]
(let [server-url (str "ws://" (.-host (.-location js/document)) "/ws")]
(reset! websocket* (js/WebSocket. server-url))
(aset @websocket* "onopen" (fn [event] (log "Connected:" event)))
(aset @websocket* "onclose" (fn [event] (log "Connection closed:" event)))
(aset @websocket* "onerror" (fn [event] (log "Connection error:" event)))
(handle-incoming-events)
(handle-outgoing-events)))
(send-outgoing-events to-remote)
(receive-remote-events)))