Bubblegumdrop/cl-chat-web
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit for git.lain.church

Browse Source
This commit is contained in:
Bubblegumdrop 2024-10-11 16:45:22 -04:00
commit 2a54fc3e0d
10 changed files with 297 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
bin/
*.bin
*.fasl
*.db

32
live-chat-cgi.lisp Normal file
View File

@ -0,0 +1,32 @@
(in-package #:live-chat-cgi)
(defun print-http-header ()
"Print standard HTTP headers for CGI."
(format t "Content-Type: text/html~%~%"))
(defun cgi-handler ()
"Handle CGI requests and dispatch them to the appropriate logic."
(let ((request-method (string-downcase (or (getenv "REQUEST_METHOD") ""))))
(print-http-header)
(cond
((string= request-method "get")
(let ((path (getenv "PATH_INFO")))
(cond
((string= path "/chat-messages")
(render-chat-messages))
((string= path "/")
(render-chat-ui))
(t
(format t "Not Found")))))
((string= request-method "post")
;; Read the POST data
(let ((input (read-line *standard-input*)))
(when (and input (not (string= input "")))
(let ((params (split-sequence:split-sequence #\& input)))
(dolist (param params)
(let* ((pair (split-sequence:split-sequence #\= param))
(key (first pair))
(value (second pair)))
(when (string= key "message")
(handle-post-message value))))))
(render-chat-messages))))))

70
live-chat-core.lisp Normal file
View File

@ -0,0 +1,70 @@
(in-package #:cl-user)
(in-package #:live-chat-core)
;; (defvar *messages* (make-array 0 :adjustable t :fill-pointer t)
;; "Array to store chat messages.")
(defun handle-post-message (message)
"Handle a new message being posted to the chat."
(insert-message message)
;; (vector-push-extend message *messages*)
(format nil "Message received: ~a" message))
(defun render-chat-messages ()
"Render the list of chat messages as HTML."
(let ((messages (fetch-messages)))
(if messages
(cl-who:with-html-output-to-string (*standard-output* nil :indent t)
(:h3 :class "title is-3" "Chat Messages")
(loop for msg in messages
do (cl-who:htm
(:div :class "box" (cl-who:str msg)))))
"")))
(defun render-chat-ui ()
"Render the main chat page with HTMX integration."
(cl-who:with-html-output-to-string (*standard-output* nil :prologue t :indent t)
(:html :lang "en"
(:head
(:meta :charset "utf-8")
(:meta :name "viewport" :content "width=device-width, initial-scale=1")
(:title "Live Chat")
(:link :rel "stylesheet"
:href "https://cdnjs.cloudflare.com/ajax/libs/bulma/1.0.2/css/bulma.min.css"
:integrity "sha512-RpeJZX3aH5oZN3U3JhE7Sd+HG8XQsqmP3clIbu4G28p668yNsRNj3zMASKe1ATjl/W80wuEtCx2dFA8xaebG5w=="
:crossorigin "anonymous"
:referrerpolicy "no-referrer")
(:script :src "https://cdnjs.cloudflare.com/ajax/libs/htmx/2.0.3/htmx.min.js"
:integrity "sha512-dQu3OKLMpRu85mW24LA1CUZG67BgLPR8Px3mcxmpdyijgl1UpCM1RtJoQP6h8UkufSnaHVRTUx98EQT9fcKohw=="
:crossorigin "anonymous"
:referrerpolicy "no-referrer"))
(:body
(:section :class "section"
(:div :class "container"
(:h1 :class "title" "Live Chat")
;; Form for sending messages
(:form :id "post-message-form"
:name "post-message-form"
:hx-post "/post-message"
:hx-swap "innerHTML"
:hx-target "#chat-messages"
(:div :class "field has-addons"
(:div :class "control is-expanded"
(:input :class "input is-expanded"
:form "post-message-form"
:placeholder "Ender your message..."
:type "text" :name "message"))
(:div :class "control"
(:button :class "button is-link is-light"
:form "post-message-form"
:type "submit" "Send"))))))
;; Chat messages will be updated by HTMX via GET to /chat-messages
(:section :class "section"
(:div :class "container"
:id "chat-messages"
:hx-get "/chat-messages"
:hx-trigger "every 2s"
(cl-who:str (render-chat-messages))))))))

50
live-chat-db.lisp Normal file
View File

@ -0,0 +1,50 @@
(in-package #:live-chat-db)
(defvar *db* nil
"Database connection object.")
(defun open-database ()
"Open the SQLite database."
(setf *db* (dbi:connect-cached
:sqlite3 :database-name
(asdf:system-relative-pathname :live-chat "chat.db"))))
(defun close-database ()
"Close the SQLite database."
(when *db* (dbi:disconnect *db*)))
(defun create-messages-table ()
"Create the messages table if it doesn't exist."
(open-database)
(let ((query (dbi:prepare *db*
"CREATE TABLE IF NOT EXISTS messages
(id INTEGER PRIMARY KEY AUTOINCREMENT,
content TEXT NOT NULL)")))
(dbi:execute query (list)))
(close-database))
(defun insert-message (message)
"Insert a new message into the database."
(open-database)
(let ((query (dbi:prepare *db*
"INSERT INTO messages (content) VALUES (?)")))
(dbi:execute query (list message))
(close-database)
message))
(defun fetch-messages ()
"Fetch all messages from the database."
(open-database)
(let* ((query (dbi:prepare *db*
"SELECT content FROM messages ORDER BY id"))
(query (dbi:execute query (list)))
(results (loop for row = (dbi:fetch query)
while row
collect (getf row :|content|))))
(close-database)
(reverse results)))
(defun clear-messages ()
"Clear all messages from the database."
(let ((query (dbi:prepare *db* "DELETE FROM messages")))
(dbi:execute query (list))))

43
live-chat-hunchentoot.lisp Normal file
View File

@ -0,0 +1,43 @@
(in-package #:live-chat-hunchentoot)
(defvar *server* nil
"The server acceptor.")
(hunchentoot:define-easy-handler (chat-index :uri "/") ()
"Handle GET requests to / and render the chat UI."
(render-chat-ui))
(hunchentoot:define-easy-handler (chat-handler :uri "/chat-messages") ()
"Handle GET requests to /chat-messages and render the chat UI."
(render-chat-messages))
(hunchentoot:define-easy-handler (chat-post-handler :uri "/post-message" :default-request-type :post) ()
"Handle POST requests to /post-message and process the message."
(let ((message (hunchentoot:post-parameter "message")))
(when (and message (not (string= message "")))
(handle-post-message message)))
(render-chat-messages))
(defun start-chat-server (&optional (address "localhost") (port 8080))
"Start the Hunchentoot chat server."
(setf (cl-who:html-mode) :html5
*server* (make-instance 'hunchentoot:easy-acceptor
:address address
:port port))
(hunchentoot:start *server*)
(format t "Chat server started on port 8080~%")
(wait-for-hunchentoot-listener "hunchentoot-listener-"))
;; https://stackoverflow.com/a/30424968
(defun wait-for-hunchentoot-listener (name)
(bt2:join-thread
(find-if
(lambda (th)
(prefixp name (bt2:thread-name th)))
(bt2:all-threads))))
;; https://github.com/brown/base?tab=readme-ov-file#prefixp-prefix-sequence-key-test-eql
(defun prefixp (prefix sequence &key (test #'eql))
"Does PREFIX match a prefix of SEQUENCE?"
(let ((mismatch (mismatch prefix sequence :test test)))
(or (null mismatch) (= mismatch (length prefix)))))

5
live-chat-main.lisp Normal file
View File

@ -0,0 +1,5 @@
(in-package #:live-chat)
(defun main ()
(create-messages-table)
(start-chat-server))

21
live-chat.asd Normal file
View File

@ -0,0 +1,21 @@
;;;; live-chat.asd
(asdf:defsystem #:live-chat
:description "Twitch.TV-like live chat on the web. Uses HTMX to poll for messages."
:author "Bubblegumdrop <staticsunn@gmail.com>"
:license "WTFPL 2+"
:version "0.1.0"
:defsystem-depends-on (:deploy) ;; so you need to quickload deploy sometime before.
:build-operation "deploy-op" ;; instead of program-op for asdf:make
:build-pathname "live-chat"
:entry-point "live-chat::main"
:depends-on (#:bordeaux-threads
#:cl-dbi
#:cl-who
#:hunchentoot)
:components ((:file "package")
(:file "live-chat-db")
(:file "live-chat-core")
(:file "live-chat-hunchentoot")
(:file "live-chat-cgi")
(:file "live-chat-main")))

22
makefile Normal file
View File

@ -0,0 +1,22 @@
PROG := live-chat
SRC := $(wildcard *.asd) $(wildcard *.lisp)
BIN := $(PROG).bin
all: install
install: $(BIN)
bin/$(PROG): $(SRC)
sbcl --load $< \
--eval "(load \"live-chat.asd\")" \
--eval "(asdf:load-system :live-chat)" \
--eval "(asdf:make 'live-chat)"
$(BIN): bin/$(PROG)
mv $< $@
clean:
$(RM) -rf *~ bin $(BIN)
.PHONY: all install

47
package.lisp Normal file
View File

@ -0,0 +1,47 @@
(in-package #:cl-user)
(defpackage #:live-chat-db
(:use #:cl)
(:local-nicknames (#:cl-dbi #:dbi))
(:export #:*db*
#:open-database
#:close-database
#:create-messages-table
#:insert-message
#:fetch-messages))
(defpackage #:live-chat-core
(:use #:cl)
(:local-nicknames (#:cl-who #:cl-who))
(:import-from #:live-chat-db
#:insert-message
#:fetch-messages)
(:export #:render-chat-messages
#:render-chat-ui
#:handle-post-message
#:*messages*))
(defpackage #:live-chat-cgi
(:use #:cl)
(:import-from #:live-chat-core)
(:export #:cgi-handler))
(defpackage #:live-chat-hunchentoot
(:use #:cl)
(:import-from #:live-chat-core
#:handle-post-message
#:render-chat-messages
#:render-chat-ui)
(:local-nicknames (#:cl-who #:cl-who)
(#:hunchentoot #:hunchentoot))
(:export #:start-chat-server))
(uiop:define-package #:live-chat
(:use #:cl)
(:use-reexport #:live-chat-core
#:live-chat-cgi
#:live-chat-db
#:live-chat-hunchentoot))
(in-package #:live-chat)

3
readme.org Normal file
View File

@ -0,0 +1,3 @@
* What It Is
Twitch.TV-like live chat on the web. Uses HTMX to poll for messages. No database support (yet).