@@ -80,7 +80,7 @@ main = do
8080
8181 createSchema sessionId conn
8282 insertSampleData sessionId conn
83− --executeSampleQueries sessionId conn
83+ --create the web routes
8484 scotty 3000 $ do
8585 S.get "/" (listBlogs sessionId conn)
8686 S.get "/blog/:blogid" (showBlogEntry sessionId conn)
@@ -121,20 +121,12 @@ insertSampleData sessionId conn = do
121121 insertCommentsExpr <- handleError $ toInsertExpr comments "comment"
122122 handleIOError $ executeDatabaseContextExpr sessionId conn insertCommentsExpr
123123
124−--issue a query and marshal the data back to the original data value
125−{-
126−executeSampleQueries :: SessionId -> Connection -> IO ()
127−executeSampleQueries sessionId conn = do
128− commentsRelation <- handleIOError $ executeRelationalExpr sessionId conn (RelationVariable "comment" ())
129−
130− comments <- toList commentsRelation >>= mapM (handleError . fromTuple) :: IO [Comment]
131− print comments
132−-}
133−
124+-- handle relational errors with scotty
134125handleWebError :: Either RelationalError a -> ActionM a
135126handleWebError (Left err) = render500 (H.toHtml (show err)) >> pure (error "bad")
136127handleWebError (Right v) = pure v
137128
129+-- show a page with all the blog entries
138130listBlogs :: SessionId -> Connection -> ActionM ()
139131listBlogs sessionId conn = do
140132 eRel <- liftIO $ executeRelationalExpr sessionId conn (RelationVariable "blog" ())
@@ -142,9 +134,10 @@ listBlogs sessionId conn = do
142134 Left err -> render500 (H.toHtml (show err))
143135 Right blogRel -> do
144136 blogs <- liftIO (toList blogRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Blog]
137+ let sortedBlogs = sortBy (\b1 b2 -> stamp b1 `compare` stamp b2) blogs
145138 html . renderHtml $ do
146139 H.h1 "Blog Posts"
147− mapM_ (\blog -> H.a H.! A.href (H.toValue $ "/blog/" <> title blog) $ H.h2 (H.toHtml (title blog))) blogs
140+ mapM_ (\blog -> H.a H.! A.href (H.toValue $ "/blog/" <> title blog) $ H.h2 (H.toHtml (title blog))) sortedBlogs
148141
149142render500 :: H.Html -> ActionM ()
150143render500 msg = do
@@ -153,6 +146,7 @@ render500 msg = do
153146 H.p msg
154147 status internalServerError500
155148
149+--display one blog post along with its comments
156150showBlogEntry :: SessionId -> Connection -> ActionM ()
157151showBlogEntry sessionId conn = do
158152 blogid <- param "blogid"
@@ -184,15 +178,17 @@ showBlogEntry sessionId conn = do
184178 comments <- liftIO (toList commentsRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Comment]
185179 let commentsSorted = sortBy (\c1 c2 -> commentTime c1 `compare` commentTime c2) comments
186180 render $ do
181+ --show blog details
187182 H.h1 (H.toHtml (title blog))
188183 H.p (H.toHtml ("Posted at " <> formatStamp (stamp blog)))
189184 H.p (H.toHtml (entry blog))
190185 H.hr
191186 H.h3 "Comments"
187+ --list the comments
192188 mapM_ (\comment -> do
193189 H.p (H.toHtml ("Commented at " <> formatStamp (commentTime comment)))
194190 H.p (H.toHtml (contents comment))) commentsSorted
195− when (length comments == 0) (H.p "No comments.")
191+ when (null comments) (H.p "No comments.")
196192 --add a comment form
197193 H.h3 "Add a Comment"
198194 H.form H.! A.method "POST" H.! A.action "/comment" $ do
@@ -200,6 +196,7 @@ showBlogEntry sessionId conn = do
200196 H.textarea H.! A.name "contents" $ ""
201197 H.input H.! A.type_ "submit"
202198
199+--add a comment to a blog post
203200addComment :: SessionId -> Connection -> ActionM ()
204201addComment sessionId conn = do
205202 blogid <- param "blogid"