(defcache TTLCache [cache ttl ttl-ms]
CacheProtocol
(lookup [this item]
(let [ret (lookup this item ::nope)]
(when-not (= ::nope ret) ret)))
(lookup [this item not-found]
(if (has? this item)
(get cache item)
not-found))
(has? [_ item]
(let [t (get ttl item (- ttl-ms))]
(< (- (System/currentTimeMillis)
t)
ttl-ms)))
(hit [this item] this)
(miss [this item result]
(let [now (System/currentTimeMillis)
kill-old (key-killer ttl ttl-ms now)]
(TTLCache. (assoc (kill-old cache) item result)
(assoc (kill-old ttl) item now)
ttl-ms)))
(seed [_ base]
(let [now (System/currentTimeMillis)]
(TTLCache. base
(into {} (for [x base] [(key x) now]))
ttl-ms)))
(evict [_ key]
(TTLCache. (dissoc cache key)
(dissoc ttl key)
ttl-ms))
Object
(toString [_]
(str cache \, \space ttl \, \space ttl-ms)))