Doc improvements and tutorial bug fix

svn: r11297

collects/web-server/scribblings/faq.scrbl

@@ -65,7 +65,7 @@ Second, if you want to make your own Scheme start-up script, you can write:
 (_start-server)
 ]
 
-@section{How do I set up the server to use HTTPS?}
+@section[#:tag "faq:https"]{How do I set up the server to use HTTPS?}
 
 The essence of the solution to this problem is to use an SSL TCP implementation as provided by @schememodname[net/ssl-tcp-unit]. Many of the functions that start the Web Server are parameterized by a @scheme[tcp@] unit. If you pass an SSL unit, then the server will be serving HTTPS. However, to do this, you must write your own start up script. Here's a simple example:
 

collects/web-server/scribblings/running.scrbl

@@ -92,6 +92,8 @@ dispatcher. See @filepath{run.ss} for an example of such a script.
          (-> void)]{
  Constructs an appropriate @scheme[dispatch-config^], invokes the
  @scheme[dispatch-server@], and calls its @scheme[serve] function.
+ 
+ The @scheme[#:tcp@] keyword is provided for building an SSL server. See @secref["faq:https"].
 }
 
 @; XXX Not the right `server' above.
@@ -134,6 +136,7 @@ from a given path:
  Calls @scheme[serve/ports] multiple times, once for each @scheme[ip], and returns
  a function that shuts down all of the server instances.
 }
+                  
 
 @defproc[(do-not-return) void]{
  This function does not return. If you are writing a script to load the @web-server

collects/web-server/scribblings/servlet.scrbl

@@ -210,6 +210,20 @@ HTTP responses.
  As with @scheme[response/basic], except with @scheme[generator] as a function that is
  called to generate the response body, by being given an @scheme[output-response] function
  that outputs the content it is called with.
+ 
+ Here is a short example:
+ @schemeblock[
+  (make-response/incremental
+    200 "OK" (current-seconds)
+    #"application/octet-stream"
+    (list (make-header #"Content-Disposition"
+                       #"attachement; filename=\"file\""))
+    (lambda (send/bytes)
+      (send/bytes #"Some content")
+      (send/bytes)
+      (send/bytes #"Even" #"more" #"content!")
+      (send/bytes "No we're done")))
+ ]
 }
 
 @defproc[(response? [v any/c])

collects/web-server/scribblings/tutorial/examples/dummy-10.ss

@@ -0,0 +1,137 @@
+#lang web-server/insta
+
+(require "dummy-3.ss")
+
+;; start: request -> html-response
+;; Consumes a request and produces a page that displays
+;; all of the web content.
+(define (start request)  
+  (render-blog-page 
+   (initialize-blog! 
+    (build-path (find-system-path 'home-dir)
+                "the-blog-data.sqlite"))
+   request))
+
+;; render-blog-page: blog request -> html-response
+;; Produces an html-response page of the content of the
+;; blog.
+(define (render-blog-page a-blog request)
+  (local [(define (response-generator make-url)        
+            `(html (head (title "My Blog"))
+                   (body 
+                    (h1 "My Blog")
+                    ,(render-posts a-blog make-url)
+                    (form ((action 
+                            ,(make-url insert-post-handler)))
+                     (input ((name "title")))
+                     (input ((name "body")))
+                     (input ((type "submit")))))))          
+          
+          (define (insert-post-handler request)
+            (define bindings (request-bindings request))
+            (blog-insert-post!
+             a-blog
+             (extract-binding/single 'title bindings)
+             (extract-binding/single 'body bindings))
+            (render-blog-page a-blog (redirect/get)))]
+
+    (send/suspend/dispatch response-generator)))
+
+;; render-post-detail-page: post request -> html-response
+;; 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-blog a-post request)
+  (local [(define (response-generator make-url)
+            `(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
+             a-blog
+             (parse-comment (request-bindings request))
+             a-post
+             request))
+
+          (define (back-handler request)
+            (render-blog-page a-blog request))]
+
+    (send/suspend/dispatch response-generator)))
+
+;; render-confirm-add-comment-page :
+;; blog comment post request -> html-response
+;; 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-blog a-comment
+                                         a-post request)
+  (local [(define (response-generator make-url)
+            `(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-blog a-post a-comment)
+            (render-post-detail-page a-blog a-post (redirect/get)))
+          
+          (define (cancel-handler request)
+            (render-post-detail-page a-blog a-post request))]
+
+    (send/suspend/dispatch response-generator)))
+
+;; render-post: post (handler -> string) -> html-response
+;; Consumes a post, produces an html-response fragment of the post.
+;; The fragment contains a link to show a detailed view of the post.
+(define (render-post a-blog a-post make-url)
+  (local [(define (view-post-handler request)
+            (render-post-detail-page a-blog 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: blog (handler -> string) -> html-response
+;; Consumes a make-url, produces an html-response fragment
+;; of all its posts.
+(define (render-posts a-blog make-url)
+  (local [(define (render-post/make-url a-post)
+            (render-post a-blog a-post make-url))]
+    `(div ((class "posts"))
+          ,@(map render-post/make-url (blog-posts a-blog)))))
+
+;; render-as-itemized-list: (listof html-response) -> html-response
+;; 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: html-response -> html-response
+;; Consumes an html-response, and produces a rendering
+;; as a list item.
+(define (render-as-item a-fragment)
+  `(li ,a-fragment))

collects/web-server/scribblings/tutorial/examples/dummy-3.ss

@@ -0,0 +1,104 @@
+#lang scheme
+(require "../dummy-sqlite.ss")
+
+;; A blog is a (make-blog db)
+;; where db is an sqlite database handle
+(define-struct blog (db))
+
+;; A post is a (make-post blog id)
+;; where blog is a blog and id is an integer?
+(define-struct post (blog id))
+
+;; initialize-blog! : path? -> blog?
+;; Sets up a blog database (if it doesn't exist)
+(define (initialize-blog! home)
+  (define db (sqlite:open home))
+  (define the-blog (make-blog db))
+  (with-handlers ([exn? void])
+    (sqlite:exec/ignore db
+                        (string-append
+                         "CREATE TABLE posts "
+                         "(id INTEGER PRIMARY KEY,"
+                         "title TEXT, body TEXT)"))
+    (blog-insert-post!
+     the-blog "First Post" "This is my first post")
+    (blog-insert-post!
+     the-blog "Second Post" "This is another post")
+    (sqlite:exec/ignore
+     db "CREATE TABLE comments (pid INTEGER, content TEXT)")
+    (post-insert-comment!
+     the-blog (first (blog-posts the-blog))
+     "First comment!"))
+  the-blog)
+
+;; blog-posts : blog -> (listof post?)
+;; Queries for the post ids
+(define (blog-posts a-blog)
+  (local [(define (row->post a-row)
+            (make-post a-blog (string->number (vector-ref a-row 0))))
+          (define rows (sqlite:select
+                        (blog-db a-blog)
+                        "SELECT id FROM posts"))]
+    (cond [(empty? rows)
+           empty]
+          [else
+           (map row->post (rest rows))])))
+
+;; post-title : post -> string?
+;; Queries for the title
+(define (post-title a-post)
+  (vector-ref 
+   (second 
+    (sqlite:select 
+     (blog-db (post-blog a-post))
+     (format "SELECT title FROM posts WHERE id = '~a'"
+             (post-id a-post))))
+   0))
+
+;; post-body : post -> string?
+;; Queries for the body
+(define (post-body p)
+  (vector-ref 
+   (second 
+    (sqlite:select 
+     (blog-db (post-blog p))
+     (format "SELECT body FROM posts WHERE id = '~a'"
+             (post-id p))))
+   0))
+
+;; post-comments : post -> (listof string?)
+;; Queries for the comments
+(define (post-comments p)
+  (local [(define (row->comment a-row)
+            (vector-ref a-row 0))
+          (define rows 
+            (sqlite:select
+             (blog-db (post-blog p))
+             (format "SELECT content FROM comments WHERE pid = '~a'"
+                     (post-id p))))]
+    (cond
+      [(empty? rows) empty]
+      [else (map row->comment (rest rows))])))
+
+;; blog-insert-post!: blog? string? string? -> void
+;; Consumes a blog and a post, adds the post at the top of the blog.
+(define (blog-insert-post! a-blog title body)
+  (sqlite:insert
+   (blog-db a-blog)
+   (format "INSERT INTO posts (title, body) VALUES ('~a', '~a')"
+           title body)))
+
+;; post-insert-comment!: blog? post string -> void
+;; Consumes a blog, 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-blog p a-comment)
+  (sqlite:insert 
+   (blog-db a-blog)
+   (format
+    "INSERT INTO comments (pid, content) VALUES ('~a', '~a')"
+    (post-id p) a-comment)))
+
+(provide blog? blog-posts
+         post? post-title post-body post-comments
+         initialize-blog!
+         blog-insert-post! post-insert-comment!)

collects/web-server/scribblings/tutorial/tutorial.scrbl

@@ -940,8 +940,8 @@ grow, we will have to deal with concurrency issues, the lack of a simply query l
 So, in the next section, we'll talk about how to use an SQL database to store our blog model.
 
 @section{Using an SQL database}
-@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-9
+@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/dummy-10
-                                  web-server/scribblings/tutorial/examples/model-2
+                                  web-server/scribblings/tutorial/examples/dummy-3
                                   web-server/scribblings/tutorial/dummy-sqlite)]
 @(require (for-label web-server/scribblings/tutorial/dummy-sqlite))
 @;@(require (prefix-in sqlite: (for-label (planet jaymccarthy/sqlite:3/sqlite))))