Adding a Back Button

ここに、私たちのWebアプリの改良版ページフローのダイアグラムがあります。render-post-detail-pageからブログのトップレベルに戻るバックリンクを足すだけです。



Exercise.render-post-detail-pageにrender-blog-pageへ戻る別リンクを含むように調整してください。

もっと面白くするには、フローをもうちょっとだけ豪華にしてみましょう。ユーザにコメントを投稿する直前に選択肢を与えるのです。ひょっとしたらひょっとするでしょう。投稿前に投稿を止めたい、って思うかもしれませんので。



複雑に見えますが、ハンドラの全体像は以前とさほど変わりません。これらハンドラを全て追加すると、webアプリはかなり機能的になります。

  #lang web-server/insta
  
  ; ブログは (make-blog posts)
  ; 投稿リストは (listof post)
  (define-struct blog (posts) #:mutable)
  
  ; 投稿は (make-post title body comments)
  ; タイトルは文字列、本体も文字列
  ; コメントは (listof string)
  (define-struct post (title body comments) #:mutable)
  
  ; BLOG: 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
  ; ブログと投稿を受け取り、ブログの頭に投稿を加える
  (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
  ; 投稿とコメント文字列を受け取る。副作用として投稿の
  ; コメントリストの最後にコメントを追加する。
  (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
  ; リクエストを受け取り、webコンテンツ全てを表示する
  ; ページを生成する
  (define (start request)
    (render-blog-page request))
  
  ; render-blog-page: request -> html-response
  ; ブログの中身のhtml-responseページを
  ; 生成する
  (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
            ; 束縛から投稿を抽出する
            (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
  ; 投稿を受け取り、投稿の詳細ページを生成する
  ; ユーザは新規コメントを挿入できる
  ; また、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
  ; リクエストと共に投稿予定のコメントを受け取る
  ; ユーザはコメントを投稿し、表示ページに戻れるようにする
  ; もしくは投稿の詳細ページへと戻る
  ; 
  (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
  ; 投稿を受け取り、投稿のhtml-response要素を生成する
  ; 要素は投稿詳細ページへのリンクを含む
  (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
  ; make-urlをつけトリ、全投稿のhtml-response
  ; 要素を生成する
  (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
  ; アイテムのリストを受け取り、未整列のリストとして
  ; レンダリングを生成する
  (define (render-as-itemized-list fragments)
    `(ul ,@(map render-as-item fragments)))
  
  ; render-as-item: html-response -> html-response
  ; html-responseを受け取り、リストアイテムとして
  ; レンダリングを生成する
  (define (render-as-item a-fragment)
    `(li ,a-fragment))