Continue: Web Applications in Racket

How do we make dynamic web applications? This tutorial will show how we can build web applications using Racket. As our working example, we’ll build a simple web journal (a “blog”). We’ll cover how to start up a web server, how to generate dynamic web content, and how to interact with the user.

The target audience for this tutorial are students who’ve gone through the design and use of structures in How to Design Programs, with some higher-order functions, local, and a minor bit of mutation.

1 Getting Started

Everything you needed in this tutorial is provided in Racket. We will be using the DrRacket Module language. Enter the following into the Definition window.

#lang web-server/insta

(define (start request)

(response/xexpr

'(html

(head (title "My Blog"))

(body (h1 "Under construction")))))

Press the Run button. If a web browser comes up with an “Under Construction” page, then clap your hands with delight: you’ve built your first web application! It doesn’t do much yet, but we will get there. Press the Stop button to shut the server down for now.

2 The Application

We want to motivate this tutorial by showing how to develop a blog. Users should be able to create posts and add comments to any posts. We’ll take an iterative approach, with one or two pitfalls along the way. The game plan, roughly, will be:

• Show a static list of posts.

• Allow a user to add new posts to the system.

• Extend the model to let a user add comments to a post.

• Allow all users to share the same set of posts.

• Serialize our data structures to disk.

By the end of this tutorial, we’ll have a simple blogging application.

3 Basic Blog

We start by considering our data definitions. We want to represent a list of posts. Let’s say that a post is:

(struct post (title body))

(struct post (title body))

title : string?

body : string?

Exercise. Make a few examples of posts.

A blog, then, will be a list of posts:

blog : (listof post?)

As a very simple example of a blog:

(define BLOG (list (post "First Post!"

"Hey, this is my first post!")))

Now that we have a sample blog structure, let’s get our web application to show it.

4 Rendering HTML

When a web browser visits our application’s URL, the browser constructs a request structure and sends it off to our web application. Our start function will consume requests and produce responses. One basic kind of response is to show an HTML page, represented as an X-expression in Racket, by using response/xexpr.

(define xexpr/c

(flat-rec-contract

xexpr

(or/c string?

(or/c (cons/c symbol? (listof xexpr))

(cons/c symbol?

(cons/c (listof (list/c symbol? string?))

(listof xexpr)))))))

For example:

The HTML hello is represented as "hello". Strings are automatically escaped when output. This guarantees valid HTML. Therefore, the value "<b>Unfinished tag" is rendered as &lt;b&gt;Unfinished tag not <b>Unfinished tag. Similarly, "<i>Finished tag</i>" is rendered as &lt;i&gt;Finished tag&lt;/i&gt; not <i>Finished tag</i>.

<p>This is an example</p> is

'(p "This is an example").

<a href="link.html">Past</a> is

'(a ((href "link.html")) "Past").

<p>This is <div class="emph">another</div> example.</p> is

'(p "This is " (div ((class "emph")) "another") " example.").

We can produce these xexprs by using cons and list directly. Doing so, however, can be notationally heavy. Consider:

(list 'html (list 'head (list 'title "Some title"))

(list 'body (list 'p "This is a simple static page.")))

vs:

'(html (head (title "Some title"))

(body (p "This is a simple static page.")))

They both produce the same xexpr, but the latter is a lot easier to type and read. We’ve been using the extended list abbreviation form described in Section 13 of How to Design Programs: by using a leading forward quote mark to concisely represent the list structure, we can construct static html responses with aplomb.

However, we can run into a problem when we use simple list abbreviation with dynamic content. If we have expressions to inject into the xexpr structure, we can’t use a simple list-abbreviation approach because those expressions will be treated literally as part of the list structure!

We want a notation that gives us the convenience of quoted list abbreviations, but with the option to treat a portion of the structure as a normal expression. That is, we would like to define a template whose placeholders can be easily expressed and filled in dynamically.

Racket provides this templating functionality with quasiquotation. Quasiquotation uses a leading back-quote in front of the whole structure. Like regular quoted list abbreviation, the majority of the list structure will be literally preserved in the nested list result. In places where we’d like a subexpression’s value to be plugged in, we prepend an unquoting comma in front of the subexpression. As an example:

; render-greeting: string -> response

; Consumes a name, and produces a dynamic response.

(define (render-greeting a-name)

(response/xexpr

`(html (head (title "Welcome"))

(body (p ,(string-append "Hello " a-name))))))

Exercise. Write a function that consumes a post and produces an xexpr representing that content.

render-post : (post? . -> . xexpr/c)

As an example, we want:

(render-post (post "First post!" "This is a first post."))

to produce:

'(div ((class "post")) "First post!" (p "This is a first post."))

Exercise. Revise render-post to show the number of comments attached to a post.

————

If an expression produces a list of xexpr fragments, we may want to splice in the elements of a list into our template, rather plug in the whole list itself. In these situations, we can use the splicing form ,@expression.

As an example, we may want a helper function that transforms a xexpr list into a fragment representing an unordered, itemized HTML list:

; render-as-itemized-list: (listof xexpr) -> xexpr

; Consumes a list of items, and produces a rendering

; as an unordered list.

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

; Consumes an xexpr, and produces a rendering

; as a list item.

(define (render-as-item a-fragment)

`(li ,a-fragment))

Exercise. Write a function render-posts that consumes a (listof post?) and produces an xexpr for that content.

render-posts : ((listof post?) . -> . xexpr/c)

As examples:

(render-posts empty)

should produce:

'(div ((class "posts")))

While

(render-posts (list (post "Post 1" "Body 1")

(post "Post 2" "Body 2")))

should produce:

'(div ((class "posts"))

(div ((class "post")) "Post 1" "Body 1")

(div ((class "post")) "Post 2" "Body 2"))

————

Now that we have the render-posts function handy, let’s revisit our web application and change our start function to return an interesting response.

#lang web-server/insta

; A blog is a (listof post)

; and a post is a (make-post title body)

(struct post (title body))

; BLOG: blog

; The static blog.

(define BLOG

(list (post "First Post" "This is my first post")

(post "Second Post" "This is another post")))

; start: request -> response

; Consumes a request, and produces a page that displays all of the

; web content.

(define (start request)

(render-blog-page BLOG request))

; render-blog-page: blog request -> response

; Consumes a blog and a request, and produces an HTML page

; of the content of the blog.

(define (render-blog-page a-blog request)

(response/xexpr

`(html (head (title "My Blog"))

(body (h1 "My Blog")

,(render-posts a-blog)))))

; render-post: post -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

(define (render-post a-post)

`(div ((class "post"))

,(post-title a-post)

(p ,(post-body a-post))))

; render-posts: blog -> xexpr

; Consumes a blog, produces an xexpr fragment

; of all its posts.

(define (render-posts a-blog)

`(div ((class "posts"))

,@(map render-post a-blog)))

If we press Run, we should see the blog posts in our web browser.

5 Inspecting Requests

Our application still seems a bit static: although we’re building the page dynamically, we haven’t yet provided a way for an external user to add new posts. Let’s tackle that now. Let’s provide a form that will let the user add a new blog entry. When the user presses the submit button, we want the user to see the new post at the top of the page.

Until now, we’ve been passing around a request object without doing anything with it. As we might expect, the request object isn’t meant to be ignored so much! When a user fills out a web form and submits it, that user’s browser constructs a new request that holds the form values in it. We can use the function request-bindings to grab at the values that the user has filled out. The type of request-bindings is:

request-bindings : (request? . -> . bindings?)

Along with request-bindings, there’s another function called extract-binding/single that takes this as well as a name, and returns the value associated to that name.

extract-binding/single : (symbol? bindings? . -> . string?)

Finally, we can check to see if a name exists in a binding with exists-binding?:

exists-binding? : (symbol? bindings? . -> . boolean?)

With these functions, we can design functions that consume requests and do something useful.

Exercise. Write a function can-parse-post? that consumes a bindings?. It should produce #t if there exist bindings both for the symbols 'title and 'body, and #f otherwise.

can-parse-post? : (bindings? . -> . boolean?)

Exercise. Write a function parse-post that consumes a bindings. Assume that the bindings structure has values for the symbols 'title and 'body. parse-post should produce a post containing those values.

parse-post : (bindings? . -> . post?)

Now that we have these helper functions, we can extend our web application to handle form input. We’ll add a small form at the bottom, and adjust out program to handle the addition of new posts. Our start method, then, will first see if the request has a parsable post, extend its set of posts if it can, and finally display those blog posts.

#lang web-server/insta

; A blog is a (listof post)

; and a post is a (make-post title body)

(struct post (title body))

; BLOG: blog

; The static blog.

(define BLOG

(list (post "First Post" "This is my first post")

(post "Second Post" "This is another post")))

; start: request -> response

; Consumes a request and produces a page that displays all of the

; web content.

(define (start request)

(local [(define a-blog

(cond [(can-parse-post? (request-bindings request))

(cons (parse-post (request-bindings request))

BLOG)]

[else

BLOG]))]

(render-blog-page a-blog request)))

; can-parse-post?: bindings -> boolean

; Produces true if bindings contains values for 'title and 'body.

(define (can-parse-post? bindings)

(and (exists-binding? 'title bindings)

(exists-binding? 'body bindings)))

; parse-post: bindings -> post

; Consumes a bindings, and produces a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)))

; render-blog-page: blog request -> response

; Consumes a blog and a request, and produces an HTML page

; of the content of the blog.

(define (render-blog-page a-blog request)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts a-blog)

(form

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

; render-post: post -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

(define (render-post a-post)

`(div ((class "post"))

,(post-title a-post)

(p ,(post-body a-post))))

; render-posts: blog -> xexpr

; Consumes a blog, produces an xexpr fragment

; of all its posts.

(define (render-posts a-blog)

`(div ((class "posts"))

,@(map render-post a-blog)))

This appears to work... but there’s an issue with this! Try to add two new posts. What happens?

6 Advanced Control Flow

For the moment, let’s ignore the admittedly huge problem of having a blog that only accepts one new blog entry. Don’t worry! We will fix this.

But there’s a higher-level problem with our program: although we do have a function, start, that can respond to requests directed at our application’s URL, that start function is starting to get overloaded with a lot of responsibility. Conceptually, start is now handling two different kinds of requests: it’s either a request for showing a blog, or a request for adding a new blog post.

What’s happening is that start is becoming a traffic cop — a dispatcher — for all the behavior of our web application. As far as we know, if we want to add more functionality to our application, start needs to know how to deal. Can we can get different kinds of requests to automatically direct themselves to different functions?

The web server library provides a function, send/suspend/dispatch, that allows us to create URLs that direct to different parts of our application. Let’s demonstrate a dizzying example. In a new file, enter the following in the definition window.

#lang web-server/insta

; start: request -> response

(define (start request)

(phase-1 request))

; phase-1: request -> response

(define (phase-1 request)

(local [(define (response-generator embed/url)

(response/xexpr

`(html

(body (h1 "Phase 1")

(a ((href ,(embed/url phase-2)))

"click me!")))))]

(send/suspend/dispatch response-generator)))

; phase-2: request -> response

(define (phase-2 request)

(local [(define (response-generator embed/url)

(response/xexpr

`(html

(body (h1 "Phase 2")

(a ((href ,(embed/url phase-1)))

"click me!")))))]

(send/suspend/dispatch response-generator)))

This is a web application that goes round and round. When a user first visits the application, the user starts off in phase-1. The page that’s generated has a hyperlink that, when clicked, continues to phase-2. The user can click back, and falls back to phase-1, and the cycle repeats.

Let’s look more closely at the send/suspend/dispatch mechanism. send/suspend/dispatch consumes a response-generating function, and it gives that response-generator a function called embed/url that we’ll use to build special URLs. What makes these URLs special is this: when a web browser visits these URLs, our web application restarts, but not from start, but from the handler that we associate to the URL. In phase-1, the use of embed/url associates the link with phase-2, and vice versa.

We can be more sophisticated about the handlers associated with embed/url. Because the handler is just a request-consuming function, it can be defined within a local. Consequently, a local-defined handler knows about all the variables that are in the scope of its definition. Here’s another loopy example:

#lang web-server/insta

; start: request -> response

(define (start request)

(show-counter 0 request))

; show-counter: number request -> doesn't

; Displays a number that's hyperlinked: when the link is pressed,

; returns a new page with the incremented number.

(define (show-counter n request)

(local [(define (response-generator embed/url)

(response/xexpr

`(html (head (title "Counting example"))

(body

(a ((href ,(embed/url next-number-handler)))

,(number->string n))))))

(define (next-number-handler request)

(show-counter (+ n 1) request))]

(send/suspend/dispatch response-generator)))

This example shows that we can accumulate the results of an interaction. Even though the user start off by visiting and seeing zero, the handlers produced by next-number-handler continue the interaction, accumulating a larger and larger number.

Now that we’ve been going a little bit in circles, let’s move forward back to the blog application. We will adjust the form’s action so it directs to a URL that’s associated to a separate handler.

#lang web-server/insta

; A blog is a (listof post)

; and a post is a (make-post title body)

(struct post (title body))

; BLOG: blog

; The static blog.

(define BLOG

(list (post "First Post" "This is my first post")

(post "Second Post" "This is another post")))

; start: request -> doesn't

; Consumes a request and produces a page that displays all of the

; web content.

(define (start request)

(render-blog-page BLOG request))

; parse-post: bindings -> post

; Extracts a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)))

; render-blog-page: blog request -> doesn't

; Consumes a blog and a request, and produces an HTML page

; of the content of the blog.

(define (render-blog-page a-blog request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts a-blog)

(form ((action

,(make-url insert-post-handler)))

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

(define (insert-post-handler request)

(render-blog-page

(cons (parse-post (request-bindings request))

a-blog)

request))]

(send/suspend/dispatch response-generator)))

; render-post: post -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

(define (render-post a-post)

`(div ((class "post"))

,(post-title a-post)

(p ,(post-body a-post))))

; render-posts: blog -> xexpr

; Consumes a blog, produces an xexpr fragment

; of all its posts.

(define (render-posts a-blog)

`(div ((class "posts"))

,@(map render-post a-blog)))

Note that the structure of the render-blog-page function looks very similar to that of our last show-counter example. The user can finally add and see multiple posts to their blog.

Unfortunately, there’s still a problem. To see the problem: add a few posts to the system, and then open up a new browser window. In the new browser window, visit the web application’s URL. What happens?

7 Share and Share Alike

We have run into another flaw with our application: each browser window keeps track of its own distinct blog. That defeats the point a blog for most people, that is, to share with others! When we insert a new post, rather than create a new blog value, we’d like to make a structural change to the existing blog. (HTDP Chapter 41). So let’s add mutation into the mix.

There’s one small detail we need to touch: in the web-server language, structures are immutable by default. We’ll want to override this default and get get access to the structure mutators. To do so, we adjust our structure definitions with the #:mutable keyword.

Earlier, we had said that a blog was a list of posts, but because we want to allow the blog to be changed, let’s revisit our definition so that a blog is a mutable structure:

(struct blog (posts) #:mutable)

(struct blog (posts))

posts : (listof post?)

Mutable structures provide functions to change the fields of a structure; in this case, we now have a structure mutator called set-blog-posts!,

set-blog-posts! : (blog? (listof post?) . -> . void)

and this will allow us to change the posts of a blog.

Exercise. Write a function blog-insert-post!

blog-insert-post! : (blog? post? . -> . void)

The intended side effect of the function will be to extend the blog’s posts.

————

Since we’ve changed the data representation of a blog, we’ll need to revise our web application to use the updated representation. One other thing to note is that, within the web application, because we’re sharing the same blog value, we don’t need to pass it around with our handlers anymore: we can get at the current blog through our BLOG variable.

After doing the adjustments incorporating insert-blog-post!, and doing a little variable cleanup, our web application now looks like this:

#lang web-server/insta

; A blog is a (make-blog posts)

; where posts is a (listof post)

(struct blog (posts) #:mutable)

; and post is a (make-post title body)

; where title is a string, and body is a string

(struct post (title body))

; BLOG: blog

; The initial BLOG.

(define BLOG

(blog

(list (post "First Post" "This is my first post")

(post "Second Post" "This is another post"))))

; blog-insert-post!: blog post -> void

; Consumes a blog and a post, adds the post at the top of the blog.

(define (blog-insert-post! a-blog a-post)

(set-blog-posts! a-blog

(cons a-post (blog-posts a-blog))))

; start: request -> doesn't

; Consumes a request and produces a page that displays

; all of the web content.

(define (start request)

(render-blog-page request))

; parse-post: bindings -> post

; Extracts a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)))

; render-blog-page: request -> doesn't

; Produces an HTML page of the content of the BLOG.

(define (render-blog-page request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts)

(form ((action

,(make-url insert-post-handler)))

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

(define (insert-post-handler request)

(blog-insert-post!

BLOG (parse-post (request-bindings request)))

(render-blog-page request))]

(send/suspend/dispatch response-generator)))

; render-post: post -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

(define (render-post a-post)

`(div ((class "post"))

,(post-title a-post)

(p ,(post-body a-post))))

; render-posts: -> xexpr

; Consumes a blog, produces an xexpr fragment

; of all its posts.

(define (render-posts)

`(div ((class "posts"))

,@(map render-post (blog-posts BLOG))))

Open two windows that visit our web application, and start adding in posts from both windows. We should see that both browsers are sharing the same blog.

8 Extending the Model

Next, let’s extend the application so that each post can hold a list of comments. We refine the data definition of a blog to be:

(struct   post (title body comments)     #:mutable)

title : string?

body : string?

comments : (listof string?)

Exercise. Write the updated data structure definition for posts. Make sure to make the structure mutable, since we intend to add comments to posts.

Exercise. Make up a few examples of posts.

Exercise. Define a function post-add-comment!

post-add-comment! : (post? string? . -> . void)

whose intended side effect is to add a new comment to the end of the post’s list of comments.

Exercise. Adjust render-post so that the produced fragment will include the comments in an itemized list.

Exercise. Because we’ve extended a post to include comments, other post-manipulating parts of the application may need to be adjusted, such as uses of post. Identify and fix any other part of the application that needs to accommodate the post’s new structure.

————

Once we’ve changed the data structure of the posts and adjusted our functions to deal with this revised structure, the web application should be runnable. The user may even see some of the fruits of our labor: if the initial BLOG has a post with a comment, the user should see those comments now. But obviously, there’s something missing: the user doesn’t have the user interface to add comments to a post!

9 Breaking Up the Display

How should we incorporate comments more fully into the user’s web experience? Seeing all the posts and comments all on one page may be a bit overwhelming. Perhaps we should hold off on showing the comments on the main blog page. Let’s present a secondary "detail" view of a post, and present the comments there.

The top-level view of a blog then can show the blog’s title and body. We can also show a count of how many comments are associated to the post.

So now we need some way to visit a post’s detail page. One way to do this is to hyperlink each post’s title: if the user wants to see the detail page of a post, user should be able to click the title to get there. From that post’s detail page, we can even add a form to let the user add new comments.

Here’s a diagram of a simple page flow of our web application that should let us add comments.

Each point in the diagram corresponds to a request-consuming handler. As we might suspect, we’ll be using send/suspend/dispatch some more. Every arrow in the diagram will be realized as a URL that we generate with embed/url.

This has a slightly messy consequence: previously, we’ve been rendering the list of posts without any hyperlinks. But since any function that generates a special dispatching URL uses embed/url to do it, we’ll need to adjust render-posts and render-post to consume and use embed/url itself when it makes those hyperlinked titles.

Our web application now looks like:

#lang web-server/insta

; A blog is a (make-blog posts)

; where posts is a (listof post)

(struct blog (posts) #:mutable)

; and post is a (make-post title body comments)

; where title is a string, body is a string,

; and comments is a (listof string)

(struct post (title body comments) #:mutable)

; BLOG: blog

; The initial BLOG.

(define BLOG

(blog

(list (post "First Post"

"This is my first post"

(list "First comment!"))

(post "Second Post"

"This is another post"

(list)))))

; blog-insert-post!: blog post -> void

; Consumes a blog and a post, adds the post at the top of the blog.

(define (blog-insert-post! a-blog a-post)

(set-blog-posts! a-blog

(cons a-post (blog-posts a-blog))))

; post-insert-comment!: post string -> void

; Consumes a post and a comment string.  As a side-efect,

; adds the comment to the bottom of the post's list of comments.

(define (post-insert-comment! a-post a-comment)

(set-post-comments!

a-post

(append (post-comments a-post) (list a-comment))))

; start: request -> doesn't

; Consumes a request, and produces a page that displays

; all of the web content.

(define (start request)

(render-blog-page request))

; render-blog-page: request -> doesn't

; Produces an doesn't page of the content of the

; BLOG.

(define (render-blog-page request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts make-url)

(form ((action

,(make-url insert-post-handler)))

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

; parse-post: bindings -> post

; Extracts a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)

(list)))

(define (insert-post-handler request)

(blog-insert-post!

BLOG (parse-post (request-bindings request)))

(render-blog-page request))]

(send/suspend/dispatch response-generator)))

; render-post-detail-page: post request -> doesn't

; Consumes a post and request, and produces a detail page

; of the post. The user will be able to insert new comments.

(define (render-post-detail-page a-post request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Post Details"))

(body

(h1 "Post Details")

(h2 ,(post-title a-post))

(p ,(post-body a-post))

,(render-as-itemized-list

(post-comments a-post))

(form ((action

,(make-url insert-comment-handler)))

(input ((name "comment")))

(input ((type "submit"))))))))

(define (parse-comment bindings)

(extract-binding/single 'comment bindings))

(define (insert-comment-handler a-request)

(post-insert-comment!

a-post (parse-comment (request-bindings a-request)))

(render-post-detail-page a-post a-request))]

(send/suspend/dispatch response-generator)))

; render-post: post (handler -> string) -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

; The fragment contains a link to show a detailed view of the post.

(define (render-post a-post make-url)

(local [(define (view-post-handler request)

(render-post-detail-page a-post request))]

`(div ((class "post"))

(a ((href ,(make-url view-post-handler)))

,(post-title a-post))

(p ,(post-body a-post))

(div ,(number->string (length (post-comments a-post)))

" comment(s)"))))

; render-posts: (handler -> string) -> xexpr

; Consumes a make-url, and produces an xexpr fragment

; of all its posts.

(define (render-posts make-url)

(local [(define (render-post/make-url a-post)

(render-post a-post make-url))]

`(div ((class "posts"))

,@(map render-post/make-url (blog-posts BLOG)))))

; render-as-itemized-list: (listof xexpr) -> xexpr

; Consumes a list of items, and produces a rendering as

; an unorderered list.

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

; Consumes an xexpr, and produces a rendering

; as a list item.

(define (render-as-item a-fragment)

`(li ,a-fragment))

We now have an application that’s pretty sophisticated: we can add posts and write comments. Still, there’s a problem with this: once the user’s in a post-detail-page, they can’t get back to the blog without pressing the browser’s back button! That’s disruptive. We should provide a page flow that lets us get back to the main blog-viewing page, to keep the user from every getting "stuck" in a dark corner of the web application.

10 Adding a Back Button

Here’s a diagram of a our revised page flow of our web application. Maybe we can just add a BACK link from the render-post-detail-page that gets us back to viewing the top-level blog.

Exercise. Adjust render-post-detail-page to include another link that goes back to render-blog-page.

To make this more interesting, maybe we should enrich the flow a bit more. We can give the user a choice right before committing to their comment. Who knows? They may have a change of heart.

Although this seems complicated, the shape of our handlers will look more-or-less like what we had before. After we’ve added all the handlers, our web application is fairly functional.

#lang web-server/insta

; A blog is a (make-blog posts)

; where posts is a (listof post)

(struct blog (posts) #:mutable)

; and post is a (make-post title body comments)

; where title is a string, body is a string,

; and comments is a (listof string)

(struct post (title body comments) #:mutable)

; BLOG: blog

; The initial BLOG.

(define BLOG

(blog

(list (post "First Post"

"This is my first post"

(list "First comment!"))

(post "Second Post"

"This is another post"

(list)))))

; blog-insert-post!: blog post -> void

; Consumes a blog and a post, adds the post at the top of the blog.

(define (blog-insert-post! a-blog a-post)

(set-blog-posts! a-blog

(cons a-post (blog-posts a-blog))))

; post-insert-comment!: post string -> void

; Consumes a post and a comment string.  As a side-efect,

; adds the comment to the bottom of the post's list of comments.

(define (post-insert-comment! a-post a-comment)

(set-post-comments!

a-post

(append (post-comments a-post) (list a-comment))))

; start: request -> doesn't

; Consumes a request and produces a page that displays

; all of the web content.

(define (start request)

(render-blog-page request))

; render-blog-page: request -> doesn't

; Produces an HTML page of the content of the

; BLOG.

(define (render-blog-page request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts make-url)

(form ((action

,(make-url insert-post-handler)))

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

; parse-post: bindings -> post

; Extracts a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)

(list)))

(define (insert-post-handler request)

(blog-insert-post!

BLOG (parse-post (request-bindings request)))

(render-blog-page request))]

(send/suspend/dispatch response-generator)))

; render-post-detail-page: post request -> doesn't

; Consumes a post and produces a detail page of the post.

; The user will be able to either insert new comments

; or go back to render-blog-page.

(define (render-post-detail-page a-post request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Post Details"))

(body

(h1 "Post Details")

(h2 ,(post-title a-post))

(p ,(post-body a-post))

,(render-as-itemized-list

(post-comments a-post))

(form ((action

,(make-url insert-comment-handler)))

(input ((name "comment")))

(input ((type "submit"))))

(a ((href ,(make-url back-handler)))

"Back to the blog")))))

(define (parse-comment bindings)

(extract-binding/single 'comment bindings))

(define (insert-comment-handler request)

(render-confirm-add-comment-page

(parse-comment (request-bindings request))

a-post

request))

(define (back-handler request)

(render-blog-page request))]

(send/suspend/dispatch response-generator)))

; render-confirm-add-comment-page :

; comment post request -> doesn't

; Consumes a comment that we intend to add to a post, as well

; as the request. If the user follows through, adds a comment

; and goes back to the display page. Otherwise, goes back to

; the detail page of the post.

(define (render-confirm-add-comment-page a-comment a-post request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Add a Comment"))

(body

(h1 "Add a Comment")

"The comment: " (div (p ,a-comment))

"will be added to "

(div ,(post-title a-post))

(p (a ((href ,(make-url yes-handler)))

"Yes, add the comment."))

(p (a ((href ,(make-url cancel-handler)))

"No, I changed my mind!"))))))

(define (yes-handler request)

(post-insert-comment! a-post a-comment)

(render-post-detail-page a-post request))

(define (cancel-handler request)

(render-post-detail-page a-post request))]

(send/suspend/dispatch response-generator)))

; render-post: post (handler -> string) -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

; The fragment contains a link to show a detailed view of the post.

(define (render-post a-post make-url)

(local [(define (view-post-handler request)

(render-post-detail-page a-post request))]

`(div ((class "post"))

(a ((href ,(make-url view-post-handler)))

,(post-title a-post))

(p ,(post-body a-post))

(div ,(number->string (length (post-comments a-post)))

" comment(s)"))))

; render-posts: (handler -> string) -> xexpr

; Consumes a make-url, produces an xexpr fragment

; of all its posts.

(define (render-posts make-url)

(local [(define (render-post/make-url a-post)

(render-post a-post make-url))]

`(div ((class "posts"))

,@(map render-post/make-url (blog-posts BLOG)))))

; render-as-itemized-list: (listof xexpr) -> xexpr

; Consumes a list of items, and produces a rendering as

; an unorderered list.

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

; Consumes an xexpr, and produces a rendering

; as a list item.

(define (render-as-item a-fragment)

`(li ,a-fragment))

11 Decorating With Style!

We have an application that’s functionally complete, but is visual lacking. Let’s try to improve its appearance. One way we can do this is to use a cascading style sheet. A style sheet can add visual panache to our web pages. For example, if we’d like to turn all of our paragraphs green, we might add the following style declaration within our response.

'(style ((type "text/css")) "p { color: green }")

It’s tempting to directly embed this style information into our responses. However, our source file is already quite busy. We often want to separate the logical representation of our application from its presentation. Rather than directly embed the .css in the HTML response, let’s instead add a link reference to an separate .css file.

Until now, all the content that our web application has produced has come from a response generating handler. Of course, we know that not everything needs to be dynamically generated: it’s common to have files that won’t be changing. We should be able to serve these static resources (images, documents, .css files) alongside our web applications.

To do this, we set aside a path to store these files, and then tell the web server where that directory is. The function static-files-path,

static-files-path : (path-string? -> void)

tells the web server to look in the given path when it receives a URL that looks like a static resource request.

Exercise. Create a simple web application called "test-static.rkt" with the following content:

#lang web-server/insta

(define (start request)

(response/xexpr

'(html (head (title "Testing"))

(link ((rel "stylesheet")

(href "/test-static.css")

(type "text/css")))

(body (h1 "Testing")

(h2 "This is a header")

(p "This is " (span ((class "hot")) "hot") ".")))))

(static-files-path "htdocs")

Make a subdirectory called "htdocs" rooted in the same directory as the "test-static.rkt" source. Finally, just to see that we can serve this .css page, create a very simple .css file "test-static.css" file in "htdocs/" with the following content:

body {

margin-left: 10%;

margin-right: 10%;

}

p { font-family: sans-serif }

h1 { color: green }

h2 { font-size: small }

span.hot { color: red }

At this point, run the application and look at the browser’s output. We should see a Spartan web page, but it should still have some color in its cheeks.

————

Exercise. Improve the presentation of the blog web application by writing your an external style sheet to your tastes. Adjust all of the HTML response handlers to include a link to the style sheet.

12 The Double Submit Bug

There’s yet another a subtle problem in our application. To see it, bring our blog application up again, and add a post. Then reload the page. Reload the page again.

What’s happening is a well-known problem: it’s an instance of the "double-submit" problem. If a user presses reload, a request is sent over to our application. This wouldn’t be such a bad thing, if not for the fact that we’re handling certain requests by mutating our application’s data structures.

A common pattern that web developers use to dodge the double submission problem is to handle state-mutating request in a peculiar way: once the user sends over a request that affects change to the system, we then redirect them off to a different URL that’s safe to reload. To make this happen, we will use the function redirect/get.

redirect/get : (-> request?)

This redirect/get function has an immediate side effect: it forces the user’s browser to follow a redirection to a safe URL, and gives us back that fresh new request.

For example, let’s look at a toy application that lets the users add names to a roster:

#lang web-server/insta

; A roster is a (make-roster names)

; where names is a list of string.

(struct roster (names) #:mutable)

; roster-add-name!: roster string -> void

; Given a roster and a name, adds the name

; to the end of the roster.

(define (roster-add-name! a-roster a-name)

(set-roster-names! a-roster

(append (roster-names a-roster)

(list a-name))))

(define ROSTER (roster '("kathi" "shriram" "dan")))

; start: request -> doesn't

(define (start request)

(show-roster request))

; show-roster: request -> doesn't

(define (show-roster request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Roster"))

(body (h1 "Roster")

,(render-as-itemized-list

(roster-names ROSTER))

(form ((action

,(make-url add-name-handler)))

(input ((name "a-name")))

(input ((type "submit"))))))))

(define (parse-name bindings)

(extract-binding/single 'a-name bindings))

(define (add-name-handler request)

(roster-add-name!

ROSTER (parse-name (request-bindings request)))

(show-roster request))]

(send/suspend/dispatch response-generator)))

; render-as-itemized-list: (listof xexpr) -> xexpr

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

(define (render-as-item a-fragment)

`(li ,a-fragment))

This application suffers the same problem as our blog: if the user adds a name, and then presses reload, then the same name will be added twice.

We can fix this by changing a single expression. Can you see what changed?

#lang web-server/insta

; A roster is a (make-roster names)

; where names is a list of string.

(struct roster (names) #:mutable)

; roster-add-name!: roster string -> void

; Given a roster and a name, adds the name

; to the end of the roster.

(define (roster-add-name! a-roster a-name)

(set-roster-names! a-roster

(append (roster-names a-roster)

(list a-name))))

(define ROSTER (roster '("kathi" "shriram" "dan")))

; start: request -> doesn't

(define (start request)

(show-roster request))

; show-roster: request -> doesn't

(define (show-roster request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Roster"))

(body (h1 "Roster")

,(render-as-itemized-list

(roster-names ROSTER))

(form ((action

,(make-url add-name-handler)))

(input ((name "a-name")))

(input ((type "submit"))))))))

(define (parse-name bindings)

(extract-binding/single 'a-name bindings))

(define (add-name-handler request)

(roster-add-name!

ROSTER (parse-name (request-bindings request)))

(show-roster (redirect/get)))]

(send/suspend/dispatch response-generator)))

; render-as-itemized-list: (listof xexpr) -> xexpr

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

(define (render-as-item a-fragment)

`(li ,a-fragment))

Double-submit, then, is painlessly easy to mitigate. Whenever we have handlers that mutate the state of our system, we use redirect/get when we send our response back.

Exercise. Revise the blog application with redirect/get to address the double-submit problem.

With these minor fixes, our blog application now looks like this:

#lang web-server/insta

; A blog is a (make-blog posts)

; where posts is a (listof post)

(struct blog (posts) #:mutable)

; and post is a (make-post title body comments)

; where title is a string, body is a string,

; and comments is a (listof string)

(struct post (title body comments) #:mutable)

; BLOG: blog

; The initial BLOG.

(define BLOG

(blog

(list (post "First Post"

"This is my first post"

(list "First comment!"))

(post "Second Post"

"This is another post"

(list)))))

; blog-insert-post!: blog post -> void

; Consumes a blog and a post, adds the post at the top of the blog.

(define (blog-insert-post! a-blog a-post)

(set-blog-posts! a-blog

(cons a-post (blog-posts a-blog))))

; post-insert-comment!: post string -> void

; Consumes a post and a comment string.  As a side-efect,

; adds the comment to the bottom of the post's list of comments.

(define (post-insert-comment! a-post a-comment)

(set-post-comments!

a-post

(append (post-comments a-post) (list a-comment))))

; start: request -> doesn't

; Consumes a request and produces a page that displays

; all of the web content.

(define (start request)

(render-blog-page request))

; render-blog-page: request -> doesn't

; Produces an doesn't page of the content of the

; BLOG.

(define (render-blog-page request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "My Blog"))

(body

(h1 "My Blog")

,(render-posts make-url)

(form ((action

,(make-url insert-post-handler)))

(input ((name "title")))

(input ((name "body")))

(input ((type "submit"))))))))

; parse-post: bindings -> post

; Extracts a post out of the bindings.

(define (parse-post bindings)

(post (extract-binding/single 'title bindings)

(extract-binding/single 'body bindings)

(list)))

(define (insert-post-handler request)

(blog-insert-post!

BLOG (parse-post (request-bindings request)))

(render-blog-page (redirect/get)))]

(send/suspend/dispatch response-generator)))

; render-post-detail-page: post request -> doesn't

; Consumes a post and produces a detail page of the post.

; The user will be able to either insert new comments

; or go back to render-blog-page.

(define (render-post-detail-page a-post request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Post Details"))

(body

(h1 "Post Details")

(h2 ,(post-title a-post))

(p ,(post-body a-post))

,(render-as-itemized-list

(post-comments a-post))

(form ((action

,(make-url insert-comment-handler)))

(input ((name "comment")))

(input ((type "submit"))))

(a ((href ,(make-url back-handler)))

"Back to the blog")))))

(define (parse-comment bindings)

(extract-binding/single 'comment bindings))

(define (insert-comment-handler request)

(render-confirm-add-comment-page

(parse-comment (request-bindings request))

a-post

request))

(define (back-handler request)

(render-blog-page request))]

(send/suspend/dispatch response-generator)))

; render-confirm-add-comment-page :

; comment post request -> doesn't

; Consumes a comment that we intend to add to a post, as well

; as the request. If the user follows through, adds a comment

; and goes back to the display page. Otherwise, goes back to

; the detail page of the post.

(define (render-confirm-add-comment-page a-comment a-post request)

(local [(define (response-generator make-url)

(response/xexpr

`(html (head (title "Add a Comment"))

(body

(h1 "Add a Comment")

"The comment: " (div (p ,a-comment))

"will be added to "

(div ,(post-title a-post))

(p (a ((href ,(make-url yes-handler)))

"Yes, add the comment."))

(p (a ((href ,(make-url cancel-handler)))

"No, I changed my mind!"))))))

(define (yes-handler request)

(post-insert-comment! a-post a-comment)

(render-post-detail-page a-post (redirect/get)))

(define (cancel-handler request)

(render-post-detail-page a-post request))]

(send/suspend/dispatch response-generator)))

; render-post: post (handler -> string) -> xexpr

; Consumes a post, produces an xexpr fragment of the post.

; The fragment contains a link to show a detailed view of the post.

(define (render-post a-post make-url)

(local [(define (view-post-handler request)

(render-post-detail-page a-post request))]

`(div ((class "post"))

(a ((href ,(make-url view-post-handler)))

,(post-title a-post))

(p ,(post-body a-post))

(div ,(number->string (length (post-comments a-post)))

" comment(s)"))))

; render-posts: (handler -> string) -> xexpr

; Consumes a make-url, produces an xexpr fragment

; of all its posts.

(define (render-posts make-url)

(local [(define (render-post/make-url a-post)

(render-post a-post make-url))]

`(div ((class "posts"))

,@(map render-post/make-url (blog-posts BLOG)))))

; render-as-itemized-list: (listof xexpr) -> xexpr

; Consumes a list of items, and produces a rendering as

; an unorderered list.

(define (render-as-itemized-list fragments)

`(ul ,@(map render-as-item fragments)))

; render-as-item: xexpr -> xexpr

; Consumes an xexpr, and produces a rendering

; as a list item.

(define (render-as-item a-fragment)

`(li ,a-fragment))