Support more than one grub list

- 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

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)]
+  (d/connect uri))
-    (println "Connected to datomic at " uri)
-    conn))
 
-(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]
+(defn get-db-grubs [db list-name]
-  (->> (d/q all-grubs-query db)
+  (->> (d/q (all-grubs-query list-name) db)
        (map grub-as-map)
        vec
        (util/map-by-key :id)))
 
-(defn get-db-recipes [db]
+(defn get-db-recipes [db list-name]
-  (->> (d/q all-recipes-query db)
+  (->> (d/q (all-recipes-query list-name) db)
        (map recipe-as-map)
        vec
        (util/map-by-key :id)))
 
-(defn get-current-db-state [db]
+(defn get-current-db-state [db list-name]
-  {:grubs (get-db-grubs db)
+  {:grubs (get-db-grubs db list-name)
-   :recipes (get-db-recipes db)})
+   :recipes (get-db-recipes db list-name)})
 
-(defn get-current-state [conn]
+(defn get-current-state [conn list-name]
-  (get-current-db-state (d/db conn)))
+  (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]
+(defn retract-grub-tx [id]
-  (d/release conn))
+  [:db.fn/retractEntity [:grub/id id]])
 
-(defn diff-tx [diff]
+(defn retract-recipe-tx [id]
-  (let [grubs-upsert-tx (->> diff
+  [:db.fn/retractEntity [:recipe/id id]])
-                             :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 patch-state! [conn diff]
+(defn grubs-upsert-tx [list-name diff]
-  @(d/transact conn (diff-tx 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)

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 (<! 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 "/")
+    (cond
-      (resp/response index)
+      (= uri "/") (resp/redirect (str "/" (redirect-grub-list request)))
-      (handler 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))
+

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))))

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)

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 (<! from-client)]
               (send-message ws msg)