implemented automatic cw generation

bot.lisp

@@ -37,7 +37,9 @@ VALUE is a function that accepts a tooter:status object as a parameter")
   (:documentation "bot superclass"))
 
 (defmethod initialize-instance :after ((bot mastodon-bot) &rest initargs
-                                       &key config-file instance token strip-html strip-username timeline
+                                       &key config-file instance token
+                                            strip-html strip-username timeline
+                                            cw-mappings
                                        &allow-other-keys)
   (declare (ignorable initargs))
   (when config-file
@@ -49,7 +51,21 @@ VALUE is a function that accepts a tooter:status object as a parameter")
     (setf-unless (config :strip-bot-username) strip-username)
     (setf-unless (config :timeline) timeline)
     (setf-unless (config :mastodon-instance) instance)
-    (setf-unless (config :mastodon-token) token))
+    (setf-unless (config :mastodon-token) token)
+    (setf-unless (config :cw-mappings) cw-mappings))
+
+  ;; load our mappings if provided and they exist
+  (when (config :cw-mappings)
+    (setf (config :cw-mappings)
+          (loop :with mappings
+                :for f in (config :cw-mappings)
+                
+                :when (uiop:file-exists-p f)
+                  :do (setf mappings
+                            (append mappings
+                                    (parse-mapping-file f)))
+                :finally (return mappings))))
+               
   
   (let* ((client (make-instance 'bot-client
                                 :access-token (config :mastodon-token)
@@ -60,7 +76,7 @@ VALUE is a function that accepts a tooter:status object as a parameter")
 	  (slot-value bot 'account-username) (concatenate 'string "@" (tooter:username account)))))
 
 (defun make-bot (&key config-file instance access-token (strip-html t) strip-username (timeline "user")
-                   on-update on-delete on-notification)
+                   on-update on-delete on-notification cw-mappings)
   "makes a bot and returns it. 
 INSTANCE, ACCESS-TOKEN, STRIP-HTML, STRIP-USERNAME, TIMELINE are all options that are typically in a config file
 passing these values in allows the developer to skip specifying a config file and can pull values in from other places
@@ -74,9 +90,10 @@ STRIP-USERNAME if non-nil strips the bot's username from incoming posts. default
 TIMELINE string denoting which timeline should be used for the streaming websocket. can be one of 'user', 'public', 'direct'. defaults to 'user'
 ON-UPDATE a function that accepts a single mastodon status. gets ran for every new post that streams in from TIMELINE
 ON-DELETE a function that accepts a single status id. gets ran for every deleted status that streams in from TIMELINE
-ON-NOTIFICATION a function that accepts a single mastodon notification. gets ran for every notification that streams in from TIMELINE"
+ON-NOTIFICATION a function that accepts a single mastodon notification. gets ran for every notification that streams in from TIMELINE
+CW-MAPPINGS a list of files that contain a single ALIST expression to automatically provide content warnings for generated posts"
   (make-instance 'mastodon-bot :config-file config-file :instance instance :strip-html strip-html
                                :strip-username strip-username :timeline timeline :token access-token
                                :on-update on-update :on-delete on-delete
-                               :on-notification on-notification))
+                               :on-notification on-notification :cw-mappings cw-mappings))
 

content-warning.map.example

@@ -0,0 +1,5 @@
+warning: content warning goes here
+words: list, of, each, word
+
+warning: a second warning here
+words: list, of, other, words

extensions.lisp

@@ -98,7 +98,7 @@ see documentation for that function"
   (tooter:make-status (bot-client *bot*)
                       text
                       :visibility visibility
-                      :spoiler-text cw
+                      :spoiler-text (or cw (generate-cw text (config :cw-mappings)))
                       :media (upload-media media)
                       :sensitive sensitive))
 

glacier.config.example

@@ -8,4 +8,9 @@ strip-html = true
 # automatically strips the bot's username out of incoming statuses
 # defaults to false
 strip-bot-username = true
-timeline = user # or public/direct
+timeline = user # or public/direct
+
+# tells the bot to load content warning mappings from the listed files
+# each "map" file should contain a single ALIST expression
+#  see the content-warning.map.example file for example
+cw-mappings = file1.map, file2.map

util.lisp

@@ -4,6 +4,47 @@
 		 follow-request-p bot-post-p agetf seconds-until-midnight
                  current-day dow-for))
 
+(defun generate-cw (status-text mappings)
+  "returns a content warning based off of our cw-mappings and the STATUS-TEXT"
+  (when mappings
+    (let ((cw-list (loop :with text := (str:split " " (str:downcase status-text))
+                         :for mapping :in mappings
+                         :for cw := (first mapping)
+                         :for trigger-words := (car (rest mapping))
+
+                         ;; i could probably do something with regexes to simplify this
+                         ;;  but also :shrug: it works
+                         :collect (loop :for trigger :in trigger-words
+                                        :if (member trigger text :test #'str:containsp)
+                                          :return cw)
+                           :into cws
+                         :finally
+                            (return (remove-if #'not cws)))))
+      (str:join ", " (remove-duplicates cw-list :test #'string=)))))
+
+(defun parse-mapping-file (file)
+  "parses mapping FILE, returning an alist of the mappings of the from (CW (words))"
+  (let ((lines (str:lines (str:from-file file))))
+    (loop :with cw-def
+          :with trigger-def
+          :with file-def
+          
+          :for line :in lines
+
+          :when (and (not cw-def) (str:starts-with-p "warning:" line))
+            :do (setf cw-def (str:trim (str:replace-first "warning:" "" line)))
+
+          :when (and cw-def (str:starts-with-p "words:" line))
+            :do (setf trigger-def (map 'list #'str:trim (str:split "," (str:replace-first "words:" "" line))))
+
+          :when (and cw-def trigger-def)
+            :do (setf file-def (append file-def (list (list cw-def trigger-def)))
+                      cw-def nil
+                      trigger-def nil)
+
+          :finally (return file-def))))
+          
+
 (defun parse-time (amount duration)
   "parses AMOUNT of DURATION into seconds"
   (* amount (cond