git.fiddlerwoaroof.com
anonyblog.lisp
ecfc7cde
 (defpackage :fwoar.anonyblog
   (:use :cl :alexandria :serapeum :fw.lu)
   (:export ))
 (in-package :fwoar.anonyblog)
 
 (defvar *b* nil)
 
 (defclass blog-route ()
   ())
 
 (defclass root-route (blog-route)
   ())
 
 (defclass post-route (blog-route)
   ((%id :initarg :id :reader id)))
 
 (defun post-route-from-params (params)
   (make-instance 'post-route :id (cdr (assoc :id params))))
 
 (defclass blog ()
   ((%posts :initarg :posts :accessor posts)
    (%title :initarg :title :accessor title)
    (%metadata :initarg :metadata :accessor metadata)
    (%author :initarg :author :accessor author))
   (:default-initargs :posts () :metadata (make-hash-table) :author "Anonymous" :title "My Blog"))
 
 (defmethod update-instance-for-redefined-class ((instance blog) added-slots discarded-slots property-list &rest r)
   (declare (ignore discarded-slots property-list r))
   (format t "updating instance: ~s" added-slots)
   (loop for slot in added-slots
      do
        (case slot
          ('%title (setf (title instance) "<< My Blog >>")))))
 
 (defclass post ()
   ())
 (defclass micro-post (post)
   ((%content :initarg :content)))
 (defclass blog-post (post)
   ((%title :initarg :title)
    (%content :initarg :content)))
 
 (defclass summary ()
   ())
 
 (defgeneric format-post (post context)
   (:method ((post micro-post) context)
     (spinneret:with-html
       (:section (slot-value post '%content))))
   (:method ((post blog-post) context)
     (spinneret:with-html
       (:section
        (:h* (slot-value post '%title))
        (:p (slot-value post '%content)))))
   (:method ((post blog-post) (context summary))
     (slot-value post '%title)))
 
 (defmethod araneus:controller ((root root-route) params &key)
   *b*)
 
 (defmethod araneus:controller ((route post-route) params &key)
   (let ((posts (posts *b*)))
     (cdr (assoc (id route) posts
                 :test 'string-equal))))
 
 (defmethod araneus:view :around ((root blog-route) model)
   (spinneret:with-html-string
     (:html
      (:head)
      (:body
       (:h* "Heading!")
       (call-next-method)))))
 
 (defmethod araneus:view ((root root-route) (model blog))
   (spinneret:with-html
     ))
 
 (defmethod araneus:view ((route post-route) model)
   (format-post model nil))
 
 (defun init-app (app)
   (araneus:defroutes app
     (("/" ()) (araneus:as-route (make-instance 'root-route)))
     (("/post/:id" ()) (lambda (params)
                         (araneus:run-route (post-route-from-params params)
                                            params)))))