file-backed-atom2.clj

file-backed-atom2.clj

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

(defn- load-file!
  [fname init-value]
  (let [f (java.io.File. fname)]
    (if (.exists f)
      (-> (slurp f) edn/read-string)
      init-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]
    (locking file
      (reset! cache value)
      (spit file (with-out-str (pprint @cache)))
      this))

  (swap [this f]
    (locking file
      (swap! cache f)
      (spit file (with-out-str (pprint @cache)))
      this))

  (swap [this f arg]
    (locking file
      (swap! cache f arg)
      (spit file (with-out-str (pprint @cache)))
      this))

  (swap [this f arg1 arg2]
    (locking file
      (swap! cache f arg1 arg2)
      (spit file (with-out-str (pprint @cache)))
      this))

  (swap [this f x y args]
    (locking file
      (swap! cache (fn [s] (apply f (list* s x y args))))
      (spit file (with-out-str (pprint @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! fname init-value)
         cache (atom value)]
     (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 %))))))]
    (loop [runs runs]
      (when-let [run (first runs)]
        (deref run)
        (recur (rest runs))))

    (is (= {:x num-threads} @data))
    (let [v (-> "test.edn" slurp edn/read-string)]
      (is (= {:x num-threads} v)))))