diff --git a/src/clj/grub/db.clj b/src/clj/grub/db.clj index 150400d..fab7a4a 100644 --- a/src/clj/grub/db.clj +++ b/src/clj/grub/db.clj @@ -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) diff --git a/src/clj/grub/server.clj b/src/clj/grub/server.clj index e446954..1ccdc8a 100644 --- a/src/clj/grub/server.clj +++ b/src/clj/grub/server.clj @@ -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 ( (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)) + diff --git a/src/clj/grub/server_sync.clj b/src/clj/grub/server_sync.clj index 7c614b0..20bfcd3 100644 --- a/src/clj/grub/server_sync.clj +++ b/src/clj/grub/server_sync.clj @@ -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)))) diff --git a/src/cljs/grub/core.cljs b/src/cljs/grub/core.cljs index 3be8bec..0e01e27 100644 --- a/src/cljs/grub/core.cljs +++ b/src/cljs/grub/core.cljs @@ -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) diff --git a/src/cljs/grub/websocket.cljs b/src/cljs/grub/websocket.cljs index 87b4a53..1bdbd6e 100644 --- a/src/cljs/grub/websocket.cljs +++ b/src/cljs/grub/websocket.cljs @@ -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 (