Support multiple backends.

README.md

@@ -138,6 +138,12 @@ If you'd like to see the options for the benchmarking tool, just run `lein bench
 
 See the `doc/` folder for technical details of the hitchhiker tree and Redis garbage collection system.
 
+### Async support
+
+We have preliminary async support that has to be selected before macro expansion
+time by setting `hitchhiker.tree.async/*async-backend*` either to `none` or
+`core.async`.
+
 ## Gratitude
 
 Thanks to the early reviewers, Kovas Boguta & Leif Walsh.

project.clj

@@ -1,17 +1,17 @@
-(defproject hitchhiker-tree "0.1.0-SNAPSHOT"
+(defproject io.replikativ/hitchhiker-tree "0.1.2"
   :description "A Hitchhiker Tree Library"
   :url "https://github.com/dgrnbrg/hitchhiker-tree"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.8.0"]
+  :dependencies [[org.clojure/clojure "1.9.0"]
                  [org.clojure/clojurescript "1.8.51" :scope "provided"]
                  [org.clojure/core.memoize "0.5.8"]
                  [com.taoensso/carmine "2.12.2"]
                  [org.clojure/core.rrb-vector "0.0.11"]
                  [org.clojure/core.cache "0.6.5"]
 
-                 [io.replikativ/incognito "0.2.2-SNAPSHOT"]
-                 [io.replikativ/konserve "0.4.9"]]
+                 [io.replikativ/konserve "0.5.0-beta3"]
+                 ]
   :aliases {"bench" ["with-profile" "profiling" "run" "-m" "hitchhiker.bench"]}
   :jvm-opts ["-server" "-Xmx3700m" "-Xms3700m"]
   :profiles {:test
@@ -23,15 +23,18 @@
                              [org.clojure/tools.cli "0.3.3"]
                              [org.clojure/test.check "0.9.0"]
                              [com.infolace/excel-templates "0.3.3"]]}
-             :dev {:dependencies [[binaryage/devtools "0.8.2"]
-                                  [figwheel-sidecar "0.5.8"]
-                                  [com.cemerick/piggieback "0.2.1"]
-                                  [org.clojure/test.check "0.9.0"]]
+             :dev {:dependencies [#_[binaryage/devtools "0.8.2"]
+                                  #_[figwheel-sidecar "0.5.8"]
+                                  #_[com.cemerick/piggieback "0.2.1"]
+                                  [org.clojure/test.check "0.9.0"]
+                                  ;; plotting
+                                  [aysylu/loom "1.0.1"]
+                                  [cheshire "5.8.0"]]
                    :source-paths ["src" "dev"]
-                   :plugins [[lein-figwheel "0.5.8"]]
+                   ;:plugins [[lein-figwheel "0.5.8"]]
                    :repl-options {; for nREPL dev you really need to limit output
                                   :init (set! *print-length* 50)
-                                  :nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}}}
+                                  #_:nrepl-middleware #_[cemerick.piggieback/wrap-cljs-repl]}}}
   :clean-targets ^{:protect false} ["resources/public/js/compiled" "target"]
 
 

src/hitchhiker/konserve.cljc

@@ -3,13 +3,16 @@
   (:require [clojure.core.rrb-vector :refer [catvec subvec]]
             #?(:clj [clojure.core.async :refer [chan promise-chan put!] :as async]
                :cljs [cljs.core.async :refer [chan promise-chan put!] :as async])
-            [konserve.core :as k]
+            [konserve.cache :as k]
+            #?(:clj [clojure.core.cache :as cache]
+               :cljs [cljs.cache :as cache])
             [konserve.memory :refer [new-mem-store]]
             [hasch.core :refer [uuid]]
             [clojure.set :as set]
-            #?(:clj [hitchhiker.tree.core :refer [go-try <?] :as core]
+            #?(:clj [hitchhiker.tree.core :refer [go-try <? <??] :as core]
                :cljs [hitchhiker.tree.core :as core])
-            [hitchhiker.tree.messaging :as msg])
+            [hitchhiker.tree.messaging :as msg]
+            [hitchhiker.tree.async :refer [*async-backend*]])
   #?(:cljs (:require-macros [hitchhiker.tree.core :refer [go-try <?]])))
 
 
@@ -24,9 +27,20 @@
   (dirty? [_] false)
   (last-key [_] last-key)
   (resolve [_]
-    (go-try
-      (-> (<? (k/get-in store [konserve-key]))
-          (assoc :storage-addr (synthesize-storage-addr konserve-key))))))
+    ;; inline konserve cache resolution
+    (let [cache (:cache store)]
+      (if-let [v (cache/lookup @cache konserve-key)]
+        (go-try
+            #_(prn "hitting cache" konserve-key)
+          (swap! cache cache/hit konserve-key)
+          (assoc v :storage-addr (synthesize-storage-addr konserve-key)))
+        (go-try
+            #_(prn "missing cache")
+            (let [ch (k/get-in store [konserve-key])]
+              (-> (case *async-backend*
+                    :none (async/<!! ch)
+                    :core.async (<? ch))
+                  (assoc :storage-addr (synthesize-storage-addr konserve-key)))))))))
 
 
 (defrecord KonserveBackend [store]
@@ -43,42 +57,51 @@
                         (update :children (fn [cs] (mapv #(assoc % :store nil
                                                                  :storage-addr nil) cs))))
                     (assoc node :storage-addr nil))]
-        (let [id (uuid pnode)]
-          (<? (k/assoc-in store [id] node))
+        (let [id (uuid pnode)
+              ch (k/assoc-in store [id] node)]
+          (case *async-backend*
+            :none (async/<!! ch)
+            :core.async (<? ch))
           (->KonserveAddr store (core/last-key node) id (synthesize-storage-addr id))))))
   (delete-addr [_ addr session]
-    (swap! session update-in :deletes inc)))
+    (swap! session update :deletes inc)))
 
 (defn get-root-key
   [tree]
-  (-> tree :storage-addr (async/poll!)))
-
-(defn create-tree-from-root-key
-  [store root-key]
-  (go-try
-    (let [val (<? (k/get-in store [root-key]))
-          last-key (core/last-key (assoc val :storage-addr (synthesize-storage-addr root-key)))] ; need last key to bootstrap
-      (<? (core/resolve
-           (->KonserveAddr store last-key root-key (synthesize-storage-addr root-key)))))))
+  ;; TODO find out why this is inconsistent
+  (or
+    (-> tree :storage-addr (async/poll!) :konserve-key)
+    (-> tree :storage-addr (async/poll!))))
 
-
-(defn add-hitchhiker-tree-handlers [store]
-  (swap! (:read-handlers store) merge
-         {'hitchhiker.konserve.KonserveAddr
-          #(-> % map->KonserveAddr
-               (assoc :store store
-                      :storage-addr (synthesize-storage-addr (:konserve-key %))))
-          'hitchhiker.tree.core.DataNode
-          (fn [{:keys [children cfg]}]
-            (core/->DataNode (into (sorted-map-by
-                                    compare) children)
-                             (promise-chan)
-                             cfg))
-          'hitchhiker.tree.core.IndexNode
-          (fn [{:keys [children cfg op-buf]}]
-            (core/->IndexNode (->> children
-                                   vec)
+  (defn create-tree-from-root-key
+    [store root-key]
+    (go-try
+     (let [val (let [ch (k/get-in store [root-key])]
+                 (case *async-backend*
+                   :none (async/<!! ch)
+                   :core.async (<? ch)))
+            last-key (core/last-key (assoc val :storage-addr (synthesize-storage-addr root-key)))] ; need last key to bootstrap
+        (<? (core/resolve
+            (->KonserveAddr store last-key root-key (synthesize-storage-addr root-key)))))))
+
+
+  (defn add-hitchhiker-tree-handlers [store]
+    (swap! (:read-handlers store) merge
+          {'hitchhiker.konserve.KonserveAddr
+            #(-> % map->KonserveAddr
+                (assoc :store store
+                        :storage-addr (synthesize-storage-addr (:konserve-key %))))
+            'hitchhiker.tree.core.DataNode
+            (fn [{:keys [children cfg]}]
+              (core/->DataNode (into (sorted-map-by
+                                      compare) children)
                               (promise-chan)
+                              cfg))
+            'hitchhiker.tree.core.IndexNode
+            (fn [{:keys [children cfg op-buf]}]
+              (core/->IndexNode (->> children
+                                    vec)
+                                (promise-chan)
                               (vec op-buf)
                               cfg))
           'hitchhiker.tree.messaging.InsertOp

src/hitchhiker/plot.clj

@@ -0,0 +1,211 @@
+(ns hitchhiker.plot
+  "This namespace provides functions to help visualizing hh-trees.
+
+  It provides a visualization similar to those in https://youtu.be/jdn617M3-P4?t=1583
+  "
+  (:require [konserve.memory :refer [new-mem-store]]
+            [hitchhiker.konserve :as kons]
+            [konserve.cache :as kc]
+            [hitchhiker.tree.core :refer [<?? <? go-try] :as core]
+            [hitchhiker.tree.messaging :as msg]
+            [clojure.core.async :refer [promise-chan] :as async]
+            [clojure.string :as str]
+
+            [loom.io :refer [view] :as lio]
+            [loom.graph :refer [graph] :as lg]
+            [loom.derived :as deriv]
+            [loom.attr :as attr]
+
+            [cheshire.core :as json]))
+
+
+;; patch loom for compass rendering
+(ns loom.io)
+
+(defn dot-str
+  "Renders graph g as a DOT-format string. Calls (node-label node) and
+  (edge-label n1 n2) to determine what labels to use for nodes and edges,
+  if any. Weights become edge labels unless a label is specified.
+  Labels also include attributes when the graph satisfies AttrGraph."
+  [g & {:keys [graph-name node-label edge-label]
+        :or {graph-name "graph"} :as opts }]
+  (let [d? (directed? g)
+        w? (weighted? g)
+        a? (attr? g)
+        node-label (or node-label
+                       (if a?
+                         #(attr g % :label)
+                         (constantly nil)))
+        edge-label (or edge-label
+                       (cond
+                         a? #(if-let [a (attr g %1 %2 :label)]
+                               a
+                               (if w? (weight g %1 %2)))
+                         w? #(weight g %1 %2)
+                         :else (constantly nil)))
+        sb (doto (StringBuilder.
+                  (if d? "digraph \"" "graph \""))
+             (.append (dot-esc graph-name))
+             (.append "\" {\n"))]
+    (doseq [k [:graph :node :edge]]
+      (when (k opts)
+        (doto sb
+          (.append (str "  " (name k) " "))
+          (.append (dot-attrs (k opts))))))
+    (doseq [[n1 n2] (distinct-edges g)]
+      (let [n1l (str (or (node-label n1) n1))
+            n2l (str (or (node-label n2) n2))
+            el (edge-label n1 n2)
+            eattrs (assoc (if a?
+                            (attrs g n1 n2) {})
+                     :label el)]
+        (doto sb
+          (.append "  \"")
+          (.append (dot-esc n1l))
+          (.append
+           (if d? (str "\"" (when (:compass eattrs)
+                              (str ":" (:compass eattrs)))
+                       " -> \"")
+               "\" -- \""))
+          (.append (dot-esc n2l))
+          (.append \"))
+        (let [eattrs (dissoc eattrs :compass)]
+          (when (or (:label eattrs) (< 1 (count eattrs)))
+            (.append sb \space)
+            (.append sb (dot-attrs eattrs))))
+        (.append sb "\n")))
+    (doseq [n (nodes g)]
+      (doto sb
+        (.append "  \"")
+        (.append (dot-esc (str (or (node-label n) n))))
+        (.append \"))
+      (when-let [nattrs (when a?
+                          (dot-attrs (attrs g n)))]
+        (.append sb \space)
+        (.append sb nattrs))
+      (.append sb "\n"))
+    (str (doto sb (.append "}")))))
+
+
+(ns hitchhiker.plot)
+
+(def store (kons/add-hitchhiker-tree-handlers
+            (kc/ensure-cache (async/<!! (new-mem-store)))) )
+
+
+;; put a tree in the store including merkle hashes
+(def flushed (<?? (core/flush-tree
+                   (time (reduce (fn [t i]
+                                   (<?? (msg/insert t i i)))
+                                 (<?? (core/b-tree (core/->Config 3 3 3)))
+                                 (shuffle (range 1 25))))
+                   (kons/->KonserveBackend store))))
+
+
+(def flushed (<?? (core/flush-tree
+                   (time (reduce (fn [t i]
+                                   (<?? (msg/insert t i i)))
+                                 (:tree flushed)
+                                 (shuffle (range 25 50))))
+                   (kons/->KonserveBackend store))))
+
+
+
+(defn init-graph [store]
+  (apply lg/digraph
+         (->> @(:state store)
+            (filter (fn [[id {:keys [children]}]] children))
+            (map (fn [[id {:keys [children] :as node}]]
+                   (if (:op-buf node)
+                     {id (mapv (fn [c] (:konserve-key c)) children)}
+                     {id []}))))))
+
+
+(defn use-record-nodes [g]
+  (attr/add-attr-to-nodes g :shape "record" (lg/nodes g)))
+
+
+(defn node-layout [g [id {:keys [children] :as node}]]
+  (if (core/index-node? node)
+    (attr/add-attr
+     g id
+     :label (str
+             ;; key space separators
+             (str/join " | "
+                           (map #(str "<" % "> " ;; compass point (invisible)
+                                     "\\<" % "\\>")
+                                (map core/last-key (:children node))))
+             ;; render op-log
+             " | {"
+             (str/join " | " (map (fn [{:keys [key value]}]
+                                    key)
+                                  (:op-buf node)))
+             "}"))
+    (attr/add-attr
+     g id
+     :label (str (str/join "|" (map key (:children node)))))))
+
+
+(defn set-node-layouts [g store]
+  (->> @(:state store)
+     (filter (fn [[id {:keys [children]}]] children))
+     (reduce node-layout g)))
+
+(defn edge-hash [id]
+  (-> id str (subs 0 4)))
+
+(defn set-edge-layouts [g store]
+  (let [node-map @(:state store)
+        edges (lg/edges g)]
+    (reduce
+     (fn [g [n1 n2]]
+       (let [h (:konserve-key (clojure.core.async/<!!
+                               (:storage-addr (into {} (node-map n2)))))]
+         (-> g
+            (attr/add-attr-to-edges :compass (core/last-key (node-map n2))
+                                    [[n1 n2]])
+            (attr/add-attr-to-edges :label (edge-hash h) [[n1 n2]]))))
+     g
+     edges)))
+
+
+(defn create-graph [store]
+  (-> (init-graph store)
+     use-record-nodes
+     (set-node-layouts store)
+     (set-edge-layouts store)))
+
+
+
+(comment
+  (view (create-graph store))
+
+  (println (lio/dot-str g)))
+
+
+
+(defn remove-storage-addrs [[k v]]
+  (if (core/index-node? v)
+    [k (-> v
+          (dissoc :storage-addr :cfg)
+          (update :children (fn [cs] (mapv #(dissoc % :storage-addr :store) cs)))
+          (update :op-buf (fn [cs] (mapv #(into {} %) cs)))
+          )]
+    [k (dissoc v :storage-addr :cfg)]))
+
+
+(comment
+  (spit "/tmp/sample-tree.json"
+        (json/generate-string
+         (into {} (map remove-storage-addrs @(:state store)))))
+
+
+  (prn (map remove-storage-addrs @(:state store))))
+
+
+
+
+
+
+
+