Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Blog

  • Loading branch information...
commit 6c7016429b6b6f5dcac29231971c7f0d4a38d643 1 parent 7605d31
@yogsototh authored
View
1  Application.hs
@@ -25,6 +25,7 @@ import Network.HTTP.Conduit (newManager, def)
import Handler.Home
import Handler.Echo
import Handler.Mirror
+import Handler.Blog
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see
View
48 Handler/Blog.hs
@@ -0,0 +1,48 @@
+module Handler.Blog
+ ( getBlogR
+ , postBlogR
+ , getArticleR
+ )
+where
+
+import Import
+
+-- to use Html into forms
+import Yesod.Form.Nic (YesodNic, nicHtmlField)
+instance YesodNic App
+
+entryForm :: Form Article
+entryForm = renderDivs $ Article
+ <$> areq textField "Title" Nothing
+ <*> areq nicHtmlField "Content" Nothing
+
+-- The view showing the list of articles
+getBlogR :: Handler RepHtml
+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")
+
+-- we continue Handler/Blog.hs
+postBlogR :: Handler RepHtml
+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")
+
+getArticleR :: ArticleId -> Handler RepHtml
+getArticleR articleId = do
+ article <- runDB $ get404 articleId
+ defaultLayout $ do
+ setTitle $ toHtml $ articleTitle article
+ $(widgetFile "article")
View
4 config/models
@@ -7,5 +7,9 @@ Email
user UserId Maybe
verkey Text Maybe
UniqueEmail email
+Article
+ title Text
+ content Html
+ deriving
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
View
2  config/routes
@@ -7,3 +7,5 @@
/ HomeR GET POST
/echo/#Text EchoR GET
/mirror MirrorR GET POST
+/blog BlogR GET POST
+/blog/#ArticleId ArticleR GET
View
2  templates/article.hamlet
@@ -0,0 +1,2 @@
+<h1> #{articleTitle article}
+<article> #{articleContent article}
View
4 templates/articleAddError.hamlet
@@ -0,0 +1,4 @@
+<form method=post enctype=#{enctype}>
+ ^{articleWidget}
+ <div>
+ <input type=submit value="Post New Article">
View
13 templates/articles.hamlet
@@ -0,0 +1,13 @@
+<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">
View
1  yosog.cabal
@@ -35,6 +35,7 @@ library
Handler.Home
Handler.Echo
Handler.Mirror
+ Handler.Blog
ghc-options: -Wall -threaded -O0
cpp-options: -DDEVELOPMENT
Please sign in to comment.
Something went wrong with that request. Please try again.