54 lines
1.9 KiB
Common Lisp
54 lines
1.9 KiB
Common Lisp
;;; cl-scopes/storage/tracking.lisp
|
|
|
|
;;;; A simple generic (SQL-based) storage for tracks, messages, and other stuff.
|
|
|
|
(defpackage :scopes/storage/tracking
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:storage :scopes/storage))
|
|
(:export #:track #:time-stamp #:data
|
|
#:container
|
|
#:create-indexes #:create-table))
|
|
|
|
(in-package :scopes/storage/tracking)
|
|
|
|
(defclass track ()
|
|
((head)
|
|
(time-stamp :reader time-stamp :accessor time-stamp!)
|
|
(data :accessor data :initform nil)
|
|
(container :initarg :container)))
|
|
|
|
(defclass container ()
|
|
((storage :initarg :storage)
|
|
(table-name :reader table-name :initform :tracks)
|
|
(head-fields :reader head-fields :initform '(:taskid :username))
|
|
(indexes :reader indexes :initform '((:taskid :username) (username)))))
|
|
|
|
(defun create-table (st cont)
|
|
(let*
|
|
((table-name (table-name cont))
|
|
(head-fields (head-fields cont))
|
|
(params (storage:db-params st))
|
|
(id-type (getf params :id-type))
|
|
(json-type (getf params :json-type))
|
|
(hf-def (mapcar #'(lambda (x)
|
|
(list x :type 'text :not-null t :default '|''|))
|
|
head-fields)))
|
|
(storage:do-sql st
|
|
(sxql:make-statement :create-table table-name
|
|
(nconc
|
|
`((trackid :type ,id-type :primary-key t :not-null t))
|
|
hf-def
|
|
`((timestamp :type timestamptz :not-null t :default current_timestamp)
|
|
(data :type ,json-type :not-null t :default |'{}'|)))))))
|
|
|
|
(defun create-indexes (st tname ixs)
|
|
(let ((i 1)
|
|
(tn (symbol-name tname)))
|
|
(dolist (ix ixs)
|
|
(let ((ixname (intern (format nil "IDX_~a_~d" tn i))))
|
|
(incf i)
|
|
(storage:do-sql st
|
|
(sxql:create-index ixname :on (cons tname ix)))))
|
|
(storage:do-sql st
|
|
(sxql:create-index (intern (format nil "IDX_~a_TS" tn))
|
|
:on (cons tname '(timestamp))))))
|