<commit_before>;;;; meta-protocol.lisp
;;;;
;;;; This file is part of the MONGO-CL-DRIVER library, released under Lisp-LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Author: <NAME> <<EMAIL>>

(in-package #:mongo-cl-driver.wire)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; message-class metaclass
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass message-class (standard-class)
  ((slot-order :initform ()
               :initarg :slot-order
               :reader class-slot-order)))

(defmethod compute-slots ((class message-class))
  (let ((order (class-slot-order class)))
    (sort (copy-list (call-next-method))
          #'(lambda (a b)
              (< (position (slot-definition-name a) order)
                 (position (slot-definition-name b) order))))))

(defmethod validate-superclass ((sub message-class) (super standard-class))
  t)

(defclass message-slot-definition (standard-direct-slot-definition)
  ((bson-type :initarg :bson-type :reader message-slot-definition-bson-type)
   (list-p :initarg :list-p :initform nil :reader message-slot-definition-list-p)))

(defclass message-effective-slot-definition (standard-effective-slot-definition)
  ((encoder :initform nil :initarg :encoder :reader message-effective-slot-encoder)
   (decoder :initform nil :initarg :decoder :reader message-effective-slot-decoder)))

(defmethod direct-slot-definition-class ((class message-class) &rest initargs)
  (declare (ignore initargs))
  'message-slot-definition)

(defmethod effective-slot-definition-class ((class message-class) &rest initargs)
  (declare (ignore initargs))
  'message-effective-slot-definition)

(defmethod compute-effective-slot-definition ((class message-class) name direct-slots)
  (let* ((normal-slot (call-next-method))
         (direct-slot (find name
                            direct-slots
                            :key #'slot-definition-name))
         (bson-type (message-slot-definition-bson-type direct-slot))
         (list-p (message-slot-definition-list-p direct-slot))
         (encoder (or (find-symbol (format nil "ENCODE-~A" bson-type)
                                   '#:mongo-cl-driver.bson)
                      (error "Can not find a encoder for ~A type" bson-type)))
         (decoder (or (find-symbol (format nil "DECODE-~A" bson-type)
                                   '#:mongo-cl-driver.bson)
                      (error "Can not find a decoder for ~A type" bson-type))))

    (setf (slot-value normal-slot 'encoder)
          (if list-p
              #'(lambda (value target)
                  (iter (for item in value)
                    (funcall encoder item target)))
              encoder))
    (setf (slot-value normal-slot 'decoder)
          decoder)
    normal-slot))<commit_msg>Make compute-effective-slot-definition compatible with print-case :downcase<commit_after>;;;; meta-protocol.lisp
;;;;
;;;; This file is part of the MONGO-CL-DRIVER library, released under Lisp-LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Author: <NAME> <<EMAIL>>

(in-package #:mongo-cl-driver.wire)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; message-class metaclass
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass message-class (standard-class)
  ((slot-order :initform ()
               :initarg :slot-order
               :reader class-slot-order)))

(defmethod compute-slots ((class message-class))
  (let ((order (class-slot-order class)))
    (sort (copy-list (call-next-method))
          #'(lambda (a b)
              (< (position (slot-definition-name a) order)
                 (position (slot-definition-name b) order))))))

(defmethod validate-superclass ((sub message-class) (super standard-class))
  t)

(defclass message-slot-definition (standard-direct-slot-definition)
  ((bson-type :initarg :bson-type :reader message-slot-definition-bson-type)
   (list-p :initarg :list-p :initform nil :reader message-slot-definition-list-p)))

(defclass message-effective-slot-definition (standard-effective-slot-definition)
  ((encoder :initform nil :initarg :encoder :reader message-effective-slot-encoder)
   (decoder :initform nil :initarg :decoder :reader message-effective-slot-decoder)))

(defmethod direct-slot-definition-class ((class message-class) &rest initargs)
  (declare (ignore initargs))
  'message-slot-definition)

(defmethod effective-slot-definition-class ((class message-class) &rest initargs)
  (declare (ignore initargs))
  'message-effective-slot-definition)

(defmethod compute-effective-slot-definition ((class message-class) name direct-slots)
  (let* ((normal-slot (call-next-method))
         (direct-slot (find name
                            direct-slots
                            :key #'slot-definition-name))
         (bson-type (message-slot-definition-bson-type direct-slot))
         (list-p (message-slot-definition-list-p direct-slot))
         (encoder (or (find-symbol (format nil "ENCODE-~A" (string bson-type))
                                   '#:mongo-cl-driver.bson)
                      (error "Can not find a encoder for ~A type" bson-type)))
         (decoder (or (find-symbol (format nil "DECODE-~A" (string bson-type))
                                   '#:mongo-cl-driver.bson)
                      (error "Can not find a decoder for ~A type" bson-type))))

    (setf (slot-value normal-slot 'encoder)
          (if list-p
              #'(lambda (value target)
                  (iter (for item in value)
                    (funcall encoder item target)))
              encoder))
    (setf (slot-value normal-slot 'decoder)
          decoder)
    normal-slot))
{'fraction_non_alphanumeric': 0.19722412611377657, 'fraction_numerical': 0.0, 'mean_word_length': 2.8655629139072847, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2064698', 'n_tokens_mistral': 1834, 'n_tokens_neox': 1677, 'n_words': 400}