Skip to content

Instantly share code, notes, and snippets.

@tajpure
Last active December 28, 2016 04:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tajpure/cad9ac367d99044c3e50 to your computer and use it in GitHub Desktop.
Save tajpure/cad9ac367d99044c3e50 to your computer and use it in GitHub Desktop.
A Racket Blog
#lang web-server/insta
; A blog is a (listof post)
; and a post is a (post title body)
(struct post (title body))
; BLOG: blog
; The static blog.
(define BLOG
(list (post "Second Post" "This is anther post")
(post "First Post" "This is my first 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 (titile "My Blog"))
(body
(h1 "My Blog")
,(render-post 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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment