1 files changed, 126 insertions, 0 deletions
diff --git a/phaser.lisp b/phaser.lisp
new file mode 100644
index 0000000..2fcda54
--- /dev/null
+++ b/phaser.lisp
@@ -0,0 +1,126 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; NewsPhaser, Mastodon posts aggregator
+;; Copyright (C) 2025  Gene Pasquet
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defpackage :phaser
+  (:use
+   :common-lisp)
+  (:import-from :phaser.unhtml #:text-excerpt)
+  (:export
+   #:get-timeline
+   #:load-timeline
+   #:load-top-statuses
+   #:reblog-top-statuses
+   #:summarize-top-statuses))
+
+(in-package :phaser)
+
+(ignore-errors
+ ;; Don't signal if .env is missing.
+ (.env:load-env (merge-pathnames ".env")))
+
+(defvar *client* (make-instance 'tooter:client
+				:base (uiop:getenv "MASTODON_URL")
+				:name "Newsphaser bot"
+				:key (uiop:getenv "MASTODON_KEY")
+				:secret (uiop:getenv "MASTODON_SECRET")
+				:access-token (uiop:getenv "MASTODON_TOKEN")))
+(defvar *timeline-page-size* 50
+  "Maximum number of statuses retrieved from the timeline for each request")
+
+(defvar *timeline-min-age* (* 24 3600)
+  "Minimum age of statuses before being considered for ranking")
+(defvar *timeline-max-age* (* 48 3600)	; 48h
+  "Maximum age of statuses to be retrieved from timelines.")
+
+(defvar *timeline-min-timestamp* (- (get-universal-time) *timeline-max-age*))
+(defvar *timeline-max-timestamp* (- (get-universal-time) *timeline-min-age*))
+
+(defvar *pop-favs-factor* 1)
+(defvar *pop-boosts-factor* 1)
+(defvar *pop-replies-factor* 1)
+(defvar *max-requests* 20)
+
+(defvar *top-statuses-to-boost* 10)
+
+(defun outdated-statuses (page)
+  (remove-if
+   (lambda (status)
+     (> (tooter:created-at status) *timeline-min-timestamp*))
+   page))
+
+(defun last-page-p (page)
+  (or (null page)
+      (not (null (outdated-statuses page)))))
+
+(defun flatten (structure)
+  (cond ((null structure) nil)
+        ((atom structure) (list structure))
+        (t (mapcan #'flatten structure))))
+
+(defun load-timeline-pages (min-id &optional (pages '()) (iter-num 0))
+  "Load statuses from the timeline up to *TIMELINE-MAX-AGE* or MIN-ID."
+  (let* ((max-id (if (null pages)
+		     nil
+		     (tooter:id (car (last (car pages))))))
+	 (page (tooter:timeline *client* :home
+				:limit *timeline-page-size*
+				:max-id max-id
+				:min-id min-id))
+	 (statuses-and-page (if (null pages)
+				(list page)
+				(cons page pages))))
+    (if (or (last-page-p page) (>= iter-num *max-requests*))
+	(flatten statuses-and-page)
+	(load-timeline-pages min-id statuses-and-page (1+ iter-num)))))
+
+(defun load-timeline ()
+  (remove-if (lambda (status)
+	       (let ((status-timestamp (tooter:created-at status)))
+		 (or (< status-timestamp *timeline-min-timestamp*)
+		     (> status-timestamp *timeline-max-timestamp*))))
+	     (load-timeline-pages nil)))
+
+(defun status-popularity (status)
+  (/ (+ (* (tooter:replies-count status) *pop-replies-factor*)
+	 (* (tooter:favourites-count status) *pop-favs-factor*)
+	 (* (tooter:reblogs-count status) *pop-boosts-factor*))
+     (- (get-universal-time) (tooter:created-at status))))
+
+(defun get-timeline ()
+  (tooter:timeline *client* :home))
+
+(defun load-top-statuses ()
+  (let* ((timeline (load-timeline))
+	 (ranked-statuses (sort (mapcar (lambda (status)
+					  `(,(status-popularity status) . ,status))
+					timeline)
+				'> :key 'car)))
+    (mapcar 'cdr (butlast ranked-statuses (- (length ranked-statuses) 10)))))
+
+
+(defun summarize-top-statuses ()
+  (let ((statuses (load-top-statuses)))
+    (mapcar (lambda (status)
+	      (text-excerpt (tooter:content status)))
+	    statuses)))
+
+(defun reblog-top-statuses ()
+  (let ((top-statuses (load-top-statuses)))
+    (mapc (lambda (status)
+	    (tooter:favourite *client* status))
+	  top-statuses)))