simple persistence through journaled refs

journal.clj

(import '(java.io File
                  BufferedWriter FileWriter
                  PushbackReader BufferedReader FileReader))

(defn apply-code
  [x code]
  (apply (eval (first code))
         x
         (rest (map eval code))))

(defn form-seq
  "Return lazy seq of forms in file at path. Closes reader only after
  all forms are read."
  [file]
  (let [reader (-> file FileReader. BufferedReader. PushbackReader.)
        eof (Object.)
        next-form (fn next-form []
                    (let [form (read reader false eof)]
                      (if (= eof form)
                        (do
                          (println "Closing reader")
                          (.close reader)
                          nil)
                        (cons form (lazy-seq (next-form))))))]
    (next-form)))

(defn read-journal
  "Return value obtained by applying all code in journal."
  [val file]
  (reduce apply-code val (form-seq file)))

(defn journaled-ref
  "Initialize a ref by setting up the journal file writer"
  [value path]
  (let [r (ref value)
        file (File. path)]
    (when (.exists file)
      (dosync
       (alter r read-journal file)))
    (let [writer (BufferedWriter. (FileWriter. file true))]
      (alter-meta! r assoc :writer-agent (agent writer)))
    r))

(defn journal
  "Write code to journal associated with ref r (async, journal may
  take time to catch up with ref state...)"
  [r command args]
  (send-off (:writer-agent (meta r))
            (fn [writer]
              (doto writer
                (.write (pr-str (apply list command args)))
                (.newLine)
                (.flush)))))

(defn command!*
  "Apply a simple command to journaled ref r

  command should be a symbol naming a function to be applied
  args are the actual values used by the command"
  [r command & args]
  (dosync (alter r (fn [state] (apply (eval command) state args))))
  (journal r command args)
  r)

(defmacro command!
  [r command-name & args]
  `(command!* ~r '~command-name ~@args))