(defpackage :fwoar.blog
(:use :cl :araneus :alexandria :serapeum :fw.lu)
(:export ))
(in-package :fwoar.blog)
(defclass blog ()
((%posts :initarg :posts :accessor posts))
(:default-initargs :posts ()))
(make-constructor blog &rest posts)
(defmethod print-object ((o blog) s)
(format s "#.(make-blog ~{~s~^ ~})"
(posts o)))
(defclass post ()
((%content :initarg :content :accessor content)))
(defclass micropost (post)
())
(make-constructor micropost content)
(defmethod print-object ((o micropost) s)
(format s "#.(make-micropost ~s)" (content o)))
(defclass macropost (post)
((%title :initarg :title :accessor title)))
(make-constructor macropost title content)
(defmethod print-object ((o macropost) s)
(format s "#.(make-macropost ~s ~s)"
(title o)
(content o)))
(defmacro orc (&rest funs)
`(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)))))
(defgeneric titled-posts (blog)
(:method ((blog blog))
(mappend #'titled-posts
(posts blog)))
(:method ((post micropost))
())
(:method ((post macropost))
(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)))
(defclass blog-route ()
((%blog :initarg :blog :reader blog)))
(defclass index-route (blog-route)
())
(defclass post-route (blog-route)
((%post :initarg :post :reader post)))
(defmethod controller ((route index-route) params &key)
(posts (blog route)))
(defmethod controller ((route post-route) params &key)
(post route))
(defmethod view ((_ blog-route) post)
'(404 (:content-type "text/plain") ("FAIL!")))
(defun layout (f)
(spinneret:with-html-string
(:style
":root {
--zenburn-fg-plus-2: #FFFFEF; --zenburn-fg-plus-1: #F5F5D6;
--zenburn-fg: #DCDCCC; --zenburn-fg-1: #A6A689;
--zenburn-fg-2: #656555; --zenburn-black: #000000;
--zenburn-bg-2: #000000; --zenburn-bg-1: #111112;
--zenburn-bg-05: #383838; --zenburn-bg: #2A2B2E;
--zenburn-bg-plus-05: #494949; --zenburn-bg-plus-1: #4F4F4F;
--zenburn-bg-plus-2: #5F5F5F; --zenburn-bg-plus-3: #6F6F6F;
--zenburn-red-plus-2: #ECB3B3; --zenburn-red-plus-1: #DCA3A3;
--zenburn-red: #CC9393; --zenburn-red-1: #BC8383;
--zenburn-red-2: #AC7373; --zenburn-red-3: #9C6363;
--zenburn-red-4: #8C5353; --zenburn-red-5: #7C4343;
--zenburn-red-6: #6C3333; --zenburn-orange: #DFAF8F;
--zenburn-yellow: #F0DFAF; --zenburn-yellow-1: #E0CF9F;
--zenburn-yellow-2: #D0BF8F; --zenburn-green-5: #2F4F2F;
--zenburn-green-4: #3F5F3F; --zenburn-green-3: #4F6F4F;
--zenburn-green-2: #5F7F5F; --zenburn-green-1: #6F8F6F;
--zenburn-green: #7F9F7F; --zenburn-green-plus-1: #8FB28F;
--zenburn-green-plus-2: #9FC59F; --zenburn-green-plus-3: #AFD8AF;
--zenburn-green-plus-4: #BFEBBF; --zenburn-cyan: #93E0E3;
--zenburn-blue-plus-3: #BDE0F3; --zenburn-blue-plus-2: #ACE0E3;
--zenburn-blue-plus-1: #94BFF3; --zenburn-blue: #8CD0D3;
--zenburn-blue-1: #7CB8BB; --zenburn-blue-2: #6CA0A3;
--zenburn-blue-3: #5C888B; --zenburn-blue-4: #4C7073;
--zenburn-blue-5: #366060; --zenburn-magenta: #DC8CC3;}"
(lass:compile-and-write
`(* :box-sizing border-box)
`((:or html body)
:margin 0
:padding 0
:color (var "--zenburn-fg")
:background (var "--zenburn-bg")
:font-family sans-serif
:font-size 16px
:display grid
:grid-template-areas "\"top top top\"
\"left main main\"
\"left main main\"")
`((:or a)
:margin 0
:padding 0
:color (var "--zenburn-blue")
)
`((:or h1 h2 h3 h4 h5 h6)
:font-size 1.1rem
:margin 0
:padding 0)
`((:and a :hover)
:color (var "--zenburn-blue-1"))
`(h1 :grid-area "top" :padding 2rem :font-size 3rem)
`(nav :grid-area "left" :padding 2rem)
`(main :grid-area "main" :padding 2rem 0 0 0)))
(:h* "the site!")
(:nav "aside")
(:main (funcall f))))
(defvar *layout-done* nil)
(defmethod view :around ((_ blog-route) post)
(if *layout-done*
(call-next-method)
(let ((*layout-done* t))
(layout #'call-next-method))))
(defmethod view ((name post-route) (post macropost))
(spinneret:with-html
(:section
(:h* (title post))
(:div
(content post)))))
(defmethod view ((name index-route) posts)
(format *standard-output* "~&~S~%" posts)
(spinneret:with-html
(:section
(:h* "Blog Index")
(:div
(loop for post in posts
do (call-current-view post))))))
(defmethod view ((name index-route) (post micropost))
(spinneret:with-html
(:section.post.micropost
(content post))))
(defmethod view ((name index-route) (post macropost))
(spinneret:with-html
(:section.post.macropost
(:h* (:a :href (format nil "/~a" (slugify (title post)))
(title post))))))
(defun setup-routes (app blog)
(defroutes app
(("/" :method :GET)
(as-route
(make-instance 'index-route :blog blog)))
(("/:post" :method :GET)
(lambda (params)
(format t "~¶ms: ~s~%" params)
(let* ((post-name (cdr (assoc :post params)))
(route (make-instance 'post-route :post (find-post post-name blog))))
(run-route route params))))))
(defvar *blog*
(make-blog (make-micropost "first post")
(make-macropost "This is the title"
"This is the post content"))
"The sample blog: passed lexically to the routes, so rebinding don't change nothin'")
(defun setup (&optional (blog *blog*))
(prog1-bind (app (make-instance 'ningle:<app>))
(setup-routes app blog)))
;;; entrypoint
(defvar *handler*)
(defun is-running ()
(and (boundp '*handler*)
*handler*))
(defun ensure-started (&rest r &key port)
(declare (ignore port))
(setf *handler*
(if (not (is-running))
(apply 'clack:clackup (setup) r)
*handler*)))
(defun stop ()
(if (is-running)
(progn
(clack:stop *handler*)
(makunbound '*handler*)
nil)
nil))
#+fw.dev
(define-cluser-entrypoint (&optional (port 5000))
(ensure-started :port port))