Tuesday, August 30, 2011


Break time.

I have been researching various options for image sizing, and I do plan on finishing up the crash course sometime soon, but I saw a thread that sent me off thinking about something else.

Someone on Reddit linked to an article about static site generators (and their effect on software freedom), in which the writer posits that it would be really nice to have a Free Software competitor to Disqus.

Well, I'm not going to say "delivered" yet, because this is the merest hint of an attempt at a solution, but I threw something together in the couple of hours I could spare between postfix woes and various marketing initiatives at the company.

I won't try to go over any of the code, that was through the github link, in case you missed it, but I want to formalize a little of my thought process on where this actually needs to go to be a real competitor, just so that I can remember when I go back to work on it this weekend.

The Idea

Is, simply enough, to offload the comment system for a given page to a third party server. Either so that the maintainer of that page doesn't have to fart around with databases, or for that extra performance kick (since the first server no longer needs to serve up dynamic content at all), or because software as a service is in again, I really don't know.

Anyway, the point is, instead of keeping your own comment database locally, you just echo a static page with a line or two of trixy javascript, and your comments get pulled in on the clients' time.

So the basic feature set here is pretty sparse:

  • Track comments on a per-page basis
  • Allow adding/liking/disliking/reporting of individual comments
  • Allow replying to individual comments (not strictly necessary, but nice)

It wouldn't be any fun if that was all though. It would also be nice if

  • you could submit to [social site of choice] through one button click
  • you could edit your comments
  • spam sites could be tracked
  • spam/low-rating comments could be omitted/hidden by default

Finally, to support the Free Software objective, it needs to:

  • be AGPL (so that anyone can run their own for their friends if they feel like)
  • be written in a Free language (which is no problem at all)
  • allow full data exports (so that you could move pages between servers if you wanted)

This is a reasonably simple problem. Not trivial, but it looks like it would take a couple of weeks of serious work to knock out something useful. To the point that I have no idea how building a company around doing it is even possible. The only thing I can imagine is that the data storage and security around it is somehow more challenging than organizing the actual functionality (which is consistent with my observations of other software).

Well, that's that. Kick the tires, but don't blow my server up, and I'll do some more hacking on it later in the week.


It's been brought to my attention that people would like to get stuff running right now. Ok, didn't really plan for it but here goes (assuming you're on Debian)

  1. apt-get install sbcl mysql-server cl-sql
  2. git clone https://github.com/Inaimathi/clomments.git
  3. create a database and user and change the definition of *db-spec* in package.lisp to match
  4. install quicklisp Is there still a lisper that doesn't use this? I'm getting kind of sick of mentioning it.
  5. cd clomments; sbcl --eval "(ql:quickload :clomments)" If you're on a 64 bit machine, you may get some warnings starting up. Continue through them, and it should be fine (it's to do with cffi bindings for clsql)
  6. Once in SBCL
    (create-view-from-class 'comment)
    (create-view-from-class 'page)
  7. Go to http://localhost:4242/test in a browser

I promise I will streamline this as soon as I get the regulation 4 hours of sleep I'm entitled to per week.

Tue, 30 Aug, 2011

Also, I'm perfectly aware why there are extra spaces this time; it's because I'm starting to use regulation xhtml markup instead of relying on Blogger's seemingly flaky spacing feature. It seems like you can only set it globally for a given blog though, so I can't just switch over one post at a time. I'll need to go through my archives and wrap everything in <p> tags first.

Tue, 30 Aug, 2011

Friday, August 26, 2011

CL-Chan (a CLSQL and Hunchentoot crash course) - Part 1

Part 2

Ever since I was made keenly aware of my shortcomings, I've been reading up on a various things including CLOS and the OO interface to CLSQL. Probably the best resource available right now is the CLSQL documentation itself, and that's not a compliment. It's basically a (not particularly complete) reference piece that gives you a function listing and some minor explanation. As far as I can tell, it doesn't get you significantly more information than a few describe and inspect calls.

Searching for clsql tutorial brings up a Bill Clementson column on CLSQL basics and a pretty long forum argument between Slobodan Blazeski and (among others) Holger Schauer, Zach Beane and Geoff Wozniak about the seeming poor quality of a webapp tutorial by Slobodan to illustrate CLSQL in conjunction with Hunchentoot. I say "seemingly" because the original was apparently put up as a PDF on MegaUpload, then taken down in favor of being posted on Slobodan's personal site, and then taken down altogether (all of the links in that thread currently lead to 404 errors).

And that's it.

So, I figured I could put something together. At first it was going to be the standard "Hello World" of webapps (a blog), but then I figured, fuck it, lets make 4chan.

Assumptions Note

Things this tutorial assumes:

You know the very basics of Lisp, SQL and HTML

I won't bother teaching you what (+ 1 2) does or the basics of how the REPL works; there are better places to learn that. I also won't be teaching you how to SELECT * FROM employees;, that horse has been shot, bludgeoned, stomped on, kicked, salted and kicked again. Finally, I assume you know a thing or two about HTML, if not web development proper.

You have a Lisp and environment installed and configured to your liking (quicklisp optional, but recommended)

It can be as simple as Notepad with SBCL+linedit in a terminal, or LispWorks or Emacs+SLIME (I prefer the third, but won't be using any arcane keyboard shortcuts without explaining them here).

If you don't, LispBox is a very good starting point.

You have a database picked out and installed

I use MySQL, but clsql supports many more (and the syntax is the same no matter which you pick, so you'll get your money's worth here in any case)

Things it does not assume (and that you therefore may want to skip through):

You are an advanced Lisper

I won't teach you about the REPL, or how to use Lisp as a calculator, but I will have some notes here about (for example) package basics.

You have used clsql or CLOS before

I'm aiming at CLOS/clsql newbs here, so I may cover some of the same ground as the mentioned documentation and tutorial. Skip those bits that you already know.

You have built a Lisp webapp before

There are a few tutorials running around, but I won't assume that you've read all or any of them. Again, skip the bits you know (though if you're familiar with CLOS, clsql and Lisp web-development, why are you reading this?)

You are using SBCL (though I am, so let me know if something here fails to work on your end)

I assume you're using a Common Lisp (and not a Scheme or one of the mongrels like newLISP or Arc), and that said Common Lisp is compatible with both Hunchentoot and CLSQL. Other than that though, go nuts.

You are psychic

I'll try specifically to explain the things that were less than obvious to me while I was learning this material. Some stuff tends to get accidentally glossed over as trivial (it's also possible that I'm just thick, in which case, skip the obvious bits).

So lets get right to it.

Start a new file and get this into it, then save it as cl-chan.lisp

(defpackage :cl-chan (:use :cl :cl-who :hunchentoot))
(in-package :cl-chan)

(defvar *web-server* (start (make-instance 'hunchentoot:easy-acceptor :port 4242)))

Then hop into your REPL and load :cl-who + :hunchentoot, followed by cl-chan

Beginner Note

You can do that by typing

    (require 'cl-who)
    (require 'hunchentoot)
    (require 'clsql)

if you already have them installed. If you don't, then you might be able to install them (on a good day, in certain implementations, if you're lucky and if your last name begins and ends with "T") by typing

    (require 'asdf)
    (require 'asdf-install)
    (asdf-install:install 'cl-who)
    (asdf-install:install 'hunchentoot)
    (asdf-install:install 'clsql)

I've been told that doesn't work on all implementations (though it does work on the SBCL you can get out of the Debian repos). If you're smart, you will instead go here and follow the installation instructions, then type

    (ql:quickload (list :cl-who :hunchentoot :clsql))

That same statement will load local copies if you already have them installed, by the way. After all that, load your original file by typing

(load "path-to/cl-chan.lisp")

then crack a browser open and head on over to http://localhost:4242 to see the default Hunchentoot page.



Ok, ok, lets get to something at least slightly workable quickly.

Add the following just below that defvar:

(define-easy-handler (front-page :uri "/") ()
  (with-html-output-to-string (*standard-output* nil :prologue t :indent t)
    (:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
           (:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
                  (:title "Test Page"))
           (:body (:h1 "This is NOT the default page")
                  (:p "Nope.")))))

and refresh your browser.

Beginner Note

The first bit we did was define a namespace ("package") called :cl-chan. You can find specifics and some more advanced uses here, but the basic reason for this is to manage how the symbols we'll be defining interact on the global level. The basic :use directive we used specified that our package would import all exported symbols from three other packages;

  • :cl (all the basic Common Lisp functions; if you get into the situation where you've defined a package and odd things are happening in expressions that really shouldn't error, what's probably going on is that you forgot to include :cl),
  • :cl-who (an HTML generation library) and
  • :hunchentoot (a lisp-based web-server). We'll talk about namespace conflicts a later.

(in-package :cl-chan) means that any symbol following it will be evaluated in the package :cl-chan instead of in the global namespace.

The defvar line defines a new variable, stores an acceptor there and starts a server listening on port 4242 using the start method. You can later stop the server by evaluating (stop *web-server*) (you don't need to at the moment).

Finally, the define-easy-handler line sets up a handler at "localhost:4242/" that will return a simple page. The :cl-who markup you see should be self-explanatory if you know HTML.

Right. So a chan is a collection of boards, each of which is a collection of threads, each of which is a collection of comments. Lets start at the bottom, since that'll be the fastest way of getting something relevant on screen. A comment is composed of

  • a name
  • an email
  • a subject
  • a comment
  • an image
  • a posted date/time
  • a password (for deletion purposes)

We won't be dealing with the image and password for a while, so the obvious thing to do is

(defclass comment ()
  ((author :reader author :initarg :author :initform nil)
   (email :reader email :initarg :email :initform nil)
   (subject :reader subject :initarg :subject :initform nil)
   (body :reader body :initarg :body :initform nil)
   (date-time :reader date-time :initarg :date-time)))

Which is an awful lot of repetitious typing. Almost enough that I'm tempted to write myself a macro, since I try to use the same symbol as the name, reader and initarg for a given class. The first bit in each slot is a slot name, the keyword arguments are

  • :reader -- the name of the function which will return that slots' value (if you want one that will also let you modify the value, you should make it an :accessor instead)
  • :initarg -- the name of the parameter that will accept a value for this slot when you call make-instance (you actually have to name it with a colon at the beginning there; :author, not author, it matters)
  • :initform -- the default value of the slot if none is passed in (a class doesn't store nil by default; if you try to get the value of a slot that hasn't been set, you get an error).

So, lets try it out.

(defparameter test-comment 
  (make-instance 'comment 
                 :author "me" :email "my@email.com" :subject "FRIST!!1!one!"
                 :body "I am most certainly the first poster in this fine establishment"
                 :date-time (get-universal-time)))

Beginner Note

A parameter is like a variable, except that they act differently if you try to define one with an existing name. If you defvar a variable that already exists, it keeps the old value (you actually have to use setf explicitly), whereas if you defparameter a parameter that exists, it gets the new value. (get-universal-time) is a function that returns the current number of seconds since the epoch (in Common Lisp, that's 00:00 Jan 1, 1900 GMT, as it happens). We won't need to do anything with it 'till later.

Hop on over to the REPL and kick the tires a bit;

> (author test-comment)
> (body test-comment)
"I am most certainly the first poster in this fine establishment"
> (setf (body test-comment) "BLARGFGHH!")
The function (SETF BODY) is undefined.
   [Condition of type UNDEFINED-FUNCTION]

 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [*ABORT] Return to SLIME's top level.
 2: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" RUNNING {1003108271}>)

  0: ("bogus stack frame")

So that didn't work out so well. Remember, we defined all of these slots as having a :reader, not an :accessor. We could have given them both, or just an accessor, but we won't really be needing to mess with a comment once it's been posted, so this should be ok. Use the ABORT restart to get back into the REPL.

Beginner Note

I'm not sure how it works elsewhere, but if you're using Emacs, you can invoke a restart by typing the number next to it and hitting Return. So in this case, it'll be 1 RET

Ok, now lets show that. Head over to that define-easy-handler from earlier and change the contents of the body tag to

(:body (with-slots (author email subject body date-time) test-comment
         (htm (:div :class "comment"
                    (:span :class "header" 
                           (str author) (str email) 
                           (str date-time) (str subject))
                    (:span :class "body" 
                           (:p (str body)))))))

and evaluate the function again.

Beginner Note

You can certainly do that by using the same (load "path-to/cl-chan.lisp") statement as earlier, or by copy-pasting the function into your REPL. If you're using Emacs, you can also just get your cursor somewhere in the body of the function and hit C-M-x. Other environments probably have similar functionality.

Refreshing your browser should show you a fairly poorly formatted comment across two lines. Hey, it's a start. The first two things to notice are the htm and str tokens. These are part of the :cl-who library; they're actually tokens for the HTML generator, and not real functions so they'll error if you try to use them outside a with-html-... macro. They're just escapes to let you write dynamic HTML as part of :cl-who markup (without the htm after with-slots, you'd get undefined function errors for :div, :span and :p.

The with-slots macro is something you can use to address several slots from an object at once. Without it, we would have to do (author test-comment), (email test-comment) and so on (had we not defined :readers earlier, we'd have to use the even more laborious (slot-value test-comment 'author)).

One comment does not a board make, though. So lets get another in here. Add this one below the first test-comment

(defparameter test-comment2 
  (make-instance 'comment 
                 :author "someone else" :email "you@fmail.com" :subject "Stop being a douchebag"
                 :date-time (get-universal-time)))

and load it into your lisp. Now, it would obviously be annoying as fuck to write out the entire display code for yet another comment when we know we'll have to deal with dozens. So, lets add the first dose of actual object-orientation.

(defmethod echo ((a-comment comment))
  (with-html-output-to-string (*standard-output* nil :indent t)
    (with-slots (author email subject body date-time) a-comment
      (htm (:div :class "comment"
                 (:span :class "header" 
                        (str author) (str email) 
                        (str date-time) (str subject))
                 (:span :class "body" 
                        (:p (str body))))))))

Put that anywhere you like in the file (after your in-package line) and evaluate it, then test it out in the REPL;

> (echo test-comment)
<div class='comment'>
  <span class='header'>memy@email.com3522954339FRIST
  <span class='body'>
    <p>I am most certainly the first poster in this fine establishment
> (echo test-comment2)
<div class='comment'>
  <span class='header'>someone elseyou@fmail.com3522956120Stop being a douchebag
  <span class='body'>

A method is like an un (in that you can def them both), but it can specialize on one or more classes. Take a look at where it says ((a-comment comment)); that means that the method accepts one argument named a-comment, and that argument must be of class comment. From what I've seen, the correct convention is actually to name the argument after its class (so I really should have done ((comment comment)), but that's a bit harder to explain clearly).

Now that we've got the method, lets go ahead and re-define the body of the front-page

(:body (str (echo test-comment))
       (str (echo test-comment2)))

Re-evaluate it and refresh your browser; you should now be seeing both poorly-formatted comments one on top of the next. So multiple comments we've got, but there's more to a board than comments; we need threads too, right? A thread is a collection of comments belonging to a board. Lets just get that defined just below the comment class.

(defclass thread ()
  ((board :reader board :initarg :board)
   (comments :accessor comments :initarg :comments)))

Note that we didn't specify :initforms for comments or :board because every thread has those filled (there wouldn't be a thread otherwise). And, lets get a test-thread going. Add this to your file and evaluate it.

(defparameter test-thread 
  (make-instance 'thread
                 :board "a"
                 :comments (list test-comment test-comment2)))

And lets get another couple of comments in there for good measure;

(defparameter test-comment3 (make-instance 'comment 
                                           :subject "You must be new here"
                                           :body "trolled-softly.jpg"
                                           :date-time (get-universal-time)))

(defparameter test-comment4 (make-instance 'comment 
                                           :body "[Something vaguely anti-semetic.]"
                                           :date-time (get-universal-time)))

We defined our first :accessor earlier, by the way. It's no different from a :reader except that you can modify the slot after its declared (which is sort of important if you're going to be replying to threads). Lets add those two other comments to the test thread. Nothing special; just hop over into the REPL

> (comments test-thread)
(#<COMMENT {C1F3AF9}> #<COMMENT {100425C101}>) 

> ;; your comment will probably look slightly different; that's ok
; No Value

> (setf (comments test-thread) 
           (append (comments test-thread) 
                   (list test-comment3 test-comment4)))
(#<COMMENT {C1F3AF9}> 
 #<COMMENT {10048B3291}> 
 #<COMMENT {10048B32F1}> 
 #<COMMENT {100425C101}>)

There. Now that we have a thread with four comments, lets show that.

(defmethod echo ((thread thread))
  (let ((first-comment (car (comments thread))))
    (with-html-output (*standard-output* nil :indent t)
      (with-slots (author email subject body date-time) first-comment
        (htm (:div :class "thread"
                   (:span :class "header" 
                          (str author) (str email) 
                          (str date-time) (str subject))
                   (:span :class "body" 
                          (:p (str body)))
                   (dolist (r (cdr (comments thread)))
                     (str (echo r))))))))

Pedantic Note

Note that we're using with-html-output instead of with-html-output-to-string. Only the top level one actually has to be the to-string variant, and using the plain version of the macro lets us omit str calls on the output of this function. If you want, you can re-define echo for comments the same way, which would let you write the dolist in the thread echo as

(dolist (r (cdr (comments thread))) (echo r))

A method for the thread object! This is the other difference between a method and an un; you can have multiple methods with the same name which specialize on different objects. If you call echo on a comment, it'll evaluate the first one we defined. If you call it on a thread, it'll evaluate this new one (also note that part of our definition of echo for threads involves calling echo on each reply to the thread, which means that every element of (cdr (comments thread)) must be an echoable object). Amend your front-page :body again;

(:body (echo test-thread))

We defined echo such that you don't need the str this time (check the Pedantic Note above for details). Refreshing your screen should now show you four poorly styled comments stacked on top of one another. Actually, lets do something about that too. Create a new file called cl-chan.css and add this to it:

.thread { background-color: #ddf; padding: 10px; margin-bottom: 10px; }
.thread .omitted { color: #88f; font-weight: bold; }
.comment { background-color: #aaf; border: 2px solid #88f; padding: 5px 5px 0px 5px; margin-bottom: 10px; }
.header span { margin-right: 3px; }
.header .subject { font-weight: bold; }
.comment .header span { color: #55f; }
.comment p { margin: 3px; }

then redefine your front-page to

(define-easy-handler (front-page :uri "/") ()
  (with-html-output-to-string (*standard-output* nil :prologue t :indent t)
    (:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
           (:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
                  (:title "Test Page")
                  (:link :rel "stylesheet" :type "text/css" :href "/cl-chan.css"))
           (:body (echo test-thread)))))

finally, add this at the bottom of the file:

  "/cl-chan.css" (merge-pathnames "cl-chan.css")) 

Style Note

If you really want to do it right, you should probably create a sub-directory for the CSS files and make that create-folder-dispatcher-and-handler instead. You might also want to look into the existing CSS generators in Lisp instead of doing the work by hand, although it probably won't save you much typing on something this minimal.

create-static-file-dispatcher-and-handler takes a uri relative to your site and a file path, and serves up that path when that uri is requested.

*dispatch-table* is where Hunchentoot figures out how to route incoming requests. By default it only has one entry; default-dispatcher, which gets called if no other dispatcher fits the request (by default, it's set to a Hunchentoot error page).

merge-pathnames creates a path given two other paths (we passed in "cl-chan.css", the second path is optional and defaults to the directory you ran your Lisp from).

Refreshing after that should get you something slightly better than plain text. The header bar is still unreadable though. You may have noticed a few lines in the CSS that said something about .comment .header span and .header span; that's called foreshadowing.

(defmethod echo-header ((comment comment))
  (with-html-output (*standard-output*)
    (:span :class "header" 
           (dolist (elem '(author email date-time subject))
             (htm (:span :class (format nil "~(~a~)" elem) (str (slot-value comment elem))))))))

We're resorting to slot-value and dolist instead of using with-slots because we're assigning a CSS class to each span that matches the slot name. We'll also need to redefine the echo methods to call this one where they need to output comment headers

(defmethod echo ((thread thread))
  (let ((first-comment (car (comments thread))))
    (with-html-output (*standard-output* nil :indent t)
      (htm (:div :class "thread"
                 (echo-header comment)
                 (:span :class "body" 
                        (:p (str (body first-comment))))
                 (dolist (r (cdr (comments thread)))
                   (str (echo r))))))))

(defmethod echo ((comment comment))
  (with-html-output-to-string (*standard-output* nil :indent t)
    (htm (:div :class "comment"
               (echo-header comment)
               (:span :class "body" 
                      (:p (str (body comment))))))))

And we can now actually read the comments. Feel free to take some time out and make it pretty, if you like; it's beyond the scope of this tutorial to teach CSS, so here's reference instead.

Now, we've got a thread, which is ok, but we also need boards. A board is a collection of threads with a name. It'll probably have other stuff as we move through this exercise, but a name and some threads will suffice for now.

(defclass board ()
  ((name :reader name :initarg :name)
   (threads :accessor threads :initarg :threads :initform nil)))

For our purposes, it would also be helpful to have a slightly longer thread.

(defparameter test-thread2
  (make-instance 'thread
                 :board "a"
                 :first-comment test-comment
                 :replies (make-list 42 :initial-element test-comment3)))

And define the test board

(defparameter test-board
  (make-instance 'board
                 :name "a"
                 :threads (list test-thread 

Now, we know how to echo a thread (output all of its comments with the first one acting as the root element), and we know how to echo an individual comment (output the header in spans, followed by the body), but a board isn't dealt with the same way. The way you echo a board is you output the board's name in giant letters, followed by an <hr />, followed by a summary of each thread it contains (a summary is the first comment along with the last five, along with a little label telling us how many were omitted). The best way to do that would probably be to let a thread summarize itself instead of echoing its whole contents.

(defmethod summarize ((thread thread) &optional (preview-comment-count 5))
  (let* ((preview-comments (last (cdr (comments thread)) preview-comment-count))
         (omitted-count (- (length (cdr (comments thread))) (length preview-comments)))
         (first-comment (car (comments thread))))
    (with-html-output (*standard-output* nil :indent t)
      (:div :class "thread"
            (echo-header first-comment)
            (:span :class "body" 
                   (:p (str (body first-comment))))
            (when (> omitted-count 0)
              (htm (:p :class "omitted" 
                       (str (format nil "~a comments omitted (and we don't do pictures yet)" 
            (dolist (r preview-comments)
              (str (echo r)))))))

With that, echoing a board becomes trivial.

(defmethod echo ((board board))
  (with-html-output (*standard-output* nil :indent t)
    (:h1 (str (name board))) (:hr)
    (dolist (thread (threads board))
      (summarize thread))))

There's really nothing new in either of these code blocks (other than my obvious fear of magic numbers exemplified by making the preview-comment-count an optional argument), so change the :body of your define-easy-handler declaration to (echo test-board) and check out your handiwork in the browser. The next step here is adding navigation. You want to be able to click on a comment to read the thread, and, more importantly, reply to it. To start with, add a link to your summarize method that leads to "/thread". The method should now look something like

(defmethod summarize ((thread thread) &optional (preview-comment-count 5))
  (let* ((preview-comments (last (cdr (comments thread)) preview-comment-count))
         (omitted-count (- (length (cdr (comments thread))) (length preview-comments)))
         (first-comment (car (comments thread))))
    (with-html-output (*standard-output* nil :indent t)
      (:div :class "thread"
            (echo-header first-comment)
            (:a :href "/thread" "Reply")
            (:span :class "body" (:p (str (body first-comment))))
            (when (> omitted-count 0)
              (htm (:p :class "omitted" 
                       (str (format nil "~a comments omitted (and we don't do pictures yet)" 
            (dolist (r (cdr preview-comments)) (str (echo r)))))))

Also, declare the "/thread" page itself.

(define-easy-handler (thread :uri "/thread") ()
  (with-html-output-to-string (*standard-output* nil :prologue t :indent t)
    (:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
           (:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
                  (:title (str (board test-thread)))
                  (:link :rel "stylesheet" :type "text/css" :href "/cl-chan.css"))
           (:body (echo test-thread)))))

Go ahead and check out the result in your browser. Click around a bit, if you like. Before we go on, you may have noticed that thread and front-page have a lot in common. In fact, the only differences are the :title property and the contents of :body. Normally, I wouldn't bother pulling out a pattern that only occurs twice, but I'm fairly sure we're going to want pages other than a board and a thread before we're done, and this one is fairly laborious to type out so...

(defmacro page-template ((&key title) &body body)
  `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
     (:html :xmlns "http://www.w3.org/1999/xhtml" :xml\:lang "en" :lang "en"
            (:head (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
                   (:title (str ,title))
                   (:link :rel "stylesheet" :type "text/css" :href "/cl-chan.css"))
            (:body ,@body))))

That'll let us re-write front-page and thread as

(define-easy-handler (front-page :uri "/") ()
  (page-template (:title "cl-chan")
    (echo test-board)))

(define-easy-handler (thread :uri "/thread") ()
  (page-template (:title (board test-thread))
    (echo test-thread)))

without really losing any readability. Right, now then. The inputs. Teaching how HTML forms work isn't really the focus of this guide, so I'm gonna go ahead and cheat because I really really don't feel like going through the entire submit->validate->show-errors||proceed semi-loop.

> (asdf-install:install 'formlets)

> (defpackage :cl-chan (:use :cl :cl-who :hunchentoot :formlets))

It's a library I wrote a little while ago to help me reduce the boilerplate involved with using HTML forms, drawing inspiration heavily from the Racket (then PLT Scheme) implementation. I won't teach you this, just show you the code involved and offer a shortened explanation so we can move on.

(define-formlet (post-comment-form)
    ((author text) (email text) (subject text) (body textarea) (captcha recaptcha))
  (let ((new-comment (make-instance 'comment
                                    :author author :email email 
                                    :subject subject :body body
                                    :date-time (get-universal-time))))
    (setf (replies test-thread)
          (append (replies test-thread) (list new-comment)))
    (redirect "/thread")))

Since we're using recaptcha, you'll also need to do

(setf formlets:*public-key* [my-public-key] formlets:*private-key* [my-private-key])

You can get your keys by signing up (it's free, and they don't need any personal details other than, I believe, an email). Finally, modify your thread page to show that formlet

(define-easy-handler (thread :uri "/thread") ()
  (page-template (:title (board test-thread))
    (show-formlet post-comment-form)
    (echo test-thread)))

That was a formlet declaration, by the by; it has 5 fields (three regular inputs named author, email and subject respectively, a textarea named body and a recaptcha field named captcha). In this case, all the fields are un-validated (except for the captcha which always validates). When the user correctly enters the captcha, we'll add their comment to the test-thread and redirect them to the "/thread" page. After evaluating all that, you should be able to see a reply link on on each thread on the front page and a comment form at the top of the thread page. It actually works, for some value of "works", so you can try to add some messages to the test-thread.

We want to be able to add threads too though, not just reply to them. There's two ways we could do that;

First, we could add a hidden field to the post-comment-form that would contain either a reference to the thread or "new" (and post a new thread when it was "new"). That would let us reuse the same formlet.

Second, we could define a new formlet that just added a new thread to the board. There would be some additional boilerplate, but the two would be kept entirely separate rather than relying on a piece of information being passed to the client and then being passed back.

Despite the fact that relying on the client isn't always the best idea, it would probably work well here. However, we'll actually want to make the body (and eventual image) fields mandatory when you're starting a new thread, which means that we do actually need to handle validation differently for both situations, even though they involve the same fields. Ah well. If we need to define a third similar formlet, we can factor the common points out with a macro later.

(define-formlet (post-thread-form)
    ((author text) (email text) (subject text)
     (body textarea :validation ((longer-than? 5) "You need to type at least six characters here."))
     (captcha recaptcha))
  (let* ((new-comment (make-instance 'comment
                                     :author author :email email 
                                     :subject subject :body body
                                     :date-time (get-universal-time)))
         (new-thread (make-instance 'thread :board "a" :first-comment new-comment)))
    (push new-thread (threads test-board))
    (redirect "/")))

Add it to the board class' echo method too

(defmethod echo ((board board))
  (with-html-output (*standard-output* nil :indent t)
    (:h1 (str (name board)))
    (show-formlet post-thread-form)
    (dolist (thread (threads board))
      (summarize thread))))

Refreshing should get you the same front page, but with a form to let you start a new thread. We're temporarily cheating on the display of threads by just showing test-thread all the time, so you can't actually see or reply to the others, but that still Actually Works™. For a tutorial titled "Crash Course on CLSQL and Hunchentoot", we haven't done a whole lot of CLSQL yet. We, actually, haven't so much as included it. Lets change that. Change your defpackage line to

(defpackage :cl-chan (:use :cl :cl-who :hunchentoot :formlets :clsql))

and re-evaluate it. That should cause an error. Ok, ok, I promise to stop teasing after this, but this is just a point you should probably know if you're going to be developing in Lisp. Those of you who know what just happened, resolve the conflict by picking the clsql:select option, and skip the following note.

Beginner Note

Namespace conflicts happen sometimes. Packages you want to include both export the same, perfectly reasonable name and when you :use them both without specifying what to do about the conflict, your Lisp throws you an error.

In this case, the conflict is with the symbol select. :formlets exports a select class (named after the HTML Select tag that it models) and :clsql exports a select function (named after the SQL SELECT statement that it models). Both packages made the right choice of name for the thing they're trying to represent, but they wouldn't play nice in the same namespace. So it's a good thing Lisp has built-in namespace management.

Now, if we weren't planning on using select at all, we could just add a shadow statement like so:

(defpackage :cl-chan (:use :cl :cl-who :hunchentoot :formlets :clsql)
  (:shadow :select))

and be done with it. However, while our project won't call for the select tag yet (possibly at all), we will be using the select statement quite a bit. In that situation, you actually want to specify a :shadowing-import-from like this:

(defpackage :cl-chan (:use :cl :cl-who :hunchentoot :formlets :clsql)
  (:shadowing-import-from :clsql :select))

That tells Lisp to import the select symbol from the :clsql package, and shadow the rest of them.

Ok, first thing to do is make sure you have a database and user set up in whatever db engine you use. You'll need to create a user too, and give the user permissions to the database (for this tutorial, you can just use your root user instead of creating a new one, but you shouldn't do that on a production server). The process varies depending on DB, so check the docs for yours.

Next, we need to change our defclass statements slightly. Lets start with comment

(def-view-class comment ()
  ((id :accessor id :initarg :id :type integer 
       :db-constraints (:not-null :auto-increment) :db-kind :key)
   (thread-id :reader thread-id :initarg :thread-id :type integer)
   (author :reader author :initarg :author :initform nil :type string)
   (email :reader email :initarg :email :initform nil :type string)
   (subject :reader subject :initarg :subject :initform nil :type string)
   (body :reader body :initarg :body :initform nil :type string)
   (date-time :reader date-time :initarg :date-time :type wall-time)))

Not all that much has actually changed. It's defined with def-view-class rather than plain defclass, we added an id field (whose :db-constraints and :db-kind field should make the intent clear if you know anything about databases), we added a thread-id field to show what thread this comment belongs to, and we added some admittedly poor type annotations to the rest of the fields. You actually need the id field, by the way. If you want clsql to update your data properly through the class-based interface, each record needs a :key, and it needs to be set (if that isn't the case, it'll just add a new record rather than editing the existing one).

Note that date-time is of type wall-time rather than integer which means we'll need to do a bit of shuffling in how we assign it. CLSQL actually has a bunch of really useful, but as far as I know largely undocumented, utilities for dealing with times, dates and durations. Define a new function called now:

(defun now () (clsql-sys:utime->time (get-universal-time))

and call it instead of (get-universal-time) to set the date-time slot on a comment (you can just do a search-and-replace here; we haven't used univeral-times for anything else).

Package Note

A point of interest, clsql-sys has plenty of similar utility functions, but they're not documented anywhere other than in the code itself (check out the test suite buried in the clsql-sys source) and in three half-line blurbs about wall-time, date and duration in the official documentation. This kind of poor visibility is what led me to re-invent the wheel last time in defining my own mysql-time function the hard way.

Other stuff you might find interesting (some of which we will touch on later):

time-difference ;; it has all the usual arithmetic items too, 
                ;; this just happens to be the most useful, IMO
print-date ;; which, oddly, takes a wall-time, 
           ;; not a date, and accepts the following 
           ;; format options: 
           ;;    :time-of-day :long-day :month :month-year 
           ;;    :full :full+weekday :daytime :day
clsql-sys::days-in-month ;;yup, not even external

The transformation of a thread is a little more interesting.

(def-view-class thread ()
  ((id :accessor id :initarg :id :type integer 
       :db-constraints (:not-null :auto-increment) :db-kind :key)
   (board-id :reader board-id :initarg :board-id :type integer)
   (comments :accessor comments :db-kind :join
             :db-info (:join-class comment :home-key id :foreign-key thread-id :set t))))

We add an id slot here too, but the declaration of comments is our first example of the :db-kind :join notation. The important parts are

  • :db-info must be provided if you have :db-kind :join.
  • :join-class must designate another class defined by def-view-class (in this case comment, obviously).
  • :home-key and :foreign-key specify which columns to join on (you can specify either single columns or multiple columns, as in '(id thread-id), for example).
  • :set is a boolean that specifies whether this join should expect multiple values. It's nil by default, but in this case, we are expecting a set of comments to be returned, so we need to set it.
  • the results of a :join are returned as a list of matching elements, so we won't need to change how we deal with comments in any of the thread methods

The boards declaration shouldn't present any surprises

(def-view-class board ()
  ((id :accessor id :initarg :id :type integer 
       :db-constraints (:not-null :auto-increment) :db-kind :key)
   (name :reader name :initarg :name :type (string 5))
   (threads :accessor threads :db-kind :join
            :db-info (:join-class thread :home-key id :foreign-key board-id :set t))))

The only new thing here is that name is of type (string 5), which just means that 5 will be passed as the width of that column (in MySQL, this will be represented as a VARCHAR(5) column; it may be different in other databases). You can do the same sort of thing with integer, varchar, float, and number fields to limit length.

Once you've got the classes defined, you can automatically create tables based on them by using create-view-from-class. Lets connect and create those tables

> (connect '("localhost" "cl_chan" "me" "my password") :database-type :mysql) ;; obviously, you'll want to change the :mysql to your DB type and "me"/"my password" to your information
#<CLSQL-MYSQL:MYSQL-DATABASE localhost/cl_chan/me OPEN {BA80359}>
> (dolist (c '(board thread comment)) (create-view-from-class c))

A similar function, drop-view-from-class will let you delete the tables later (you don't need to do this right now). Lets get our data into our DB. We're kind of starting from scratch because we want the DB to handle assigning IDs to everything (even though we could easily guess them at this point).

> (defparameter test-board (make-instance 'board :name "a"))
> (update-records-from-instance test-board)

The return value from the function is the ID the database assigned to that record. Obviously, "a" being the first board, it's assigned the id 1. At this stage, we also need to change our handlers and our methods slightly. First up, lets get a board page up

(define-easy-handler (board :uri "/board") ()
  (page-template (:title "cl-chan")
    (let ((board (caar (select 'board :where [= [slot-value 'board 'id] 1]))))
      (echo board))))

The select statement there should be decipherable to you if you're familiar with SQL (we only have one board, so I'm hard-coding the board ID right now, we'll change that later). First thing to note is that caar call wrapping select. select always returns a list of lists. It's a bit annoying here because we're only selecting one thing, so it would be helpful to just return a single item. But if we did, for example

(select 'board 'thread 'comment)

then we'd actually want a list of lists (((board thread comment) (board thread comment) ...)). I guess the developers of clsql thought it better to be consistent than convenient (which I agree with up to a point, and this isn't past that point yet).

Notice also that the :where clause is expressed as a keyword argument. The square brackets delimit expressions that are going to be translated mechanically to SQL behind the scenes. The thing is, they're implemented as reader macros, so you'll need to add


to your file (just below the in-package line), as well as evaluate

> (enable-sql-reader-syntax)

at the REPL. If you don't, you'll get some odd undefined-variable errors. We'll need to re-write our post-thread-form too

(define-formlet (post-thread-form)
    ((author text) (email text) (subject text)
     (body textarea :validation ((longer-than? 5) "You need to type at least six characters here."))
     (captcha recaptcha))
  (let* ((thread-id (update-records-from-instance
                     (make-instance 'thread :board-id 1)))
         (new-comment (make-instance 'comment 
                                     :thread-id thread-id
                                     :author author :email email 
                                     :subject subject :body body
                                     :date-time (now))))
    (update-records-from-instance new-comment)
    (redirect "/board")))

After evaluating all that, hop into your browser and add a thread. If you've done everything correctly, you'll notice that nothing happened. Hop into the REPL, just to make sure something else didn't go wrong; you should be able to do

> (select 'thread)
((#<THREAD {B5D5D49}>))

> (select 'comment)
((#<COMMENT {B64AE29}>))

There'll be more of them if you tried a few times. So the threads and comments are being generated, but they're not showing up on your page. This is actually a feature of CLSQL. A caching feature. I don't mean for that to sound tongue-in-cheek, it's very useful when you have a somewhat static set of data and you'd like to save database round-trips. In those situations, you'd want to keep caching on globally and specify the individual non-caching selects by doing

(select 'foo :caching nil)

It's just that this isn't that kind of project. We'd like non-caching to be the default (and we'll specify the places where caching should happen). So add

(setf *default-caching* nil)

near the top of your file and evaluate it. Go ahead and refresh, and you should see your new threads. Of course, clicking "Reply" does not do what we want at this point. Lets fix the thread page and finally get this thing off the ground.

(define-formlet (post-comment-form)
    ((thread-id hidden) 
     (author text) (email text) (subject text) (body textarea)
     (captcha recaptcha))
  (let ((new-comment (make-instance 'comment
                                    :thread-id (parse-integer thread-id)
                                    :author author :email email 
                                    :subject subject :body body
                                    :date-time (now))))
    (update-records-from-instance new-comment)
    (redirect (format nil "/thread?thread-id=~a" thread-id))))

(define-easy-handler (thread-page :uri "/thread") (thread-id)
  (let ((thread (caar (select 'thread :where [= [slot-value 'thread 'id] thread-id]))))
    (page-template (:title (or (title (car (comments thread))) (id thread)))
      (echo thread))))

You'll also need to change the show-formlet line in the threads' echo method to

(show-formlet post-comment-form :default-values (list (id thread)))
so that the hidden field we've got going will actually have the correct default value.

Note that we've got a new field to let us know which thread is being replied to (we could have done this through hunchentoots' session, but that would have some odd corner cases if someone wanted to keep in multiple threads at once). Adding an argument to an easy-handler just makes sure it's bound appropriately (so the thread-id in those :where and :default-values clauses will be set to the correct values).

Pedantic Note

Just as an addendum, keep in mind two things here.

One, if you feel like calling get-parameter manually, you call it with the lower-cased string. Above, it would be (get-parameter "thread-id"), not (get-parameter :thread-id) or (get-parameter "THREAD-ID"). Those are all different things (the second one will throw an error, I think, the third one will just return NIL).

Two, any values you get back this way are strings, no matter what they actually represent. It doesn't matter in this case because the CLSQL reader macro handles it intelligently, and formlets converts anything it gets into a string anyway. However, if we wanted to create a new DB object (as in the formlet above), or do a standard numeric comparison, however, we'd need to convert from string. So,

    (= 1 (parse-integer thread-id))
and not
    (= 1 thread-id)

Finally, change the reply link in the summarize method to point to (format nil "/thread?thread-id=~a" (id thread)) instead of "/thread" (so that you can just click on the "Reply" link to get around). Go ahead and add some threads, then respond to them. You should be able to at this point.

I honestly thought this was going to be a shorter piece, but it's at 6k words and I've just managed to explain how to put together a very simple non-image message board. I'm calling this Part 1 and picking it up later. The code so far is over at github, in case you feel like starting from something when you tinker. If you feel like doing some exercises in the meantime, use what we've learned here to implement multiple boards (everything should be in place for that to be a simple tweak).

Still to Come: multiple boards, images, working with uploads and defining asdf-systems.

Tuesday, August 2, 2011

Formlets and defclass

Ok, I am officially off this fucking self-imposed thinking break.

By the by, in the post I linked above, I idly mused about why more people aren't making money tweaking PHP/CSS full time with WordPress. I'll save you the suspense; it's because the activity is mind-numbingly, eye-stabbingly boring. No one would do it for fun (except perhaps when working on their own monstrous websites, but at that point... why use PHP again? It's not like you're getting paid). So yeah, the cash is good, but it's because anyone who's out of university runs as fast as their fresh degree can take them in the other direction. There's probably a solution somewhere in there that pays well, and doesn't induce a boredom-related coma. I'll look for it eventually, but this week, I finally sat down and forced myself through a very nice CLOS tutorial and a page or two of the spec.

Really, I've been meaning to do this ever since my feeble attempt at the 2011 Spring Lisp Game Jam taught me the hard way just how little I know about loop, CLOS and object-orientation in general. The hard way because this isn't some theoretical exercise where a certain language feature might come in handy; there are parts of that project that could have been modeled much cleaner as objects. This weekend, I got to thinking that the formlet project I've been kicking around since getting a small taste from PLT Racket might be similarly object-appropriate. It's heavily inspired by their implementation, except that I go the extra step and automate validation at the same time. I think I had a semi-coherent rant about that lying around somewhere. The solution wasn't very clearly thought out, but I still think I was onto something. The pattern for form use is very consistent and simple; so why should I do something the computer can handle for me? I still need to add support for ajax, and a last handful of HTML form fields, but even in its half-assed, purely macro-driven form, it saved me a lot of typing at work and play. Trouble was that it was too difficult to add features. And hey, it looks like I could model it pretty well with objects, so I sat down with some documentation and copious amounts of green tea to see how far I could get in a weekend.

Pretty far, it turns out.

It's not quite a rewrite because stuff was kept, but that diff says I added/deleted 602 lines, and wc -l *.lisp *.asd *.md is telling me that I've got 555 lines total. So... yeah.

The declarations have been simplified. I did my best to carve out the annoyances, including

  • There's no show-[name]-formlet function anymore, there's just a show method that handles all formlet and field output, as well as a show-formlet macro for ease-of-use purposes
  • That show-formlet macro doesn't need any magical values passed to it because the validating and sending pages are communicating via huncentoots' session-value now
  • It is now easy to add additional field type handlers (just add a new defclass, show, and potentially validate method)
  • I've got the HTML output functions isolated enough that it actually wouldn't be very hard at all to port away from cl-who (I'm not going to, because it's the best of the lisp->html markup languages I've seen so far, but feel free to; it won't take you more than a few hours)
  • The hunchentoot-specific stuff is isolated in the define-formlet and show-formlet helper macros and a tiny bit in the post-value method (which means that the previous non-goal of portability across Lisp servers may also be attainable)

I've also added bunches of features that will come in handy in an ongoing work project. I think I've got a semi-handle on the CLOS stuff, having slogged through this. I don't imagine it's the greatest OO code in the world, but it's certainly a step up from defining tons of functions. The biggest difference in expressiveness actually came from the method system (though, full disclosure, I haven't yet plumbed the depths of defgeneric).

Basically, it's possible to model the HTML fields as a series of subclasses. For starters, a regular field

(defclass formlet-field ()
  ((name :reader name :initarg :name)
   (validation-functions :accessor validation-functions 
                         :initarg :validation-functions :initform nil)
   (default-value :reader default-value :initarg :default-value 
                  :initform nil)
   (error-messages :accessor error-messages :initarg :error-messages 
                   :initform nil)))

is fairly self-explanatory. It has a name, a set of validation functions and associated error messages, and a default value (which I actually haven't implemented yet, but each field has the slot and it's properly assigned by define-formlet). I realize that I could also model the different HTML outputs as a field, but I chose to do it as methods. The basic form fields are

(defclass text (formlet-field) ())
(defclass textarea (formlet-field) ())
(defclass password (formlet-field) ())
(defclass file (formlet-field) ())
(defclass checkbox (formlet-field) ())

These hold no surprises. They all have very slightly different show methods, but it's trivial differences. The HTML representation is subtly different, but they all generate exactly one return value and don't need to be primed. As an example, here's the show method for textarea

(defmethod show ((field textarea) &optional value error)
  (html-to-str (:textarea :name (name field) (str value)) (str (show error))))

That first argument may look a bit odd if you're in the state I was at the beginning of the weekend. This is a method, not a function, so that's not a default value for field, rather it's fields expected type. Basically, if you call show on a field of type textarea, you'll get that particular view function. Instead of, say, this one

(defmethod show ((field file) &optional value error)
  (html-to-str (:input :name (name field) :type "file" :class "file") 
               (str (show error))))

which would only apply to a field of type file.

Moving on, the next set of fields introduces a bit of a twist.

(defclass formlet-field-set (formlet-field)
  ((value-set :reader value-set :initarg :value-set :initform nil))
  (:documentation "This class is for fields that show the user a list of options"))

(defclass select (formlet-field-set) ())
(defclass radio-set (formlet-field-set) ())

Ok, yes, radio-set isn't technically an HTML field, but I'm not sure that's a reasonable approach. I can't think of a situation where a single radio button would be needed, but a lone checkbox couldn't do the job. Anyway, the twist is that while these fields return a single value, they make the user choose from a set of different options rather than entering data (or just accepting/rejecting as with the single checkbox situation). The main difference is that you need to allow for a set of values to be specified in the field as options that the user can choose from, and you potentially need to apply the checked or selected property to the currently selected field. Here's what that looks like

(defmethod show ((field radio-set) &optional value error)
  (html-to-str (loop for v in (value-set field)
                     do (htm (:span :class "input+label" 
                                (:input :type "radio" :name (name field) :value v 
                                        :checked (when (string= v value) "checked"))
                                        (str v))))
               (str (show error))))

Note that this is all still defining a single method. Before I knew about this, I would have done something like defining separate show-textarea, show-file and show-radio-set, or having a single cond somewhere, dispatching and treating each element differently somewhere. In fact, that's how my formlet system worked for a fairly long time. I'm rather happy I took the time to learn this way.

The last set of fields proved to be most problematic, and only because of how Hunchentoot deals with post-parameter.

(defclass formlet-field-return-set (formlet-field-set) ()
  (:documentation "This class is specifically for fields that return multiple values from the user"))

(defclass multi-select (formlet-field-return-set) ())
(defclass checkbox-set (formlet-field-return-set) ())

We're not just specifying a set of potential choices here, we're now also getting a set back from the user to play around with. Which means that it's not enough to compare the current value against each option, we need to check whether each option is a member of the set of values.

(defmethod show ((field multi-select) &optional value error)
  (html-to-str (:select :name (name field) :multiple "multiple" :size 5
                        (loop for v in (value-set field)
                              do (htm (:option :value v 
                                               :selected (when (member v value :test #'string=) "selected")
                                                         (str v)))))
               (str (show error))))

But. We also need a way of getting those values in the first place. As I said, Hunchentoot fought me on this. The (post-parameters*) are represented as an alist, which is alright if a bit more verbose than I hoped, but at the same time, (post-parameter "field") seems to be a very thin wrapper around (cdr (assoc "field" (post-parameters*)). Which means that if I want to get all of the values of a particular field out of the posted data, I need to traverse that alist and filter it myself. So, here's how I did that

(defmethod post-value ((field formlet-field) post-alist)
  (cdr (assoc (name field) post-alist :test #'string=)))

(defmethod post-value ((field formlet-field-return-set) post-alist)
  (loop for (k . v) in post-alist
        if (string= k (name field)) collect v))

Now, bear in mind that I was (and still am) operating of very little sleep, so I can guarantee that this isn't the best solution, but it does what I need very simply. When I need the set of values posted, it's as easy as

(mapcar (lambda (field) (post-value field (post-parameters*))) (fields formlet))

Which doesn't look nearly as easy as it seemed in my mind, but it's still not too hairy to parse. I probably didn't need to go quite as crazy on the hierarchy my first time out. But it was my first time out. And I wanted to learn something. Next time, I'm hoping to finally have a little tutorialette that I've been kicking around fininished. Something related to CLOS and clsql.

Right, that's it. I've uploaded a fresh copy of the formlet system to my github, and to an asdf-able location (so (asdf-install:install 'formlets) should work). Still no gpg key. I'm working on it, if you'll believe that. If you find any issues, feel free to note them (I actually check my github tracker more often than my email).

And now, if you'll excuse me, I'm going to go collapse into bed for about 12 hours.


Ok, seriously, done dicking around with the formatting around now.

If it's any consolation at all, the actual project is properly indented.

Tue, 02 Aug, 2011