git.fiddlerwoaroof.com
Raw Blame History
(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)))))