[plt-scheme] documentation/continue/help
hi!
please help me debug this attempt at the Continue... tutorial. i am stuck at "9: Breaking Up the
Display" whole day. i am on terminal so i don't do it from drscheme just start the webserver on
one screen, emacs with code on another and elinks in a third, but so far this was not a problem as
long as i rewrote the #lang... part. but now, i don't understand this error message because the
things after "given:" look very much like a proper "response". :o
maxigas
---8k--{cut here}---
Servlet (@ /servlets/stratobe/stratobe1.ss) exception:
(file
"/usr/local/plt/lib/plt/collects/web-server/default-web-root/././servlets/stratobe/stratobe1.ss")
broke the contract
(->
(->
(->*
((-> request? any/c))
((or/c (-> request? response?) #f))
string?)
response?)
any/c)
on send/suspend/dispatch; expected <response?>, given: (html (head (title "Stratified Blog"))
(body (h1 "Stratified Blog") (div ((class "posts")) (h2 "Posts") (hr) (div ((class "post")) (b (a
((href "/servlets;1*1*27550801/stratobe/stratobe1.ss") "Hello World!"))) (p "First post on the
blog powered by a sch...
---8k--{cut here}---
;;; --- BOOT ---
#lang scheme
(require web-server/servlet)
(provide (all-defined-out))
(define interface-version 'v1)
(define timeout +inf.0)
;;; --- DATA STRUCTURES ---
(define-struct blog (posts) #:mutable)
(define-struct post (title body comments) #:mutable)
;;; --- SAMPLE DATA ---
(define BLOG (make-blog (list
(make-post "Hello World!" "First post on the blog powered by a scheme engine." (list "hey" "ho" "yo"))
(make-post "Hello China!" "Second post on the blog powered by a scheme engine." '()))))
;;; --- DATA HANDLERS ---
(define (blog-insert-post! apost)
(set-blog-posts! BLOG (cons apost (blog-posts BLOG))))
(define (post-insert-comment! apost acomment)
(set-post-comments! apost (cons acomment (post-comments apost))))
;;; --- FUNCTIONS ---
(define (start request)
(render-blog request))
;; --- RENDERERS ---
(define (render-blog request)
(local ((define (response-generator make-url)
`(html (head (title "Stratified Blog"))
(body (h1 "Stratified Blog")
,(render-posts make-url request)
(form ((action ,(make-url insert-post-hander)))
(input ((name "title")))
(input ((name "body")))
(input ((type "submit")))))))
(define (insert-post-hander request)
(blog-insert-post! (parse-post (request-bindings request))
(render-blog request))))
(send/suspend/dispatch response-generator)))
(define (render-posts make-url request)
(local ((define (render-post/make-url apost)
(render-post apost make-url request)))
`(div ((class "posts")) (h2 "Posts") (hr)
,@(map render-post/make-url (blog-posts BLOG)))))
(define (render-post apost make-url request)
(local ((define (view-post-handler request)
(render-post-detail-page apost request)))
`(div ((class "post"))
(b (a ((href ,(make-url view-post-handler)) ,(post-title apost))))
(p ,(post-body apost))
(div ,(number->string (length (post-comments apost))))
" comment(s)")))
(define (render-post-detail-page apost request)
(local ((define (response-generator make-url)
`(html (head (title "Post"))
(body (h1 "Post")
(h2 ,(post-title apost))
(p ,(post-body apost))
(ul ,@(map render-comments (post-comments apost)))
(form ((action ,(make-url insert-comment-handler)))
(input ((name "comment")))
(input ((type "submit")))))))
(define (insert-comment-handler request)
(post-insert-comment! apost (extract-binding/single 'comment (request-bindings request)))
(render-post-detail-page apost request)))
(send/suspend/dispatch response-generator)))
(define (render-comments acomment)
`(li ,acomment))
;; --- PARSERS ---
(define (can-parse-post? bindings)
(and (exists-binding? 'title bindings) (exists-binding? 'body bindings)))
(define (parse-post bindings) ; -> post
(if (can-parse-post? bindings)
(make-post (extract-binding/single 'title bindings) (extract-binding/single 'body bindings) '())
#f))