New architecture under way.

project.clj

@@ -1,4 +1,4 @@
-(defproject views "0.5.2"
+(defproject views "1.0.0"
   :description "You underestimate the power of the SQL side"
 
   :url "https://github.com/diligenceengine/views"
@@ -15,6 +15,7 @@
                  [org.postgresql/postgresql "9.2-1003-jdbc4"]
                  [clj-logging-config "1.9.10"]
                  [zip-visit "1.0.2"]
+                 [prismatic/plumbing "0.3.5"]
                  [pjstadig/humane-test-output "0.6.0"]]
 
   :profiles {:test {:dependencies [[org.clojure/tools.nrepl "0.2.3"]

src/views/core.clj

@@ -1,18 +1,162 @@
 (ns views.core
   (:require
-   [views.base-subscribed-views :as bsv]
-   [views.core :as vp]
-   [edl.schema :refer [denormalized-schema get-schema]]
-   [views.persistence.memory :refer [new-memory-persistence]])
-  (:import
-   [views.base_subscribed_views BaseSubscribedViews]))
-
-(defn config
-  [{:keys [db templates persistence vexec-ns-fn] :as conf}]
-  (let [schema (denormalized-schema (get-schema db (get conf :schema-name "public")))
-        conf   (if persistence conf (assoc conf :persistence (new-memory-persistence)))]
-    {:db                    db
-     :schema                schema
-     :templates             templates
-     :vexec-ns-fn           vexec-ns-fn
-     :base-subscribed-views (BaseSubscribedViews. conf)}))
+    [views.protocols :refer [IView id data relevant?]]
+    [plumbing.core :refer [swap-pair!]]))
+
+;; The view-system data structure has this shape:
+;;
+;; {:views {:id1 view1, id2 view2, ...}
+;;  :send-fn (fn [subscriber-key data] ...)
+;;
+;;  :hashes {view-sig hash, ...}
+;;  :subscribed {subscriber-key #{view-sig, ...}}
+;;  :subscribers {view-sig #{subscriber-key, ...}}
+;;  :hints #{hint1 hint2 ...}
+;;
+;;  }
+;;
+;;  Each hint has the form {:namespace x :hint y}
+
+(defn subscribe-view!
+  [view-system view-sig subscriber-key data-hash]
+  (-> view-system
+      (update-in [:subscribed subscriber-key] (fnil conj #{}) view-sig)
+      (update-in [:subscribers view-sig] (fnil conj #{}) subscriber-key)
+      (assoc-in [:hashes view-sig] data-hash)))
+
+(defn subscribe!
+  [view-system namespace view-id parameters subscriber-key]
+  (if-let [view  (get-in @view-system [:views view-id])]
+    (let [vdata (data view namespace parameters)]
+      (swap! view-system subscribe-view! [namespace view-id parameters] subscriber-key (hash vdata))
+      ((get @view-system :send-fn) subscriber-key vdata))))
+
+(defn remove-from-subscribers
+  [view-system view-sig subscriber-key]
+  (update-in view-system [:subscribers view-sig] disj subscriber-key))
+
+(defn unsubscribe!
+  [view-system namespace view-id parameters subscriber-key]
+  (swap! view-system
+         (fn [vs]
+           (-> vs
+               (update-in [:subscribed subscriber-key] disj [namespace view-id parameters])
+               (remove-from-subscribers [namespace view-id parameters] subscriber-key)))))
+
+(defn unsubscribe-all!
+  "Remove all subscriptions by a given subscriber."
+  [view-system subscriber-key]
+  (swap! view-system
+         (fn [vs]
+           (let [view-sigs (get-in vs [:subscribed subscriber-key])
+                 vs*       (update-in vs [:subscribed] dissoc subscriber-key)]
+             (reduce #(remove-from-subscribers %1 %2 subscriber-key) vs* view-sigs)))))
+
+(defn refresh-view!
+  "We refresh a view if it is relevant and its data hash has changed."
+  [view-system hints [namespace view-id parameters :as view-sig]]
+  (let [v (get-in @view-system [:views view-id])]
+    (if (relevant? v namespace parameters hints)
+      (let [vdata (data v namespace parameters)
+            hdata (hash vdata)]
+        (when-not (= hdata (get-in @view-system [:hashes view-sig]))
+          (doseq [s (get-in @view-system [:subscribers view-sig])]
+            ((:send-fn @view-system) s vdata))
+          (swap! view-system assoc-in [:hashes view-sig] hdata))))))
+
+(defn subscribed-views
+  [view-system]
+  (reduce into #{} (vals (:subscribed view-system))))
+
+(defn pop-hints!
+  "Return hints and clear hint set atomicly."
+  [view-system]
+  (let [p (swap-pair! view-system assoc :hints #{})]
+    (or (:hints (first p)) #{})))
+
+(defn refresh-views!
+  "Given a collection of hints, find all dirty views."
+  [view-system]
+  (let [hints (pop-hints! view-system)]
+    (mapv #(refresh-view! view-system hints %) (subscribed-views @view-system))
+    (swap! view-system assoc :last-update (System/currentTimeMillis))))
+
+(defn can-refresh?
+  [last-update min-refresh-interval]
+  (> (- (System/currentTimeMillis) last-update) min-refresh-interval))
+
+(defn wait
+  [last-update min-refresh-interval]
+  (Thread/sleep (max 0 (- min-refresh-interval (- (System/currentTimeMillis) last-update)))))
+
+(defn start-update-watcher!
+  "A single threaded view update mechanism."
+  [view-system min-refresh-interval]
+  (swap! view-system assoc :last-update 0)
+  (.start (Thread.  (fn [] (let [last-update (:last-update @view-system)]
+                             (if (can-refresh? last-update min-refresh-interval)
+                               (do (refresh-views! view-system) (recur))
+                               (do (wait last-update min-refresh-interval) (recur))))))))
+
+(defn add-hint!
+  "Add a hint to the system."
+  [view-system namespace hint]
+  (swap! view-system update-in [:hints] (fnil conj #{}) {:namespace namespace :hint hint}))
+
+(comment
+  (defrecord SQLView [id query-fn]
+    IView
+    (id [_] id)
+    (data [_ namespace parameters]
+      (j/query (db/firm-connection namespace) (hsql/format (apply query-fn parameters))))
+    (relevant? [_ namespace parameters hints]
+      (let [tables (query-tables (apply query-fn parameters))]
+        (boolean (some #(not-empty (intersection % talbes)) hints)))))
+
+  (def memory-system (atom {}))
+
+  (reset! memory-system {:a {:foo 1 :bar 200 :baz [1 2 3]}
+                         :b {:foo 2 :bar 300 :baz [2 3 4]}})
+
+  (defrecord MemoryView [id ks]
+    IView
+    (id [_] id)
+    (data [_ namespace parameters]
+      (get-in @memory-system (-> [namespace] (into ks) (into parameters))))
+    (relevant? [_ namespace parameters hints]
+      (some #(and (= namespace (:namespace %)) (= ks (:hint %))) hints)))
+
+  (def view-system
+    (atom
+      {:views   {:foo (MemoryView. :foo [:foo])
+                 :bar (MemoryView. :bar [:bar])
+                 :baz (MemoryView. :baz [:baz])}
+       :send-fn (fn [subscriber-key data] (println "sending to:" subscriber-key "data:" data))}))
+
+  (subscribe! view-system :a :foo [] 1)
+  (subscribe! view-system :b :foo [] 2)
+  (subscribe! view-system :b :baz [] 2)
+
+  (subscribed-views @view-system)
+
+  (doto view-system
+    (add-hint! [:foo])
+    (add-hint! [:baz]))
+
+
+  (refresh-views! view-system)
+
+  ;; Example of function that updates and hints the view system.
+  (defn massoc-in!
+    [memory-system namespace ks v]
+    (let [ms (swap! memory-system assoc-in (into [namespace] ks) v)]
+      (add-hint! view-system ks)
+      ms))
+
+  (massoc-in! memory-system :a [:foo] 1)
+  (massoc-in! memory-system :b [:baz] [2 4 3])
+
+
+  (start-update-watcher! view-system 1000)
+
+  )