@@ -19,11 +19,11 @@ import Control.DeepSeq
1919import Data.Proxy
2020import Data.Monoid
2121import Data.List
22−import Control.Monad (when)
22+import Control.Monad (when, forM_)
2323
2424import Web.Scotty as S
25−import qualified Text.Blaze.Html5 as H
26−import qualified Text.Blaze.Html5.Attributes as A
25+import Text.Blaze.Html5 (h1, h2, h3, p, form, input, (!), toHtml, Html, a, toValue, hr, textarea)
26+import Text.Blaze.Html5.Attributes (name, href, type_, method, action, value)
2727import Text.Blaze.Html.Renderer.Text
2828import Control.Monad.IO.Class (liftIO)
2929import Network.HTTP.Types.Status
@@ -123,7 +123,7 @@ insertSampleData sessionId conn = do
123123
124124-- handle relational errors with scotty
125125handleWebError :: Either RelationalError a -> ActionM a
126−handleWebError (Left err) = render500 (H.toHtml (show err)) >> pure (error "bad")
126+handleWebError (Left err) = render500 (toHtml (show err)) >> pure (error "bad")
127127handleWebError (Right v) = pure v
128128
129129-- show a page with all the blog entries
@@ -131,19 +131,19 @@ listBlogs :: SessionId -> Connection -> ActionM ()
131131listBlogs sessionId conn = do
132132 eRel <- liftIO $ executeRelationalExpr sessionId conn (RelationVariable "blog" ())
133133 case eRel of
134− Left err -> render500 (H.toHtml (show err))
134+ Left err -> render500 (toHtml (show err))
135135 Right blogRel -> do
136136 blogs <- liftIO (toList blogRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Blog]
137137 let sortedBlogs = sortBy (\b1 b2 -> stamp b1 `compare` stamp b2) blogs
138138 html . renderHtml $ do
139− H.h1 "Blog Posts"
140− mapM_ (\blog -> H.a H.! A.href (H.toValue $ "/blog/" <> title blog) $ H.h2 (H.toHtml (title blog))) sortedBlogs
139+ h1 "Blog Posts"
140+ forM_ sortedBlogs $ \blog -> a ! href (toValue $ "/blog/" <> title blog) $ h2 (toHtml (title blog))
141141
142−render500 :: H.Html -> ActionM ()
142+render500 :: Html -> ActionM ()
143143render500 msg = do
144144 html . renderHtml $ do
145− H.h1 "Internal Server Error"
146− H.p msg
145+ h1 "Internal Server Error"
146+ p msg
147147 status internalServerError500
148148
149149--display one blog post along with its comments
@@ -163,14 +163,14 @@ showBlogEntry sessionId conn = do
163163 let render = html . renderHtml
164164 formatStamp = formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S"))
165165 case eRel of
166− Left err -> render500 (H.toHtml (show err))
166+ Left err -> render500 (toHtml (show err))
167167 --handle successful query execution
168168 Right rel -> case singletonTuple rel of
169169 Nothing -> do --no results for this blog id
170− render (H.h1 "No such blog post")
170+ render (h1 "No such blog post")
171171 status status404
172172 Just blogTuple -> case fromTuple blogTuple of --just one blog post found- it's a match!
173− Left err -> render500 (H.toHtml (show err))
173+ Left err -> render500 (toHtml (show err))
174174 Right blog -> do
175175 --extract comments for the blog
176176 commentsAtom <- handleWebError (atomForAttributeName "comments" blogTuple)
@@ -179,22 +179,22 @@ showBlogEntry sessionId conn = do
179179 let commentsSorted = sortBy (\c1 c2 -> commentTime c1 `compare` commentTime c2) comments
180180 render $ do
181181 --show blog details
182− H.h1 (H.toHtml (title blog))
183− H.p (H.toHtml ("Posted at " <> formatStamp (stamp blog)))
184− H.p (H.toHtml (entry blog))
185− H.hr
186− H.h3 "Comments"
182+ h1 (toHtml (title blog))
183+ p (toHtml ("Posted at " <> formatStamp (stamp blog)))
184+ p (toHtml (entry blog))
185+ hr
186+ h3 "Comments"
187187 --list the comments
188− mapM_ (\comment -> do
189− H.p (H.toHtml ("Commented at " <> formatStamp (commentTime comment)))
190− H.p (H.toHtml (contents comment))) commentsSorted
191− when (null comments) (H.p "No comments.")
188+ forM_ commentsSorted $ \comment -> do
189+ p (toHtml ("Commented at " <> formatStamp (commentTime comment)))
190+ p (toHtml (contents comment))
191+ when (null comments) (p "No comments.")
192192 --add a comment form
193− H.h3 "Add a Comment"
194− H.form H.! A.method "POST" H.! A.action "/comment" $ do
195− H.input H.! A.type_ "hidden" H.! A.name "blogid" H.! A.value (H.toValue blogid)
196− H.textarea H.! A.name "contents" $ ""
197− H.input H.! A.type_ "submit"
193+ h3 "Add a Comment"
194+ form ! method "POST" ! action "/comment" $ do
195+ input ! type_ "hidden" ! name "blogid" ! value (toValue blogid)
196+ textarea ! name "contents" $ ""
197+ input ! type_ "submit"
198198
199199--add a comment to a blog post
200200addComment :: SessionId -> Connection -> ActionM ()