diff --git a/collects/web-server/info.ss b/collects/web-server/info.ss index a43e03b577..0bf155824c 100644 --- a/collects/web-server/info.ss +++ b/collects/web-server/info.ss @@ -1,8 +1,10 @@ #lang setup/infotab -(define scribblings '(("scribblings/web-server.scrbl" (multi-page) (tool)))) +(define scribblings '(("scribblings/web-server.scrbl" (multi-page) (tool)) + ("scribblings/tutorial/tutorial.scrbl" () (getting-started)))) (define mzscheme-launcher-libraries '("main.ss")) (define mzscheme-launcher-names '("PLT Web Server")) -(define compile-omit-paths '("default-web-root")) +(define compile-omit-paths '("default-web-root" + "scribblings/tutorial/examples")) diff --git a/collects/web-server/scribblings/managers.scrbl b/collects/web-server/scribblings/managers.scrbl index 8fddc83edb..107d52ffa0 100644 --- a/collects/web-server/scribblings/managers.scrbl +++ b/collects/web-server/scribblings/managers.scrbl @@ -149,7 +149,7 @@ deployments of the @web-server . The recommended usage of this manager is codified as the following function: -@defproc[(create-threshold-LRU-manager +@defproc[(make-threshold-LRU-manager [instance-expiration-handler expiration-handler?] [memory-threshold number?]) manager?]{ diff --git a/collects/web-server/scribblings/tutorial/examples/htdocs/test-static.css b/collects/web-server/scribblings/tutorial/examples/htdocs/test-static.css new file mode 100644 index 0000000000..9767d57d2c --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/htdocs/test-static.css @@ -0,0 +1,15 @@ +body { + + margin-left: 10%; + + margin-right: 10%; + +} + +p { font-family: sans-serif } + +h1 { color: green } + +h2 { font-size: small } + +span.hot { color: red } \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-1.ss b/collects/web-server/scribblings/tutorial/examples/iteration-1.ss new file mode 100644 index 0000000000..76fa6d8630 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-1.ss @@ -0,0 +1,39 @@ +#lang web-server/insta + +;; A blog is a (listof post) +;; and a post is a (make-post title body) +(define-struct post (title body)) + +;; BLOG: blog +;; The static blog. +(define BLOG + (list (make-post "First Post" "This is my first post") + (make-post "Second Post" "This is another post"))) + +;; start: request -> html-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 -> html-response +;; Consumes a blog and a request, and produces an html-response page +;; of the content of the blog. +(define (render-blog-page a-blog request) + `(html (head (title "My Blog")) + (body (h1 "My Blog") + ,(render-posts a-blog)))) + +;; render-post: post -> html-response +;; Consumes a post, produces an html-response fragment of the post. +(define (render-post a-post) + `(div ((class "post")) + ,(post-title a-post) + (p ,(post-body a-post)))) + +;; render-posts: blog -> html-response +;; Consumes a blog, produces an html-response fragment +;; of all its posts. +(define (render-posts a-blog) + `(div ((class "posts")) + ,@(map render-post a-blog))) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-10.ss b/collects/web-server/scribblings/tutorial/examples/iteration-10.ss new file mode 100644 index 0000000000..ed687bf176 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-10.ss @@ -0,0 +1,137 @@ +#lang web-server/insta + +(require "model-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.db")) + 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-2.ss b/collects/web-server/scribblings/tutorial/examples/iteration-2.ss new file mode 100644 index 0000000000..e422354f5b --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-2.ss @@ -0,0 +1,67 @@ +#lang web-server/insta + +;; A blog is a (listof post) +;; and a post is a (make-post title body) +(define-struct post (title body)) + +;; BLOG: blog +;; The static blog. +(define BLOG + (list (make-post "First Post" "This is my first post") + (make-post "Second Post" "This is another post"))) + +;; start: request -> html-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 +;; Consuems a bindings, and produces a post out of the bindings. +(define (parse-post bindings) + (make-post (extract-binding/single 'title bindings) + (extract-binding/single 'body bindings))) + +;; render-blog-page: blog request -> html-response +;; Consumes a blog and a request, and produces an html-response page +;; of the content of the blog. +(define (render-blog-page a-blog request) + `(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 -> html-response +;; Consumes a post, produces an html-response fragment of the post. +(define (render-post a-post) + `(div ((class "post")) + ,(post-title a-post) + (p ,(post-body a-post)))) + + +;; render-posts: blog -> html-response +;; Consumes a blog, produces an html-response fragment +;; of all its posts. +(define (render-posts a-blog) + `(div ((class "posts")) + ,@(map render-post a-blog))) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-3.ss b/collects/web-server/scribblings/tutorial/examples/iteration-3.ss new file mode 100644 index 0000000000..882f4c41e9 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-3.ss @@ -0,0 +1,60 @@ +#lang web-server/insta + +;; A blog is a (listof post) +;; and a post is a (make-post title body) +(define-struct post (title body)) + +;; BLOG: blog +;; The static blog. +(define BLOG + (list (make-post "First Post" "This is my first post") + (make-post "Second Post" "This is another post"))) + +;; start: request -> html-response +;; 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) + (make-post (extract-binding/single 'title bindings) + (extract-binding/single 'body bindings))) + +;; render-blog-page: blog request -> html-response +;; Consumes a blog and a request, and 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) + (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 -> html-response +;; Consumes a post, produces an html-response fragment of the post. +(define (render-post a-post) + `(div ((class "post")) + ,(post-title a-post) + (p ,(post-body a-post)))) + +;; render-posts: blog -> html-response +;; Consumes a blog, produces an html-response fragment +;; of all its posts. +(define (render-posts a-blog) + `(div ((class "posts")) + ,@(map render-post a-blog))) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-4.ss b/collects/web-server/scribblings/tutorial/examples/iteration-4.ss new file mode 100644 index 0000000000..3a5a766a57 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-4.ss @@ -0,0 +1,69 @@ +#lang web-server/insta + +;; A blog is a (make-blog posts) +;; where posts is a (listof post) +(define-struct blog (posts) #:mutable) + +;; and post is a (make-post title body) +;; where title is a string, and body is a string +(define-struct post (title body)) + +;; BLOG: blog +;; The initial BLOG. +(define BLOG + (make-blog + (list (make-post "First Post" "This is my first post") + (make-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 -> html-response +;; 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) + (make-post (extract-binding/single 'title bindings) + (extract-binding/single 'body bindings))) + +;; render-blog-page: request -> html-response +;; Produces an html-response page of the content of the BLOG. +(define (render-blog-page request) + (local [(define (response-generator make-url) + `(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 -> html-response +;; Consumes a post, produces an html-response fragment of the post. +(define (render-post a-post) + `(div ((class "post")) + ,(post-title a-post) + (p ,(post-body a-post)))) + +;; render-posts: -> html-response +;; Consumes a blog, produces an html-response fragment +;; of all its posts. +(define (render-posts) + `(div ((class "posts")) + ,@(map render-post (blog-posts BLOG)))) diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-5.ss b/collects/web-server/scribblings/tutorial/examples/iteration-5.ss new file mode 100644 index 0000000000..2e9a141594 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-5.ss @@ -0,0 +1,134 @@ +#lang web-server/insta + +;; A blog is a (make-blog posts) +;; where posts is a (listof post) +(define-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) +(define-struct post (title body comments) #:mutable) + +;; BLOG: blog +;; The initial BLOG. +(define BLOG + (make-blog + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-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 -> html-response +;; 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 -> html-response +;; Produces an html-response page of the content of the +;; BLOG. +(define (render-blog-page request) + (local [(define (response-generator make-url) + `(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) + (make-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 -> html-response +;; 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) + `(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) -> 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-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) -> html-response +;; Consumes a make-url, and produces an html-response 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 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-6.ss b/collects/web-server/scribblings/tutorial/examples/iteration-6.ss new file mode 100644 index 0000000000..94ce399474 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-6.ss @@ -0,0 +1,168 @@ +#lang web-server/insta + +;; A blog is a (make-blog posts) +;; where posts is a (listof post) +(define-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) +(define-struct post (title body comments) #:mutable) + +;; BLOG: blog +;; The initial BLOG. +(define BLOG + (make-blog + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-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 -> html-response +;; 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 -> html-response +;; Produces an html-response page of the content of the +;; BLOG. +(define (render-blog-page request) + (local [(define (response-generator make-url) + `(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) + (make-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 -> 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-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 + (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 -> 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-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-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) -> 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-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) -> html-response +;; Consumes a make-url, produces an html-response 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 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-7.ss b/collects/web-server/scribblings/tutorial/examples/iteration-7.ss new file mode 100644 index 0000000000..4a3e0b9893 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-7.ss @@ -0,0 +1,168 @@ +#lang web-server/insta + +;; A blog is a (make-blog posts) +;; where posts is a (listof post) +(define-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) +(define-struct post (title body comments) #:mutable) + +;; BLOG: blog +;; The initial BLOG. +(define BLOG + (make-blog + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-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 -> html-response +;; 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 -> html-response +;; Produces an html-response page of the content of the +;; BLOG. +(define (render-blog-page request) + (local [(define (response-generator make-url) + `(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) + (make-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 -> 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-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 + (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 -> 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-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-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) -> 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-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) -> html-response +;; Consumes a make-url, produces an html-response 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 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-8.ss b/collects/web-server/scribblings/tutorial/examples/iteration-8.ss new file mode 100644 index 0000000000..f51fb32fe7 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-8.ss @@ -0,0 +1,135 @@ +#lang web-server/insta + +(require "model.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 request)) + +;; render-blog-page: request -> html-response +;; Produces an html-response page of the content of the +;; BLOG. +(define (render-blog-page request) + (local [(define (response-generator make-url) + `(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) + (make-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 -> 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-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 + (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 -> 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-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-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) -> 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-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) -> html-response +;; Consumes a make-url, produces an html-response 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 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/iteration-9.ss b/collects/web-server/scribblings/tutorial/examples/iteration-9.ss new file mode 100644 index 0000000000..05f4b1e71a --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/iteration-9.ss @@ -0,0 +1,137 @@ +#lang web-server/insta + +(require "model-2.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.db")) + 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)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/model-2.ss b/collects/web-server/scribblings/tutorial/examples/model-2.ss new file mode 100644 index 0000000000..797abc8c47 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/model-2.ss @@ -0,0 +1,58 @@ +#lang scheme + +;; A blog is a (make-blog home posts) +;; where home is a string, posts is a (listof post) +(define-struct blog (home posts) #:mutable #:prefab) + +;; and post is a (make-post blog title body comments) +;; where title is a string, body is a string, +;; and comments is a (listof string) +(define-struct post (title body comments) #:mutable #:prefab) + +;; initialize-blog! : path? -> blog +;; Reads a blog from a path, if not present, returns default +(define (initialize-blog! home) + (define the-blog + (with-handlers + ([exn? (lambda (exn) + (make-blog + (path->string home) + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-post "Second Post" + "This is another post" + (list)))))]) + (with-input-from-file home + read))) + (set-blog-home! the-blog (path->string home)) + the-blog) + +;; save-blog! : blog -> void +;; Saves the contents of a blog to its home +(define (save-blog! a-blog) + (with-output-to-file (blog-home a-blog) + (lambda () (write a-blog)) + #:exists 'replace)) + +;; 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) + (set-blog-posts! + a-blog + (cons (make-post title body empty) (blog-posts a-blog))) + (save-blog! a-blog)) + +;; 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 a-post a-comment) + (set-post-comments! + a-post + (append (post-comments a-post) (list a-comment))) + (save-blog! a-blog)) + +(provide blog? blog-posts + post? post-title post-body post-comments + initialize-blog! + blog-insert-post! post-insert-comment!) diff --git a/collects/web-server/scribblings/tutorial/examples/model-3.ss b/collects/web-server/scribblings/tutorial/examples/model-3.ss new file mode 100644 index 0000000000..3b8f96bcd6 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/model-3.ss @@ -0,0 +1,100 @@ +#lang scheme +(require (prefix-in sqlite: (planet jaymccarthy/sqlite:3/sqlite))) + +;; 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? (lambda (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) + (map (compose (lambda (n) (make-post a-blog n)) + string->number + (lambda (v) (vector-ref v 0))) + (rest (sqlite:select + (blog-db a-blog) + "SELECT id FROM posts")))) + +;; 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) + (with-handlers ([exn? (lambda _ empty)]) + (map + (lambda (v) (vector-ref v 0)) + (rest + (sqlite:select + (blog-db (post-blog p)) + (format "SELECT content FROM comments WHERE pid = '~a'" + (post-id p))))))) + +;; 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!) diff --git a/collects/web-server/scribblings/tutorial/examples/model.ss b/collects/web-server/scribblings/tutorial/examples/model.ss new file mode 100644 index 0000000000..1bcc43ac0b --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/model.ss @@ -0,0 +1,38 @@ +#lang scheme + +;; A blog is a (make-blog posts) +;; where posts is a (listof post) +(define-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) +(define-struct post (title body comments) #:mutable) + +;; BLOG: blog +;; The initial BLOG. +(define BLOG + (make-blog + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-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)))) + +(provide (all-defined-out)) diff --git a/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss new file mode 100644 index 0000000000..9661dbad93 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/no-use-redirect.ss @@ -0,0 +1,47 @@ +#lang web-server/insta + +;; A roster is a (make-roster names) +;; where names is a list of string. +(define-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 (make-roster '("kathi" "shriram" "dan"))) + +;; start: request -> html-response +(define (start request) + (show-roster request)) + +;; show-roster: request -> html-response +(define (show-roster request) + (local [(define (response-generator make-url) + `(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 html-response) -> html-response +(define (render-as-itemized-list fragments) + `(ul ,@(map render-as-item fragments))) + +;; render-as-item: html-response -> html-response +(define (render-as-item a-fragment) + `(li ,a-fragment)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/send-suspend-1.ss b/collects/web-server/scribblings/tutorial/examples/send-suspend-1.ss new file mode 100644 index 0000000000..b0a8cc9dd9 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/send-suspend-1.ss @@ -0,0 +1,20 @@ +#lang web-server/insta + +;; start: request -> html-response +(define (start request) + (send/suspend/dispatch + (lambda (make-url) + `(html + (body + (a ((href ,(make-url link-1))) "Link 1") + (a ((href ,(make-url link-2))) "Link 2")))))) + + +;; link-1: request -> html-response +(define (link-1 request) + "This is link-1") + + +;; link-2: request -> html-response +(define (link-2 request) + "This is link-2") diff --git a/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss b/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss new file mode 100644 index 0000000000..c1ae5e5471 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/send-suspend-2.ss @@ -0,0 +1,15 @@ +#lang web-server/insta + +(define (start request) + (show-counter 0)) + +;; show-counter: number -> html-response +(define (show-counter n) + (send/suspend/dispatch + (lambda (make-url) + `(html (head (title "Counting example")) + (body + (a ((href ,(make-url + (lambda (request) + (show-counter (+ n 1)))))) + ,(number->string n))))))) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/test-static.ss b/collects/web-server/scribblings/tutorial/examples/test-static.ss new file mode 100644 index 0000000000..f14384fe1a --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/test-static.ss @@ -0,0 +1,9 @@ +#lang web-server/insta +(define (start request) + '(html (head (title "Testing")) + (link ((rel "stylesheet") + (href "/test-static.css") + (type "text/css"))) + (body (h1 "This is a header") + (p "This is " (span ((class "hot")) "hot") ".")))) +(static-files-path "htdocs") \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/examples/use-redirect.ss b/collects/web-server/scribblings/tutorial/examples/use-redirect.ss new file mode 100644 index 0000000000..d5780d700d --- /dev/null +++ b/collects/web-server/scribblings/tutorial/examples/use-redirect.ss @@ -0,0 +1,47 @@ +#lang web-server/insta + +;; A roster is a (make-roster names) +;; where names is a list of string. +(define-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 (make-roster '("kathi" "shriram" "dan"))) + +;; start: request -> html-response +(define (start request) + (show-roster request)) + +;; show-roster: request -> html-response +(define (show-roster request) + (local [(define (response-generator make-url) + `(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 html-response) -> html-response +(define (render-as-itemized-list fragments) + `(ul ,@(map render-as-item fragments))) + +;; render-as-item: html-response -> html-response +(define (render-as-item a-fragment) + `(li ,a-fragment)) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/images/Flow1.dia b/collects/web-server/scribblings/tutorial/images/Flow1.dia new file mode 100644 index 0000000000..e16536fda7 Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow1.dia differ diff --git a/collects/web-server/scribblings/tutorial/images/Flow1.png b/collects/web-server/scribblings/tutorial/images/Flow1.png new file mode 100644 index 0000000000..c5c94e7436 Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow1.png differ diff --git a/collects/web-server/scribblings/tutorial/images/Flow2.dia b/collects/web-server/scribblings/tutorial/images/Flow2.dia new file mode 100644 index 0000000000..eed3017cae Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow2.dia differ diff --git a/collects/web-server/scribblings/tutorial/images/Flow2.png b/collects/web-server/scribblings/tutorial/images/Flow2.png new file mode 100644 index 0000000000..7ce92ebf56 Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow2.png differ diff --git a/collects/web-server/scribblings/tutorial/images/Flow3.dia b/collects/web-server/scribblings/tutorial/images/Flow3.dia new file mode 100644 index 0000000000..eb1275a316 Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow3.dia differ diff --git a/collects/web-server/scribblings/tutorial/images/Flow3.png b/collects/web-server/scribblings/tutorial/images/Flow3.png new file mode 100644 index 0000000000..ea285136ca Binary files /dev/null and b/collects/web-server/scribblings/tutorial/images/Flow3.png differ diff --git a/collects/web-server/scribblings/tutorial/sql.scrbl b/collects/web-server/scribblings/tutorial/sql.scrbl new file mode 100644 index 0000000000..791b2464d8 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/sql.scrbl @@ -0,0 +1,170 @@ + +@section{Using an SQL database} +@declare-exporting[#:use-sources ("iteration-10.ss" + "model-3.ss")] +@(require (prefix-in sqlite: (for-label (planet jaymccarthy/sqlite:3/sqlite)))) + +Our next task is to employ an SQL database for the blog model. We'll be using SQLite with the @schememodname[(planet jaymccarthy/sqlite:3/sqlite)] PLaneT package. We add the following to the top of our model: + +@schemeblock[ +(require (prefix-in sqlite: (planet jaymccarthy/sqlite:3/sqlite))) +] + +We now have the following bindings: + +@defthing[sqlite:open (path? . -> . db?)] +@defthing[sqlite:exec/ignore (db? string? . -> . void)] +@defthing[sqlite:select (db? string? . -> . (listof vector?))] +@defthing[sqlite:insert (db? string? . -> . integer?)] + + +The first thing we should do is decide on the relational structure of our model. We will use the following tables: + +@verbatim{ + CREATE TABLE posts (id INTEGER PRIMARY KEY, title TEXT, body TEXT) + CREATE TABLE comments (pid INTEGER, content TEXT) +} + +Each post will have an identifier, a title, and a body. This is the same as our old Scheme structure, +except we've added the identifier. (Actually, there was always an identifier---the memory pointer---but now +we have to make it explicit in the database.) + +Each comment is tied to a post by the post's identifier and has textual content. We could have chosen to +serialize comments with @scheme[write] and add a new TEXT column to the posts table to store the value. +By adding a new comments table, we are more in accord with the relational style. + +A @scheme[blog] structure will simply be a container for the database handle: + +@defstruct[blog ([db db?])] + +@bold{Exercise.} Write the @scheme[blog] structure definition. (It does not need to be mutable or serializable.) + +We can now write the code to initialize a @scheme[blog] structure: +@schemeblock[ +@code:comment{initialize-blog! : path? -> blog?} +@code:comment{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? (lambda (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) +] + +@scheme[sqlite:open] will create a database if one does not already exist at the @scheme[home] path. But, we still need +to initialize the database with the table definitions and initial data. + +We used @scheme[blog-insert-post!] and @scheme[post-insert-comment!] to initialize the database. Let's see their implementation: + +@schemeblock[ +@code:comment{blog-insert-post!: blog? string? string? -> void} +@code:comment{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))) + +@code:comment{post-insert-comment!: blog? post string -> void} +@code:comment{Consumes a blog, a post and a comment string. As a side-effect,} +@code:comment{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))) +] + +@bold{Exercise.} Find the security hole common to these two functions. + +@centerline{------------} + +A user could submit a post with a title like, @scheme{null', 'null') and INSERT INTO accounts (username, password) VALUES ('ur','hacked} and get our simple @scheme[sqlite:insert] to make two INSERTs instead of one. + + This is called an SQL injection attack. It can be resolved by using + prepared statements that let SQLite do the proper quoting for us. Refer + to the SQLite package documentation for usage. + +@centerline{------------} + +In @scheme[post-insert-comment!], we used @scheme[post-id], but we have not yet defined the new @scheme[post] structure. +It @emph{seems} like a @scheme[post] should be represented by an integer id, because the post table contains an integer as the identifying value. + +However, we cannot tell from this structure +what blog this posts belongs to, and therefore, what database; so, we could not extract the title or body values, +since we do not know what to query. Therefore, we should associate the blog with each post: + +@defstruct[post ([blog blog?] [id integer?])] + +@bold{Exercise.} Write the structure definition for posts. + +The only function that creates posts is @scheme[blog-posts]: + +@schemeblock[ +@code:comment{blog-posts : blog -> (listof post?)} +@code:comment{Queries for the post ids} +(define (blog-posts a-blog) + (map (compose (lambda (n) (make-post a-blog n)) + string->number + (lambda (v) (vector-ref v 0))) + (rest (sqlite:select (blog-db a-blog) + "SELECT id FROM posts")))) +] + +@scheme[sqlite:select] returns a list of vectors. The first element of the list is the name of the columns. +Each vector has one element for each column. Each element is a string representation of the value. + +At this point we can write the functions that operate on posts: +@schemeblock[ +@code:comment{post-title : post -> string?} +@code:comment{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)) +] + +@bold{Exercise.} Write the definition of @scheme[post-body]. + +@bold{Exercise.} Write the definition of @scheme[post-comments]. +(Hint: Use @scheme[blog-posts] as a template, not @scheme[post-title].) + +@centerline{------------} + +The only change that we need to make to the application is to require the new model. The interface is exactly the same! + +@centerline{------------} + +Our model is now: + +@external-file["model-3.ss"] + +And our application is: + +@schememod[ +web-server/insta + +(require "model-3.ss") + +.... +] + diff --git a/collects/web-server/scribblings/tutorial/tutorial-util.ss b/collects/web-server/scribblings/tutorial/tutorial-util.ss new file mode 100644 index 0000000000..7b72b87dcd --- /dev/null +++ b/collects/web-server/scribblings/tutorial/tutorial-util.ss @@ -0,0 +1,32 @@ +#lang scheme +(require scribble/basic + (for-syntax scheme/port) + scheme/include + (except-in scribble/manual link)) +(provide external-file) + +; Copied from guide/scribblings/contracts-utils +(require (for-syntax (only-in scribble/comment-reader [read-syntax comment-reader]))) +(define-for-syntax (comment-schememod-reader path port) + (let ([pb (peek-byte port)]) + (if (eof-object? pb) + pb + (let ([m (regexp-match #rx"^#lang " port)]) + (unless m + (raise-syntax-error 'comment-scheme-reader "expected a #lang to begin file ~s" path)) + (let ([np (let-values ([(line col pos) (port-next-location port)]) + (relocate-input-port port line 0 pos))]) + (port-count-lines! np) + (let loop ([objects '()]) + (let ([next (comment-reader path np)]) + (cond + [(eof-object? next) + #`(schememod #,@(reverse objects))] + [else + (loop (cons next objects))])))))))) + +(define-syntax (external-file stx) + (syntax-case stx () + [(_ filename) + #`(include/reader #,(format "examples/~a" (syntax-e #'filename)) + comment-schememod-reader)])) \ No newline at end of file diff --git a/collects/web-server/scribblings/tutorial/tutorial.scrbl b/collects/web-server/scribblings/tutorial/tutorial.scrbl new file mode 100644 index 0000000000..9f02c47460 --- /dev/null +++ b/collects/web-server/scribblings/tutorial/tutorial.scrbl @@ -0,0 +1,996 @@ +#lang scribble/doc +@(require scribble/manual + (for-label scheme) + (for-label web-server/servlet) + "tutorial-util.ss") + +@title{@bold{Cont}: Web Applications in PLT Scheme} + +By Danny Yoo (dyoo at cs dot wpi dot edu) & Jay McCarthy (jay at cs dot byu dot edu) + +How do we make dynamic web applications? This tutorial will show how we +can build web applications using PLT Scheme. 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, as well as +use of higher-order functions, local, and a minor bit of mutation. + +@section{Getting Started} + +Everything you needed in this tutorial is provided in @link["http://plt-scheme.org/"]{PLT Scheme}. +We will be using the DrScheme Module language. Enter the following into the Definition window. + +@schememod[ +web-server/insta +(define (start request) + '(html + (head (title "My Blog")) + (body (h1 "Under construction")))) +] + +Press the @onscreen{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 @onscreen{Stop} button to shut the server down for now. + +@section{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: + +@itemize[ + @item{Show a static list of posts.} + @item{Allow a user to add new posts to the system.} + @item{Extend the model to let a user add comments to a post.} + @item{Allow all users to share the same set of posts.} + @item{Serialize our data structures to disk.} + ] + +By the end of this tutorial, we'll have a simple blogging application. + +@section{Basic Blog} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-1)] + +We start by considering our data definitions. We want to represent a +list of posts. Let's say that a post is: + +@schemeblock[(define-struct post (title body))] + +@(defstruct post ([title string?] [body string?])) + +@bold{Exercise.} Make a few examples of posts. + +A blog, then, will be a list of posts: + +@(defthing blog (listof post?)) + +As a very simple example of a blog: + +@schemeblock[ +(define BLOG (list (make-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. + +@section{Rendering HTML} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-1)] + +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. + +@schemeblock[ + (define html-response/c + (or/c string? + (or/c (cons/c symbol? (listof html-response/c)) + (cons/c symbol? + (cons/c (listof (list/c symbol? string?)) + (listof html-response/c))))))] + +For example: + +The HTML @tt{hello} is represented as @scheme["hello"]. + +@tt{

This is an example

} is + +@scheme['(p "This is an example")]. + +@tt{Past} is + +@scheme['(a ((href "link.html")) "Past")]. + +@tt{

This is

another
example.

} is + +@scheme['(p "This is " (div ((class "emph")) "another") " example.")]. + +We can produce these @scheme[html-response]s by using @scheme[cons] and @scheme[list] directly. +Doing so, however, can be notationally heavy. Consider: + +@schemeblock[ + (list 'html (list 'head (list 'title "Some title")) + (list 'body (list 'p "This is a simple static page."))) +] + +vs: + +@schemeblock[ + '(html (head (title "Some title")) + (body (p "This is a simple static page."))) +] + +They both produce the same @scheme[html-response], 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 @scheme[html-response] 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. + +Scheme 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: + +@schemeblock[ +@code:comment{render-greeting: string -> html-response} +@code:comment{Consumes a name, and produces a dynamic html-response.} +(define (render-greeting a-name) + `(html (head (title "Welcome")) + (body (p ,(string-append "Hello " a-name))))) +] + +@bold{Exercise.} Write a function that consumes a @scheme[post] and produces +an @scheme[html-response] representing that content. + +@defthing[render-post (post? . -> . html-response/c)] + +As an example, we want: + +@schemeblock[ + (render-post (make-post "First post!" "This is a first post.")) +] + +to produce: + +@schemeblock[ + '(div ((class "post")) "First post!" (p "This is a first post.")) +] + +@bold{Exercise.} Revise @scheme[render-post] to show the number of comments attached +to a post. + +@centerline{------------} + +If an expression produces a list of @scheme[html-response] 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 @scheme[,@expression]. + +As an example, we may want a helper function that transforms a +@scheme[html-response] list into a fragment representing an unordered, itemized +HTML list: + +@schemeblock[ +@code:comment{render-as-itemized-list: (listof html-response) -> html-response} +@code:comment{Consumes a list of items, and produces a rendering} +@code:comment{as an unordered list.} +(define (render-as-itemized-list fragments) + `(ul ,@(map render-as-item fragments))) + +@code:comment{render-as-item: html-response -> html-response} +@code:comment{Consumes an html-response, and produces a rendering} +@code:comment{as a list item.} +(define (render-as-item a-fragment) + `(li ,a-fragment)) +] + +@bold{Exercise.} Write a function @scheme[render-posts] that consumes a @scheme[(listof post?)] +and produces an @scheme[html-response] for that content. + +@defthing[render-posts ((listof post?) . -> . html-response/c)] + +As examples: + +@schemeblock[ +(render-posts empty) +] + +should produce: + +@schemeblock[ +'(div ((class "posts"))) +] + +@schemeblock[ +(render-posts (list (make-post "Post 1" "Body 1") + (make-post "Post 2" "Body 2"))) +] + +should produce: + +@schemeblock[ +'(div ((class "posts")) + (div ((class "post")) "Post 1" "Body 1") + (div ((class "post")) "Post 2" "Body 2")) +] + +@centerline{------------} + +Now that we have the @scheme[render-posts] function handy, let's revisit our +web application and change our @scheme[start] function to return an interesting +@scheme[html-response]. + +@external-file["iteration-1.ss"] + +If we press Run, we should see the blog posts in our web browser. + +@section{Inspecting Requests} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-2 + web-server/servlet)] + +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 @scheme[request] object without doing +anything with it. As we might expect, the @scheme[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 @scheme[request] that holds the form +values in it. We can use the function @scheme[request-bindings] to grab at +the values that the user has filled out. The type of @scheme[request-bindings] +is: + +@defthing[request-bindings (request? . -> . bindings?)] + +Along with @scheme[request-bindings], there's another function called +@scheme[extract-binding/single] that takes this as well as a name, and returns +the value associated to that name. + +@defthing[extract-binding/single (symbol? bindings? . -> . string?)] + +Finally, we can check to see if a name exists in a binding with +@scheme[exists-binding?]: + +@defthing[exists-binding? (symbol? bindings? . -> . boolean?)] + +With these functions, we can design functions that consume @scheme[request]s +and do something useful. + +@bold{Exercise.} Write a function @scheme[can-parse-post?] that consumes a @scheme[bindings?]. +It should produce @scheme[#t] if there exist bindings both for the symbols +@scheme['title] and @scheme['body], and @scheme[#f] otherwise. + +@defthing[can-parse-post? (bindings? . -> . boolean?)] + +@bold{Exercise.} Write a function @scheme[parse-post] that consumes a bindings. +Assume that the bindings structure has values for the symbols @scheme['title] +and @scheme['body]. @scheme[parse-post] should produce a post containing those values. + +@defthing[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. + +@external-file["iteration-2.ss"] + +This appears to work... but there's an issue with this! Try to add +two new posts. What happens? + +@section{Advanced Control Flow} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-3)] + +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, @scheme[start], that can respond to requests directed at our +application's URL, that @scheme[start] function is starting to get overloaded +with a lot of responsibility. Conceptually, @scheme[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 @scheme[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, @scheme[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. + +@schememod[ +web-server/insta +@code:comment{start: request -> html-response} +(define (start request) + (phase-1 request)) + +@code:comment{phase-1: request -> html-response} +(define (phase-1 request) + (local [(define (response-generator make-url) + `(html + (body (h1 "Phase 1") + (a ((href ,(make-url phase-2))) + "click me!"))))] + (send/suspend/dispatch response-generator))) + +@code:comment{phase-2: request -> html-response} +(define (phase-2 request) + (local [(define (response-generator make-url) + `(html + (body (h1 "Phase 2") + (a ((href ,(make-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 @scheme[phase-1]. The +page that's generated has a hyperlink that, when clicked, continues to +@scheme[phase-2]. The user can click back, and falls back to @scheme[phase-1], and the +cycle repeats. + +Let's look more closely at the @scheme[send/suspend/dispatch] mechanism. +@scheme[send/suspend/dispatch] consumes a response-generating function, and it +gives that response-generator a function called @scheme[make-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 @scheme[phase-1], the use of @scheme[make-url] associates the link with @scheme[phase-2], and +vice versa. + +We can be more sophisticated about the handlers associated with +@scheme[make-url]. Because the handler is just a request-consuming function, +it can be defined within a @scheme[local]. Consequently, a local-defined +handler knows about all the variables that are in the scope of its +definition. Here's another loopy example: + +@schememod[ +web-server/insta +@code:comment{start: request -> html-response} +(define (start request) + (show-counter 0 request)) + +@code:comment{show-counter: number request -> html-response} +@code:comment{Displays a number that's hyperlinked: when the link is pressed,} +@code:comment{returns a new page with the incremented number.} +(define (show-counter n request) + (local [(define (response-generator make-url) + `(html (head (title "Counting example")) + (body + (a ((href ,(make-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. + +@external-file["iteration-3.ss"] + +Note that the structure of the @scheme[render-blog-page] function looks very +similar to that of our last @scheme[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? + +@section{Share and Share Alike} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-4)] + +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 @scheme[#:mutable] keyword. + +Earlier, we had said that a @scheme[blog] was a list of @scheme[post]s, +but because we want to allow the blog to be changed, let's revisit our +definition so that a blog is a mutable structure: + +@schemeblock[(define-struct blog (posts) #:mutable)] + +@defstruct[blog ([posts (listof post?)])] + +Mutable structures provide functions to change the fields of a +structure; in this case, we now have a structure mutator called +@scheme[set-blog-posts!], + +@defthing[set-blog-posts! (blog? (listof post?) . -> . void)] + +and this will allow us to change the posts of a blog. + +@bold{Exercise.} Write a function @scheme[blog-insert-post!] + +@defthing[blog-insert-post! (blog? post? . -> . void)] + +The intended side effect of the function will be to extend the blog's +posts. + +@centerline{------------} + +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 @scheme[BLOG] +variable. + +After doing the adjustments incorporating @scheme[insert-blog-post!], and doing +a little variable cleanup, our web application now looks like this: + +@external-file["iteration-4.ss"] + +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. + +@section{Extending the Model} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-5)] + +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: + +@defstruct[post ([title string?] [body string?] [comments (listof string?)]) #:mutable] + +@bold{Exercise.} Write the updated data structure definition for posts. Make +sure to make the structure mutable, since we intend to add comments to +posts. + +@bold{Exercise.} Make up a few examples of posts. + +@bold{Exercise.} Define a function @scheme[post-add-comment!] + +@defthing[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. + +@bold{Exercise.} Adjust @scheme[render-post] so that the produced fragment will include the +comments in an itemized list. + +@bold{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 @scheme[make-post]. Identify and fix any other part of the +application that needs to accommodate the post's new structure. + +@centerline{------------} + +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 may even see some of the fruits +of our labor: if the initial @scheme[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! + +@section{Breaking Up the Display} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-5)] + +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. + +@image{scribblings/tutorial/images/Flow1.png} + +Each point in the diagram corresponds to a request-consuming handler. +As we might suspect, we'll be using @scheme[send/suspend/dispatch] some more. +Every arrow in the diagram will be realized as a URL that we generate +with @scheme[make-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 make-url to do +it, we'll need to adjust @scheme[render-posts] and @scheme[render-post] to consume and +use @scheme[make-url] itself when it makes those hyperlinked titles. + +Our web application now looks like: + +@external-file["iteration-5.ss"] + +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 @scheme[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. + +@section{Adding a Back Button} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-6)] + +Here's a diagram of a our revised page flow of our web application. +Maybe we can just add a BACK link from the @scheme[render-post-detail-page] +that gets us back to viewing the top-level blog. + +@image{scribblings/tutorial/images/Flow2.png} + +@bold{Exercise.} Adjust @scheme[render-post-detail-page] to include another link that goes +back to @scheme[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. + +@image{scribblings/tutorial/images/Flow3.png} + +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. + +@external-file["iteration-6.ss"] + +@section{Decorating With Style!} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-7 + web-server/insta/insta)] + +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 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. + +@scheme['(style ((type "text/css")) "p { color: green }")] + +It's tempting to directly embed this style information into our +@scheme[html-response]s. 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 +@scheme[static-files-path], + +@defthing[static-files-path (path? -> void)] + +tells the web server to look in the given path when it receives a URL +that looks like a static resource request. + +@bold{Exercise.} Create a simple web application called @filepath{test-static.ss} with the +following content: + +@schememod[ +web-server/insta +(define (start request) + '(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 @filepath{htdocs} rooted in the same directory as +the @filepath{test-static.ss} source. Finally, just to see that we can serve +this .css page, create a very simple .css file @filepath{test-static.css} file +in @filepath{htdocs/} with the following content: + +@verbatim{ +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. + +@centerline{------------} + +@bold{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. + +@section{The Double Submit Bug} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-7 + web-server/servlet)] + +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 @scheme[redirect/get]. + +@defthing[redirect/get (-> request?)] + +This @scheme[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: + +@external-file["no-use-redirect.ss"] + +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? + +@external-file["use-redirect.ss"] + +Double-submit, then, is painlessly easy to mitigate. Whenever we have +handlers that mutate the state of our system, we use @scheme[redirect/get] when +we send our response back. + +@bold{Exercise.} +Revise the blog application with @scheme[redirect/get] to address the +double-submit problem. + +With these minor fixes, our blog application now looks like this: + +@external-file["iteration-7.ss"] + +@section{Abstracting the Model} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-8 + web-server/scribblings/tutorial/examples/model)] + +If we "turn off the lights" by closing the program, then the state of +our application disappears into the ether. How do we get our +ephemeral state to stick around? Before we tackle that question, we +should consider: what do we want to save? There's some state that we +probably don't have a lingering interest in, like requests. What we +care about saving is our model of the blog. + +If we look closely at our web application program, we see a seam +between the model of our blog, and the web application that uses that +model. Let's isolate the model: it's all the stuff near the top: + +@schemeblock[ + (define-struct blog (posts) #:mutable) + (define-struct post (title body comments) #:mutable) + (define BLOG ...) + (define (blog-insert-post! ...) ...) + (define (post-insert-comment! ...) ...) +] + +In realistic web applications, the model and the web application are +separated by some wall of abstraction. The theory is that, if we do +this separation, it should be easier to then make isolated changes +without breaking the entire system. Let's do this: we will first rip +the model out into a separate file. Once we've done that, then we'll +look into making the model persist. + +Create a new file called @filepath{model.ss} with the following content. + +@external-file["model.ss"] + +This is essentially a cut-and-paste of the lines we identified as our +model. There's one additional expression that looks a little odd at first: + +@schemeblock[ + (provide (all-defined-out)) +] + +which tells PLT Scheme to allow other files to have access to +everything that's defined in the @filepath{model.ss} file. There are +situations where we may want to hide things for the sake of s private +functions, or the internal representation of structures, in which case +the pro + +We change our web application to use this model. Going back to our +web application, we rip out the old model code, and replace it with an +expression that let's use use the new model. + +@schemeblock[ + (require "model.ss") +] + +which hooks up our web application module to the @schememodname["model.ss"] module. + +@external-file["iteration-8.ss"] + +@section{A Model of Persistent} +@declare-exporting[#:use-sources (web-server/scribblings/tutorial/examples/iteration-9 + web-server/scribblings/tutorial/examples/model-2)] + +Now that the model is separated into a separate module, we can more easily modify +its functionality, and in particular, make it persistent. + +The first step is to make the model structures serializable. Earlier, we made the +structures mutable by adding @scheme[#:mutable] to their definitions. We can make +the structures serializable by adding @scheme[#:prefab]. This tells PLT Scheme that +these structures can be "previously fabricated", that is, created before the program +started running---which is exactly what we want when restoring the blog data from disk. +Our blog structure definition now looks like: + +@schemeblock[ + (define-struct blog (posts) #:mutable #:prefab) +] + +Now @scheme[blog] structures can be read from the outside world with @scheme[read] and written +with @scheme[write]. However, we need to make sure everything inside a @scheme[blog] structure is +also marked as @scheme[#:prefab]. If we had a more complicated structure, we would need to ensure +that everything (transitively) in the structure was @scheme[#:prefab]'d. + +@bold{Exercise.} Write the new structure definition for posts. + +At this point, we @emph{can} read and write the blog to disk. Now let's actually do it. + +First, we'll make a place to record in the model where the blog lives on disk. So, we need to change +the blog structure again. Now it will be: + +@defstruct[blog ([home string?] [posts (listof post?)]) #:mutable] + +@bold{Exercise.} Write the new structure definition for blogs. + +Then, we'll make a function that allows our application to initialize the blog: + +@schemeblock[ +@code:comment{initialize-blog! : path? -> blog} +@code:comment{Reads a blog from a path, if not present, returns default} +(define (initialize-blog! home) + (define the-blog + (with-handlers + ([exn? (lambda (exn) + (make-blog + (path->string home) + (list (make-post "First Post" + "This is my first post" + (list "First comment!")) + (make-post "Second Post" + "This is another post" + (list)))))]) + (with-input-from-file home + read))) + (set-blog-home! the-blog (path->string home)) + the-blog) +] + +@scheme[initialize-blog!] takes a path and tries to @scheme[read] from it. If the path contains +a @scheme[blog] structure, then @scheme[read] will parse it, because @scheme[blog]s are @scheme[#:prefab]. +If there is no file at the path, or if the file has some spurious data, then @scheme[read] or +@scheme[with-input-from-file] will throw an exception. @scheme[with-handlers] provides an +exception handler that will return the default @scheme[blog] structure for all +kinds of errors. + +After @scheme[the-blog] is bound to the newly read (or default) structure, we set the home to the +correct path. (Notice that we need to convert the path into a string. Why didn't we just make the blog +structure contain paths? Answer: They can't be used with @scheme[read] and @scheme[write].) + +Next, we will need to write a function to save the model to the disk. + +@schemeblock[ +@code:comment{save-blog! : blog -> void} +@code:comment{Saves the contents of a blog to its home} +(define (save-blog! a-blog) + (with-output-to-file (blog-home a-blog) + (lambda () (write a-blog)) + #:exists 'replace)) +] + +@scheme[save-blog!] @scheme[write]s the model into its home . +It provides @scheme[with-output-to-file] with an @scheme[#:exists] flag that tells it to replace the +file contents if the file at @scheme[blog-home] exists. + +This function can now be used to save the blog structure whenever we modify it. Since we only ever modify the +blog structure in the model, we only need to update @scheme[blog-insert-post!] and @scheme[post-insert-comment!]. + +@bold{Exercise.} Change @scheme[blog-insert-post!] and @scheme[post-insert-comment!] to call @scheme[save-blog!]. + +@centerline{------------} + +You may have had a problem when trying to update @scheme[post-insert-comment!]. It needs to call @scheme[save-blog!] +with the blog structure. But, it wasn't passed the blog as an argument. We'll need to add that argument and change the +application appropriately. While we're at it, let's change @scheme[blog-insert-post!] to accept the contents of the +post structure, rather the structure itself, to better abstract the model interface: + +@defthing[blog-insert-post! (blog? string? string? . -> . void)] +@defthing[post-insert-comment! (blog? post? string? . -> . void)] + +@bold{Exercise.} Write the new definitions of @scheme[blog-insert-post!] and @scheme[post-insert-comment!]. +(Remember to call @scheme[save-blog!].) + +We'll change the @scheme[provide] line in the model to: +@schemeblock[ +(provide blog? blog-posts + post? post-title post-body post-comments + initialize-blog! + blog-insert-post! post-insert-comment!) +] + +@centerline{------------} + +The last step is to change the application. We need to call @scheme[initialize-blog!] to read in the blog structure, and we +need to pass the blog value that is returned around the application, because there is no longer a @scheme[BLOG] export. + +First, change @scheme[start] to call @scheme[initialize-blog!] with a path in our home directory: + +@schemeblock[ + (define (start request) + (render-blog-page + (initialize-blog! + (build-path (find-system-path 'home-dir) + "the-blog-data.db")) + request)) +] + +@bold{Exercise.} Thread the @scheme[blog] structure through the application appropriately to give +@scheme[blog-insert-post!] and @scheme[post-insert-comment!] the correct values. (You'll also need to +change how @scheme[render-blog-page] adds new posts.) + +@centerline{------------} + +Our model is now: + +@external-file["model-2.ss"] + +And our application is: + +@external-file["iteration-9.ss"] + +@centerline{------------} + +This approach to persistence can work surprisingly well for simple applications. But as our application's needs +grow, we will have to deal with concurrency issues, the lack of a simply query language over our data model, etc. +So, in a future tutorial, we'll talk about how to use an SQL database to store our blog model. + +@section{Leaving DrScheme} + +So far, to run our application, we've been pressing @onscreen{Run} in DrScheme. If we were to actually deploy +an application, we'd need to do this differently. + +@(require (for-label web-server/servlet-env) + (for-label web-server/managers/lru)) + +The simplest way to do this is to use @schememodname[web-server/servlet-env]. + +First, change the first lines in your application from +@schememod[ +web-server/insta +] + +to +@schememod[ +scheme + +(require web-server/servlet) +(provide/contract (start (request? . -> . response?))) +] + +Second, add the following at the bottom of your application: + +@schemeblock[ +(require web-server/servlet-env + web-server/managers/lru) +(serve/servlet start + #:launch-browser? #f + #:quit? #f + + #:listen-ip #f + #:port 8000 + + #:manager + (make-threshold-LRU-manager + (lambda (request) + `(html + (head (title "Page Has Expired.")) + (body (p "Sorry, this page has expired. " + "Please go back.")))) + (* 64 1024 1024)) + + #:extra-files-path + (build-path _path "htdocs") + #:servlet-path + [servlet-path "servlets/APPLICATION.ss"]) +] + +You can change the value of the @scheme[#:port] parameter to use a different port. + +@scheme[#:listen-ip] is set to @scheme[#f] so that the server will listen on @emph{all} available IPs. + +The number given to the @scheme[make-threshold-LRU-manager] specifies a memory limit for the Web server's +session data. (In the code above, it is 64 MBs.) + +You should change @scheme[_path] to be the path to the parent of your @scheme[htdocs] directory. + +You should change @scheme["APPLICATION.ss"] to be the name of your application. + +Third, to run your server, you can either press @onscreen{Run} in DrScheme, or type + +@commandline{mzscheme -t } + +(With your own file name, of course.) Both of these will start a Web server @emph{just} for your application. + +@centerline{------------} + +There are more advanced ways of starting the Web Server, but you'll have to +refer to the PLT Web Server Reference Manual for details. + +@section{Moving Forward} + +As you move forward on your own applications, you may find many useful packages on PLaneT. There are interfaces to +databases. Many tools for generating HTML, XML, and Javascript output. Etc. There is also an active community of +users on the @scheme[plt-scheme] mailing list. We welcome new users! \ No newline at end of file