[plt-scheme] documentation/continue/help

From: maxigas (maxigas at anargeek.net)
Date: Sat Oct 25 18:59:48 EDT 2008

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))


    


Posted on the users mailing list.