add compact fn

README.md

@@ -206,6 +206,19 @@ values of the database, by setting the `*return-history?*` binding to `true`.
     (println "new value:" new-value)))
 ```
 
+## Compaction
+
+Normally, an immutable database grows forever, because old data is never deleted. To reclaim disk space and clear the history, xitdb supports compaction. This involves completely rebuilding the database file to only contain the data accessible from the latest copy (i.e., "moment") of the database.
+
+```clojure
+(with-open [compacted (xdb/compact db "compacted.xdb")]
+  (println (xdb/materialize @compacted)))
+```
+
+The `compact` function takes either a file name or `:memory` and returns a new database rather than modifying the existing one. A file target must not already exist, because in-place compaction is not supported. If you want to delete the original database and replace it with the compacted one, you'll need to do that yourself.
+
+Compaction holds the source database's write lock for the duration of the copy: reads continue, but any `swap!` or `reset!` on the source will block until compaction finishes. For the same reason, `compact` must not be called from inside a `swap!` or `reset!` on the database being compacted; it throws an `IllegalStateException` if it is.
+
 ## Freezing
 
 One important distinction from the Clojure atom is that inside a transaction (eg. a `swap!`), the data is temporarily mutable. This is exactly like Clojure's transients, and it is a very important optimization. However, this can lead to a surprising behavior:

deps.edn

@@ -1,6 +1,6 @@
 {:paths ["src" "test"]
  :deps  {org.clojure/clojure        {:mvn/version "1.12.0"}
-         io.github.radarroark/xitdb {:mvn/version "0.32.0"}}
+         io.github.radarroark/xitdb {:mvn/version "0.34.0"}}
 
  :aliases
  {:test  {:extra-deps {io.github.cognitect-labs/test-runner

src/xitdb/db.clj

@@ -5,9 +5,11 @@
     [xitdb.xitdb-types :as xtypes])
   (:import
     [io.github.radarroark.xitdb
-     CoreBufferedFile CoreFile CoreMemory Database Database$ContextFunction Hasher
+     Core CoreBufferedFile CoreMemory Database Database$ContextFunction Hasher
      RandomAccessBufferedFile RandomAccessMemory ReadArrayList WriteArrayList WriteCursor]
-    [java.io File RandomAccessFile]
+    [java.io File]
+    [java.nio.file Files]
+    [java.nio.file.attribute FileAttribute]
     [java.security MessageDigest]
     [java.util.concurrent.locks ReentrantLock]))
 
@@ -23,11 +25,14 @@
   If `filename` is `:memory`, returns a memory based db.
   open-mode can be `r` or `rw`."
   [filename ^String open-mode]
-  (let [core   (if (= filename :memory)
-                 (CoreMemory. (RandomAccessMemory.))
-                 (CoreBufferedFile. (RandomAccessBufferedFile. (File. ^String filename) open-mode)))
-        hasher (Hasher. (MessageDigest/getInstance "SHA-1"))]
-    (Database. core hasher)))
+  (let [^Core core (if (= filename :memory)
+                     (CoreMemory. (RandomAccessMemory.))
+                     (CoreBufferedFile. (RandomAccessBufferedFile. (File. ^String filename) open-mode)))]
+    (try
+      (Database. core (Hasher. (MessageDigest/getInstance "SHA-1")))
+      (catch Throwable t
+        (.close core)
+        (throw t)))))
 
 
 (defn ^WriteArrayList db-history [^Database db]
@@ -110,11 +115,10 @@
         (.unlock lock)))))
 
 (defn- close-db-internal!
-  "Closes the db file. Does nothing if it's a memory db"
+  "Closes the underlying core of `db` (the file handle for file databases,
+  the in-memory buffer for memory databases)."
   [^Database db]
-  (let [core (-> db .-core)]
-    (when (instance? CoreFile core)
-      (.close ^RandomAccessFile (-> db .-core .file)))))
+  (.close ^Core (.-core db)))
 
 
 (defn ^ReadArrayList read-history
@@ -173,25 +177,77 @@
   (swap [this f x y args]
     (apply xitdb-swap-with-lock! (concat [this nil f x y] args))))
 
+(defn- wrap-db [filename ^Database rwdb]
+  (if (= :memory filename)
+    (let [tdbmem (proxy [ThreadLocal] []
+                   (initialValue []
+                     rwdb))]
+      (->XITDBDatabase tdbmem rwdb (ReentrantLock.)))
+
+    (let [tldb (proxy [ThreadLocal] []
+                 (initialValue []
+                   (open-database filename "r")))]
+      (->XITDBDatabase tldb rwdb (ReentrantLock.)))))
+
 (defn xit-db
   "Returns a new XITDBDatabase which can be used to query and transact data.
   `filename` can be `:memory` or the name of a file on the filesystem.
   If the file does not exist, it will be created.
   The returned database handle can be used from multiple threads.
   Reads can run in parallel, transactions (eg. `swap!`) will only allow one writer at a time."
   [filename]
-  (if (= :memory filename)
-    (let [memdb  (open-database :memory "rw")
-          tdbmem (proxy [ThreadLocal] []
-                   (initialValue []
-                     memdb))]
-      (->XITDBDatabase tdbmem memdb (ReentrantLock.)))
+  (wrap-db filename (open-database filename "rw")))
 
-    (let [tldb (proxy [ThreadLocal] []
-                 (initialValue []
-                   (open-database filename "r")))
-          rwdb (open-database filename "rw")]
-      (->XITDBDatabase tldb rwdb (ReentrantLock.)))))
+(defn- create-compact-target [filename]
+  (if (= :memory filename)
+    {:core (CoreMemory. (RandomAccessMemory.))}
+    (let [file (File. ^String filename)]
+      (Files/createFile (.toPath file) (make-array FileAttribute 0))
+      (try
+        {:core (CoreBufferedFile. (RandomAccessBufferedFile. file "rw"))
+         :file file}
+        (catch Throwable t
+          (Files/deleteIfExists (.toPath file))
+          (throw t))))))
+
+(defn compact
+  "Compacts the latest value of `xdb` into a new database at `target`.
+  `target` can be `:memory` or the name of a file that does not exist.
+  Returns an open XITDBDatabase containing at most one history entry. The source
+  database is unchanged.
+
+  Holds the source's write lock for the whole copy, so `swap!` and `reset!` on
+  `xdb` block until compaction finishes. Must not be called from inside a
+  `swap!` or `reset!` on `xdb`; doing so throws IllegalStateException."
+  [^XITDBDatabase xdb target]
+  (let [^ReentrantLock lock (.-lock xdb)]
+    (when (.isHeldByCurrentThread lock)
+      (throw (IllegalStateException. "compact should not be called from swap! or reset!")))
+    (try
+      (.lock lock)
+      (let [target-info (create-compact-target target)
+            ^Core target-core (:core target-info)]
+        (try
+          (let [compacted (.compact ^Database (.-rwdb xdb) target-core)]
+            ;; xitdb 0.34.0 shares the source's mutable digest with the copy.
+            ;; These handles have independent locks, so their digests must too.
+            (set! (.-md compacted)
+                  (MessageDigest/getInstance (.getAlgorithm (.-md compacted))))
+            (wrap-db target compacted))
+          (catch Throwable t
+            ;; Clean up the target without hiding the original error
+            (try
+              (.close target-core)
+              (catch Throwable close-error
+                (.addSuppressed ^Throwable t close-error)))
+            (when-let [^File file (:file target-info)]
+              (try
+                (Files/deleteIfExists (.toPath file))
+                (catch Throwable delete-error
+                  (.addSuppressed ^Throwable t delete-error))))
+            (throw t))))
+      (finally
+        (.unlock lock)))))
 
 
 (deftype XITDBCursor [xdb keypath]
@@ -243,4 +299,3 @@
             (str "freeze! requires a writeable XITDB data structure, got: " (type x)))))
   (-> x common/-unwrap .cursor .db .freeze)
   (common/-read-only x))
-