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