-
Notifications
You must be signed in to change notification settings - Fork 0
/
dal.lisp
62 lines (54 loc) · 2.26 KB
/
dal.lisp
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
(in-package :rekishi)
(defparameter *connection* nil)
(defun setup-connection ()
(dbi:connect :sqlite :database-name "/home/marcecoll/rekishi.sqlite3"))
(defun query (query-string &optional args)
"Helper to query the DB"
(let* ((q (dbi:prepare *connection* query-string))
(q (dbi:execute q args)))
(dbi:fetch-all q)))
(defun upsert-object (&key hash definition documentation parent)
(query
"INSERT INTO objects (hash, definition, documentation, parent, mtime)
VALUES (?, ?, ?, ?, unixepoch())
ON CONFLICT DO
UPDATE SET parent = ?"
(list hash (format nil "~s" definition) documentation parent parent)))
(defun get-binding-object-hash (binding)
(let ((row (car (query
"SELECT object FROM bindings WHERE binding = ? AND package = ?"
(list (symbol-name binding) (package-name (symbol-package binding)))))))
(getf row :|object|)))
(defun get-binding-object (binding)
(let ((row (car (query
"
SELECT o.*, b.package, b.binding FROM objects AS o
JOIN bindings AS b ON (b.object = o.hash)
WHERE binding = ? AND package = ?"
(list (symbol-name binding) (package-name (symbol-package binding)))))))
row))
(defun get-history (sym)
(let ((query-string "
WITH RECURSIVE ancestor(hash, parent, definition, mtime) AS (
SELECT hash, parent, definition, mtime FROM objects
WHERE hash = (SELECT object FROM bindings WHERE binding = ? AND package = ?)
UNION
SELECT o.hash, o.parent, o.definition, o.mtime
FROM ancestor AS a, objects AS o
WHERE a.parent = o.hash
UNION
SELECT o.hash, o.parent, o.definition, o.mtime
FROM ancestor AS a, objects AS o
WHERE o.parent = a.hash
ORDER BY o.mtime DESC
)
SELECT o.*, o.hash = (SELECT object FROM bindings WHERE binding = ? AND package = ?) AS current_binding
FROM objects AS o JOIN ancestor USING (hash)
ORDER BY o.mtime DESC"))
(query query-string (list (symbol-name sym) (package-name (symbol-package sym)) (symbol-name sym) (package-name (symbol-package sym))))))
(defun set-binding (binding compiled-function new-hash)
(setf (symbol-function binding) compiled-function)
(query "
INSERT INTO bindings (binding, package, object) VALUES (?, ?, ?)
ON CONFLICT DO UPDATE SET object = ?
" (list (symbol-name binding) (package-name (symbol-package binding)) new-hash new-hash)))