changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra / scripts/org-graph-db-init.lisp

changeset 360: 7e7981b3af10
parent: 9fc8fc324c10
child: 43afcbbe2d07
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 25 Aug 2024 20:35:51 -0400
permissions: -rw-r--r--
description: org-graph-db updates 
     1 ;;; org-graph-db-init.lisp --- Initialize the org-graph-db-directory
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 #-user (ql:quickload :user)
     7 (in-package :user)
     8 (unless (find-package :org-graph-db)
     9   (defpkg :org-graph-db
    10     (:use :cl :std :rdb
    11      :obj/db :obj/query :obj/id :obj/uuid)))
    12 
    13 (in-package :org-graph-db)
    14 
    15 (rocksdb:load-rocksdb)
    16 
    17 (defun make-org-graph-schema ()
    18   (make-schema
    19    (make-field :name "file" :type 'string)
    20    (make-field :name "title" :type 'string)
    21    (make-field :name "hash" :type 'octet-vector)
    22    (make-field :name "atime" :type 'octet-vector)
    23    (make-field :name "mtime" :type 'octet-vector)
    24    (make-field :name "node" :type 'octet-vector)
    25    (make-field :name "edge" :type 'octet-vector)
    26    (make-field :name "node-tags" :type 'string)
    27    (make-field :name "node-links" :type 'string)
    28    (make-field :name "node-properties" :type 'string)
    29    (make-field :name "node-priority" :type 'string)
    30    (make-field :name "node-schedule" :type 'string)
    31    (make-field :name "node-file" :type 'string)
    32    (make-field :name "node-pos" :type 'octet-vector)
    33    (make-field :name "node-state" :type 'string)))
    34 
    35 (defparameter *org-graph-schema* (make-org-graph-schema))
    36 
    37 (defvar *org-graph-db* nil)
    38 
    39 (defparameter *org-graph-db-directory*
    40   (or (probe-file (car (cli:args)))
    41       (merge-pathnames ".stash/org/graph/db/" (user-homedir-pathname))))
    42 
    43 (defun make-org-graph-db ()
    44   (create-db (namestring *org-graph-db-directory*)
    45              :opts (default-rdb-opts)))
    46 
    47 (define-condition org-id-locations-out-of-sync (simple-error) ())
    48 
    49 (defvar *emacs-org-id-locations-file* (merge-pathnames ".emacs.d/.org-id-locations" (user-homedir-pathname)))
    50 
    51 (defun make-org-id-locations (&optional (file *emacs-org-id-locations-file*))
    52   (let ((tbl (make-hash-table :test 'equal)))
    53     (with-open-file (file file)
    54       (dolist (entry (read file))
    55         (if-let ((file (probe-file (car entry))))
    56           (setf (gethash (namestring file) tbl) (cdr entry))
    57           (signal 'org-id-locations-out-of-sync :format-control "~A" :format-arguments (list entry)))))
    58     tbl))
    59 
    60 (defvar *org-graph-id-locations* (make-org-id-locations))
    61 
    62 (defun insert-org-files ()
    63   (log:info! "inserting org files")
    64   (open-cf *org-graph-db* "file")
    65   (maphash (lambda (k v) (insert-key *org-graph-db* k
    66                                      (apply 'concatenate 'string v)
    67                                      :cf "file"))
    68            *org-graph-id-locations*)
    69   (flush-db *org-graph-db*))
    70 
    71 (defun insert-org-nodes ()
    72   (log:info! "inserting org nodes")
    73   (open-cf *org-graph-db* "node")
    74   (dolist (v (hash-table-values *org-graph-id-locations*))
    75     (dolist (id v)
    76       (insert-key *org-graph-db* id "0" :cf "node"))))
    77 
    78 (defun close-org-graph-db ()
    79   (when (db-open-p *org-graph-db*)
    80     (close-db *org-graph-db*)))        
    81 
    82 (defun init-org-graph-db ()
    83   (ensure-directories-exist (make-pathname :directory (butlast (pathname-directory *org-graph-db-directory*))) :verbose t)
    84   (with-db (db (load-schema (make-org-graph-db) *org-graph-schema*))
    85     (open-db db)
    86     (open-cfs db)
    87     (setq *org-graph-db* db)
    88     ;; (open-cfs db)
    89     (insert-org-files)
    90     (insert-org-nodes)
    91     (log:info! "created org-graph-db" db *org-graph-db-directory* *org-graph-schema*)))
    92 
    93 (defun open-org-graph-db ()
    94   (unless (probe-file *org-graph-db-directory*)
    95     (init-org-graph-db))
    96   (if (db-open-p *org-graph-db*)
    97       *org-graph-db*
    98       (open-db (or *org-graph-db* (make-org-graph-db)))))
    99 
   100 (defun destroy-org-graph-db (&optional force)
   101   (when (probe-file *org-graph-db-directory*)
   102     (unwind-protect
   103          (with-db (db (or *org-graph-db* (make-org-graph-db)))
   104            (shutdown-db db)
   105            (destroy-db db)
   106            (log:info! "destroyed org-graph-db" db *org-graph-db-directory*))
   107       (when force
   108         (sb-ext:delete-directory *org-graph-db-directory* :recursive t)
   109         (setq *org-graph-db* nil)))))