(in-package :fwoar.blog) (defgeneric posts (blog) (:documentation "get a list of all the posts in the blog")) (defgeneric content (post) (:documentation "get a post's content")) (defgeneric title (post) (:documentation "get a post's title")) ;; constituent data-points (defclass blog () ((%posts :initarg :posts :accessor posts)) (:default-initargs :posts ())) (defclass post () ((%content :initarg :content :accessor content))) (defclass titled () ((%title :initarg :title :accessor title))) (defclass micropost (post) () (:documentation "A tweet-style post")) (defclass macropost (titled post) () (:documentation "A longer post, with a title and content")) ;; protocols (defgeneric titled-posts (blog) (:documentation "return blog posts that have titles") (:method ((blog blog)) (mappend #'titled-posts (posts blog))) (:method ((post post)) ()) (:method ((post titled)) (list post))) (defgeneric find-post (slug blog) (:method ((slug string) (blog blog)) (loop with needle-slug = (slugify slug) for post in (titled-posts blog) for haystack-slug = (slugify (title post)) when (equal needle-slug haystack-slug) return post))) (defmacro orc (&rest funs) "Run a bunch of functions against a value, stop when " `(lambda (v) (or ,@(loop for fun in funs collect `(,fun v))))) (defun slugify (string) (substitute #\- #\space (trim-whitespace (remove-if-not (orc alphanumericp (lambda (c) (eql c #\space)) (lambda (c) (eql c #\-))) (string-downcase string))))) (make-constructor blog &rest posts) (make-constructor micropost content) (make-constructor macropost title content) (defmethod print-object ((o blog) s) (format s "#.(make-blog ~{~s~^ ~})" (posts o))) (defmethod print-object ((o micropost) s) (format s "#.(make-micropost ~s)" (content o))) (defmethod print-object ((o macropost) s) (format s "#.(make-macropost ~s ~s)" (title o) (content o)))