1.1--- a/scripts/org-graph-db-init.lisp	Sun Aug 25 00:13:49 2024 -0400
     1.2+++ b/scripts/org-graph-db-init.lisp	Sun Aug 25 20:35:51 2024 -0400
     1.3@@ -5,21 +5,105 @@
     1.4 ;;; Code:
     1.5 #-user (ql:quickload :user)
     1.6 (in-package :user)
     1.7-(defpkg :org-graph-db-init
     1.8-  (:use :cl :std :rdb
     1.9-   :obj/db :obj/query :obj/id :obj/uuid))
    1.10+(unless (find-package :org-graph-db)
    1.11+  (defpkg :org-graph-db
    1.12+    (:use :cl :std :rdb
    1.13+     :obj/db :obj/query :obj/id :obj/uuid)))
    1.14 
    1.15-(in-package :org-graph-db-init)
    1.16+(in-package :org-graph-db)
    1.17 
    1.18 (rocksdb:load-rocksdb)
    1.19 
    1.20-(defvar org-graph-schema nil)
    1.21+(defun make-org-graph-schema ()
    1.22+  (make-schema
    1.23+   (make-field :name "file" :type 'string)
    1.24+   (make-field :name "title" :type 'string)
    1.25+   (make-field :name "hash" :type 'octet-vector)
    1.26+   (make-field :name "atime" :type 'octet-vector)
    1.27+   (make-field :name "mtime" :type 'octet-vector)
    1.28+   (make-field :name "node" :type 'octet-vector)
    1.29+   (make-field :name "edge" :type 'octet-vector)
    1.30+   (make-field :name "node-tags" :type 'string)
    1.31+   (make-field :name "node-links" :type 'string)
    1.32+   (make-field :name "node-properties" :type 'string)
    1.33+   (make-field :name "node-priority" :type 'string)
    1.34+   (make-field :name "node-schedule" :type 'string)
    1.35+   (make-field :name "node-file" :type 'string)
    1.36+   (make-field :name "node-pos" :type 'octet-vector)
    1.37+   (make-field :name "node-state" :type 'string)))
    1.38 
    1.39-(defvar org-graph)
    1.40+(defparameter *org-graph-schema* (make-org-graph-schema))
    1.41+
    1.42+(defvar *org-graph-db* nil)
    1.43+
    1.44+(defparameter *org-graph-db-directory*
    1.45+  (or (probe-file (car (cli:args)))
    1.46+      (merge-pathnames ".stash/org/graph/db/" (user-homedir-pathname))))
    1.47+
    1.48+(defun make-org-graph-db ()
    1.49+  (create-db (namestring *org-graph-db-directory*)
    1.50+             :opts (default-rdb-opts)))
    1.51+
    1.52+(define-condition org-id-locations-out-of-sync (simple-error) ())
    1.53 
    1.54-(defparameter org-graph-db-directory
    1.55-  (or (probe-file (car (cli:args)))
    1.56-      #P"~/.stash/org/graph/db"))
    1.57+(defvar *emacs-org-id-locations-file* (merge-pathnames ".emacs.d/.org-id-locations" (user-homedir-pathname)))
    1.58+
    1.59+(defun make-org-id-locations (&optional (file *emacs-org-id-locations-file*))
    1.60+  (let ((tbl (make-hash-table :test 'equal)))
    1.61+    (with-open-file (file file)
    1.62+      (dolist (entry (read file))
    1.63+        (if-let ((file (probe-file (car entry))))
    1.64+          (setf (gethash (namestring file) tbl) (cdr entry))
    1.65+          (signal 'org-id-locations-out-of-sync :format-control "~A" :format-arguments (list entry)))))
    1.66+    tbl))
    1.67+
    1.68+(defvar *org-graph-id-locations* (make-org-id-locations))
    1.69+
    1.70+(defun insert-org-files ()
    1.71+  (log:info! "inserting org files")
    1.72+  (open-cf *org-graph-db* "file")
    1.73+  (maphash (lambda (k v) (insert-key *org-graph-db* k
    1.74+                                     (apply 'concatenate 'string v)
    1.75+                                     :cf "file"))
    1.76+           *org-graph-id-locations*)
    1.77+  (flush-db *org-graph-db*))
    1.78+
    1.79+(defun insert-org-nodes ()
    1.80+  (log:info! "inserting org nodes")
    1.81+  (open-cf *org-graph-db* "node")
    1.82+  (dolist (v (hash-table-values *org-graph-id-locations*))
    1.83+    (dolist (id v)
    1.84+      (insert-key *org-graph-db* id "0" :cf "node"))))
    1.85+
    1.86+(defun close-org-graph-db ()
    1.87+  (when (db-open-p *org-graph-db*)
    1.88+    (close-db *org-graph-db*)))        
    1.89 
    1.90 (defun init-org-graph-db ()
    1.91-  (with-db (db (make-rdb "org-graph" (make-rdb-opts)))))
    1.92+  (ensure-directories-exist (make-pathname :directory (butlast (pathname-directory *org-graph-db-directory*))) :verbose t)
    1.93+  (with-db (db (load-schema (make-org-graph-db) *org-graph-schema*))
    1.94+    (open-db db)
    1.95+    (open-cfs db)
    1.96+    (setq *org-graph-db* db)
    1.97+    ;; (open-cfs db)
    1.98+    (insert-org-files)
    1.99+    (insert-org-nodes)
   1.100+    (log:info! "created org-graph-db" db *org-graph-db-directory* *org-graph-schema*)))
   1.101+
   1.102+(defun open-org-graph-db ()
   1.103+  (unless (probe-file *org-graph-db-directory*)
   1.104+    (init-org-graph-db))
   1.105+  (if (db-open-p *org-graph-db*)
   1.106+      *org-graph-db*
   1.107+      (open-db (or *org-graph-db* (make-org-graph-db)))))
   1.108+
   1.109+(defun destroy-org-graph-db (&optional force)
   1.110+  (when (probe-file *org-graph-db-directory*)
   1.111+    (unwind-protect
   1.112+         (with-db (db (or *org-graph-db* (make-org-graph-db)))
   1.113+           (shutdown-db db)
   1.114+           (destroy-db db)
   1.115+           (log:info! "destroyed org-graph-db" db *org-graph-db-directory*))
   1.116+      (when force
   1.117+        (sb-ext:delete-directory *org-graph-db-directory* :recursive t)
   1.118+        (setq *org-graph-db* nil)))))