git.fiddlerwoaroof.com
fwoar.blog/data-model.lisp
f11cdeec
 (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)))