<commit_before>(util:def-file-package #:sykosomatic.db
  (:use :postmodern)
  (:shadow :with-transaction)
  (:export
   ;; DAO
   :id :defdao :get-dao :select-dao
   ;; Misc sql
   :defprepared
   ;; Querying
   :query :make-dao :db-query :doquery
   ;; Connections
   :with-db :with-transaction
   :get-connection
   :done-with-connection
   ;; Development utilities
   :dblog :init-db :rebuild-db :rebuild-table
   :drop-table :drop-all-tables
   ;; Init hooks
   :register-db-init-hook :remove-db-init-hook :run-db-init-hook
   ;; Validation
   :assert-validation :with-validation :assert-required
   ;; misc stuff from s-sql
   :smallint :bigint :numeric :real :double-precision :bytea
   :text :varchar :db-null :sql-type-name :*standard-sql-strings*
   :sql-escape-string :sql-escape :from-sql-name :to-sql-name
   :*escape-sql-names-p* :sql :sql-compile :sql-template :$$
   :register-sql-operators :enable-s-sql-syntax :sql-error))

(defparameter *db-name* "sykosomatic")
(defparameter *db-user* "postgres")
(defparameter *db-password* "")
(defparameter *db-host* "localhost")

;;;
;;; Connection pooling
;;;
(defparameter *connection-pool-lock* (bt:make-lock))
(defparameter *max-pooled-connections* 50)
(defvar *connection-pool* (make-queue *max-pooled-connections*))

(defun get-connection ()
  (or (bt:with-lock-held (*connection-pool-lock*)
        (unless (queue-empty-p *connection-pool*)
          (dequeue *connection-pool*)))
      (apply #'connect (list *db-name* *db-user* *db-password* *db-host*))))

(defun done-with-connection (connection)
  (bt:with-lock-held (*connection-pool-lock*)
    (if (queue-full-p *connection-pool*)
        (disconnect connection)
        (enqueue connection *connection-pool*))))

(defun clear-pooled-connections ()
  (bt:with-lock-held (*connection-pool-lock*)
    (loop until (queue-empty-p *connection-pool*)
       for connection = (dequeue *connection-pool*)
       when (connected-p connection)
       do (disconnect connection))))

(defmacro with-db ((&key (reusep t)) &body body)
  `(let* ((reusing-connection-p (and *database* ,reusep))
          (*database* (or (when reusing-connection-p *database*)
                          (get-connection))))
     (unwind-protect (progn ,@body)
       (unless reusing-connection-p
         (done-with-connection *database*)))))

(defmacro db-query (query &rest args/format)
  `(with-db () (query ,query ,@args/format)))

;;;
;;; SQL utils
;;;
(defclass base-table ()
  ((id :reader id :col-type serial))
  (:metaclass dao-class))

(defmacro defdao (name superclasses slots &body dao-options)
  (flet ((parsed-opts (keyword deftable-func-name)
           (mapcar (lambda (statement)
                     `(,deftable-func-name ,@(cdr statement)))
                   (remove-if-not (lambda (opt) (eq keyword (car opt)))
                                  dao-options))))
    `(progn
       (defclass ,name ,(append '(base-table) superclasses)
         ,(loop for (slotname col-type . other-args) in slots
             collect `(,slotname :initarg ,(intern (string slotname) :keyword)
                                 :col-type ,col-type
                                 ,@other-args))
         (:metaclass dao-class)
         ,@(when-let (keys (assoc :keys dao-options)) `(,keys)))
       (deftable ,name
         (!dao-def)
         ,@(loop for (opt . args) in dao-options
              for form = (case opt
                           (:index `(!index ,@(mapcar (curry #'list 'quote) args)))
                           (:unique-index `(!unique-index ,@(mapcar (curry #'list 'quote) args)))
                           (:foreign-key `(!foreign ,@args))
                           (:unique `(!unique ,@(mapcar (curry #'list 'quote) args)))
                           (:query `(query ,@args))
                           (:keys nil)
                           (otherwise (error "Unknown defdao option: ~S" opt)))
              when form
              collect form)))))

(defmacro with-transaction ((&optional name) &body body)
  `(with-db ()
     (pomo:with-transaction (,@(when name `(,name)))
       ,@body)))

;;;
;;; DB booting
;;;
(defun drop-table (symbol)
  (db-query (format nil "drop table if exists ~A" (sql-compile symbol))))
(defun drop-all-tables ()
  (map nil (compose #'drop-table #'car) pomo::*tables*))

(defun rebuild-table (table-name)<commit_msg>Future-proofing with-transaction.<commit_after>(util:def-file-package #:sykosomatic.db
  (:use :postmodern)
  (:shadow :with-transaction)
  (:export
   ;; DAO
   :id :defdao :get-dao :select-dao
   ;; Misc sql
   :defprepared
   ;; Querying
   :query :make-dao :db-query :doquery
   ;; Connections
   :with-db :with-transaction
   :get-connection
   :done-with-connection
   ;; Development utilities
   :dblog :init-db :rebuild-db :rebuild-table
   :drop-table :drop-all-tables
   ;; Init hooks
   :register-db-init-hook :remove-db-init-hook :run-db-init-hook
   ;; Validation
   :assert-validation :with-validation :assert-required
   ;; misc stuff from s-sql
   :smallint :bigint :numeric :real :double-precision :bytea
   :text :varchar :db-null :sql-type-name :*standard-sql-strings*
   :sql-escape-string :sql-escape :from-sql-name :to-sql-name
   :*escape-sql-names-p* :sql :sql-compile :sql-template :$$
   :register-sql-operators :enable-s-sql-syntax :sql-error))

(defparameter *db-name* "sykosomatic")
(defparameter *db-user* "postgres")
(defparameter *db-password* "")
(defparameter *db-host* "localhost")

;;;
;;; Connection pooling
;;;
(defparameter *connection-pool-lock* (bt:make-lock))
(defparameter *max-pooled-connections* 50)
(defvar *connection-pool* (make-queue *max-pooled-connections*))

(defun get-connection ()
  (or (bt:with-lock-held (*connection-pool-lock*)
        (unless (queue-empty-p *connection-pool*)
          (dequeue *connection-pool*)))
      (apply #'connect (list *db-name* *db-user* *db-password* *db-host*))))

(defun done-with-connection (connection)
  (bt:with-lock-held (*connection-pool-lock*)
    (if (queue-full-p *connection-pool*)
        (disconnect connection)
        (enqueue connection *connection-pool*))))

(defun clear-pooled-connections ()
  (bt:with-lock-held (*connection-pool-lock*)
    (loop until (queue-empty-p *connection-pool*)
       for connection = (dequeue *connection-pool*)
       when (connected-p connection)
       do (disconnect connection))))

(defmacro with-db ((&key (reusep t)) &body body)
  `(let* ((reusing-connection-p (and *database* ,reusep))
          (*database* (or (when reusing-connection-p *database*)
                          (get-connection))))
     (unwind-protect (progn ,@body)
       (unless reusing-connection-p
         (done-with-connection *database*)))))

(defmacro db-query (query &rest args/format)
  `(with-db () (query ,query ,@args/format)))

;;;
;;; SQL utils
;;;
(defclass base-table ()
  ((id :reader id :col-type serial))
  (:metaclass dao-class))

(defmacro defdao (name superclasses slots &body dao-options)
  (flet ((parsed-opts (keyword deftable-func-name)
           (mapcar (lambda (statement)
                     `(,deftable-func-name ,@(cdr statement)))
                   (remove-if-not (lambda (opt) (eq keyword (car opt)))
                                  dao-options))))
    `(progn
       (defclass ,name ,(append '(base-table) superclasses)
         ,(loop for (slotname col-type . other-args) in slots
             collect `(,slotname :initarg ,(intern (string slotname) :keyword)
                                 :col-type ,col-type
                                 ,@other-args))
         (:metaclass dao-class)
         ,@(when-let (keys (assoc :keys dao-options)) `(,keys)))
       (deftable ,name
         (!dao-def)
         ,@(loop for (opt . args) in dao-options
              for form = (case opt
                           (:index `(!index ,@(mapcar (curry #'list 'quote) args)))
                           (:unique-index `(!unique-index ,@(mapcar (curry #'list 'quote) args)))
                           (:foreign-key `(!foreign ,@args))
                           (:unique `(!unique ,@(mapcar (curry #'list 'quote) args)))
                           (:query `(query ,@args))
                           (:keys nil)
                           (otherwise (error "Unknown defdao option: ~S" opt)))
              when form
              collect form)))))

(defmacro with-transaction ((&key name) &body body)
  `(with-db ()
     (pomo:with-transaction (,@(when name `(,name)))
       ,@body)))

;;;
;;; DB booting
;;;
(defun drop-table (symbol)
  (db-query (format nil "drop table if exists ~A" (sql-compile symbol))))
(defun drop-all-tables ()
  (map nil (compose #'drop-table #'car) pomo::*tables*))

(defun rebuild-table (table-name)
{'fraction_non_alphanumeric': 0.16366968273966326, 'fraction_numerical': 0.0004581376703699462, 'mean_word_length': 2.5684511646914587, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1139638', 'n_tokens_mistral': 2893, 'n_tokens_neox': 2805, 'n_words': 662}