computersandblues.lodestone/src/computersandblues/lodestone/database.cljs

190 lines
7.1 KiB
Clojure

(ns computersandblues.lodestone.database
(:refer-clojure :exclude [count get]))
(defonce +db+ (atom nil))
(defn setup! [namespace db-version migrations]
(assert (some? (migrations db-version)) "Will not increase db version as no migration is found")
(let [request (js/indexedDB.open (str namespace) db-version)]
(js/Promise.
(fn [resolve reject]
(doto request
(.addEventListener "success"
(fn [ev]
(let [db (.-result request)]
; see https://javascript.info/indexeddb#parallel-update-problem
(.addEventListener db "versionchange"
(fn []
(.. request -result close)
(js/alert "Database is outdated! Please reload the browser window.")))
(reset! +db+ db)
(resolve @+db+ ev))))
(.addEventListener "upgradeneeded"
(fn [ev]
(let [db (.-result request)
old-version (.-oldVersion ev)
txn (-> ev .-target .-transaction)]
(js/console.log ::upgradeneeded ev db)
(doseq [version (range (inc old-version) (inc db-version))
:let [migration (migrations version)]]
(migration db txn)))))
; we don't add a listener for "blocked" events because we handle "versionchange" above
(.addEventListener "error" (fn [ev] (reject (.-result request) ev))))))))
(def transaction? (partial instance? js/IDBTransaction))
(def store? (partial instance? js/IDBObjectStore))
(defn open-store
([store-id permissions]
(open-store @+db+ store-id permissions))
([db store-id permissions]
(let [store-id (str store-id) ; simplifies using keywords as store identifiers
txn (if (transaction? db)
db
(.transaction db store-id permissions))]
(.objectStore txn store-id))))
(defn create-object-store! [db store-id key-opts]
(.createObjectStore db (str store-id) (clj->js key-opts)))
(defn create-index!
([store idx-name fields]
(create-index! store idx-name fields {}))
([store idx-name fields opts]
(.createIndex store (str idx-name) (clj->js fields) (clj->js opts))))
(defn- promisify [request]
(js/Promise. (fn [resolve reject]
(doto request
(.addEventListener "success" (fn [] (resolve (.-result request))))
(.addEventListener "error" (fn [] (reject (.-error request))))))))
(defn add!
([store-id object] (add! @+db+ store-id object))
([db store-id object]
(let [store (open-store db store-id "readwrite")
request (.add store (clj->js object))]
(promisify request))))
(defn put!
([store-id object] (put! @+db+ store-id object))
([db store-id object]
(let [store (open-store db store-id "readwrite")
request (.put store (clj->js object))]
(promisify request))))
(defn get
([store-id k] (get @+db+ store-id k))
([db store-id k]
(let [store (open-store db store-id "readonly")
request (.get store k)]
(promisify request))))
(defn get-all
([store-id key-range] (get-all @+db+ store-id key-range))
([db store-id key-range]
(let [store (open-store db store-id "readonly")
request (.getAll store key-range)]
(promisify request))))
(defn clear!
([store-id] (clear! @+db+ store-id))
([db store-id]
(let [store (open-store db store-id "readwrite")
request (.clear store)]
(promisify request))))
(defn delete!
([store-id k] (get @+db+ store-id k))
([db store-id k]
(let [store (open-store db store-id "readwrite")
request (.delete store k)]
(promisify request))))
(defn count
([store-id] (count @+db+ store-id))
([db store-id]
(let [store (open-store db store-id "readonly")
request (.count store)]
(promisify request))))
(defn open-cursor
([store-id key-range] (open-cursor @+db+ store-id key-range {:direction :asc}))
([store-id key-range opts] (open-cursor @+db+ store-id key-range opts))
([db store-id key-range {:keys [direction index]}]
(let [store (open-store db store-id "readonly")
key-range (if (= key-range ::all)
(js/IDBKeyRange.lowerBound js/Number.NEGATIVE_INFINITY)
key-range)
direction ({:asc "next" :desc "prev"} direction direction)]
(if index
(.openCursor (.index store (str index)) key-range direction)
(.openCursor store key-range direction)))))
#_(defn logging [f]
(let [n (volatile! 0)]
(fn [& args]
(when (< @n 10)
(vswap! n inc)
(js/console.log :logging args)
(apply f args)))))
(defn iterate-cursor [f cursor-req]
(.addEventListener cursor-req "success"
(fn [ev]
(if-let [cursor (-> ev .-target .-result)]
(do (f cursor)
(.continue cursor))
(f)))))
(defn transduce-cursor
"Allows to transduce over all values in a cursor.
Takes a transducer `xform`, a reducing function `rf` and an initial `init`.
If no `init` is given, it will default to `(rf)`. If no `rf` is given, the
resulting value will be a persistent vector containing the result of all steps."
([xform cursor-req]
; optimization: work with a transient vector before returning the final result
(-> (transduce-cursor xform conj! (transient []) cursor-req)
(.then persistent!)))
([xform rf cursor-req]
(transduce-cursor xform rf (rf) cursor-req))
([xform rf init cursor-req]
(let [result (volatile! init)
xform (xform rf)]
(js/Promise.
(fn [resolve _]
(iterate-cursor (fn [cursor]
(if cursor
(let [step (xform @result (.-value cursor))]
(if (reduced? step)
(resolve @step)
(vreset! result step)))
(resolve @result)))
cursor-req))))))
(defn first-result
"Given a cursor, will return a promise that resolves to the first result.
Optionally takes an `xform` that can be used to filter or transform values
returned by the cursor."
([cursor-req]
(first-result (map identity) cursor-req))
([xform cursor-req]
(transduce-cursor (comp xform (take 1)) (fn [_ x] x) nil cursor-req)))
(comment
(let [re (js/RegExp. "user" "i")]
(do (print "starting…" (js/Date.))
(-> (open-cursor ::posts ::all)
(transduce-cursor (comp (filter #(re-find re (.-content %)))
(take 50)
(map #(js->clj % :keywordize-keys true))))
(.then (fn [result]
(print "done!" (js/Date.))
(js/console.log (first result)))))))
)