<commit_before>(in-package #:orcabot)

(defun save-pick-catalog (module)
  (with-open-file (ouf (data-path "pick-catalog.lisp")
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (write (catalog-of module) :stream ouf)))

(defun load-pick-catalog (module)
  (with-open-file (inf (data-path "pick-catalog.lisp")
                       :if-does-not-exist nil)
    (setf (catalog-of module) (if inf (read inf nil) nil))))

(defmodule pick pick-module ("pick")
  (catalog :accessor catalog-of :initform nil))

(defmethod initialize-module ((module pick-module) config)
  (load-pick-catalog module))

(defun lookup-category (catalog category)
  (rest (assoc category catalog :test #'string-equal)))

(defun find-reference-cycles (catalog start category)
  (dolist (term (lookup-category catalog category))
    (when (or (string-equal start term)
              (find-reference-cycles catalog start term))
      (return t))))

(defun add-pick-choice (module message category choices)
  (let ((bad-choices (remove-if-not (lambda (choice)
                                      (find-reference-cycles (catalog-of module) category choice))
                                    choices)))
    (when bad-choices
      (reply-to message "Ignoring choices that would cause a dependency cycle: ~{~a~^, ~}"
                bad-choices))
    (setf choices (set-difference choices bad-choices)))

  (let ((tuple (assoc category (catalog-of module) :test #'string-equal)))
    (cond
      ((null choices)
       (reply-to message "No choices to add."))
      ((null tuple)
       (push (cons category choices) (catalog-of module))
       (save-pick-catalog module)
       (reply-to message "Category '~a' added with choices: ~{~a~^, ~}"
                 category
                 choices))
      (t
       (let* ((new-choices (set-difference choices (rest tuple) :test #'string=)))
         (cond
           (new-choices
            (setf (rest tuple) (append (rest tuple) new-choices))
            (save-pick-catalog module)
            (reply-to message "Added ~{~a~^, ~} to category '~a'" new-choices category))
           (t
            (reply-to message "No new choices added to category '~a'" category))))))))

(defun del-pick-choice (module message category choices)
  (cond
    ((null (assoc category
                  (catalog-of module)
                  :test #'string-equal))
     (reply-to message "Category '~a' does not exist." category))
    ((null choices)
     (let ((category-def (assoc category
                                (catalog-of module)
                                :test #'string-equal)))
       (setf (catalog-of module) (delete category-def (catalog-of module)))
       (save-pick-catalog module)
       (reply-to message "Category '~a': removed ~@[(~{~a~^, ~})~]"
                 (first category-def)
                 (rest category-def))))
    (t
     (let* ((category-def (assoc category
                                 (catalog-of module)
                                 :test #'string-equal))
            (doomed-picks (intersection choices
                                        (rest category-def)
                                        :test #'string-equal))
            (invalid-picks (set-difference choices
                                           (rest category-def)
                                           :test #'string-equal)))
       ;; Remove category if all picks are removed
       (cond
         ((subsetp (rest category-def) doomed-picks :test #'string-equal)
          (setf (catalog-of module) (delete category-def (catalog-of module)))
          (reply-to message "Category '~a': removed ~@[ (~{~a~^, ~})~]"
                    (first category-def)
                    (rest category-def)))
         (t
          (setf (rest category-def) (set-difference (rest category-def)
                                                    doomed-picks
                                                    :test #'string-equal))
          (reply-to message "Category '~a':~@[ removed ~{~a~^, ~}~]~:[~;, ~]~@[ ignored ~{~a~^, ~}~]"
                    (first category-def)
                    doomed-picks
                    (and doomed-picks invalid-picks)
                    invalid-picks)))

       (save-pick-catalog module)))))

(defun parse-pick-args (raw-args)
  (let (opts args)
    (dolist (arg raw-args)
      (if (and (> (length arg) 2)
               (string= "--" arg :end2 2))
          (push (string-left-trim "-" arg) opts)
          (push arg args)))
    (setf args (nreverse args))
    (let* ((addp (find "add" opts :test #'string=))
           (delp (find "del" opts :test #'string=))
           (showp (or (find "show" opts :test #'string=)
                      (find "list" opts :test #'string=)))
           (category (when (or addp delp showp)
                       (pop args))))
      (values
       addp delp showp category
       (re:split "\\s*,\\s*" (join-to-string " " args))))))

(defmethod handle-command ((module pick-module)
                           (cmd (eql 'pick))
                           message args)
  ".pick <choice>, <choice> [,<choice>...] ) - selects randomly between choices
.pick - lists categories from which to pick
.pick <category> - selects random option in category
.pick --show [<category>] - display list of categories or category contents
.pick --add category <choice> - adds option to category
.pick --del category <choice> - removes option from category
"
  (multiple-value-bind (addp delp showp category choices)
      (parse-pick-args args)
    (cond
     ((and category (find #\, category))
      (reply-to message "~a: Categories may not have commas in their names." (source message)))
     (addp
      (add-pick-choice module message category choices))
     (delp
      (del-pick-choice module message category choices))
     (showp
      (if category
          (let ((terms (lookup-category (catalog-of module) category)))
            (if terms
                (reply-to message "Picks in category ~a: ~{~a~^, ~}" category terms)
                (reply-to message "~a is not a category." category)))
          (reply-to message "Pick categories: ~{~a~^, ~}"
                    (mapcar #'first (catalog-of module)))))
     ((endp choices)
          (reply-to message "Pick categories: ~{~a~^, ~}"
                    (mapcar #'first (catalog-of module))))
     ((cdr choices)
      (reply-to message "~a: I pick ~a!" (source message) (random-elt choices)))
     ((lookup-category (catalog-of module) (first choices))
      (let ((choice (random-elt (lookup-category (catalog-of module) (first choices)))))
        (loop for terms = (lookup-category (catalog-of module) choice)
           while terms do
             (setf choice (random-elt terms)))
        (reply-to message "~a: I pick ~a!" (source message) choice)))
     (t
      (reply-to message "~a is not a category." (first choices))))))
<commit_msg>Pick command now expands categories given multiple choices.<commit_after>(in-package #:orcabot)

(defun save-pick-catalog (module)
  (with-open-file (ouf (data-path "pick-catalog.lisp")
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (write (catalog-of module) :stream ouf)))

(defun load-pick-catalog (module)
  (with-open-file (inf (data-path "pick-catalog.lisp")
                       :if-does-not-exist nil)
    (setf (catalog-of module) (if inf (read inf nil) nil))))

(defmodule pick pick-module ("pick")
  (catalog :accessor catalog-of :initform nil))

(defmethod initialize-module ((module pick-module) config)
  (load-pick-catalog module))

(defun lookup-category (catalog category)
  (rest (assoc category catalog :test #'string-equal)))

(defun find-reference-cycles (catalog start category)
  (dolist (term (lookup-category catalog category))
    (when (or (string-equal start term)
              (find-reference-cycles catalog start term))
      (return t))))

(defun add-pick-choice (module message category choices)
  (let ((bad-choices (remove-if-not (lambda (choice)
                                      (find-reference-cycles (catalog-of module) category choice))
                                    choices)))
    (when bad-choices
      (reply-to message "Ignoring choices that would cause a dependency cycle: ~{~a~^, ~}"
                bad-choices))
    (setf choices (set-difference choices bad-choices)))

  (let ((tuple (assoc category (catalog-of module) :test #'string-equal)))
    (cond
      ((null choices)
       (reply-to message "No choices to add."))
      ((null tuple)
       (push (cons category choices) (catalog-of module))
       (save-pick-catalog module)
       (reply-to message "Category '~a' added with choices: ~{~a~^, ~}"
                 category
                 choices))
      (t
       (let* ((new-choices (set-difference choices (rest tuple) :test #'string=)))
         (cond
           (new-choices
            (setf (rest tuple) (append (rest tuple) new-choices))
            (save-pick-catalog module)
            (reply-to message "Added ~{~a~^, ~} to category '~a'" new-choices category))
           (t
            (reply-to message "No new choices added to category '~a'" category))))))))

(defun del-pick-choice (module message category choices)
  (cond
    ((null (assoc category
                  (catalog-of module)
                  :test #'string-equal))
     (reply-to message "Category '~a' does not exist." category))
    ((null choices)
     (let ((category-def (assoc category
                                (catalog-of module)
                                :test #'string-equal)))
       (setf (catalog-of module) (delete category-def (catalog-of module)))
       (save-pick-catalog module)
       (reply-to message "Category '~a': removed ~@[(~{~a~^, ~})~]"
                 (first category-def)
                 (rest category-def))))
    (t
     (let* ((category-def (assoc category
                                 (catalog-of module)
                                 :test #'string-equal))
            (doomed-picks (intersection choices
                                        (rest category-def)
                                        :test #'string-equal))
            (invalid-picks (set-difference choices
                                           (rest category-def)
                                           :test #'string-equal)))
       ;; Remove category if all picks are removed
       (cond
         ((subsetp (rest category-def) doomed-picks :test #'string-equal)
          (setf (catalog-of module) (delete category-def (catalog-of module)))
          (reply-to message "Category '~a': removed ~@[ (~{~a~^, ~})~]"
                    (first category-def)
                    (rest category-def)))
         (t
          (setf (rest category-def) (set-difference (rest category-def)
                                                    doomed-picks
                                                    :test #'string-equal))
          (reply-to message "Category '~a':~@[ removed ~{~a~^, ~}~]~:[~;, ~]~@[ ignored ~{~a~^, ~}~]"
                    (first category-def)
                    doomed-picks
                    (and doomed-picks invalid-picks)
                    invalid-picks)))

       (save-pick-catalog module)))))

(defun parse-pick-args (raw-args)
  (let (opts args)
    (dolist (arg raw-args)
      (if (and (> (length arg) 2)
               (string= "--" arg :end2 2))
          (push (string-left-trim "-" arg) opts)
          (push arg args)))
    (setf args (nreverse args))
    (let* ((addp (find "add" opts :test #'string=))
           (delp (find "del" opts :test #'string=))
           (showp (or (find "show" opts :test #'string=)
                      (find "list" opts :test #'string=)))
           (category (when (or addp delp showp)
                       (pop args))))
      (values
       addp delp showp category
       (re:split "\\s*,\\s*" (join-to-string " " args))))))

(defmethod handle-command ((module pick-module)
                           (cmd (eql 'pick))
                           message args)
  ".pick <choice>, <choice> [,<choice>...] ) - selects randomly between choices
.pick - lists categories from which to pick
.pick <category> - selects random option in category
.pick --show [<category>] - display list of categories or category contents
.pick --add category <choice> - adds option to category
.pick --del category <choice> - removes option from category
"
  (multiple-value-bind (addp delp showp category choices)
      (parse-pick-args args)
    (cond
     ((and category (find #\, category))
      (reply-to message "~a: Categories may not have commas in their names." (source message)))
     (addp
      (add-pick-choice module message category choices))
     (delp
      (del-pick-choice module message category choices))
     (showp
      (if category
          (let ((terms (lookup-category (catalog-of module) category)))
            (if terms
                (reply-to message "Picks in category ~a: ~{~a~^, ~}" category terms)
                (reply-to message "~a is not a category." category)))
          (reply-to message "Pick categories: ~{~a~^, ~}"
                    (mapcar #'first (catalog-of module)))))
     ((endp choices)
          (reply-to message "Pick categories: ~{~a~^, ~}"
                    (mapcar #'first (catalog-of module))))
     ((and (null (rest choices))
           (endp (lookup-category (catalog-of module) (first choices))))
      ;; if there's only one choice given, it must be a category.
      (reply-to message "~a is not a category." (first choices)))
     (t
      ;; otherwise, pick from categories and expand.
      (let ((choice (random-elt choices)))
        (loop for terms = (lookup-category (catalog-of module) choice)
           while terms do
             (setf choice (random-elt terms)))
        (reply-to message "~a: I pick ~a!" (source message) choice))))))

{'fraction_non_alphanumeric': 0.13743604320636726, 'fraction_numerical': 0.00042637862421830583, 'mean_word_length': 1.8632756866734486, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 28, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '292923', 'n_tokens_mistral': 3988, 'n_tokens_neox': 3843, 'n_words': 1217}