１．ブログを作成する
次の課題は「簡単なブログ」である。これは次の図に示すように三種類の機能を有している。一つはこれまでの記事の一覧表示であり、二つ目は新しい記事の入力であり、三番目は選択された記事の内容の表示である。
この課題は二つの相互に関連するサービスを有する。一つはブログそのものに対するものであり、他の一つは記事に関するものである。そこで、これらに対して、BlogとArticleという名称を与え、それぞれ、コントロール部分を次のように作成する。
yesod add-handler Name of route (without trailing R): Blog Enter route pattern (ex: /entry/#EntryId): /blog Enter space-separated list of methods (ex: GET POST): GET POST
上記で、GETは記事の一覧を表示し、POSTは新しい記事の作成である。
yesod add-handler Name of route (without trailing R): Article Enter route pattern (ex: /entry/#EntryId): /blog/#ArticleId Enter space-separated list of methods (ex: GET POST): GET
上記で、GETはArticleIdで指定された記事の内容を表示する。
次にモデルの追加を行う。記事をデータベースに記憶しておくことが必要なので、次のようにする。
Article
title Text
content Html
deriving
なお、HtmlはRead,Show,Eqのインスタンスではないので、データベースへの読み書きができるようにするためにderivingを加える。これをしないとエラーとなる。
また、Blog.hsの先頭部分は次のようにする。
module Handler.Blog ( getBlogR , postBlogR ) where import Import -- to use Html into forms import Yesod.Form.Nic (YesodNic, nicHtmlField) instance YesodNic App
まず、記事の一覧を表示する機能と新しい記事を作成するための機能を外部から用いることができるようにするため、getBlogRとpostBlogRをmoduleの定義のカッコの中に書込む。また、Htmlでフォームを利用できるようにするため、YosodNicのインスタンスも加える。（本来は、Foundation.hsにおくべきものである）。
次に、新しい記事を追加するためのフォームを以下のように定義する。
entryForm :: Form Article entryForm = renderDivs $ Article <$> areq textField "Title" Nothing <*> areq nicHtmlField "Content" Nothing
ここで利用しているareqは、三種類の引数type, label, default_valueを必要とする。
一覧を表示する機能は次のようにする。
-- The view showing the list of articles getBlogR :: Handler Html getBlogR = do -- Get the list of articles inside the database. articles <- runDB $ selectList [] [Desc ArticleTitle] -- We'll need the two "objects": articleWidget and enctype -- to construct the form (see templates/articles.hamlet). (articleWidget, enctype) <- generateFormPost entryForm defaultLayout $ do $(widgetFile "articles")
これはデータベースから記事の一覧を得て、フォームを作成する。
これに対応したtemplateは次の通りとなる。(フィル名はarticles.hamlet)
<h1> Articles $if null articles <p> There are no articles in the blog $else <ul> $forall Entity articleId article <- articles <li> <a href=@{ArticleR articleId} > #{articleTitle article} <hr> <form method=post enctype=#{enctype}> ^{articleWidget} <div> <input type=submit value="Post New Article">
注目すべき点は、記事を書き込むためのフォームarticleWidgetがYesodによって作成されることである。また、記事を投稿するためのボタンを最後の行で用意している。
Blog.hsに戻る。新しい記事を作成するための機能は次のようになる。
postBlogR :: Handler Html postBlogR = do ((res,articleWidget),enctype) <- runFormPost entryForm case res of FormSuccess article -> do articleId <- runDB $ insert article setMessage $ toHtml $ (articleTitle article) <> " created" redirect $ ArticleR articleId _ -> defaultLayout $ do setTitle "Please correct your entry form" $(widgetFile "articleAddError")
これは新しい記事を作るためのもので、フォームを受け取ってその処理を行う。もしエラーがなければ、次のことを行う。
1) 新しい記事をデータベースに書込む。(runDB $ insert article)
2) 新しい記事を表示の一覧に加える。(setMessage $ …)
3) 記事のホームページに移動する。
エラーに関するtemplateは次のようになる。(フィル名はarticleAddError.hamlet)
<form method=post enctype=#{enctype}> ^{articleWidget} <div> <input type=submit value="Post New Article">
Articl.hsの未定義部分は以下のように定義する。
getArticleR :: ArticleId -> Handler Html getArticleR articleId = do article <- runDB $ get404 articleId defaultLayout $ do setTitle $ toHtml $ articleTitle article $(widgetFile "article")
また、templateは次のようになる。(フィル名はarticle.hamlet)
<h1> #{articleTitle article} <article> #{articleContent article} <hr> <a href=@{BlogR}> Go to article list.
後はコンパイルして、展開すれば利用できる。
なお、Blog.hsはつぎはぎで説明したが、全体は次のようになっている。
module Handler.Blog ( getBlogR , postBlogR ) where import Import import Yesod.Form.Nic (YesodNic,nicHtmlField) instance YesodNic App entryForm :: Form Article entryForm = renderDivs $ Article <$> areq textField "Title" Nothing <*> areq nicHtmlField "Content" Nothing getBlogR :: Handler Html getBlogR = do -- Get the list of articles inside the database articles <- runDB $ selectList [] [Desc ArticleTitle] -- We'll need the two "objects": articleWidget and enctype -- to construct the form (see temlates/articles.hamlet) (articleWidget, enctype) <- generateFormPost entryForm defaultLayout $ do $(widgetFile "articles") postBlogR :: Handler Html postBlogR = do ((res,articleWidget),enctype) <- runFormPost entryForm case res of FormSuccess article -> do articleId <- runDB $ insert article setMessage $ toHtml $ (articleTitle article) <> " created" redirect $ ArticleR articleId _ -> defaultLayout $ do setTitle "Please correct your entry form" $(widgetFile "articleAddError")
