assboard/web.lisp

(in-package :cl-user)

(restas:define-module #:assboard.web
  (:use :cl :hunchentoot :assboard.utils :assboard.engine))

(in-package #:assboard.web)

;; Parameters
(setf (who:html-mode) :html5)

(restas:define-route static/css ("css/:file" :content-type "text/css")
  (let ((css-path (merge-pathnames "css/" +project-path+)))
    (merge-pathnames file css-path)))


(defclass renderer () ())
(restas::register-pkgmodule-traits
 'assboard.web
 :render-method (lambda () (make-instance 'assboard.web::renderer)))

;; Rendering
(defgeneric finalize-page (data)
  (:documentation "Final rendering step"))
(defgeneric render-route-data (route data)
  (:documentation "Process route-specific data"))

(defmethod finalize-page ((data list))
  (who:with-html-output-to-string (out nil :prologue t)
    (:html
     (:head
      (:meta :charset "utf-8")
      (:meta :http-equiv "X-UA-Compatible" :content "IE=edge")
      (:meta :name "viewport" :content "width=device-width, initial-scale=1")
      (:title (who:str (getf data :title)))
      ;;(:link :rel "stylesheet" :href (restas:genurl 'static/css :file "styles.css"))
      )
     (:body
      (who:str (getf data :menu))
      (who:str (getf data :content))))))

(defmethod render-route-data (route (data list))
  (list*
   :title (getf data :title "AssBoard")
   data))

(defmethod restas:render-object ((designer renderer) (object list))
  (let ((full-data (render-route-data (restas:route-symbol restas:*route*)
                                      object)))
    (finalize-page full-data)))

(defun posts-list (out posts)
  (who:with-html-output (out)
    (if posts
        (who:htm
         (:ul
          (loop for post in posts
             :do (who:htm
                  (:li
                   (:a :href (restas:genurl 'posting :hash (data::posting-hash post))
                       (who:str (data::posting-title post)))
                   " by "
                   (:a :href (restas:genurl 'author
                                            :author (data::posting-author post))
                       (who:str (data::posting-author post))))))))
        (who:htm (:ul (:li "No posts yet"))))))

(defmethod render-route-data ((route (eql 'index)) (posts list))
  (list
   :title "AssBoard"
   :content
   (who:with-html-output-to-string (out)
     (:h1 "AssBoard open postings")
     (posts-list out posts)
     (:h2 "Add new posting")
     (:form :method "POST" :action (restas:genurl 'posting/post)
            (:input :type "text" :name "title" :placeholder "Title") (:br) (:br)
            (:textarea :name "body" :cols 80 :rows 10 :placeholder "Body") (:br)
            (:button :type "submit" "Prepare")))))

(restas:define-route index ("")
  (pomo:query-dao
   'data::posting
   (:select 'hash 'author 'status 'title 'maintainer 'created-on
            :from 'posting)))

(defmethod render-route-data ((route (eql 'posting/post)) (data list))
  (list
   :title "Add new posting"
   :content
   (who:with-html-output-to-string (out)
     (:h1 "Add new posting")
     (if (getf data :error)
         (who:htm (:h2 "Error adding post:")
                  (:p (who:str (getf data :error))))
         (who:htm
          (:p "To add new posting, clearsign (`gpg --clearsign`) the following text and paste results from '-----BEGIN PGP SIGNED MESSAGE-----' up to '-----END PGP SIGNATURE-----'")
          (:textarea :disabled t :cols 80 :rows 10
                     (who:str (getf data :to-sign)))
          (:form :method "POST"
                 (:textarea :name "clearsigned" :cols 80 :rows 20 :placeholder "clearsigned") (:br)
                 (:button :type "submit" "Post")))))))

(restas:define-route posting/post ("posting/" :method :post)
  (let ((clearsigned (hunchentoot:post-parameter "clearsigned")))
    (if clearsigned
        (handler-case
            (let ((posting (process-command clearsigned)))
              (restas:redirect 'posting :hash (data::posting-hash posting)))
          (command-error (err)
            (log:info "Error processing command ~A" err)
            (list :error err
                  :clearsigned clearsigned)))
        (let ((title (hunchentoot:post-parameter "title"))
              (body (hunchentoot:post-parameter "body")))
          (if (or (equal title "") (equal body ""))
              (restas:redirect 'index)
              (list
               :to-sign (format-new-posting title body)))))))

(defmethod render-route-data ((route (eql 'author)) (data list))
  (list
   :title (format nil "~A's postings @ AssBoard" (getf data :author))
   :content
   (who:with-html-output-to-string (out)
     (:h1 (who:str (getf data :author)) "'s postings")
     (who:str (posts-list out (getf data :posts))))))

(restas:define-route author ("author/:author/")
  (let ((posts (pomo:query-dao
                'data::posting
                (:select 'hash 'author 'status 'title 'maintainer 'created-on
                         :from 'posting
                         :where (:= 'author author)))))
    (if posts
        (list :author author :posts posts)
        hunchentoot:+HTTP-NOT-FOUND+)))

(defmethod restas:render-object ((designer renderer) (object data::posting))
  (finalize-page
   (list
    :title (format nil "~A by ~A @ AssBoard"
                   (data::posting-title object)
                   (data::posting-author object))
    :content
    (who:with-html-output-to-string (out)
      (:h1 (who:str (data::posting-title object)))
      (:div (cl-markdown:markdown (data::posting-body object) :stream out))))))

(restas:define-route posting ("posting/:hash/")
  (let ((post (first (pomo:select-dao 'data::posting (:= 'hash hash)))))
    (if post post
        hunchentoot:+HTTP-NOT-FOUND+)))