;;; Joke --- Not a joke. ;; -*- lexical-binding: t; -*-
;;; Commentary:
;; yes.
;;; Code:
(require 'cl-lib)

(defconst joke-harm-categories
  '((("chicken" "cow" "meat")            . vegetarian)
    ((vegetarian "cheese" "milk" "fish") . vegan)
    (("god" "sex" "heaven" "hell")       . religious)
    ((religious "religion")              . atheist)
    (("marketplace")                     . agoraphobic)
    ((".*")                              . child))
  "Lists of categories of people will be offended by jokes on certain topics.")

(defun joke-victims (joke)
  "Return victims of JOKE."
  (cl-loop for (spec . victim) in joke-harm-categories
           for regexps = (flatten-tree
                          (cl-loop for el in spec collect
                                   (if (symbolp el)
                                       (car (rassoc el joke-harm-categories))
                                     el)))
           when (cl-some (lambda (regexp) (string-match-p regexp joke)) regexps)
           collect victim))

(defun joke-jokes (text)
  "Return list of jokes in TEXT."
  (let ((jokes))
    (with-temp-buffer
      (insert text)
      (goto-char (point-min))
      (while (re-search-forward "\\(?:<joke>\\([^z-a]*?\\)</joke>\\)" nil 'noerror)
        (push (match-string 1) jokes))
      (nreverse jokes))))

(defun joke-harm-by-category (text &rest victims)
  "Return percentage of JOKES in TEXT which will harm VICTIMS."
  (cl-loop with jokes = (joke-jokes text)
           for victim in (or victims '(anyone))
           for harmful =
           (cl-remove-if-not (lambda (joke) (member victim (joke-victims joke)))
                             jokes)
           collect (cons victim (* 100 (/ (cl-reduce #'+ harmful :key #'length)
                                          (float (length text)))))))

(provide 'joke)
;;; joke.el ends here