add delete of a poll

src/Noodle/Views/Index.hs

@@ -16,6 +16,9 @@ render items =
       H.h2 "Noodle - The doodle"
       H.a ! A.class_ "btn" ! A.href "/polls/new" $ "New Poll"
       H.table ! A.class_ "table" $ mapM_ renderLn items
-  where renderLn i = H.tr $ H.td $
-          H.a ! A.href ("/polls/" <> H.stringValue (show $ fst i)) $
+  where renderLn i = H.tr $ do
+          H.td $ H.a ! A.href ("/polls/" <> H.stringValue (show $ fst i)) $
             H.toHtml (snd i)
+          H.td $ H.a ! A.class_ "btn" !
+            A.href (H.stringValue ("/polls/" ++ (show $ fst i) ++ "/delete")) $
+              "delete"

src/main.hs

@@ -76,6 +76,10 @@ scottySite = S.scotty 3000 $ do
           else acc) [] all_params
       deleteOptions choosen_opt_ids
       S.redirect $ T.pack $ "/polls/" ++ id ++ "/edit"
+    S.get "/polls/:id/delete" $ do
+      id <- S.param "id"
+      deletePoll id
+      S.redirect "/polls"
     S.post "/polls/:id/vote" $ do
       (id, name, options) <- getPollFromParam
       all_params <- S.params
@@ -171,6 +175,10 @@ createCant id name opt_ids = do
   return ()
   where pollId = toSqlKey (read id)
 
+deletePoll id = runSqlite "noodle.db" $
+  deleteWhere [PollId ==. pollId]
+  where pollId = toSqlKey (read id)
+
 updatePoll id name desc = do
   now <- liftIO $ getCurrentTime
   runSqlite "noodle.db" $ replace pollId $ Poll name desc now