LispForTheWeb-RetroGames-InSqlite

retro-games-sqlite.lisp

; Port of Lisp.For.The.Web (Adam Tornhill) 
; Retro Games on MongoDB to Sqlite

; Ensure QuickLoad dependencies
(load "~/.sbclrc") ; or (load "~/.quicklisp/setup.lisp")
(ql:quickload '(cl-who hunchentoot parenscript sqlite) :silent t)

(defpackage :retro-games-sqlite
    (:use :cl :cl-who :hunchentoot :parenscript :sqlite))

(in-package :retro-games-sqlite)

(defvar *db* (connect "retro-games.db"))

(defun db-init-table ()
    (execute-non-query *db* "create table if not exists game (id integer primary key, name varchar(255), votes integer)"))

(db-init-table)

(defun db-find-records (query &rest params) (apply #'execute-to-list *db* query params))
(defun db-create-record (query &rest params) (apply #'execute-non-query *db* query params))
(defun db-update-record (query &rest params) (apply #'execute-non-query *db* query params))

(defclass game ()
    ((id :initarg :id :reader id)
     (name :initarg :name :reader name)
     (votes :initarg :votes :initform 0 :accessor votes)))

(defun rec->game (game-rec)
    (make-instance 'game :id (first game-rec)
                   :name (second game-rec)
                   :votes (third game-rec)))

(defun game->rec (game)
    (list (id game) (name game) (votes game)))
    
(defmethod vote-for (user-selected-game)
    (incf (votes user-selected-game)))

(defmethod vote-for :after (game)
    (db-update-record "update game set votes = ? where name = ?" (votes game) (name game)))

(defun game-from-name (name)
    (let ((found-games (db-find-records "select id, name, votes from game where name = ?" name)))
        (when found-games (rec->game (first found-games)))))

(defun game-stored? (game-name) (game-from-name game-name))

(defun games () 
    (mapcar #'rec->game (db-find-records "select id, name, votes from game order by votes desc")))

(defun add-game (name)
    (let ((game (make-instance 'game :name name)))
        (db-create-record "insert into game (name, votes) values (?, ?)" (name game) (votes game))))

(defmethod print-object ((object game) stream)
    (print-unreadable-object (object stream :type t)
        (with-slots (name votes) object
            (format stream "name: ~s with ~d votes" name votes))))

; -----------------------------------------------------------------

(setf (html-mode) :html5) ; HTML5 doctype prologue

(defmacro standard-page ((&key title script) &body body)
    `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
        (:html :lang "en"
            (:head
                (:meta :charset "utf-8")
                (:title ,title)
                (:link :type "text/css" :rel "stylesheet" :href "/retro.css")
                ,(when script `(:script :type "text/javascript" (str ,script))))
            (:body 
                (:div :id "header"
                    (:img :width "96px" :style "vertical-align: middle" :src "/logo.png" :alt "Commodore 64" :class "logo")
                    (:span :class "strapline" "Vote on your favourite Retro Game"))
                ,@body))))

; -------------------------------------------------------------
(define-easy-handler (retro-games :uri "/retro-games") ()
    (standard-page (:title "Retro Games")
        (:h1 "Vote on your all time favorite retro games!")
        (:p "Missing a game? Make it available for votes"
            (:a :href "new-game" "here"))
        (:h2 "Current stand")
        (:div :id "chart"
            (:ol 
                (dolist (game (games))
                    (htm 
                        (:li (:a :href (format nil "vote?name=~a" (url-encode (name game)) "Vote")
                             (fmt "~A with ~d votes" (escape-string (name game)) (votes game))))))))))

(define-easy-handler (vote :uri "/vote") (name)
    (when (game-stored? name)
        (vote-for (game-from-name name)))
    (redirect "/retro-games"))

(define-easy-handler (new-game :uri "/new-game") ()
    (standard-page (:title "Add a new game"
                    :script (ps
                                (defvar add-form nil)
                                (defun valdiate-game-name (evt)
                                    (when (= (@ add-form name value) "")
                                        (chain evt (prevent-default))
                                        (alert "Please enter a name.")))
                                (defun init()
                                        (setf add-form (chain document (get-element-by-id "addform")))
                                        (chain add-form (add-event-listener "submit" valdiate-game-name false)))
                                (setf (chain window onload) init)))
        (:h1 "Add a new game to the chart")
        (:form :action "/game-added" :method "post" :id "addform"
            (:p "What is the name of the game?" (:br)
                (:input :type "text" :name "name" :class "txt"))
            (:p (:input :type "submit" :value "Add" :class "btn")))))

(define-easy-handler (game-added :uri "/game-added") (name)
    (unless (or (null name) (zerop (length name)))
        (add-game name))
    (redirect "/retro-games"))

; -----------------------------------------------------------------
(defun start-server (port)
    (start (make-instance 'easy-acceptor :port port))
    (format t "http server running on :~a~%" port)
    ; block sbcl main-thread
    (handler-case 
        (loop do (sleep 1000))
        (condition () nil)))

(start-server 8080)