-
-
Save fogus/1377358 to your computer and use it in GitHub Desktop.
Alternate cache protocol
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns pallet.cache.impl | |
"An implementation namespace for pallet.cache") | |
(defprotocol CacheProtocolImpl | |
"Cache implementation interface." | |
(lookup [cache e] [cache e default] | |
"Retrieve the value associated with `e` if it exists") | |
(has? [cache e] | |
"Checks if the cache contains a value associtaed with `e`")) | |
(ns pallet.cache | |
"A caching interface and implementations" | |
(:require | |
[pallet.cache.impl :as impl])) | |
;; Based on fogus' clache protocol of the same name. | |
;; Adds an expiry callback, enabling use with resource holding values. | |
;; Assumes mutable fields, to enable use of cache from multiple threads. | |
(defprotocol CacheProtocol | |
"Cache interface." | |
(miss [cache e ret] [cache map-entry] | |
"Is meant to be called if the cache is determined to **not** contain a | |
value associated with `e`") | |
(expire [cache e] | |
"Expire a key from the cache") | |
(expire-all [cache] | |
"Expires all items in the cache")) | |
;; Implementation macro. Based on macro of the same name from clache. | |
;; Adds a factory function for use with clojure 1.2 | |
(defmacro ^{:private true} defcache | |
[cache-name fields & specifics] | |
`(deftype ~cache-name [~@fields] | |
~@specifics | |
clojure.lang.ILookup | |
(valAt [this# key#] | |
(impl/lookup this# key#)) | |
(valAt [this# key# not-found#] | |
(if-let [res# (impl/lookup this# key#)] | |
res# | |
not-found#)) | |
clojure.lang.IPersistentMap | |
(assoc [this# k# v#] | |
(miss this# k# v#)) | |
(without [this# k#] | |
(expire this# k#)) | |
clojure.lang.Associative | |
(containsKey [this# k#] | |
(impl/has? this# k#)) | |
(entryAt [this# k#] | |
(impl/lookup this# k#)))) | |
(defcache FIFOCache [cache queue limit expire-f] | |
impl/CacheProtocolImpl | |
(lookup | |
[_ item] | |
(get @cache item)) | |
(lookup | |
[_ item default] | |
(get @cache item default)) | |
(has? | |
[_ item] | |
(contains? @cache item)) | |
CacheProtocol | |
(miss | |
[_ item result] | |
(let [[not-free? v] (dosync | |
(let [k (peek @queue) | |
not-free? (not= ::free k) | |
v (when not-free? (get @cache k))] | |
(alter cache #(-> % (dissoc k) (assoc item result))) | |
(alter queue #(-> % pop (conj item))) | |
[not-free? v]))] | |
(when (and expire-f not-free?) | |
(expire-f v)) | |
nil)) | |
(miss [this [item result]] (miss this item result)) | |
(expire-all | |
[_] | |
(let [c (dosync | |
(let [c @cache] | |
(alter | |
queue | |
(constantly | |
(into clojure.lang.PersistentQueue/EMPTY | |
(repeat limit ::free)))) | |
(alter cache (constantly {})) | |
c))] | |
(when expire-f | |
(doseq [[_ v] c] | |
(expire-f v))) | |
nil)) | |
(expire | |
[_ item] | |
(let [v (dosync | |
(let [v (get @cache item ::miss)] | |
(when (not= ::miss v) | |
(alter | |
queue | |
(fn [q] | |
(into clojure.lang.PersistentQueue/EMPTY | |
(conj (remove (partial = item) q) ::free)))) | |
(alter cache dissoc item)) | |
v))] | |
(when (and expire-f (not= v ::miss)) | |
(expire-f v))) | |
nil) | |
Object | |
(toString [_] | |
(str @cache \, \space (pr-str @queue))) | |
clojure.lang.Counted | |
(count | |
[this#] | |
(count @cache)) | |
clojure.lang.IPersistentCollection | |
;; (cons [this# elem#] (cons (-base this#) elem#)) | |
(empty [this#] (expire-all this#)) | |
;; (equiv [this# other#] (.equiv this# other#)) | |
clojure.lang.Seqable | |
(seq [this#] (seq @cache)) | |
;; Java interfaces | |
java.lang.Iterable | |
(iterator [this#] (.iterator @cache))) | |
(defn make-fifo-cache [& {:keys [cache queue limit expire-f]}] | |
(FIFOCache. | |
(ref (or cache {})) | |
(ref (or queue | |
(into clojure.lang.PersistentQueue/EMPTY (repeat limit ::free)))) | |
(or limit 10) | |
expire-f)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment