<commit_before>#|
  This file is a part of integral project.
  Copyright (c) 2014 <NAME> (<EMAIL>)
|#

(in-package :cl-user)
(defpackage integral.table
  (:use :cl)
  (:import-from :integral.connection
                :get-connection
                :database-type
                :with-quote-char
                :retrieve-table-column-definitions-by-name)
  (:import-from :integral.column
                :table-column-name
                :table-column-definition
                :auto-increment-p
                :primary-key-p
                :ghost-slot-p
                :column-info-for-create-table
                :slot-definition-to-plist)
  (:import-from :integral.database
                :execute-sql)
  (:import-from :integral.variable
                :*auto-migration-mode*)
  (:import-from :integral.util
                :symbol-name-literally
                :class-inherit-p)
  (:import-from :closer-mop
                :validate-superclass
                :ensure-class-using-class
                :direct-slot-definition-class
                :slot-definition-name
                :class-direct-slots)
  (:import-from :sxql
                :make-statement
                :primary-key
                :unique-key
                :index-key
                :yield)
  (:import-from :alexandria
                :ensure-list))
(in-package :integral.table)

(cl-syntax:use-syntax :annot)

@export
(defclass dao-class () ()
  (:documentation "Base class of classes whose metaclass is DAO-TABLE-CLASS. The inheritance will be done implicitly.
If you want to use another class, specify it as a superclass in the usual way."))

@export
(defclass dao-table-class (standard-class)
  ((primary-key :initarg :primary-key)
   (unique-keys :initarg :unique-keys)
   (keys :type list
         :initarg :keys)
   (table-name :type (proper-list 'string)
               :initarg :table-name
               :initform nil)
   (generate-slots :type (proper-list 'boolean)
                   :initarg :generate-slots
                   :initform nil)
   (%initialized :type (proper-list 'boolean)
                 :initform nil
                 :accessor initializedp))
  (:documentation "Metaclass to define classes for your database-access objects as regular CLOS classes."))

(defparameter *oid-slot-definition*
  '(:name %oid :col-type serial :auto-increment t :primary-key t :readers (getoid)))

(defun initargs-contains-primary-key (initargs)
  (or (car (getf initargs :generate-slots))
      (getf initargs :primary-key)
      (find-if (lambda (slot)
                 (getf slot :primary-key))
               (getf initargs :direct-slots))))

(defmethod make-instance :before ((class dao-table-class) &key &allow-other-keys)
  (unless (and (slot-boundp class '%initialized)
               (initializedp class))
    (initialize-dao-table-class class)))

(defmethod initialize-instance :around ((class dao-table-class) &rest initargs &key direct-superclasses &allow-other-keys)
  (unless (and (car (getf initargs :generate-slots))
               (initargs-contains-primary-key initargs))
    (push *oid-slot-definition* (getf initargs :direct-slots)))

  (unless (contains-class-or-subclasses 'dao-class direct-superclasses)
    (setf (getf initargs :direct-superclasses)
          (cons (find-class 'dao-class) direct-superclasses)))
  (apply #'call-next-method class initargs))

(defmethod initialize-instance :after ((class dao-table-class) &key)
  (let ((generate-slots (car (slot-value class 'generate-slots))))
    (unless generate-slots
      (setf (initializedp class) t))
    (when (and *auto-migration-mode*
               (not generate-slots))
      (funcall (symbol-function (intern #.(string :migrate-table) (find-package :integral.migration)))
               class))))

(defmethod reinitialize-instance :around ((class dao-table-class) &rest initargs)
  (let ((generate-slots (car (slot-value class 'generate-slots))))
    (if (or generate-slots
            (initargs-contains-primary-key initargs))
        (setf (getf initargs :direct-slots)
              (remove '%oid (getf initargs :direct-slots)
                      :key #'car
                      :test #'eq))
        (push *oid-slot-definition* (getf initargs :direct-slots)))
    (prog1
        (apply #'call-next-method class initargs)
      (when generate-slots
        (setf (initializedp class) nil))
      (when (and *auto-migration-mode*
                 (not generate-slots))
        (funcall (symbol-function (intern #.(string :migrate-table) (find-package :integral.migration)))
                 class)))))

(defmethod c2mop:direct-slot-definition-class ((class dao-table-class) &key)
  'table-column-definition)

(defmethod c2mop:validate-superclass ((class dao-table-class) (super standard-class))<commit_msg>Delete a slot %oid when reinitializing with :generate-slots t.<commit_after>#|
  This file is a part of integral project.
  Copyright (c) 2014 <NAME> (<EMAIL>)
|#

(in-package :cl-user)
(defpackage integral.table
  (:use :cl)
  (:import-from :integral.connection
                :get-connection
                :database-type
                :with-quote-char
                :retrieve-table-column-definitions-by-name)
  (:import-from :integral.column
                :table-column-name
                :table-column-definition
                :auto-increment-p
                :primary-key-p
                :ghost-slot-p
                :column-info-for-create-table
                :slot-definition-to-plist)
  (:import-from :integral.database
                :execute-sql)
  (:import-from :integral.variable
                :*auto-migration-mode*)
  (:import-from :integral.util
                :symbol-name-literally
                :class-inherit-p)
  (:import-from :closer-mop
                :validate-superclass
                :ensure-class-using-class
                :direct-slot-definition-class
                :slot-definition-name
                :class-direct-slots)
  (:import-from :sxql
                :make-statement
                :primary-key
                :unique-key
                :index-key
                :yield)
  (:import-from :alexandria
                :ensure-list))
(in-package :integral.table)

(cl-syntax:use-syntax :annot)

@export
(defclass dao-class () ()
  (:documentation "Base class of classes whose metaclass is DAO-TABLE-CLASS. The inheritance will be done implicitly.
If you want to use another class, specify it as a superclass in the usual way."))

@export
(defclass dao-table-class (standard-class)
  ((primary-key :initarg :primary-key)
   (unique-keys :initarg :unique-keys)
   (keys :type list
         :initarg :keys)
   (table-name :type (proper-list 'string)
               :initarg :table-name
               :initform nil)
   (generate-slots :type (proper-list 'boolean)
                   :initarg :generate-slots
                   :initform nil)
   (%initialized :type (proper-list 'boolean)
                 :initform nil
                 :accessor initializedp))
  (:documentation "Metaclass to define classes for your database-access objects as regular CLOS classes."))

(defparameter *oid-slot-definition*
  '(:name %oid :col-type serial :auto-increment t :primary-key t :readers (getoid)))

(defun initargs-contains-primary-key (initargs)
  (or (car (getf initargs :generate-slots))
      (getf initargs :primary-key)
      (find-if (lambda (slot)
                 (getf slot :primary-key))
               (getf initargs :direct-slots))))

(defmethod make-instance :before ((class dao-table-class) &key &allow-other-keys)
  (unless (and (slot-boundp class '%initialized)
               (initializedp class))
    (initialize-dao-table-class class)))

(defmethod initialize-instance :around ((class dao-table-class) &rest initargs &key direct-superclasses &allow-other-keys)
  (unless (and (car (getf initargs :generate-slots))
               (initargs-contains-primary-key initargs))
    (push *oid-slot-definition* (getf initargs :direct-slots)))

  (unless (contains-class-or-subclasses 'dao-class direct-superclasses)
    (setf (getf initargs :direct-superclasses)
          (cons (find-class 'dao-class) direct-superclasses)))
  (apply #'call-next-method class initargs))

(defmethod initialize-instance :after ((class dao-table-class) &key)
  (let ((generate-slots (car (slot-value class 'generate-slots))))
    (unless generate-slots
      (setf (initializedp class) t))
    (when (and *auto-migration-mode*
               (not generate-slots))
      (funcall (symbol-function (intern #.(string :migrate-table) (find-package :integral.migration)))
               class))))

(defmethod reinitialize-instance :around ((class dao-table-class) &rest initargs)
  (let ((generate-slots (car (getf initargs :generate-slots))))
    (if (or generate-slots
            (initargs-contains-primary-key initargs))
        (setf (getf initargs :direct-slots)
              (remove '%oid (getf initargs :direct-slots)
                      :key #'car
                      :test #'eq))
        (push *oid-slot-definition* (getf initargs :direct-slots)))
    (prog1
        (apply #'call-next-method class initargs)
      (when generate-slots
        (setf (initializedp class) nil))
      (when (and *auto-migration-mode*
                 (not generate-slots))
        (funcall (symbol-function (intern #.(string :migrate-table) (find-package :integral.migration)))
                 class)))))

(defmethod c2mop:direct-slot-definition-class ((class dao-table-class) &key)
  'table-column-definition)

(defmethod c2mop:validate-superclass ((class dao-table-class) (super standard-class))
{'fraction_non_alphanumeric': 0.12515553712152633, 'fraction_numerical': 0.0014516798009124845, 'mean_word_length': 2.323569951757409, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5473182', 'n_tokens_mistral': 2964, 'n_tokens_neox': 2833, 'n_words': 691}