simple document and query caching

src/document_storage/core.clj

@@ -11,7 +11,7 @@
 (defonce default-repository :default)
 (defonce upstream-ssh-identity "upstream")
 (defonce storage-directory (atom ""))
-
+(defonce cache (atom {}))
 
 (defn init-repository [dir]
   (when-not (jp/discover-repo dir)
@@ -44,7 +44,11 @@
         file-path (str repo-directory "/" id)]
     file-path))
 
+(defn cached-repository? [repository]
+  (get-in @repositories [repository :caching]))
 
+(defn reset-cache! []
+  (reset! cache {}))
 
 (defn get-repository-path [repository]
   (let [repo-directory (get-in @repositories [repository :directory])]
@@ -69,23 +73,47 @@
 (defn- commit-document-change [message repository]
   (jp/git-commit (get-repo repository) message {:name "Document-Manager" :email "burke@fh-muenster.de"}))
 
+(defn cache-document [repository id doc]
+  (swap! cache update-in [repository :documents] assoc id doc)
+  doc)
+
+(defn cache-query [repository query result]
+  (swap! cache update-in [repository :queries] assoc query result)
+  result)
+
+(defn uncache-document [repository id]
+  (swap! cache update-in [repository] dissoc :queries)
+  (swap! cache update-in [repository :documents] dissoc id))
+
 (defn save-document [id document & {:keys [repository] :or {repository default-repository}}]
   (let [file-path (get-file-path id repository)
         document (with-out-str (pprint document))]
     (when-not (and (valid-id? id repository) (= (slurp file-path) document))
+      (uncache-document repository id)
       (spit file-path document)
       (jp/git-add (get-repo repository) id)
       (commit-document-change (str "saved new version of " id) repository))))
 
 (defn delete-document [id & {:keys [repository] :or {repository default-repository}}]
   (when (valid-id? id repository)
+    (uncache-document repository id)
     (io/delete-file (get-file-path id :units) true)
     (jp/git-rm (get-repo repository) id)
     (commit-document-change (str "deleted document " id) repository)))
 
 (defn load-document [id & {:keys [repository] :or {repository default-repository}}]
-  (when (valid-id? id repository)
-    (read-string (slurp (get-file-path id repository)))))
+  (let [cached-repository (cached-repository? repository)]
+  (or
+   (when cached-repository?
+     (get-in @cache [repository :documents id]))
+   (when (valid-id? id repository)
+     (let [result (read-string (slurp (get-file-path id repository)))]
+       (if cached-repository
+         (cache-document repository id result)
+         result
+         )
+       )
+     ))))
 
 (defn list-documents [& {:keys [repository] :or {repository default-repository}}]
   (let [repo-path (get-repository-path repository)
@@ -99,21 +127,26 @@
 (defn query-fits? [data query]
   (reduce (fn [a b]
             (and (true? a) (= a b)))
-
           (map
            (fn [[key [compare-fn val]]]
              (compare-fn (key data) val))
            query)))
 
 (defn find-documents [query & {:keys [repository] :or {repository default-repository}}]
-  (let [docs (list-documents :repository repository)]
-    (into {} (keep (fn [fname]
-                     (let [doc (load-document fname :repository repository)]
-                       (when (query-fits? doc query)
-                         [fname doc]
-                         )
-                       ))
-                   docs))))
+  (let [docs (list-documents :repository repository)
+        cached-repository (cached-repository? repository)]
+    (or (when cached-repository
+          (get-in @cache [repository :queries query]))
+        (let [result (into {} (keep (fn [fname]
+                               (let [doc (load-document fname :repository repository)]
+                                 (when (query-fits? doc query)
+                                   [fname doc]
+                                   )
+                                 ))
+                                    docs))]
+          (if cached-repository
+            (cache-query repository query result)
+            result)))))
 
 (defn get-upstreams [repo-name]
   (-> (get-repo-data repo-name)