Browse code
feat: basic views
Ed Langley authored on 29/10/2020 20:31:18Showing 2 changed files
| ... | ... |
@@ -0,0 +1,86 @@ |
| 1 |
+(defpackage :fwoar.anonyblog |
|
| 2 |
+ (:use :cl :alexandria :serapeum :fw.lu) |
|
| 3 |
+ (:export )) |
|
| 4 |
+(in-package :fwoar.anonyblog) |
|
| 5 |
+ |
|
| 6 |
+(defvar *b* nil) |
|
| 7 |
+ |
|
| 8 |
+(defclass blog-route () |
|
| 9 |
+ ()) |
|
| 10 |
+ |
|
| 11 |
+(defclass root-route (blog-route) |
|
| 12 |
+ ()) |
|
| 13 |
+ |
|
| 14 |
+(defclass post-route (blog-route) |
|
| 15 |
+ ((%id :initarg :id :reader id))) |
|
| 16 |
+ |
|
| 17 |
+(defun post-route-from-params (params) |
|
| 18 |
+ (make-instance 'post-route :id (cdr (assoc :id params)))) |
|
| 19 |
+ |
|
| 20 |
+(defclass blog () |
|
| 21 |
+ ((%posts :initarg :posts :accessor posts) |
|
| 22 |
+ (%title :initarg :title :accessor title) |
|
| 23 |
+ (%metadata :initarg :metadata :accessor metadata) |
|
| 24 |
+ (%author :initarg :author :accessor author)) |
|
| 25 |
+ (:default-initargs :posts () :metadata (make-hash-table) :author "Anonymous" :title "My Blog")) |
|
| 26 |
+ |
|
| 27 |
+(defmethod update-instance-for-redefined-class ((instance blog) added-slots discarded-slots property-list &rest r) |
|
| 28 |
+ (declare (ignore discarded-slots property-list r)) |
|
| 29 |
+ (format t "updating instance: ~s" added-slots) |
|
| 30 |
+ (loop for slot in added-slots |
|
| 31 |
+ do |
|
| 32 |
+ (case slot |
|
| 33 |
+ ('%title (setf (title instance) "<< My Blog >>")))))
|
|
| 34 |
+ |
|
| 35 |
+(defclass post () |
|
| 36 |
+ ()) |
|
| 37 |
+(defclass micro-post (post) |
|
| 38 |
+ ((%content :initarg :content))) |
|
| 39 |
+(defclass blog-post (post) |
|
| 40 |
+ ((%title :initarg :title) |
|
| 41 |
+ (%content :initarg :content))) |
|
| 42 |
+ |
|
| 43 |
+(defclass summary () |
|
| 44 |
+ ()) |
|
| 45 |
+ |
|
| 46 |
+(defgeneric format-post (post context) |
|
| 47 |
+ (:method ((post micro-post) context) |
|
| 48 |
+ (spinneret:with-html |
|
| 49 |
+ (:section (slot-value post '%content)))) |
|
| 50 |
+ (:method ((post blog-post) context) |
|
| 51 |
+ (spinneret:with-html |
|
| 52 |
+ (:section |
|
| 53 |
+ (:h* (slot-value post '%title)) |
|
| 54 |
+ (:p (slot-value post '%content))))) |
|
| 55 |
+ (:method ((post blog-post) (context summary)) |
|
| 56 |
+ (slot-value post '%title))) |
|
| 57 |
+ |
|
| 58 |
+(defmethod araneus:controller ((root root-route) params &key) |
|
| 59 |
+ *b*) |
|
| 60 |
+ |
|
| 61 |
+(defmethod araneus:controller ((route post-route) params &key) |
|
| 62 |
+ (let ((posts (posts *b*))) |
|
| 63 |
+ (cdr (assoc (id route) posts |
|
| 64 |
+ :test 'string-equal)))) |
|
| 65 |
+ |
|
| 66 |
+(defmethod araneus:view :around ((root blog-route) model) |
|
| 67 |
+ (spinneret:with-html-string |
|
| 68 |
+ (:html |
|
| 69 |
+ (:head) |
|
| 70 |
+ (:body |
|
| 71 |
+ (:h* "Heading!") |
|
| 72 |
+ (call-next-method))))) |
|
| 73 |
+ |
|
| 74 |
+(defmethod araneus:view ((root root-route) (model blog)) |
|
| 75 |
+ (spinneret:with-html |
|
| 76 |
+ )) |
|
| 77 |
+ |
|
| 78 |
+(defmethod araneus:view ((route post-route) model) |
|
| 79 |
+ (format-post model nil)) |
|
| 80 |
+ |
|
| 81 |
+(defun init-app (app) |
|
| 82 |
+ (araneus:defroutes app |
|
| 83 |
+ (("/" ()) (araneus:as-route (make-instance 'root-route)))
|
|
| 84 |
+ (("/post/:id" ()) (lambda (params)
|
|
| 85 |
+ (araneus:run-route (post-route-from-params params) |
|
| 86 |
+ params))))) |