refactor: replace core.async with promesa for all async operations

- Store protocol now returns promesa promises instead of core.async channels
- MemoryStore: `(p/resolved val)` replaces chan+put!+close! ceremony
- IDBStore: `p/create` with resolve/reject wraps IDB callbacks
- sync.cljc: CLJ uses `p/vthread`, CLJS returns native Promise chains
- core.cljc: `p/let` replaces go blocks, timer-based sync loop replaces
  go-loop+alts!, debounced push replaces kick channel
- Tests use `deref` with timeout on promesa promises
- Todomvc example uses `p/let` instead of go/<!
This commit is contained in:
Florian Schroedl
2026-04-16 20:05:08 +02:00
parent fffd934262
commit 973b079ae3
9 changed files with 360 additions and 321 deletions

View File

@@ -1,6 +1,6 @@
{:paths ["src"]
:deps {org.clojure/clojure {:mvn/version "1.12.0"}
org.clojure/core.async {:mvn/version "1.7.701"}
funcool/promesa {:mvn/version "11.0.678"}
http-kit/http-kit {:mvn/version "2.8.0"}
com.cognitect/transit-clj {:mvn/version "1.0.333"}
com.taoensso/nippy {:mvn/version "3.4.2"}
@@ -18,12 +18,10 @@
;; ClojureScript client build
:cljs {:extra-paths ["example/todomvc"]
:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
org.clojure/core.async {:mvn/version "1.7.701"}}
com.cognitect/transit-cljs {:mvn/version "0.8.280"}}
:main-opts ["-m" "cljs.main" "-co" "build.edn" "-c"]}
:cljs-dev {:extra-paths ["example/todomvc"]
:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
org.clojure/core.async {:mvn/version "1.7.701"}}
com.cognitect/transit-cljs {:mvn/version "0.8.280"}}
:main-opts ["-m" "cljs.main" "-co" "build.edn" "-w" "src:example/todomvc/pocketbook" "-c"]}}}

View File

@@ -3,7 +3,7 @@
(:require [pocketbook.core :as pb]
[pocketbook.store.idb :as idb]
[pocketbook.hiccup :refer [html]]
[cljs.core.async :refer [go <!]]
[promesa.core :as p]
[clojure.string :as str]))
;; ---------------------------------------------------------------------------
@@ -232,9 +232,8 @@
;; ---------------------------------------------------------------------------
(defn ^:export init []
(go
(let [store (<! (idb/open "pocketbook-todomvc"))
todos (pb/synced-atom store "todo"
(p/let [store (idb/open "pocketbook-todomvc")]
(let [todos (pb/synced-atom store "todo"
{:server "http://localhost:8090/sync"
:interval 15000})]
(reset! !conn store)
@@ -248,7 +247,7 @@
(.addEventListener js/window "online" (fn [_] (render!)))
(.addEventListener js/window "offline" (fn [_] (render!)))
;; Wait for IDB — watch triggers render automatically
(<! (pb/ready? todos))
(js/console.log "🔶 Pocketbook TodoMVC loaded —" (count @todos) "todos"))))
(p/let [_ (pb/ready? todos)]
(js/console.log "🔶 Pocketbook TodoMVC loaded —" (count @todos) "todos")))))
(init)

View File

@@ -2,18 +2,18 @@
"Pocketbook: a Clojure-native synced atom.
Usage:
(def store (<! (idb/open \"my-app\"))) ;; or (memory/create)
(def store @(idb/open \"my-app\")) ;; or (memory/create)
(def todos (pb/synced-atom store \"todo\"
{:server \"http://localhost:8090/sync\"}))
(go (<! (ready? todos))
(swap! todos assoc \"todo:1\" {:text \"Buy milk\"}))
(.then (ready? todos)
(fn [_] (swap! todos assoc \"todo:1\" {:text \"Buy milk\"})))
@todos ;=> {\"todo:1\" {:text \"Buy milk\"}}
"
(:require [pocketbook.store :as store]
[pocketbook.sync :as sync]
[clojure.string :as str]
#?(:clj [clojure.core.async :as async :refer [go go-loop <! >! chan put! timeout alts!]]
:cljs [cljs.core.async :as async :refer [go go-loop <! >! chan put! timeout alts!]])))
[promesa.core :as p])
#?(:clj (:import [java.util.concurrent Executors ScheduledExecutorService TimeUnit])))
;; ---------------------------------------------------------------------------
;; Internal helpers
@@ -26,13 +26,19 @@
(defn- prefix-str [group]
(str group ":"))
;; ---------------------------------------------------------------------------
;; Forward declarations
;; ---------------------------------------------------------------------------
(declare schedule-push!)
;; ---------------------------------------------------------------------------
;; Shared reset logic
;; ---------------------------------------------------------------------------
(defn- do-reset!*
"Shared reset implementation. Updates cache, tracks pending, writes to store, kicks sync."
[store cache versions pending kick-ch new-val]
[store cache versions pending sa new-val]
(let [old @cache]
(reset! cache new-val)
(let [all-keys (into (set (keys old)) (keys new-val))
@@ -50,7 +56,7 @@
{:id k :value v :version (get @versions k 0)
:updated (now-ms) :deleted false :synced false})))))
(when @changed?
(put! kick-ch :kick)))
(schedule-push! sa)))
new-val))
;; ---------------------------------------------------------------------------
@@ -64,9 +70,11 @@
pending ;; atom containing #{id} — unsynced ids
server-opts ;; {:server url} or nil
last-sync ;; atom containing epoch ms
ready-ch ;; channel, closed when initial load complete
stop-ch ;; channel to signal stop
kick-ch ;; channel to trigger immediate push
ready-pr ;; promesa deferred, resolved when initial load complete
sync-timer ;; atom holding timer reference (for cleanup)
push-timer ;; atom holding debounce timer reference
pushing? ;; atom boolean — guard against overlapping pushes
syncing? ;; atom boolean — guard against overlapping syncs
cleanup-fn ;; atom holding connectivity cleanup fn
sync-interval ;; ms
_meta] ;; metadata atom
@@ -83,8 +91,8 @@
(setValidator [_ _vf] nil)
clojure.lang.IAtom
(reset [_ newval]
(do-reset!* store cache versions pending kick-ch newval))
(reset [this newval]
(do-reset!* store cache versions pending this newval))
(swap [this f]
(.reset this (f @cache)))
(swap [this f arg]
@@ -105,8 +113,8 @@
(-deref [_] @cache)
IReset
(-reset! [_ new-val]
(do-reset!* store cache versions pending kick-ch new-val))
(-reset! [this new-val]
(do-reset!* store cache versions pending this new-val))
ISwap
(-swap! [o f]
@@ -142,31 +150,28 @@
(defn- load-from-store!
"Load all docs for the group from the store into the atom.
Returns a channel that closes when done."
Returns a promise that resolves when done."
[sa]
(let [ch (chan 1)]
(go
(let [prefix (prefix-str (.-group sa))
docs (<! (store/docs-by-prefix (.-store sa) prefix))
state (into {}
(comp
(remove :deleted)
(map (fn [d] [(:id d) (:value d)])))
docs)
vers (into {}
(map (fn [d] [(:id d) (:version d)]))
docs)]
(reset! (.-cache sa) state)
(reset! (.-versions sa) vers)
(let [ls (<! (store/get-meta (.-store sa)
(str "last-sync:" (.-group sa))))]
(reset! (.-last_sync sa) (or ls 0)))
(put! ch true)
(async/close! ch)))
ch))
(p/let [prefix (prefix-str (.-group sa))
docs (store/docs-by-prefix (.-store sa) prefix)
state (into {}
(comp
(remove :deleted)
(map (fn [d] [(:id d) (:value d)])))
docs)
vers (into {}
(map (fn [d] [(:id d) (:version d)]))
docs)
_ (do (reset! (.-cache sa) state)
(reset! (.-versions sa) vers))
ls (store/get-meta (.-store sa)
(str "last-sync:" (.-group sa)))]
(reset! (.-last_sync sa) (or ls 0))
true))
(defn- mark-synced!
"Mark a doc as synced in the store and update its version."
"Mark a doc as synced in the store and update its version.
Returns a promise."
[sa id version]
(swap! (.-versions sa) assoc id version)
(swap! (.-pending sa) disj id)
@@ -184,117 +189,164 @@
;; ---------------------------------------------------------------------------
(defn- do-pull!
"Pull changes from server, merge into atom + store."
"Pull changes from server, merge into atom + store. Returns a promise."
[sa]
(go
(when-let [opts (.-server_opts sa)]
(let [since @(.-last_sync sa)
result (<! (sync/pull! opts (.-group sa) since))]
(when (:ok result)
(let [docs (:docs result)
max-ts (reduce max @(.-last_sync sa)
(map :updated docs))]
(doseq [doc docs]
(let [id (:id doc)]
(when (> (:version doc) (get @(.-versions sa) id 0))
(if (:deleted doc)
(do
(swap! (.-cache sa) dissoc id)
(swap! (.-versions sa) assoc id (:version doc))
(store/put-doc! (.-store sa)
{:id id :value nil :version (:version doc)
:updated (:updated doc) :deleted true :synced true}))
(do
(swap! (.-cache sa) assoc id (:value doc))
(swap! (.-versions sa) assoc id (:version doc))
(store/put-doc! (.-store sa)
{:id id :value (:value doc) :version (:version doc)
:updated (:updated doc) :deleted false :synced true}))))))
(if-let [opts (.-server_opts sa)]
(p/let [since @(.-last_sync sa)
result (sync/pull! opts (.-group sa) since)]
(when (:ok result)
(let [docs (:docs result)
max-ts (reduce max @(.-last_sync sa)
(map :updated docs))]
(p/let [_ (p/all
(for [doc docs
:let [id (:id doc)]
:when (> (:version doc) (get @(.-versions sa) id 0))]
(if (:deleted doc)
(do
(swap! (.-cache sa) dissoc id)
(swap! (.-versions sa) assoc id (:version doc))
(store/put-doc! (.-store sa)
{:id id :value nil :version (:version doc)
:updated (:updated doc) :deleted true :synced true}))
(do
(swap! (.-cache sa) assoc id (:value doc))
(swap! (.-versions sa) assoc id (:version doc))
(store/put-doc! (.-store sa)
{:id id :value (:value doc) :version (:version doc)
:updated (:updated doc) :deleted false :synced true})))))]
(reset! (.-last_sync sa) max-ts)
(store/set-meta! (.-store sa)
(str "last-sync:" (.-group sa)) max-ts))
true)))))
(str "last-sync:" (.-group sa)) max-ts)))))
(p/resolved nil)))
(defn- do-push!
"Push all unsynced local docs to the server."
"Push all unsynced local docs to the server. Returns a promise."
[sa]
(go
(when-let [opts (.-server_opts sa)]
(let [pending-ids @(.-pending sa)]
(when (seq pending-ids)
(let [docs (mapv (fn [id]
(let [v (get @(.-cache sa) id)]
(if (nil? v)
{:id id :deleted true
:base-version (get @(.-versions sa) id 0)}
{:id id :value v
:base-version (get @(.-versions sa) id 0)})))
pending-ids)
result (<! (sync/push! opts docs))]
(if-let [opts (.-server_opts sa)]
(let [pending-ids @(.-pending sa)]
(if (seq pending-ids)
(let [docs (mapv (fn [id]
(let [v (get @(.-cache sa) id)]
(if (nil? v)
{:id id :deleted true
:base-version (get @(.-versions sa) id 0)}
{:id id :value v
:base-version (get @(.-versions sa) id 0)})))
pending-ids)]
(p/let [result (sync/push! opts docs)]
(when (:ok result)
(doseq [r (:results result)]
(case (:status r)
:ok
(<! (mark-synced! sa (:id r) (:version r)))
(p/all
(for [r (:results result)]
(case (:status r)
:ok
(mark-synced! sa (:id r) (:version r))
:conflict
(do
(when (:value r)
(swap! (.-cache sa) assoc (:id r) (:value r)))
(swap! (.-versions sa) assoc (:id r) (:current-version r))
(swap! (.-pending sa) disj (:id r))
(store/put-doc! (.-store sa)
{:id (:id r)
:value (or (:value r) (get @(.-cache sa) (:id r)))
:version (:current-version r)
:updated (now-ms)
:deleted false
:synced true}))
:conflict
(do
(when (:value r)
(swap! (.-cache sa) assoc (:id r) (:value r)))
(swap! (.-versions sa) assoc (:id r) (:current-version r))
(swap! (.-pending sa) disj (:id r))
(store/put-doc! (.-store sa)
{:id (:id r)
:value (or (:value r) (get @(.-cache sa) (:id r)))
:version (:current-version r)
:updated (now-ms)
:deleted false
:synced true}))
;; Unknown status
#?(:clj (println "Unknown push result:" (pr-str r))
:cljs (js/console.warn "Unknown push result:" (pr-str r)))))
true)))))))
;; Unknown status
(do #?(:clj (println "Unknown push result:" (pr-str r))
:cljs (js/console.warn "Unknown push result:" (pr-str r)))
(p/resolved nil))))))))
(p/resolved nil)))
(p/resolved nil)))
(defn- do-sync!
"Run a full sync cycle: pull then push."
"Run a full sync cycle: pull then push. Returns a promise."
[sa]
(go
(when (sync/online?)
(<! (do-pull! sa))
(<! (do-push! sa)))))
(if (sync/online?)
(p/let [_ (do-pull! sa)]
(do-push! sa))
(p/resolved nil)))
;; ---------------------------------------------------------------------------
;; Sync loop
;; Push scheduling (replaces kick channel)
;; ---------------------------------------------------------------------------
(defn- schedule-push!
"Schedule a push after a short debounce. Coalesces rapid changes.
If a push is in flight, another will follow after it completes."
[sa]
(when-let [t @(.-push_timer sa)]
#?(:clj (future-cancel t)
:cljs (js/clearTimeout t)))
(reset! (.-push_timer sa)
#?(:clj (future
(Thread/sleep 50)
(when-not @(.-pushing? sa)
(reset! (.-pushing? sa) true)
(-> (do-push! sa)
(p/finally
(fn [_ _]
(reset! (.-pushing? sa) false)
(when (seq @(.-pending sa))
(schedule-push! sa)))))))
:cljs (js/setTimeout
(fn []
(when-not @(.-pushing? sa)
(reset! (.-pushing? sa) true)
(-> (do-push! sa)
(p/finally
(fn [_ _]
(reset! (.-pushing? sa) false)
(when (seq @(.-pending sa))
(schedule-push! sa)))))))
50))))
;; ---------------------------------------------------------------------------
;; Sync loop (timer-based)
;; ---------------------------------------------------------------------------
(defn- start-sync-loop!
"Start the background sync loop."
"Start the background sync loop using platform timers."
[sa]
(let [stop-ch (.-stop_ch sa)
kick-ch (.-kick_ch sa)
interval (.-sync_interval sa)
cleanups (atom [])]
;; Periodic sync (fallback) + immediate push on kick
(go-loop []
(let [[_ ch] (alts! [stop-ch kick-ch (timeout interval)])]
(when-not (= ch stop-ch)
(if (= ch kick-ch)
(<! (do-push! sa))
(<! (do-sync! sa)))
(recur))))
(let [interval (.-sync_interval sa)
cleanups (atom [])
sync-fn (fn []
(when-not @(.-syncing? sa)
(reset! (.-syncing? sa) true)
(-> (do-sync! sa)
(p/finally
(fn [_ _]
(reset! (.-syncing? sa) false))))))]
;; Periodic sync
#?(:clj
(let [^ScheduledExecutorService exec (Executors/newSingleThreadScheduledExecutor)]
(.scheduleAtFixedRate exec ^Runnable sync-fn
(long interval) (long interval) TimeUnit/MILLISECONDS)
(reset! (.-sync_timer sa) exec)
(swap! cleanups conj (fn [] (.shutdown exec))))
:cljs
(let [timer-id (js/setInterval sync-fn interval)]
(reset! (.-sync_timer sa) timer-id)
(swap! cleanups conj (fn [] (js/clearInterval timer-id)))))
;; Online/offline handler
(swap! cleanups conj
(sync/on-connectivity-change
(fn [] (go (<! (do-sync! sa))))
(fn [] (do-sync! sa))
(fn [] nil)))
;; SSE — live pull on server push (CLJS only)
#?(:cljs
(when-let [opts (.-server_opts sa)]
(swap! cleanups conj
(sync/listen-events opts (.-group sa)
(fn [_group]
(go (<! (do-pull! sa))))))))
(do-pull! sa))))))
(reset! (.-cleanup_fn sa) @cleanups)))
;; ---------------------------------------------------------------------------
@@ -315,30 +367,33 @@
pending (atom #{})
server-opts (when server {:server server})
last-sync (atom 0)
ready-ch (chan 1)
stop-ch (chan 1)
kick-ch (chan (async/sliding-buffer 1))
ready-pr (p/deferred)
sync-timer (atom nil)
push-timer (atom nil)
pushing? (atom false)
syncing? (atom false)
cleanup-fn (atom nil)
meta-atom (atom nil)
sa (SyncedAtom. group store cache-atom versions pending
server-opts last-sync ready-ch stop-ch kick-ch
cleanup-fn interval meta-atom)]
(go
(<! (load-from-store! sa))
(put! ready-ch true)
(async/close! ready-ch)
(when server-opts
(<! (do-sync! sa))
(start-sync-loop! sa)))
server-opts last-sync ready-pr sync-timer push-timer
pushing? syncing? cleanup-fn interval meta-atom)]
(-> (load-from-store! sa)
(p/then (fn [_]
(p/resolve! ready-pr true)
(when server-opts
(-> (do-sync! sa)
(p/then (fn [_] (start-sync-loop! sa)))))))
(p/catch (fn [err]
(p/reject! ready-pr err))))
sa))
(defn ready?
"Returns a channel that yields true when the atom has finished loading from the store."
"Returns a promise that yields true when the atom has finished loading from the store."
[sa]
(.-ready_ch sa))
(.-ready_pr sa))
(defn sync-now!
"Trigger an immediate sync cycle. Returns a channel."
"Trigger an immediate sync cycle. Returns a promise."
[sa]
(do-sync! sa))
@@ -350,5 +405,9 @@
(defn destroy!
"Stop the sync loop and clean up. Does not close the store."
[sa]
(put! (.-stop_ch sa) :stop)
;; Cancel push debounce timer
(when-let [t @(.-push_timer sa)]
#?(:clj (future-cancel t)
:cljs (js/clearTimeout t)))
;; Run all cleanup fns (timer, connectivity, SSE)
(doseq [f @(.-cleanup_fn sa)] (f)))

View File

@@ -1,23 +1,23 @@
(ns pocketbook.store
"Storage protocol for Pocketbook.
All methods return core.async channels.")
All methods return promesa promises.")
(defprotocol PStore
(put-doc! [store doc]
"Write a document to the store. doc is a map:
{:id str, :value any, :version int, :updated int, :deleted bool, :synced bool}
Returns a channel that closes on success.")
Returns a promise that resolves on success.")
(docs-by-prefix [store prefix]
"Get all documents whose id starts with prefix.
Returns a channel yielding a vector of doc maps.")
Returns a promise yielding a vector of doc maps.")
(get-meta [store key]
"Get a metadata value by key.
Returns a channel yielding the value, or nil if not found.")
Returns a promise yielding the value, or nil if not found.")
(set-meta! [store key value]
"Set a metadata value. Returns a channel that closes on success.")
"Set a metadata value. Returns a promise that resolves on success.")
(close-store! [store]
"Close the store and release resources."))

View File

@@ -2,7 +2,7 @@
"IndexedDB store implementing the PStore protocol."
(:require [pocketbook.store :as store]
[pocketbook.transit :as transit]
[cljs.core.async :as async :refer [chan put!]]))
[promesa.core :as p]))
;; ---------------------------------------------------------------------------
;; IDB operations
@@ -21,70 +21,71 @@
(deftype IDBStore [db]
store/PStore
(put-doc! [_ doc]
(let [ch (chan 1)
txn (tx db "docs" :readwrite)
store (.objectStore txn "docs")
obj #js {:id (:id doc)
:value (transit/encode (:value doc))
:version (:version doc 0)
:updated (:updated doc 0)
:deleted (boolean (:deleted doc false))
:synced (boolean (:synced doc false))}
req (.put store obj)]
(set! (.-onsuccess req) (fn [_] (put! ch true) (async/close! ch)))
(set! (.-onerror req) (fn [e] (js/console.error "IDB put error:" e) (async/close! ch)))
ch))
(p/create
(fn [resolve reject]
(let [txn (tx db "docs" :readwrite)
store (.objectStore txn "docs")
obj #js {:id (:id doc)
:value (transit/encode (:value doc))
:version (:version doc 0)
:updated (:updated doc 0)
:deleted (boolean (:deleted doc false))
:synced (boolean (:synced doc false))}
req (.put store obj)]
(set! (.-onsuccess req) (fn [_] (resolve true)))
(set! (.-onerror req) (fn [e]
(js/console.error "IDB put error:" e)
(reject e)))))))
(docs-by-prefix [_ prefix]
(let [ch (chan 1)
txn (tx db "docs" :readonly)
store (.objectStore txn "docs")
range (.bound js/IDBKeyRange prefix (str prefix "\uffff"))
req (.openCursor store range)
docs (atom [])]
(set! (.-onsuccess req)
(fn [e]
(let [cursor (.-result (.-target e))]
(if cursor
(let [val (.-value cursor)]
(swap! docs conj
{:id (.-id val)
:value (transit/decode (.-value val))
:version (.-version val)
:updated (.-updated val)
:deleted (.-deleted val)
:synced (.-synced val)})
(.continue cursor))
(do
(put! ch @docs)
(async/close! ch))))))
(set! (.-onerror req)
(fn [e] (js/console.error "IDB cursor error:" e) (async/close! ch)))
ch))
(p/create
(fn [resolve reject]
(let [txn (tx db "docs" :readonly)
store (.objectStore txn "docs")
range (.bound js/IDBKeyRange prefix (str prefix "\uffff"))
req (.openCursor store range)
docs (atom [])]
(set! (.-onsuccess req)
(fn [e]
(let [cursor (.-result (.-target e))]
(if cursor
(let [val (.-value cursor)]
(swap! docs conj
{:id (.-id val)
:value (transit/decode (.-value val))
:version (.-version val)
:updated (.-updated val)
:deleted (.-deleted val)
:synced (.-synced val)})
(.continue cursor))
(resolve @docs)))))
(set! (.-onerror req)
(fn [e]
(js/console.error "IDB cursor error:" e)
(reject e)))))))
(get-meta [_ key]
(let [ch (chan 1)
txn (tx db "meta" :readonly)
store (.objectStore txn "meta")
req (.get store key)]
(set! (.-onsuccess req)
(fn [e]
(let [result (.-result (.-target e))]
(if result
(do (put! ch (.-value result))
(async/close! ch))
(async/close! ch)))))
(set! (.-onerror req) (fn [_] (async/close! ch)))
ch))
(p/create
(fn [resolve reject]
(let [txn (tx db "meta" :readonly)
store (.objectStore txn "meta")
req (.get store key)]
(set! (.-onsuccess req)
(fn [e]
(let [result (.-result (.-target e))]
(resolve (when result (.-value result))))))
(set! (.-onerror req)
(fn [_] (reject (js/Error. "IDB get-meta error"))))))))
(set-meta! [_ key value]
(let [ch (chan 1)
txn (tx db "meta" :readwrite)
store (.objectStore txn "meta")
req (.put store #js {:key key :value value})]
(set! (.-onsuccess req) (fn [_] (put! ch true) (async/close! ch)))
(set! (.-onerror req) (fn [_] (async/close! ch)))
ch))
(p/create
(fn [resolve reject]
(let [txn (tx db "meta" :readwrite)
store (.objectStore txn "meta")
req (.put store #js {:key key :value value})]
(set! (.-onsuccess req) (fn [_] (resolve true)))
(set! (.-onerror req)
(fn [_] (reject (js/Error. "IDB set-meta error"))))))))
(close-store! [_]
(when db (.close db))))
@@ -94,25 +95,24 @@
;; ---------------------------------------------------------------------------
(defn open
"Open an IndexedDB store. Returns a channel yielding the IDBStore."
"Open an IndexedDB store. Returns a promise yielding the IDBStore."
[db-name]
(let [ch (chan 1)
req (.open js/indexedDB db-name 1)]
(set! (.-onupgradeneeded req)
(fn [e]
(let [db (.-result (.-target e))]
(when-not (.contains (.-objectStoreNames db) "docs")
(let [store (.createObjectStore db "docs" #js {:keyPath "id"})]
(.createIndex store "synced" "synced" #js {:unique false})
(.createIndex store "updated" "updated" #js {:unique false})))
(when-not (.contains (.-objectStoreNames db) "meta")
(.createObjectStore db "meta" #js {:keyPath "key"})))))
(set! (.-onsuccess req)
(fn [e]
(put! ch (IDBStore. (.-result (.-target e))))
(async/close! ch)))
(set! (.-onerror req)
(fn [e]
(js/console.error "IDB open error:" e)
(async/close! ch)))
ch))
(p/create
(fn [resolve reject]
(let [req (.open js/indexedDB db-name 1)]
(set! (.-onupgradeneeded req)
(fn [e]
(let [db (.-result (.-target e))]
(when-not (.contains (.-objectStoreNames db) "docs")
(let [store (.createObjectStore db "docs" #js {:keyPath "id"})]
(.createIndex store "synced" "synced" #js {:unique false})
(.createIndex store "updated" "updated" #js {:unique false})))
(when-not (.contains (.-objectStoreNames db) "meta")
(.createObjectStore db "meta" #js {:keyPath "key"})))))
(set! (.-onsuccess req)
(fn [e]
(resolve (IDBStore. (.-result (.-target e))))))
(set! (.-onerror req)
(fn [e]
(js/console.error "IDB open error:" e)
(reject e)))))))

View File

@@ -1,44 +1,28 @@
(ns pocketbook.store.memory
"In-memory store backed by atoms. Useful for testing and JVM clients."
(:require [pocketbook.store :as store]
#?(:clj [clojure.core.async :as async :refer [chan put!]]
:cljs [cljs.core.async :as async :refer [chan put!]])
[promesa.core :as p]
[clojure.string :as str]))
(deftype MemoryStore [docs meta-store]
store/PStore
(put-doc! [_ doc]
(let [ch (chan 1)]
(swap! docs assoc (:id doc) doc)
(put! ch true)
(async/close! ch)
ch))
(swap! docs assoc (:id doc) doc)
(p/resolved true))
(docs-by-prefix [_ prefix]
(let [ch (chan 1)
matching (->> @docs
vals
(filter #(str/starts-with? (:id %) prefix))
vec)]
(put! ch matching)
(async/close! ch)
ch))
(p/resolved
(->> @docs
vals
(filter #(str/starts-with? (:id %) prefix))
vec)))
(get-meta [_ key]
(let [ch (chan 1)
v (get @meta-store key)]
(if (some? v)
(put! ch v)
nil)
(async/close! ch)
ch))
(p/resolved (get @meta-store key)))
(set-meta! [_ key value]
(let [ch (chan 1)]
(swap! meta-store assoc key value)
(put! ch true)
(async/close! ch)
ch))
(swap! meta-store assoc key value)
(p/resolved true))
(close-store! [_]
nil))

View File

@@ -2,8 +2,7 @@
"HTTP sync client — pull and push documents to/from the Pocketbook server."
(:require [pocketbook.transit :as transit]
[clojure.string :as str]
#?(:clj [clojure.core.async :as async :refer [chan put!]]
:cljs [cljs.core.async :as async :refer [chan put!]]))
[promesa.core :as p])
#?(:clj (:import [java.net URI]
[java.net.http HttpClient HttpRequest HttpRequest$BodyPublishers
HttpResponse$BodyHandlers])))
@@ -40,28 +39,22 @@
#?(:cljs
(defn- fetch-transit
"Make an HTTP request with Transit encoding (browser).
Returns a channel yielding {:ok bool :body decoded :status int}."
Returns a promise yielding {:ok bool :body decoded :status int}."
[{:keys [url method body]}]
(let [ch (chan 1)
opts (clj->js
(cond-> {:method (or method "GET")
:headers {"Content-Type" "application/transit+json"
"Accept" "application/transit+json"}}
body (assoc :body (transit/encode body))))]
(-> (js/fetch url opts)
(.then (fn [resp]
(-> (.text resp)
(.then (fn [text]
(if (.-ok resp)
(put! ch {:ok true :body (transit/decode text)})
(put! ch {:ok false
:status (.-status resp)
:error text}))
(async/close! ch))))))
(.catch (fn [err]
(put! ch {:ok false :status 0 :error (str err)})
(async/close! ch))))
ch)))
(-> (js/fetch url
(clj->js
(cond-> {:method (or method "GET")
:headers {"Content-Type" "application/transit+json"
"Accept" "application/transit+json"}}
body (assoc :body (transit/encode body)))))
(.then (fn [resp]
(-> (.text resp)
(.then (fn [text]
(if (.-ok resp)
{:ok true :body (transit/decode text)}
{:ok false
:status (.-status resp)
:error text})))))))))
;; ---------------------------------------------------------------------------
;; Pull
@@ -69,27 +62,24 @@
(defn pull!
"Pull documents from server updated since `since` for `group`.
Returns a channel yielding {:ok true :docs [...]} or {:ok false :error str}."
Returns a promise yielding {:ok true :docs [...]} or {:ok false :error str}."
[{:keys [server]} group since]
(let [url (str server "?group=" #?(:clj (java.net.URLEncoder/encode group "UTF-8")
:cljs (js/encodeURIComponent group))
"&since=" since)]
#?(:clj
(async/thread
(p/vthread
(let [result (http-request {:url url :method :get})]
(if (:ok result)
{:ok true :docs (:body result)}
result)))
:cljs
(let [ch (chan 1)]
(async/go
(let [result (async/<! (fetch-transit {:url url :method "GET"}))]
(if (:ok result)
(put! ch {:ok true :docs (:body result)})
(put! ch result))
(async/close! ch)))
ch))))
(p/then (fetch-transit {:url url :method "GET"})
(fn [result]
(if (:ok result)
{:ok true :docs (:body result)}
result))))))
;; ---------------------------------------------------------------------------
;; Push
@@ -97,24 +87,21 @@
(defn push!
"Push a batch of documents to the server.
Returns a channel yielding {:ok true :results [...]} or {:ok false :error str}."
Returns a promise yielding {:ok true :results [...]} or {:ok false :error str}."
[{:keys [server]} docs]
#?(:clj
(async/thread
(p/vthread
(let [result (http-request {:url server :method :post :body docs})]
(if (:ok result)
{:ok true :results (:body result)}
result)))
:cljs
(let [ch (chan 1)]
(async/go
(let [result (async/<! (fetch-transit {:url server :method "POST" :body docs}))]
(if (:ok result)
(put! ch {:ok true :results (:body result)})
(put! ch result))
(async/close! ch)))
ch)))
(p/then (fetch-transit {:url server :method "POST" :body docs})
(fn [result]
(if (:ok result)
{:ok true :results (:body result)}
result)))))
;; ---------------------------------------------------------------------------
;; SSE — live change notifications (CLJS only)

13
tasks/todo.md Normal file
View File

@@ -0,0 +1,13 @@
# Replace core.async with promesa
## Tasks
- [x] 1. Add `funcool/promesa` to deps.edn, remove `core.async`
- [x] 2. Update `store.cljc` docstring (returns promises, not channels)
- [x] 3. Rewrite `store/memory.cljc` — return `(p/resolved val)`
- [x] 4. Rewrite `store/idb.cljs` — wrap IDB callbacks in `(p/create ...)`
- [x] 5. Rewrite `sync.cljc` — return promises from pull!/push!/fetch-transit
- [x] 6. Rewrite `core.cljc` — promises + timer-based sync loop
- [x] 7. Update `test/core_test.clj``deref` promises instead of `<!!`
- [x] 8. Update `example/todomvc/todomvc.cljs``p/let` instead of `go`/`<!`
- [x] 9. Run tests — 28 tests, 87 assertions, 0 failures

View File

@@ -1,6 +1,6 @@
(ns pocketbook.core-test
(:require [clojure.test :refer [deftest is testing use-fixtures]]
[clojure.core.async :as async :refer [<!! go <! timeout]]
[promesa.core :as p]
[pocketbook.core :as pb]
[pocketbook.store :as store]
[pocketbook.store.memory :as memory]
@@ -38,11 +38,10 @@
;; Helpers
;; ---------------------------------------------------------------------------
(defn- <!!timeout
"Take from channel with timeout. Returns nil on timeout."
[ch ms]
(let [[v _] (<!! (go (async/alts! [ch (timeout ms)])))]
v))
(defn- await!
"Deref a promise with timeout. Returns nil on timeout."
[promise ms]
(deref promise ms nil))
(defn- wait-synced
"Wait until the synced atom has no pending changes."
@@ -62,7 +61,7 @@
(testing "SyncedAtom works without a server (local store only)"
(let [store (memory/create)
sa (pb/synced-atom store "todo")]
(<!!timeout (pb/ready? sa) 1000)
(await! (pb/ready? sa) 1000)
(is (= {} @sa))
(swap! sa assoc "todo:1" {:text "Buy milk"})
@@ -81,13 +80,13 @@
(testing "Changes are persisted to the store"
(let [store (memory/create)
sa (pb/synced-atom store "todo")]
(<!!timeout (pb/ready? sa) 1000)
(await! (pb/ready? sa) 1000)
(swap! sa assoc "todo:1" {:text "Buy milk"})
(Thread/sleep 50) ;; let async store write complete
;; Read from store directly
(let [docs (<!!timeout (store/docs-by-prefix store "todo:") 1000)]
(let [docs (await! (store/docs-by-prefix store "todo:") 1000)]
(is (= 1 (count docs)))
(is (= "todo:1" (:id (first docs))))
(is (= {:text "Buy milk"} (:value (first docs)))))
@@ -98,13 +97,13 @@
(testing "SyncedAtom loads existing data from store on creation"
(let [store (memory/create)]
;; Pre-populate the store
(<!!timeout (store/put-doc! store
{:id "todo:1" :value {:text "Existing"}
:version 1 :updated 1000 :deleted false :synced true})
1000)
(await! (store/put-doc! store
{:id "todo:1" :value {:text "Existing"}
:version 1 :updated 1000 :deleted false :synced true})
1000)
(let [sa (pb/synced-atom store "todo")]
(<!!timeout (pb/ready? sa) 1000)
(await! (pb/ready? sa) 1000)
(is (= {:text "Existing"} (get @sa "todo:1")))
(pb/destroy! sa)))))
@@ -113,7 +112,7 @@
(let [store (memory/create)
sa (pb/synced-atom store "todo")
changes (atom [])]
(<!!timeout (pb/ready? sa) 1000)
(await! (pb/ready? sa) 1000)
(add-watch sa :test (fn [_ _ old new]
(swap! changes conj {:old old :new new})))
@@ -133,7 +132,7 @@
(let [store (memory/create)
sa (pb/synced-atom store "todo"
{:server (server-url)})]
(<!!timeout (pb/ready? sa) 2000)
(await! (pb/ready? sa) 2000)
(swap! sa assoc "todo:push1" {:text "Pushed!"})
(Thread/sleep 500) ;; let push complete
@@ -149,15 +148,15 @@
{:server (server-url) :interval 500})
sa-b (pb/synced-atom store-b "todo"
{:server (server-url) :interval 500})]
(<!!timeout (pb/ready? sa-a) 2000)
(<!!timeout (pb/ready? sa-b) 2000)
(await! (pb/ready? sa-a) 2000)
(await! (pb/ready? sa-b) 2000)
;; Client A writes
(swap! sa-a assoc "todo:sync1" {:text "From A"})
(Thread/sleep 500) ;; let A push
;; Trigger a sync on B
(<!!timeout (pb/sync-now! sa-b) 2000)
(await! (pb/sync-now! sa-b) 2000)
;; B should have A's data
(is (= {:text "From A"} (get @sa-b "todo:sync1")))
@@ -169,7 +168,7 @@
(testing "Standard atom operations work"
(let [store (memory/create)
sa (pb/synced-atom store "note")]
(<!!timeout (pb/ready? sa) 1000)
(await! (pb/ready? sa) 1000)
;; reset!
(reset! sa {"note:1" {:body "Hello"}})