<commit_before>(util:def-file-package #:sykosomatic.components.describable
  (:use :sykosomatic.db
        :sykosomatic.entity)
  (:export :noun
           :configure-noun
           :remove-noun
           :plural-noun
           :pluralize
           :adjectives
           :add-adjective
           :remove-adjective
           :remove-all-adjectives
           :add-feature
           :remove-feature
           :list-features
           :nickname
           :configure-nickname
           :remove-nickname
           :base-description
           :short-description
           :find-by-short-description
           :partial-short-description))

;;;
;;; Nouns
;;;
(defdao noun ()
  ((entity-id bigint)
   (singular text)
   (plural text)))

(defun noun (entity)
  (values (db-query (:select 'singular :from 'noun :where (:= 'entity-id entity)) :single)))
(defun plural-noun (entity)
  (values (db-query (:select 'plural :from 'noun :where (:= 'entity-id entity)) :single)))
(defun pluralize (word &aux (unaccented-word (db-query (:select (:unaccent word)) :single)))
  (cond ((or
          (ends-with-subseq "ch" unaccented-word :test #'equal)
          (ends-with-subseq "sh" unaccented-word :test #'equal)
          (ends-with-subseq "s" unaccented-word :test #'equal))
         (format nil "~Aes" word))
        ((and (equal #\y (last-elt unaccented-word))
              (> (length unaccented-word) 2)
              (not (find (elt unaccented-word (- (length unaccented-word) 2))
                         "aeiou")))
         (format nil "~Aies" (subseq word 0 (1- (length word)))))
        ((and (equal #\o (last-elt unaccented-word))
              (> (length unaccented-word) 2)
              (not (find (elt unaccented-word (- (length unaccented-word) 2))
                         "aeiou")))
         (format nil "~Aoes" (subseq word 0 (1- (length word)))))
        (t (format nil "~As" word))))

(defun configure-noun (entity singular &key plural)
  (with-transaction ()
    (if (noun entity)
        (db-query (:update 'noun :set
                           'singular singular
                           'plural (or plural (pluralize singular))
                           :where (:= 'entity-id entity)))
        (insert-row 'noun
                    :entity-id entity
                    :singular singular
                    :plural (or plural (pluralize singular))))
    (cache-base-description entity :update-featured t))
  t)

(defun remove-noun (entity)
  (values (db-query (:delete-from 'noun :where (:= 'entity-id entity)))))

;;;
;;; Adjectives
;;;
(defdao adjective ()
  ((entity-id bigint)
   (adjective text)
   (show-in-short-p boolean :col-default t)
   (index numeric :col-default 0)))

(defun adjectives (entity)
  (db-query (:select 'adjective :from 'adjective
                     :where (:= 'entity-id entity))
            :column))

(defun add-adjective (entity adjective &key (show-in-short-p t) (index 0))
  (with-transaction ()
    (insert-row 'adjective
                :entity-id entity :adjective adjective
                :show-in-short-p show-in-short-p
                :index index)
    (cache-base-description entity :update-featured t)))

(defun remove-adjective (entity adjective)
  (db-query (:delete-from 'adjective :where (:and (:= 'entity-id entity)
                                                  (:= 'adjective adjective)))))

(defun remove-all-adjectives (entity)
  (db-query (:delete-from 'adjective :where (:= 'entity-id entity))))

;;;
;;; Features
;;;
;;; - Features are basically regular entities, with their own nouns, adjectives, and features, that
;;;   are treated as 'details' for this entity.
;;;
(defdao feature ()
  ((entity-id bigint)
   (feature-id bigint)))

(defun add-feature (entity feature)
  (with-transaction ()
    (unless (db-query (:select t :from 'feature :where (:and (:= 'entity-id entity)
                                                             (:= 'feature-id feature)))
                      :single)
      (insert-row 'feature :feature-id feature :entity-id entity)
      (cache-base-description entity))))
(defun remove-feature (entity feature)
  (with-transaction ()
    (db-query (:delete-from 'feature :where (:and (:= 'entity-id entity)
                                                  (:= 'feature-id feature))))
    (cache-base-description entity)))
(defun list-features (entity)
  (db-query (:select 'feature-id :from 'feature :where (:= 'entity-id entity))
            :column))

;;;
;;; Base description
;;;
;;; - The base description for an entity is what it will look like when not given a nickname. For
;;;   example, 'a teapot', or 'a tall person'.
;;;
;;;   We cache these base descriptions to make lookups fast. These caches are updated whenever a
;;;   feature, noun, or adjective changes. In the case of nouns and adjectives, any entities that
;;;   use the current entity as a feature also have their cache updated. This system needs to go no
;;;   deeper than a single level because base-description does not recursively 'render' features.
(defdao cached-base-description ()<commit_msg>Initial work toward feature display control.<commit_after>(util:def-file-package #:sykosomatic.components.describable
  (:use :sykosomatic.db
        :sykosomatic.entity)
  (:export :noun
           :configure-noun
           :remove-noun
           :plural-noun
           :pluralize
           :adjectives
           :add-adjective
           :remove-adjective
           :remove-all-adjectives
           :add-feature
           :remove-feature
           :list-features
           :nickname
           :configure-nickname
           :remove-nickname
           :base-description
           :short-description
           :find-by-short-description
           :partial-short-description))

;;;
;;; Nouns
;;;
(defdao noun ()
  ((entity-id bigint)
   (singular text)
   (plural text)))

(defun noun (entity)
  (values (db-query (:select 'singular :from 'noun :where (:= 'entity-id entity)) :single)))
(defun plural-noun (entity)
  (values (db-query (:select 'plural :from 'noun :where (:= 'entity-id entity)) :single)))
(defun pluralize (word &aux (unaccented-word (db-query (:select (:unaccent word)) :single)))
  (cond ((or
          (ends-with-subseq "ch" unaccented-word :test #'equal)
          (ends-with-subseq "sh" unaccented-word :test #'equal)
          (ends-with-subseq "s" unaccented-word :test #'equal))
         (format nil "~Aes" word))
        ((and (equal #\y (last-elt unaccented-word))
              (> (length unaccented-word) 2)
              (not (find (elt unaccented-word (- (length unaccented-word) 2))
                         "aeiou")))
         (format nil "~Aies" (subseq word 0 (1- (length word)))))
        ((and (equal #\o (last-elt unaccented-word))
              (> (length unaccented-word) 2)
              (not (find (elt unaccented-word (- (length unaccented-word) 2))
                         "aeiou")))
         (format nil "~Aoes" (subseq word 0 (1- (length word)))))
        (t (format nil "~As" word))))

(defun configure-noun (entity singular &key plural)
  (with-transaction ()
    (if (noun entity)
        (db-query (:update 'noun :set
                           'singular singular
                           'plural (or plural (pluralize singular))
                           :where (:= 'entity-id entity)))
        (insert-row 'noun
                    :entity-id entity
                    :singular singular
                    :plural (or plural (pluralize singular))))
    (cache-base-description entity :update-featured t))
  t)

(defun remove-noun (entity)
  (values (db-query (:delete-from 'noun :where (:= 'entity-id entity)))))

;;;
;;; Adjectives
;;;
(defdao adjective ()
  ((entity-id bigint)
   (adjective text)
   (show-in-short-p boolean :col-default t)
   (index numeric :col-default 0)))

(defun adjectives (entity)
  (db-query (:select 'adjective :from 'adjective
                     :where (:= 'entity-id entity))
            :column))

(defun add-adjective (entity adjective &key (show-in-short-p t) (index 0))
  (with-transaction ()
    (insert-row 'adjective
                :entity-id entity :adjective adjective
                :show-in-short-p show-in-short-p
                :index index)
    (cache-base-description entity :update-featured t)))

(defun remove-adjective (entity adjective)
  (db-query (:delete-from 'adjective :where (:and (:= 'entity-id entity)
                                                  (:= 'adjective adjective)))))

(defun remove-all-adjectives (entity)
  (db-query (:delete-from 'adjective :where (:= 'entity-id entity))))

;;;
;;; Features
;;;
;;; - Features are basically regular entities, with their own nouns, adjectives, and features, that
;;;   are treated as 'details' for this entity.
;;;
(defdao feature ()
  ((entity-id bigint)
   (feature-id bigint)
   (show-in-short-p boolean :col-default t)
   (index numeric :col-default 0)))

(defun add-feature (entity feature &key (show-in-short-p t) (index 0))
  (with-transaction ()
    (if (db-query (:select t :from 'feature :where (:and (:= 'entity-id entity)
                                                         (:= 'feature-id feature)))
                  :single)
        (db-query (:update 'feature :set
                           'show-in-short-p show-in-short-p
                           'index index
                           :where (:and (:= 'entity-id entity)
                                        (:= 'feature-id feature))))
        (insert-row 'feature
                    :feature-id feature
                    :entity-id entity
                    :show-in-short-p show-in-short-p
                    :index index))
    (cache-base-description entity)))

(defun remove-feature (entity feature)
  (with-transaction ()
    (db-query (:delete-from 'feature :where (:and (:= 'entity-id entity)
                                                  (:= 'feature-id feature))))
    (cache-base-description entity)))
(defun list-features (entity)
  (db-query (:select 'feature-id :from 'feature :where (:= 'entity-id entity))
            :column))

;;;
;;; Base description
;;;
;;; - The base description for an entity is what it will look like when not given a nickname. For
;;;   example, 'a teapot', or 'a tall person'.
;;;
;;;   We cache these base descriptions to make lookups fast. These caches are updated whenever a
;;;   feature, noun, or adjective changes. In the case of nouns and adjectives, any entities that
;;;   use the current entity as a feature also have their cache updated. This system needs to go no
;;;   deeper than a single level because base-description does not recursively 'render' features.
(defdao cached-base-description ()
{'fraction_non_alphanumeric': 0.1367664894113257, 'fraction_numerical': 0.002052430264017166, 'mean_word_length': 2.1409317316144154, 'pattern_counts': {'":': 0, '<': 3, '<?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': 14, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6792245', 'n_tokens_mistral': 3332, 'n_tokens_neox': 3163, 'n_words': 914}