michael/grub-fork
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Support more than one grub list

Browse source 
- Connecting to / redirects to /<random string>
- Connecting to /:list-name connects users to the list
  :list-name. Changes are synced only with this list.
- A cookie saves the last list visited, so future / visits go to last list
This commit is contained in:
Nicholas Kariniemi 2015-12-16 13:32:18 +02:00
parent 81f4a47d84
commit 4da9e8a617
5 changed files with 136 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

137
src/clj/grub/db.clj
View file

@ -5,7 +5,22 @@
[clojure.pprint :refer [pprint]]))
(def schema-tx [
;; list
{:db/id #db/id[:db.part/db]
:db/ident :list/name
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity
:db/doc "List name (external identifier)"
:db.install/_attribute :db.part/db}
;; grubs
{:db/id #db/id[:db.part/db]
:db/ident :grub/listid
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/one
:db/doc "Grub list entity ID"
:db.install/_attribute :db.part/db}
{:db/id #db/id[:db.part/db]
:db/ident :grub/id
:db/valueType :db.type/keyword
@ -28,6 +43,12 @@
:db.install/_attribute :db.part/db}
;; recipes
{:db/id #db/id[:db.part/db]
:db/ident :recipe/listid
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/one
:db/doc "Recipe list entity ID"
:db.install/_attribute :db.part/db}
{:db/id #db/id[:db.part/db]
:db/ident :recipe/id
:db/valueType :db.type/keyword
@ -58,29 +79,36 @@
:db.install/_attribute :db.part/db}
])
(defn add-schema-to-db [uri]
(defn add-schema-to-db [uri schema-tx]
(d/transact (d/connect uri) schema-tx) )
(defn create-db-unless-exists [uri]
(let [db-created? (d/create-database uri)]
(when db-created? @(add-schema-to-db uri))))
(when db-created? @(add-schema-to-db uri schema-tx))))
(defn connect [uri]
(create-db-unless-exists uri)
(let [conn (d/connect uri)]
(println "Connected to datomic at " uri)
conn))
(d/connect uri))
(def all-grubs-query
(defn add-list-tx [list-name]
{:db/id (d/tempid :db.part/user)
:list/name list-name})
(defn create-list-unless-exists [conn list-name]
(d/transact conn [(add-list-tx list-name)]))
(defn all-grubs-query [list-name]
[:find '?id '?text '?completed
:where
['?e :grub/listid [:list/name list-name]]
['?e :grub/id '?id]
['?e :grub/text '?text]
['?e :grub/completed '?completed]])
(def all-recipes-query
(defn all-recipes-query [list-name]
[:find '?id '?name '?grubs '?directions
:where
['?e :recipe/listid [:list/name list-name]]
['?e :recipe/id '?id]
['?e :recipe/name '?name]
['?e :recipe/grubs '?grubs]
@ -92,75 +120,88 @@
(defn recipe-as-map [[id name grubs directions]]
{:id id :name name :grubs grubs :directions directions})
(defn get-db-grubs [db]
(->> (d/q all-grubs-query db)
(defn get-db-grubs [db list-name]
(->> (d/q (all-grubs-query list-name) db)
(map grub-as-map)
vec
(util/map-by-key :id)))
(defn get-db-recipes [db]
(->> (d/q all-recipes-query db)
(defn get-db-recipes [db list-name]
(->> (d/q (all-recipes-query list-name) db)
(map recipe-as-map)
vec
(util/map-by-key :id)))
(defn get-current-db-state [db]
{:grubs (get-db-grubs db)
:recipes (get-db-recipes db)})
(defn get-current-db-state [db list-name]
{:grubs (get-db-grubs db list-name)
:recipes (get-db-recipes db list-name)})
(defn get-current-state [conn]
(get-current-db-state (d/db conn)))
(defn get-current-state [conn list-name]
(get-current-db-state (d/db conn) list-name))
(defn disconnect [conn]
(d/release conn))
(defn remove-keys-with-nil-vals [mapcoll]
(->> mapcoll
(remove (fn [[k v]] (nil? v)))
(reduce (fn [cur [k v]] (assoc cur k v)) {})))
(defn upsert-grub-tx [grub]
(defn upsert-grub-tx [list-name grub]
[(remove-keys-with-nil-vals {:db/id (d/tempid :db.part/user)
:grub/listid [:list/name list-name]
:grub/id (:id grub)
:grub/text (:text grub)
:grub/completed (:completed grub)})])
(defn upsert-recipe-tx [recipe]
(defn upsert-recipe-tx [list-name recipe]
[(remove-keys-with-nil-vals {:db/id (d/tempid :db.part/user)
:recipe/listid list-name
:recipe/id (:id recipe)
:recipe/name (:name recipe)
:recipe/grubs (:grubs recipe)
:recipe/directions (:directions recipe)})])
(defn disconnect [conn]
(d/release conn))
(defn retract-grub-tx [id]
[:db.fn/retractEntity [:grub/id id]])
(defn diff-tx [diff]
(let [grubs-upsert-tx (->> diff
:grubs
:+
(map (fn [[k v]] (assoc v :id k)))
(map upsert-grub-tx)
(flatten)
(vec))
grubs-retract-tx (->> diff
:grubs
:-
(map (fn [id] [:db.fn/retractEntity [:grub/id id]]))
(vec))
recipes-upsert-tx (->> diff
:recipes
:+
(map (fn [[k v]] (assoc v :id k)))
(map upsert-recipe-tx)
(flatten)
(vec))
recipes-retract-tx (->> diff
:recipes
:-
(map (fn [id] [:db.fn/retractEntity [:recipe/id id]]))
(vec))]
(vec (concat grubs-upsert-tx grubs-retract-tx recipes-upsert-tx recipes-retract-tx))))
(defn retract-recipe-tx [id]
[:db.fn/retractEntity [:recipe/id id]])
(defn patch-state! [conn diff]
@(d/transact conn (diff-tx diff)))
(defn grubs-upsert-tx [list-name diff]
(->> (:+ (:grubs diff))
(map (fn [[k v]] (assoc v :id k)))
(map (partial upsert-grub-tx list-name))
(flatten)
(vec)))
(defn grubs-retract-tx [diff]
(->> (:- (:grubs diff))
(map retract-grub-tx)
(vec)))
(defn recipes-upsert-tx [list-name diff]
(->> (:+ (:recipes diff))
(map (fn [[k v]] (assoc v :id k)))
(map (partial upsert-recipe-tx list-name))
(flatten)
(vec)))
(defn recipes-retract-tx [diff]
(->> (:- (:recipes diff))
(map retract-recipe-tx)
(vec)))
(defn diff-tx [list-name diff]
(vec (concat
(grubs-upsert-tx list-name diff)
(grubs-retract-tx diff)
(recipes-upsert-tx list-name diff)
(recipes-retract-tx diff))))
(defn patch-state! [conn list-name diff]
(let [tx (diff-tx list-name diff)]
@(d/transact conn tx)))
(defn report-queue-channel [conn]
(let [queue (d/tx-report-queue conn)

41
src/clj/grub/server.clj
View file

@ -4,10 +4,12 @@
[grub.server-sync :as sync]
[ring.middleware.resource :as resource]
[ring.middleware.content-type :as content-type]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.util.response :as resp]
[org.httpkit.server :as httpkit]
[clojure.core.async :as a :refer [<! >! chan go]]
[hiccup.page :as hiccup]))
[hiccup.page :as hiccup]
[grub.util :as util]))
(def prod-index-page
(hiccup/html5
@ -47,7 +49,7 @@
:port 3000
:stop-server nil})
(defn sync-client-with-db! [ws-channel db-conn db-reports]
(defn sync-client-with-db! [ws-channel list-name db-conn db-reports]
(let [from-client (chan)
to-client (chan)
diffs (chan)
@ -61,7 +63,8 @@
(a/close! full-sync-reqs)
)]
(ws/add-connected-client! ws-channel to-client from-client on-close)
(sync/start-sync! to-client diffs full-sync-reqs db-conn report-queue)
(db/create-list-unless-exists db-conn list-name)
(sync/start-sync! list-name to-client diffs full-sync-reqs db-conn report-queue)
(go (loop [] (let [event (<! from-client)]
(cond
(nil? event) nil ;; drop out of loop
@ -70,16 +73,25 @@
:else (do (println "Unknown event:" event) (recur))))))))
(defn handle-websocket [handler db-conn db-reports]
(fn [{:keys [websocket?] :as request}]
(fn [{:keys [websocket? uri] :as request}]
(if websocket?
(httpkit/with-channel request ws-channel (sync-client-with-db! ws-channel db-conn db-reports))
(let [list-name (last (clojure.string/split uri #"/"))]
(httpkit/with-channel request ws-channel (sync-client-with-db! ws-channel list-name db-conn db-reports)))
(handler request))))
(defn handle-root [handler index]
(defn random-list-name []
(util/rand-str 10))
(defn redirect-grub-list [{:keys [cookies]}]
(let [last-list (:value (get cookies "list"))]
(or last-list (random-list-name))))
(defn handle-routes [handler index]
(fn [{:keys [uri] :as request}]
(if (= uri "/")
(resp/response index)
(handler request))))
(cond
(= uri "/") (resp/redirect (str "/" (redirect-grub-list request)))
(re-matches #"/[\w]+" uri) (resp/response index)
:else (handler request))))
(defn wrap-bounce-favicon [handler]
(fn [req]
@ -91,8 +103,9 @@
(-> (fn [req] (resp/not-found "Not found"))
(resource/wrap-resource "public")
(content-type/wrap-content-type)
(handle-root index)
(handle-routes index)
(handle-websocket db-conn db-reports)
(wrap-cookies)
(wrap-bounce-favicon)))
(defn start [{:keys [port database-uri] :as system}]
@ -109,3 +122,11 @@
(stop-server)
(db/disconnect db-conn)
system)
(defn start-dev [system]
(atom (start system)))
(defn restart-dev [system-atom]
(swap! system-atom stop)
(swap! system-atom start))

14
src/clj/grub/server_sync.clj
View file

@ -21,7 +21,7 @@
(defn rand-id [] (util/rand-str 10))
(defn start-sync! [to-client diffs full-sync-reqs db-conn report-queue]
(defn start-sync! [list-name to-client diffs full-sync-reqs db-conn report-queue]
(let [id (rand-id)]
(go (loop [client-tag nil
awaiting-state? true]
@ -32,11 +32,11 @@
diffs
(let [{:keys [diff shadow-tag tag]} event
client-shadow-db (d/as-of (d/db db-conn) shadow-tag)
client-shadow-state (db/get-current-db-state client-shadow-db)
client-shadow-state (db/get-current-db-state client-shadow-db list-name)
a (debug-print (str id " " "Got diff from client: " shadow-tag " -> " tag))
{:keys [db-after]} (db/patch-state! db-conn diff)
{:keys [db-after]} (db/patch-state! db-conn list-name diff)
new-tag (d/basis-t db-after)
new-state (assoc (db/get-current-db-state db-after) :tag new-tag)
new-state (assoc (db/get-current-db-state db-after list-name) :tag new-tag)
new-shadow (assoc (diff/patch-state client-shadow-state diff) :tag tag)
return-diff (event/diff-msg new-shadow new-state)]
(debug-print (str id " " "Send diff to client : " tag " -> " new-tag))
@ -46,7 +46,7 @@
full-sync-reqs
(let [current-db (d/db db-conn)
current-tag (d/basis-t current-db)
current-state (assoc (db/get-current-db-state current-db) :tag current-tag)]
current-state (assoc (db/get-current-db-state current-db list-name) :tag current-tag)]
(debug-print (str id " " "Full sync client to : " current-tag))
(>! to-client (event/full-sync current-state))
(recur current-tag false))
@ -61,9 +61,9 @@
(recur client-tag false))
;; Changes, send them down
(let [new-state (assoc (db/get-current-db-state new-db-state) :tag new-tag)
(let [new-state (assoc (db/get-current-db-state new-db-state list-name) :tag new-tag)
client-db (d/as-of (d/db db-conn) client-tag)
client-state (assoc (db/get-current-db-state client-db) :tag client-tag)]
client-state (assoc (db/get-current-db-state client-db list-name) :tag client-tag)]
(debug-print (str id " " "Got report, send diff to client: " client-tag " -> " new-tag))
(>! to-client (event/diff-msg client-state new-state))
(recur new-tag false))))

7
src/cljs/grub/core.cljs
View file

@ -6,7 +6,14 @@
[cljs.core.async :as a :refer [<! >! chan]])
(:require-macros [cljs.core.async.macros :refer [go-loop]] ))
(defn list-name-from-url []
(last (clojure.string/split (.-location js/window) #"/")))
(defn save-list-name-from-url []
(set! (.-cookie js/document) (str "list=" (list-name-from-url))))
(defn start-app []
(save-list-name-from-url)
(let [ui-state (atom state/empty-state)
from-server (chan)
to-server (chan)

4
src/cljs/grub/websocket.cljs
View file

@ -13,7 +13,7 @@
(def protocol (.-protocol location))
(def ws-protocol (if (= protocol "http:") "ws://" "wss://"))
(def host (.-host location))
(def path (str (.-pathname location) "ws"))
(def path (str "/ws" (.-pathname location)))
(def server-url (str ws-protocol host path))
(def reader (t/reader :json))
(def writer (t/writer :json))
@ -35,7 +35,7 @@
(listen goog.net.WebSocket.EventType.OPENED #(do (println "ws connected") (a/put! to-client (event/connected))))
(listen goog.net.WebSocket.EventType.MESSAGE #(a/put! to-client (read-msg %)))
(listen goog.net.WebSocket.EventType.CLOSED #(println "ws disconnected"))
(listen goog.net.WebSocket.EventType.ERROR #(println "ws error:" %))
(listen goog.net.WebSocket.EventType.ERROR #(do (println "ws error:") (.log js/console %)))
(go (loop []
(when-let [msg (<! from-client)]
(send-message ws msg)