Skip to content

Instantly share code, notes, and snippets.

@prasad83
Created November 28, 2023 05:16
Show Gist options
  • Save prasad83/a6600cf2281ad0f8f3a3b23f89139616 to your computer and use it in GitHub Desktop.
Save prasad83/a6600cf2281ad0f8f3a3b23f89139616 to your computer and use it in GitHub Desktop.
LispForTheWeb-RetroGames-InSqlite
; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment