src/model/post.lisp
(defpackage murja.model.post
(:use :cl)
(:export :Post :get-page :get-post :post-id :post-title :article :creator :tags :created-at :post-hidden? :post-unlisted? :next-post-id :previous-post-id :previouslies
:id :title :creator :created-at :content :admin-get-all-titles
:title :month :year :id :tags :hidden :unlisted)
(:import-from :com.inuoe.jzon :parse))
(in-package :murja.model.post)
;; fuck it we're moving from hashmaps to clos now
(defclass Post ()
;; slots are copied from the table blog.Post, accessors are what I might call these were I designing the db nowadays
((id :initarg :id :accessor post-id :col-type integer)
(title :initarg :title :accessor post-title :initform "" :col-type string)
(content :initarg :content :accessor article :initform "" :col-type string)
(creator :initarg :creator :accessor creator)
(creator-id :initarg :creator-id :col-type string :reader creator-id :col-references (murja.model.user:user 'murja.model.user::id))
(tags :initarg :tags :accessor tags :col-type string)
(created-at :initarg :created-at :accessor created-at :col-type simple-date:timestamp)
(hidden :initarg :hidden? :accessor post-hidden? :initform t :col-type boolean)
(unlisted :initarg :unlisted? :accessor post-unlisted? :initform nil :col-type boolean)
(previous :ghost t :initarg :previous :accessor previous-post-id :col-type integer :initform -1)
(next :initform -1 :ghost t :initarg :next :accessor next-post-id :col-type integer)
(previouslies :initform nil :ghost t :initarg ghostlies :accessor previouslies :col-type string))
(:metaclass postmodern:dao-class)
(:keys id)
(:documentation "A blogpost")
(:table-name "blog.Post"))
(defclass Title ()
((title :initarg :title :accessor post-title :initform (error "Title required"))
(month :initarg :month :accessor month :initform (error "Month required"))
(year :initarg :year :accessor year :initform (error "Year required"))
(id :initarg :id :accessor id :initform (error "Id required"))
(tags :initarg :tags :accessor tags :initform nil)
(hidden :initarg :hidden :accessor hidden :initform nil)
(unlisted :initarg :unlisted :accessor unlisted :initform nil))
(:documentation "A subset of the data in the class Post. This is for use in the sidebar's tree view and admin's postmanager"))
(defmethod print-object ((p Title) output)
(with-slots (id title month year tags hidden unlisted) p
(format output "#<TITLE: ~{~{~a: ~s~}~^,~%~t ~}>" (list
(list :id id)
(list :title title)
(list :tags tags)
(list :month month)
(list :year year)
(list :hidden hidden)
(list :unlisted unlisted)))))
(defmethod print-object ((p Post) output)
(with-slots (creator id title content creator-id tags created-at hidden unlisted previous next previouslies) p
(format output "#<POST: ~{~{~a: ~s~}~^,~%~t ~}>" (list
(list :id id)
(list :title title)
(list :content
(if (> (length content) 50)
(format nil "~a..."
(str:substring 0 50 content))
content))
(list :creator-id creator-id)
(list :creator creator)
(list :tags tags)
(list :created-at created-at)
(list :hidden hidden)
(list :unlisted unlisted)
(list :previous previous)
(list :next next)
(list :previouslies previouslies)))))
(defun admin-get-all-titles ()
(map 'list
(lambda (row)
;; could this bs be macrofied?
(destructuring-bind (title month year id tags hidden unlisted) row
(make-instance 'Title
:title title
:month month
:year year
:id id
:tags (coerce (parse tags) 'list)
:hidden hidden
:unlisted unlisted)))
(postmodern:query "
SELECT p.Title AS \"Title\",
EXTRACT(MONTH FROM p.created_at) AS \"Month\",
EXTRACT(YEAR FROM p.created_at) AS \"Year\",
p.id as \"Id\",
p.Tags as \"Tags\", p.hidden, p.unlisted
FROM blog.Post p
ORDER BY p.created_at DESC" :lists)))
;; (postmodern:query "SELECT * FROM blog.Post limit 1" (:dao post :single))
;; (postmodern:get-dao 'Post 349)
;; #<POST: ID: 349, TITLE: "Lisp webapps ", CONTENT: "<p>So, after <a href=\"https://feuerx.net/blog/post...", CREATOR-ID: 1, TAGS: "[\"postgresql\", \"hunchentoot\", \"lisp\", \"programming\"]", CREATED-AT: #<SIMPLE-DATE:TIMESTAMP 22-02-2025T09:31:40,016>, HIDDEN: NIL, UNLISTED: NIL>
(defun fix-post (p)
;; let's coerce this array into list, #() is truthy according to lisp
(setf (tags p) (coerce (parse (tags p)) 'list))
(unless (previouslies p)
(format t "ERROR previouslies were nil. Have you forgotten to join them to your posts?~%"))
(if (equalp "[null]" (previouslies p))
(setf (previouslies p) nil)
(when (stringp (previouslies p))
(setf (previouslies p) (coerce (parse (previouslies p)) 'list))))
(setf (creator p) (postmodern:get-dao 'murja.model.user:user (creator-id p)))
;; next-id and previous-id might point to unlisted posts. They should not do that, but I don't know how to wrangle *post-query* sql to support that, so they have to be fixed in lisp.
(unless (or (equalp (previous-post-id p) -1)
(not (caar (postmodern:query "SELECT unlisted FROM blog.Post WHERE id = $1" (previous-post-id p)))))
(setf (previous-post-id p)
(or (caar (postmodern:query "SELECT id FROM blog.Post WHERE ID < $1 AND NOT hidden AND NOT unlisted" (previous-post-id p)))
-1)))
(unless (or (equalp (next-post-id p) -1)
(not (caar (postmodern:query "SELECT unlisted FROM blog.Post WHERE id = $1" (next-post-id p)))))
(setf (next-post-id p)
(or (caar (postmodern:query "SELECT id FROM blog.Post WHERE ID > $1 AND NOT hidden AND NOT unlisted" (next-post-id p)))
-1)))
p)
(defparameter *post-query*
"
SELECT * FROM
(SELECT p.*,
LAG(p.id, 1, -1) OVER (ORDER BY created_at) as previous,
LEAD(p.id, 1, -1) OVER (ORDER BY created_at) as next,
JSON_AGG(TO_JSONB (pl.*) - 'referencee_id') as previouslies
FROM blog.Post p
LEFT JOIN blog.Previously_Link_Titles pl ON (p.id = pl.referencee_id AND
EXISTS (SELECT * FROM blog.Post pp WHERE pp.id = pl.id AND NOT pp.hidden AND NOT pp.unlisted))
WHERE (NOT p.hidden OR (p.hidden AND $2))
GROUP BY p.id
)
where id = $1
")
(defun get-post (id &key allow-hidden?)
(let ((p (postmodern:query *post-query* id allow-hidden? (:dao Post :single))))
(when p
(fix-post p))
p))
(defun get-page (page page-size &key allow-hidden? modified-since)
(let* ((page (if (< page 1)
1
page)))
(map 'list
#'fix-post
(postmodern:query
"SELECT p.*, JSON_AGG(TO_JSONB (pl.*) - 'referencee_id') as previouslies
FROM blog.Post p
LEFT JOIN blog.Previously_Link_Titles pl ON (p.id = pl.referencee_id AND
EXISTS (SELECT * FROM blog.Post pp WHERE pp.id = pl.id AND NOT pp.hidden AND NOT pp.unlisted))
WHERE ((NOT p.unlisted) OR $3)
AND ((NOT p.hidden) OR $3)
AND (($4::timestamp IS NULL) OR p.created_at > $4::timestamp)
GROUP BY p.id
ORDER BY p.created_at DESC
LIMIT $2
OFFSET $1"
(* (1- page) page-size)
page-size
allow-hidden?
(if modified-since
modified-since
:null)
(:dao Post)))))
;;(get-post 1)