agent version of file based atom

gambit-1.clj

(ns afile.gambit-1
  (:refer-clojure :exclude [deref])
  (:require
   [clojure.edn :as edn]
   [clojure.pprint :refer [pprint]]
   [clojure.test :refer [deftest is run-tests]]))

(defn- load-file!
  [file init-value]
  (if (.exists file)
    (-> file slurp edn/read-string)
    init-value))

(defn write!
  [file value]
  (spit file (with-out-str (pprint value)))
  value)

(deftype FileAtom [file cache]

  clojure.lang.IDeref
  (deref [this]
    (clojure.core/deref cache))

  clojure.lang.IBlockingDeref
  (deref [this time timeout-value]
    (clojure.core/deref cache time timeout-value))

  clojure.lang.IAtom
  (reset [this value]
    (send-off cache (fn [v] (write! file value)))
    (await cache)
    this)

  (swap [this f]
    (send-off cache (fn [v] (write! file (f v))))
    (await cache)
    this)

  (swap [this f arg]
    (send-off cache (fn [v] (write! file (apply f [v arg]))))
    (await cache)
    this)

  (swap [this f arg1 arg2]
    (send-off cache (fn [v] (write! file (apply f [v arg1 arg2]))))
    (await cache)
    this)

  (swap [this f x y args]
    (send-off cache (fn [v] (write! file (fn [s] (apply f (list* v x y args))))))
    (await cache)
    this)

  (compareAndSet [this old new]
    (locking file
      (when (compare-and-set! cache old new)
        (spit file (with-out-str (pprint @cache))))
      this)))

(defn fatom
  "A file-backed atom: takes a file and an initial value (if the file
  is empty) and returns an atom such that all updates are saved to the
  file. Supports [swap! reset! compare-and-set!]."
  ([fname]
   (fatom fname nil))
  ([fname init-value]
   (let [file (java.io.File. fname)
         value (load-file! file init-value)
         cache (agent value :error-mode :continue)]
     (FileAtom. file cache))))

;; ;;;

(deftest file-backed-atom
  (.delete (java.io.File. "test.edn"))
  (let [data (fatom "test.edn")
        _ (reset! data {:x 0})
        num-threads 300
        runs (for [x (range num-threads)]
               (future (swap! data #(assoc % :x (inc (:x %))))))]
    (doseq [r runs]
      @r)
    (is (= num-threads (:x @data)))
    (let [v (-> "test.edn" slurp edn/read-string)]
      (is (= num-threads (:x v))))))

Not faster than the locking version.