-
-
Notifications
You must be signed in to change notification settings - Fork 95
/
gc.cljc
65 lines (62 loc) · 3.03 KB
/
gc.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
(ns datahike.experimental.gc
(:require [clojure.set :as set]
[datahike.index.interface :refer [-mark]]
[konserve.core :as k]
[konserve.gc :refer [sweep!]]
[taoensso.timbre :refer [debug trace]]
[superv.async :refer [<? S go-try <<?]]
[clojure.core.async :as async])
(:import [java.util Date]))
;; meta-data does not get passed in macros
(defn get-time [d]
(.getTime ^Date d))
(defn- reachable-in-branch [store branch after-date config]
(go-try S
(let [head-cid (<? S (k/get-in store [branch :meta :datahike/commit-id]))]
(loop [[to-check & r] [branch]
visited #{}
reachable #{branch head-cid}]
(if to-check
(if (visited to-check) ;; skip
(recur r visited reachable)
(let [{:keys [eavt-key avet-key aevt-key
temporal-eavt-key temporal-avet-key temporal-aevt-key]
{:keys [datahike/parents
datahike/created-at
datahike/updated-at]} :meta}
(<? S (k/get store to-check))
in-range? (> (get-time (or updated-at created-at))
(get-time after-date))]
(recur (concat r (when in-range? parents))
(conj visited to-check)
(set/union reachable #{to-check}
(-mark eavt-key)
(-mark aevt-key)
(-mark avet-key)
(when (:keep-history? config)
(set/union
(-mark temporal-eavt-key)
(-mark temporal-aevt-key)
(-mark temporal-avet-key)))))))
reachable)))))
(defn gc!
"Invokes garbage collection on the database by whitelisting currently known branches.
All db snapshots on these branches before remove-before date will also be
erased (defaults to beginning of time [no erasure]). The branch heads will
always be retained."
([db] (gc! db (Date.)))
([db remove-before]
(go-try S
(let [now (Date.)
_ (debug "starting gc" now)
{:keys [config store]} db
branches (<? S (k/get store :branches))
_ (trace "retaining branches" branches)
reachable (->> branches
(map #(reachable-in-branch store % remove-before config))
async/merge
(<<? S)
(apply set/union))
reachable (conj reachable :branches)]
(trace "gc reached: " reachable)
(<? S (sweep! store reachable now))))))