├── .gitignore ├── README.md ├── build.boot ├── resources └── cache │ ├── cache.cljs.edn │ └── index.html ├── src └── cljs │ ├── cache.clj │ └── cache.cljs └── test └── cljs └── cache_test.cljs /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | *jar 3 | /lib/ 4 | /classes/ 5 | /out/ 6 | /target/ 7 | .lein-deps-sum 8 | .lein-repl-history 9 | .lein-plugins/ 10 | .repl/ 11 | .nrepl* 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cljs.cache : Clojurescript port of clojure/core.cache 2 | 3 | [![Clojars Project](https://img.shields.io/clojars/v/org.clojars.mmb90/cljs-cache.svg)](https://clojars.org/org.clojars.mmb90/cljs-cache) 4 | 5 | * An underlying `CacheProtocol` used as the base abstraction for implementing new synchronous caches 6 | 7 | * A `defcache` macro for hooking your `CacheProtocol` implementations into the Clojurescript associative data capabilities. 8 | 9 | * Implementations of some basic caching strategies 10 | - Least-recently-used (LRUCache) 11 | - Time-to-live (TTLCache) 12 | - Naive cache (BasicCache) 13 | 14 | * Factory functions for each existing cache type 15 | 16 | ## Example Usage 17 | 18 | ```clojure 19 | (require '[cljs.cache :as cache]) 20 | 21 | (def C (cache/lru-cache-factory {:a 1, :b 2} :threshold 2)) 22 | 23 | (if (cache/has? C :c) 24 | (cache/hit C :c) 25 | (cache/miss C :c 42)) 26 | 27 | ;=> {:b 2, :c 42} 28 | 29 | (cache/evict C :b) 30 | 31 | ;=> {:a 1} 32 | 33 | (def C (cache/lru-cache-factory {:a 1, :b 2} :threshold 3)) 34 | 35 | (if (cache/has? C :c) 36 | (cache/hit C :c) 37 | (cache/miss C :c 42)) 38 | 39 | ;=> {:a 1, :b 2, :c 42} 40 | 41 | ;; Technically in order to see those results at the repl you'd have 42 | ;; to use .-cache but I left it off for clarity since that's what's 43 | ;; in the cache. 44 | 45 | (.-cache (cache/evict C :b)) 46 | 47 | ;=> {:a 1} 48 | ``` 49 | 50 | Refer to docstrings in the `clojure.core.cache` namespace, or the [autogenerated API documentation](http://clojure.github.com/core.cache/) for additional documentation 51 | 52 | ## License ## 53 | 54 | Copyright (c) Rich Hickey. All rights reserved. The use and 55 | distribution terms for this software are covered by the Eclipse 56 | Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 57 | which can be found in the file epl-v10.html at the root of this 58 | distribution. By using this software in any fashion, you are 59 | agreeing to be bound by the terms of this license. You must 60 | not remove this notice, or any other, from this software. 61 | 62 | Shout out to @timgalebach for his version of cljs-cache to get me started. 63 | -------------------------------------------------------------------------------- /build.boot: -------------------------------------------------------------------------------- 1 | (set-env! 2 | :source-paths #{"src"} 3 | :resource-paths #{"resources"} 4 | 5 | :dependencies '[[org.clojure/clojure "1.9.0-alpha10"] 6 | [org.clojure/clojurescript "1.9.89"] 7 | [org.clojure/tools.namespace "0.2.11" :scope "test"] 8 | [org.clojure/tools.nrepl "0.2.12" :scope "test"] ;; needed by bREPL 9 | 10 | [adzerk/boot-cljs "1.7.228-1" :scope "test"] 11 | [adzerk/boot-cljs-repl "0.3.2" :scope "test"] 12 | [adzerk/bootlaces "0.1.13" :scope "test"] 13 | [adzerk/boot-reload "0.4.11" :scope "test"] 14 | [adzerk/boot-test "1.1.2"] 15 | [com.cemerick/piggieback "0.2.1" :scope "test"] ;; needed by bREPL 16 | [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT"] 17 | [pandeiro/boot-http "0.7.3" :scope "test"] 18 | [tailrecursion/cljs-priority-map "1.2.1"] 19 | [weasel "0.7.0" :scope "test"] ;; needed by bREPL 20 | ]) 21 | 22 | (require '[adzerk.boot-cljs :refer [cljs]] 23 | '[adzerk.boot-cljs-repl :refer [cljs-repl cljs-repl-env start-repl]] 24 | '[adzerk.bootlaces :refer :all] 25 | '[adzerk.boot-reload :refer [reload]] 26 | '[crisptrutski.boot-cljs-test :refer [test-cljs exit!]] 27 | '[clojure.tools.namespace.repl :refer [set-refresh-dirs]] 28 | '[pandeiro.boot-http :refer [serve]]) 29 | 30 | 31 | (def +version+ "0.1.4") 32 | 33 | (bootlaces! +version+) 34 | 35 | (task-options! 36 | pom {:project 'org.clojars.mmb90/cljs-cache 37 | :version +version+ 38 | :description "Port of clorjure/core.cache" 39 | :url "https://github.com/burbma/cljs-cache" 40 | :scm {:url "https://github.com/burbma/cljs-cache"} 41 | :license {"Eclipse Public License 1.0" 42 | "http://opensource.org/licenses/eclipse-1.0.php"}}) 43 | 44 | (deftask testing 45 | "Conj test path to environment." 46 | [] 47 | (merge-env! :source-paths #{"test"}) 48 | identity) 49 | 50 | (deftask test-all 51 | "Run tests on phantomjs." 52 | [] 53 | (comp (testing) 54 | (test-cljs) 55 | (exit!))) 56 | 57 | (deftask dev 58 | "Launch immediate feedback dev environment." 59 | [] 60 | (apply set-refresh-dirs (get-env :directories)) 61 | (comp 62 | (testing) 63 | (serve :dir "target/cache/") 64 | (watch) 65 | (cljs-repl) 66 | (reload) 67 | (cljs) 68 | (target :dir #{"target"}))) 69 | 70 | (deftask dev-testing 71 | "Launch immediate feedback dev environment that also runs tests each 72 | time. Alternatively (preferably in my case) you can run `boot dev` and 73 | include `(run-tests)` at the bottom of core_test.cljs and the tests will run 74 | in the browser and you can see the results in the console." 75 | [] 76 | (apply set-refresh-dirs (get-env :directories)) 77 | (comp 78 | (testing) 79 | (serve :dir "target/cache/") 80 | (watch) 81 | (cljs-repl) 82 | (reload) 83 | (test-cljs) 84 | (cljs) 85 | (target :dir #{"target"}))) 86 | -------------------------------------------------------------------------------- /resources/cache/cache.cljs.edn: -------------------------------------------------------------------------------- 1 | {:require [cljs.cache_test]} 2 | -------------------------------------------------------------------------------- /resources/cache/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /src/cljs/cache.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns cljs.cache) 10 | 11 | (defmacro defcache 12 | [type-name fields & specifics] 13 | (let [[base & _] fields 14 | base-field (with-meta base {:tag 'cljs.core/IMap})] 15 | `(deftype ~type-name [~@fields] 16 | ~@specifics 17 | 18 | cljs.core/ILookup 19 | (~'-lookup [this# key#] 20 | (~'-lookup this# key# nil)) 21 | (~'-lookup [this# key# not-found#] 22 | (if (has? this# key#) 23 | (lookup this# key#) 24 | not-found#)) 25 | 26 | cljs.core/IIterable 27 | (~'-iterator [_#] 28 | (.iterator ~base-field)) 29 | 30 | cljs.core/IAssociative 31 | (~'-assoc [this# k# v#] 32 | (miss this# k# v#)) 33 | (~'-contains-key? [this# k#] 34 | (has? this# k#)) 35 | 36 | cljs.core/IMap 37 | (~'-dissoc [this# k#] 38 | (evict this# k#)) 39 | 40 | cljs.core/ICounted 41 | (~'-count [this#] 42 | (~'-count ~base-field)) 43 | 44 | cljs.core/ICollection 45 | (~'-conj [this# elem#] 46 | (seed this# ('-conj ~base-field elem#))) 47 | 48 | cljs.core/IEquiv 49 | (~'-equiv [this# other#] 50 | (= other# ~base-field)) 51 | 52 | cljs.core/IEmptyableCollection 53 | (~'-empty [this#] 54 | (seed this# ('-empty ~base-field))) 55 | 56 | cljs.core/ISeqable 57 | (~'-seq [_#] 58 | (~'-seq ~base-field))))) 59 | -------------------------------------------------------------------------------- /src/cljs/cache.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | 10 | (ns ^{:doc "A port of clojure/core.cache to Clojurescript" 11 | :author "Matt Burbidge"} 12 | cljs.cache 13 | (:require [tailrecursion.priority-map :refer [priority-map]]) 14 | (:require-macros [cljs.cache :refer [defcache]])) 15 | 16 | (defprotocol CacheProtocol 17 | "This is the protocol describing the basic cache capability." 18 | (lookup [cache e] 19 | [cache e not-found] 20 | "Retrieve the value associated with `e` if it exists, else `nil` in 21 | the 2-arg case. Retrieve the value associated with `e` if it exists, 22 | else `not-found` in the 3-arg case.") 23 | (has? [cache e] 24 | "Checks if the cache contains a value associated with `e`") 25 | (hit [cache e] 26 | "Is meant to be called if the cache is determined to contain a value 27 | associated with `e`") 28 | (miss [cache e ret] 29 | "Is meant to be called if the cache is determined to **not** contain a 30 | value associated with `e`") 31 | (evict [cache e] 32 | "Removes an entry from the cache") 33 | (seed [cache base] 34 | "Is used to signal that the cache should be created with a seed. 35 | The contract is that said cache should return an instance of its 36 | own type.")) 37 | 38 | (def ^{:private true} default-wrapper-fn #(%1 %2)) 39 | 40 | (defn through 41 | "The basic hit/miss logic for the cache system. Expects a wrap function and 42 | value function. The wrap function takes the value function and the item in 43 | question and is expected to run the value function with the item whenever a 44 | cache miss occurs. The intent is to hide any cache-specific cells from 45 | leaking into the cache logic itelf." 46 | ([cache item] (through default-wrapper-fn identity cache item)) 47 | ([value-fn cache item] (through default-wrapper-fn value-fn cache item)) 48 | ([wrap-fn value-fn cache item] 49 | (if (has? cache item) 50 | (hit cache item) 51 | (miss cache item (wrap-fn #(value-fn %) item))))) 52 | 53 | (defcache BasicCache [cache] 54 | CacheProtocol 55 | (lookup [_ item] 56 | (get cache item)) 57 | (lookup [_ item not-found] 58 | (get cache item not-found)) 59 | (has? [_ item] 60 | (contains? cache item)) 61 | (hit [this item] this) 62 | (miss [_ item result] 63 | (BasicCache. (assoc cache item result))) 64 | (evict [_ key] 65 | (BasicCache. (dissoc cache key))) 66 | (seed [_ base] 67 | (BasicCache. base)) 68 | Object 69 | (toString [_] (str cache))) 70 | 71 | ;; TTL Cache 72 | 73 | (defn- get-time [] 74 | (.getTime (js/Date.))) 75 | 76 | (defn- key-killer-fn 77 | "returns a fn that dissocs expired keys from a map" 78 | [ttl expiry now] 79 | (let [ks (map key (filter #(> (- now (val %)) expiry) ttl))] 80 | #(apply dissoc % ks))) 81 | 82 | (defcache TTLCache [cache ttl ttl-ms] 83 | CacheProtocol 84 | (lookup [this item] 85 | (let [ret (lookup this item ::nope)] 86 | (when-not (= ret ::nope) ret))) 87 | (lookup [this item not-found] 88 | (if (has? this item) 89 | (get cache item) 90 | not-found)) 91 | (has? [_ item] 92 | (let [t (get ttl item (- ttl-ms))] 93 | (< (- (get-time) 94 | t) 95 | ttl-ms))) 96 | (hit [this item] this) 97 | (miss [this item result] 98 | (let [now (get-time) 99 | kill-old (key-killer-fn ttl ttl-ms now)] 100 | (TTLCache. (assoc (kill-old cache) item result) 101 | (assoc (kill-old ttl) item now) 102 | ttl-ms))) 103 | (seed [_ base] 104 | (let [now (get-time)] 105 | (TTLCache. base 106 | (into {} (for [x base] [(key x) now])) 107 | ttl-ms))) 108 | (evict [_ key] 109 | (TTLCache. (dissoc cache key) 110 | (dissoc ttl key) 111 | ttl-ms)) 112 | Object 113 | (toString [_] 114 | (str cache \, \space ttl \, \space ttl-ms))) 115 | 116 | ;; LRU Cache 117 | 118 | (defn- build-leastness-queue 119 | [base limit start-at] 120 | (into (priority-map) 121 | (concat (take (- limit (count base)) (for [k (range (- limit) 0)] [k k])) 122 | (for [[k _] base] [k start-at])))) 123 | 124 | 125 | (defcache LRUCache [cache lru tick limit] 126 | CacheProtocol 127 | (lookup [_ item] 128 | (get cache item)) 129 | (lookup [_ item not-found] 130 | (get cache item not-found)) 131 | (has? [_ item] 132 | (contains? cache item)) 133 | (hit [_ item] 134 | (let [tick+ (inc tick)] 135 | (LRUCache. cache 136 | (if (contains? cache item) 137 | (assoc lru item tick+) 138 | lru) 139 | tick+ 140 | limit))) 141 | (miss [_ item result] 142 | (let [tick+ (inc tick)] 143 | (if (>= (count lru) limit) 144 | (let [k (if (contains? lru item) 145 | item 146 | (first (peek lru))) ;; minimum-key, maybe evict case 147 | c (-> cache (dissoc k) (assoc item result)) 148 | l (-> lru (dissoc k) (assoc item tick+))] 149 | (LRUCache. c l tick+ limit)) 150 | (LRUCache. (assoc cache item result) ;; no change case 151 | (assoc lru item tick+) 152 | tick+ 153 | limit)))) 154 | (evict [this key] 155 | (if (contains? cache key) 156 | (LRUCache. (dissoc cache key) 157 | (dissoc lru key) 158 | (inc tick) 159 | limit) 160 | this)) 161 | (seed [_ base] 162 | (LRUCache. base 163 | (build-leastness-queue base limit 0) 164 | 0 165 | limit)) 166 | Object 167 | (toString [_] 168 | (str cache \, \space lru \, \space tick \, \space limit))) 169 | 170 | 171 | ;; Factories 172 | 173 | (defn basic-cache-factory 174 | "Returns a pluggable basic cache initialied to `base`" 175 | [base] 176 | {:pre [(map? base)]} 177 | (BasicCache. base)) 178 | 179 | (defn ttl-cache-factory 180 | "Returns a TTL cache with the cache and expiration-table initialied to `base` -- 181 | each with the same time-to-live. 182 | 183 | This function also allows an optional `:ttl` argument that defines the default 184 | time in milliseconds that entries are allowed to reside in the cache." 185 | [base & {ttl :ttl :or {ttl 2000}}] 186 | {:pre [(number? ttl) (<= 0 ttl) 187 | (map? base)]} 188 | (seed (TTLCache. {} {} ttl) base)) 189 | 190 | (defn lru-cache-factory 191 | "Returns an LRU cache with the cache and usage-table initialied to `base` -- 192 | each entry is initialized with the same usage value. 193 | This function takes an optional `:threshold` argument that defines the maximum number 194 | of elements in the cache before the LRU semantics apply (default is 32)." 195 | [base & {threshold :threshold :or {threshold 32}}] 196 | {:pre [(number? threshold) (< 0 threshold) 197 | (map? base)]} 198 | (seed (LRUCache. {} (priority-map) 0 threshold) base)) 199 | -------------------------------------------------------------------------------- /test/cljs/cache_test.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns cljs.cache-test 10 | (:require [cljs.cache :refer [BasicCache TTLCache LRUCache 11 | ttl-cache-factory lru-cache-factory 12 | lookup has? hit miss evict seed]] 13 | [cljs.test :refer-macros [deftest run-tests testing is are async]])) 14 | 15 | (enable-console-print!) 16 | 17 | (deftest test-basic-cache-lookup 18 | (testing "that the BasicCache can lookup as expected" 19 | (is (= :robot (lookup (miss (BasicCache. {}) '(servo) :robot) '(servo)))))) 20 | 21 | (defn do-dot-lookup-tests [c] 22 | (are [expect actual] (= expect actual) 23 | 1 (.lookup c :a) 24 | 2 (.lookup c :b) 25 | 42 (.lookup c :c 42) 26 | nil (.lookup c :c))) 27 | 28 | (defn do-ilookup-tests [c] 29 | (are [expect actual] (= expect actual) 30 | 1 (:a c) 31 | 2 (:b c) 32 | 42 (:X c 42) 33 | nil (:X c))) 34 | 35 | (defn do-the-assoc [c] 36 | (are [expect actual] (= expect actual) 37 | 1 (:a (assoc c :a 1)) 38 | nil (:a (assoc c :b 1)))) 39 | 40 | (defn do-dissoc [c] 41 | (are [expect actual] (= expect actual) 42 | 2 (:b (dissoc c :a)) 43 | nil (:a (dissoc c :a)) 44 | nil (:b (-> c (dissoc :a) (dissoc :b))) 45 | 0 (count (-> c (dissoc :a) (dissoc :b))))) 46 | 47 | (defn do-getting [c] 48 | (are [actual expect] (= expect actual) 49 | (get c :a) 1 50 | (get c :e) nil 51 | (get c :e 0) 0 52 | (get c :b 0) 2 53 | (get c :f 0) nil 54 | 55 | (get-in c [:c :e]) 4 56 | (get-in c '(:c :e)) 4 57 | (get-in c [:c :x]) nil 58 | (get-in c [:f]) nil 59 | (get-in c [:g]) false 60 | (get-in c [:h]) nil 61 | (get-in c []) c 62 | (get-in c nil) c 63 | 64 | (get-in c [:c :e] 0) 4 65 | (get-in c '(:c :e) 0) 4 66 | (get-in c [:c :x] 0) 0 67 | (get-in c [:b] 0) 2 68 | (get-in c [:f] 0) nil 69 | (get-in c [:g] 0) false 70 | (get-in c [:h] 0) 0 71 | (get-in c [:x :y] {:y 1}) {:y 1} 72 | (get-in c [] 0) c 73 | (get-in c nil 0) c)) 74 | 75 | (defn do-finding [c] 76 | (are [expect actual] (= expect actual) 77 | (find c :a) [:a 1] 78 | (find c :b) [:b 2] 79 | (find c :c) nil 80 | (find c nil) nil)) 81 | 82 | (defn do-contains [c] 83 | (are [expect actual] (= expect actual) 84 | (contains? c :a) true 85 | (contains? c :b) true 86 | (contains? c :c) false 87 | (contains? c nil) false)) 88 | 89 | 90 | (def big-map {:a 1 :b 2 :c {:d 3 :e 4} :f nil :g false nil {:h 5}}) 91 | (def small-map {:a 1 :b 2}) 92 | 93 | (deftest test-basic-cache-ilookup 94 | (testing "counts" 95 | (is (= 0 (count (BasicCache. {})))) 96 | (is (= 1 (count (BasicCache. {:a 1}))))) 97 | (testing "that the BasicCache can lookup via keywords" 98 | (do-ilookup-tests (BasicCache. small-map))) 99 | #_(testing "that the BasicCache can .lookup" 100 | (do-dot-lookup-tests (BasicCache. small-map))) 101 | (testing "assoc and dissoc for BasicCache" 102 | (do-the-assoc (BasicCache. {})) 103 | (do-dissoc (BasicCache. {:a 1 :b 2}))) 104 | (testing "that get and cascading gets work for BasicCache" 105 | (do-getting (BasicCache. big-map))) 106 | (testing "that finding works for BasicCache" 107 | (do-finding (BasicCache. small-map))) 108 | (testing "that contains? works for BasicCache" 109 | (do-contains (BasicCache. small-map)))) 110 | 111 | (defn get-time [] 112 | (.getTime (js/Date.))) 113 | 114 | (deftest test-ttl-cache-ilookup 115 | (let [five-secs (+ 5000 (get-time)) 116 | big-time (into {} (for [[k _] big-map] [k five-secs])) 117 | small-time (into {} (for [[k _] small-map] [k five-secs]))] 118 | (testing "that the TTLCache can lookup via keywords" 119 | (do-ilookup-tests (TTLCache. small-map small-time 2000))) 120 | #_(testing "that the TTLCache can lookup via keywords" 121 | (do-dot-lookup-tests (TTLCache. small-map small-time 2000))) 122 | (testing "assoc and dissoc for TTLCache" 123 | (do-the-assoc (TTLCache. {} {} 2000)) 124 | (do-dissoc (TTLCache. {:a 1 :b 2} {:a five-secs :b five-secs} 2000))) 125 | (testing "that get and cascading gets work for TTLCache" 126 | (do-getting (TTLCache. big-map big-time 2000))) 127 | (testing "that finding works for TTLCache" 128 | (do-finding (TTLCache. small-map small-time 2000))) 129 | (testing "that contains? works for TTLCache" 130 | (do-contains (TTLCache. small-map small-time 2000))))) 131 | 132 | (deftest test-ttl-cache 133 | (let [C (ttl-cache-factory {} :ttl 500)] 134 | (testing "TTL-ness with empty cache" 135 | (is (= {:a 1 :b 2} (-> C (assoc :a 1) (assoc :b 2) .-cache)))) 136 | (async done 137 | (let [C1 (-> C (assoc :a 1) (assoc :b 2)) 138 | C2 (-> C (assoc :a 1))] 139 | (js/setTimeout 140 | #(do 141 | (testing "TTL-ness with empty cache, expired" 142 | (is (= {:c 3} (-> C1 (assoc :c 3) .-cache)))) 143 | (testing "TTL cache does not return a value that has expired" 144 | (is (nil? (-> C2 (lookup :a))))) 145 | (done)) 146 | 700))))) 147 | 148 | (deftest test-lru-cache-ilookup 149 | (testing "that the LRUCache can lookup via keywords" 150 | (do-ilookup-tests (LRUCache. small-map {} 0 2))) 151 | #_(testing "that the LRUCache can lookup via keywords" 152 | (do-dot-lookup-tests (LRUCache. small-map {} 0 2))) 153 | (testing "assoc and dissoc for LRUCache" 154 | (do-the-assoc (LRUCache. {} {} 0 2)) 155 | (do-dissoc (LRUCache. {:a 1 :b 2} {} 0 2))) 156 | (testing "that get and cascading gets work for LRUCache" 157 | (do-getting (LRUCache. big-map {} 0 2))) 158 | (testing "that finding works for LRUCache" 159 | (do-finding (LRUCache. small-map {} 0 2))) 160 | (testing "that contains? works for LRUCache" 161 | (do-contains (LRUCache. small-map {} 0 2)))) 162 | 163 | (deftest test-lru-cache 164 | (testing "LRU-ness with empty cache and threshold 2" 165 | (let [C (lru-cache-factory {} :threshold 2)] 166 | (are [x y] (= x y) 167 | {:a 1, :b 2} (-> C (assoc :a 1) (assoc :b 2) .-cache) 168 | {:b 2, :c 3} (-> C (assoc :a 1) (assoc :b 2) (assoc :c 3) .-cache) 169 | {:a 1, :c 3} (-> C (assoc :a 1) (assoc :b 2) (hit :a) (assoc :c 3) .-cache)))) 170 | (testing "LRU-ness with seeded cache and threshold 4" 171 | (let [C (lru-cache-factory {:a 1, :b 2} :threshold 4)] 172 | (are [x y] (= x y) 173 | {:a 1, :b 2, :c 3, :d 4} (-> C (assoc :c 3) (assoc :d 4) .-cache) 174 | {:a 1, :c 3, :d 4, :e 5} (-> C (assoc :c 3) (assoc :d 4) (hit :c) (hit :a) (assoc :e 5) .-cache)))) 175 | (testing "regressions against LRU eviction before threshold met" 176 | (is (= {:b 3 :a 4} 177 | (-> (lru-cache-factory {} :threshold 2) 178 | (assoc :a 1) 179 | (assoc :b 2) 180 | (assoc :b 3) 181 | (assoc :a 4) 182 | .-cache))) 183 | 184 | (is (= {:e 6, :d 5, :c 4} 185 | (-> (lru-cache-factory {} :threshold 3) 186 | (assoc :a 1) 187 | (assoc :b 2) 188 | (assoc :b 3) 189 | (assoc :c 4) 190 | (assoc :d 5) 191 | (assoc :e 6) 192 | .-cache))) 193 | 194 | (is (= {:a 1 :b 3} 195 | (-> (lru-cache-factory {} :threshold 2) 196 | (assoc :a 1) 197 | (assoc :b 2) 198 | (assoc :b 3) 199 | .-cache)))) 200 | 201 | (is (= {:d 4 :e 5} 202 | (-> (lru-cache-factory {} :threshold 2) 203 | (hit :x) 204 | (hit :y) 205 | (hit :z) 206 | (assoc :a 1) 207 | (assoc :b 2) 208 | (assoc :c 3) 209 | (assoc :d 4) 210 | (assoc :e 5) 211 | .-cache)))) 212 | --------------------------------------------------------------------------------