(declaim (optimize (debug 3) (speed 0) (safety 3))) (ql:quickload :alexandria) (ql:quickload :ironclad) (ql:quickload :uuid) (ql:quickload :bordeaux-threads) (ql:quickload :manardb) (ql:quickload :ningle) (ql:quickload :anaphora) (ql:quickload :ubiquitous) (ql:quickload :spinneret) (ql:quickload :clack) (ql:quickload :clack-errors) (defpackage :blogerate (:use :cl :alexandria :ningle :anaphora :ningle)) (in-package :blogerate) (ubiquitous:restore 'blogerate) (manardb:use-mmap-dir "/tmp/manardb-blogerate") (manardb:defmmclass blog () ((id :initarg :id :accessor blog-id) (posts :initarg :posts :accessor blog-posts :initform nil) (tags :initform (make-hash-table :test #'equal) :accessor blog-tags) (authors :initform (make-hash-table :test #'equal) :accessor blog-authors) (sets :initform (make-hash-table :test #'equal) :accessor blog-sets))) (manardb:defmmclass post () ((id :initarg :id :accessor post-id :initform (with-output-to-string (s) (uuid:print-bytes s (uuid:make-v5-uuid uuid:+namespace-oid+ "blump")))) (title :initarg :title :accessor post-title :initform "") (text :initarg :text :accessor post-text :initform "") (author :initarg :author :accessor post-author :initform "") (post-set :initarg :set :accessor post-set :initform "") (tags :initarg :tags :initform '() :accessor post-tags))) (defun make-post (blog title text author set &key (tags nil tags-p)) (let ((result (make-instance 'post :title title :text text :author author :set set :tags tags))) (push result (blog-posts blog)) (when tags-p (mapcar (lambda (x) (push (cons x result) (blog-tags blog))) (post-tags result))) (push (cons (post-set result) result) (blog-sets blog)) (push (cons (post-author result) result) (blog-authors blog)) result)) (defun get-blog (id) (flet ((new-blog () (make-instance 'blog :id id))) (aif (manardb:retrieve-all-instances 'blog) (aif (car (remove-if-not (lambda (x) (equal id (blog-id x))) it)) it (new-blog)) (new-blog)))) (defparameter *blog* (get-blog "my-blog3")) (defparameter *app* (make-instance 'ningle:<app>)) (defmacro with-page ((&key title) &body body) `(spinneret:with-html-string (:doctype) (:html (:head (:link :rel "stylesheet" :href "/static/main.css") (:title ,title)) (:body ,@body)))) (setf (route *app* "/post/new" :method :GET) (lambda (params) (declare (ignorable params)) (with-page (:title "new post") (:header (:h1 "New Post:")) (:section :class "post-new" (:form :action "/post/new" :method "POST" (:input :type "text" :name "title") (:input :type "text" :name "author") (:textarea :name "post") (:input :type "text" :name "set") (:input :type "text" :name "tags") (:input :type "submit")))))) (defun str-assoc-cdr (key alist) (cdr (assoc key alist :test #'equal))) (defun split-tags (str) (mapcar (lambda (x) (string-trim " " x)) (split-sequence:split-sequence #\, str))) (setf (route *app* "/post/new" :method :POST) (lambda (params) (format nil "~s" params) (let ((new-post (make-post *blog* (str-assoc-cdr "title" params) (str-assoc-cdr "post" params) (str-assoc-cdr "author" params) (str-assoc-cdr "set" params) :tags (split-tags (str-assoc-cdr "tags" params))))) (with-page (:title (post-title new-post)) (:header (:h1 (post-title new-post))) (:section :class "post-show" (:article (post-text new-post)) (:span :class "author" (post-author new-post)) (:span :class "set" (post-set new-post))))))) (setf (route *app* "/" :method :GET) (lambda (params) (with-page (:title "Blog") (:header (:h1 "Blog")) (loop for new-post in (blog-posts *blog*) collect (:section :class "post-show" (:h2 (post-title new-post)) (:article (post-text new-post)) (:span :class "author" (post-author new-post)) (:span :class "set" (post-set new-post))))))) (defparameter *handler* (clack:clackup (lack.builder:builder :session ;:csrf ;clack-errors:*clack-error-middleware* (:static :path "/static/" :root #p"./static/") *app*) :port 5000))