git.fiddlerwoaroof.com
db.lisp
55a3cfc9
 (defpackage :fwoar.web-test.db
   (:use :cl )
   (:export :blog-post :id :title :author :content
            :make-blog-post
            :save-blog-post
            :blog))
 (in-package :fwoar.web-test.db)
 
 (defgeneric id (ided-object))
 (defgeneric title (title-object))
 (defgeneric author (author-object))
 (defgeneric content (content-object))
 
 (defclass ided ()
   ((%id :initarg :id :reader id)))
 
 (defun slugify (v)
   (format nil "~(~{~a~^-~}~)"
           (coerce (fwoar.string-utils:split " " v)
                   'list)))
 
 (defclass blog-post (ided)
   ((title :initarg :title :reader title :initform (error "must have a title"))
    (author :initarg :author :reader author :initform (error "must have a author"))
    (content :initarg :content :reader content :initform (error "must have a content")))
   (:metaclass fwoar.server-aware-class:server-aware-class))
 
 (defmethod slot-unbound (class (blog-post blog-post) (slot-name (eql '%id)))
   (setf (slot-value blog-post slot-name)
         (slugify (title blog-post))))
 
 (defmethod yason:encode-slots progn ((object blog-post))
   (yason:encode-object-elements
    "title" (title object)
    "author" (author object)
    "content" (content object)))
 
 (defmacro new (class &rest initializer-syms)
   `(make-instance ,class
                   ,@(mapcan (serapeum:op (list (alexandria:make-keyword _1) _1))
                             initializer-syms)))
 
 (defun make-blog-post (title author content)
   (new 'blog-post title author content))
 
 (defun save-blog-post (blog post)
   (montezuma:add-document-to-index blog post))
 
 
 (defmethod fset:compare ((a blog-post) (b blog-post))
   (fset:compare-slots a b 'title 'author 'content))
 
 (defclass blog (montezuma:index)
   ())
 
 (defmethod montezuma:add-document-to-index ((index blog) (doc blog-post)
                                             &optional analyzer)
   (with-accessors ((title title) (author author) (content content)) doc
     (let* ((doc (make-instance 'montezuma:document)))
       (montezuma:add-field doc (montezuma:make-field "title" title))
       (montezuma:add-field doc (montezuma:make-field "author" author))
       (montezuma:add-field doc (montezuma:make-field "content" content
                                                      :index :tokenized))
       (montezuma:add-document-to-index index doc analyzer))))
 
 (defmethod montezuma:get-document ((index blog) doc-number)
   (let ((doc (call-next-method)))
     (funcall (alexandria:compose
               (data-lens:applying 'make-blog-post)
               (data-lens:over 'montezuma:field-data)
               (data-lens:juxt
                (lambda (it) (montezuma:document-field it "title"))
                (lambda (it) (montezuma:document-field it "author"))
                (lambda (it) (montezuma:document-field it "content"))))
              doc)))