Add a edit page and add deletion of options

noodle.cabal

@@ -19,6 +19,7 @@ cabal-version:       >=1.10
 executable noodle
   main-is:             main.hs
   other-modules:       Noodle.Views.Index, Noodle.Views.Show, Noodle.Views.New
+                       Noodle.Views.Edit
   -- other-extensions:    
   build-depends:       base >=4.7 && <4.8, scotty, blaze-html, monads-tf,
                        persistent, persistent-sqlite, time, transformers,

src/Noodle/Views/Edit.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Noodle.Views.Edit where
+
+import Text.Blaze.Html5 as H
+import Text.Blaze.Html5.Attributes as A
+import Text.Blaze.Html.Renderer.Text
+import Data.Monoid ((<>))
+
+render (pollId, pollName, pollDesc) options errors = do
+  H.html $ do
+    H.head $ do
+      H.title "Noodle - The doodle"
+      H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/noodle.css"
+    H.body $ do
+      H.h2 "Edit the poll"
+      mapM_ renderErrors errors
+      H.form ! A.class_ "form" ! A.method "post" !
+        A.action (H.stringValue ("/polls/" ++ (show pollId) ++ "/update")) $ do
+        H.table $ do
+          H.tr $ do
+            H.td $ do
+              H.label "Name: "
+            H.td $ do
+              H.input ! A.name "name" ! A.value (H.stringValue pollName)
+          H.tr $ do
+            H.td $ do
+              H.label "Description: "
+            H.td $ do
+              H.textarea ! A.name "desc" ! A.cols "50" ! A.rows "10" $
+                H.toHtml pollDesc
+        H.div ! A.class_ "btns" $ do
+          H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Update Poll"
+      H.h4 "Options"
+      H.form ! A.method "post" ! A.action "/options/" $ do
+        H.input ! A.class_ "input" ! A.placeholder "add a option" ! A.name "name"
+        H.input ! A.class_ "input" ! A.placeholder "with desctiption" ! A.name "desc"
+        H.input ! A.type_ "hidden" ! A.value (H.stringValue (show pollId)) !
+          A.name "id"
+        H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Add"
+      H.form ! A.method "post" !
+        A.action (H.stringValue ("/options/delete")) $ do
+        H.table $ do
+          mapM_ (renderLn) options
+        H.input ! A.type_ "hidden" ! A.value (H.stringValue (show pollId)) !
+          A.name "id"
+        H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Delete"
+      H.a ! A.class_ "btn" ! A.href (H.stringValue ("/polls/" ++ (show pollId))) $
+        "Back"
+  where renderErrors error = do
+          H.p ! A.class_ "error" $ error
+          H.br
+        renderLn (id, name, desc) = do
+          H.tr $ do
+            H.td $ do
+              H.input ! A.name "option_id" ! A.value (H.stringValue (show id)) !
+                A.type_ "checkbox"
+            H.td $ do
+              H.b $ H.toHtml $ name
+              H.br
+              H.toHtml desc

src/Noodle/Views/Show.hs

@@ -17,20 +17,16 @@ render (pollId, pollName, pollDesc) options voters errors = do
       mapM_ (\x-> do H.toHtml x; H.br) (lines pollDesc)
       H.h4 "Options"
       mapM_ renderErrors errors
-      H.form ! A.method "post" ! A.action "/options/" $ do
-        H.input ! A.class_ "input" ! A.placeholder "add a option" ! A.name "name"
-        H.input ! A.class_ "input" ! A.placeholder "with desctiption" ! A.name "desc"
-        H.input ! A.type_ "hidden" ! A.value (H.stringValue (show pollId)) !
-          A.name "id"
-        H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Add"
       H.form ! A.method "post" !
-        A.action (H.stringValue ("/polls/" ++ (show pollId) ++ "/vote/")) $ do
+        A.action (H.stringValue ("/polls/" ++ (show pollId) ++ "/vote")) $ do
         H.table $ do
           mapM_ (renderLn) (zip options voters)
         H.input ! A.class_ "input" ! A.placeholder "Vote as" ! A.name "name"
         H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Vote"
       H.br
       H.a ! A.class_ "btn" ! A.href "/polls" $ "Back"
+      H.a ! A.class_ "btn" !
+        A.href (H.stringValue ("/polls/" ++ (show pollId) ++ "/edit")) $ "Edit"
   where renderLn ((id, name, desc), (_, voters)) = do
           H.tr $ do
             H.td $ do

src/main.hs

@@ -25,6 +25,7 @@ import Data.Monoid (mconcat)
 import qualified Noodle.Views.Index
 import qualified Noodle.Views.Show
 import qualified Noodle.Views.New
+import qualified Noodle.Views.Edit
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
   Poll
@@ -61,6 +62,14 @@ scottySite = do
       blaze $ Noodle.Views.Index.render $ pollNames $ polls
     S.get "/polls/new" $ do
       blaze $ Noodle.Views.New.render []
+    S.post "/options/delete" $ do
+      id <- S.param "id" :: S.ActionM String
+      all_params <- S.params
+      let choosen_opt_ids = foldl (\ acc (key, value) -> if key == "option_id"
+          then (T.unpack value):acc
+          else acc) [] all_params
+      deleteOptions choosen_opt_ids
+      S.redirect $ T.pack $ "/polls/" ++ id ++ "/edit"
     S.post "/polls/:id/vote" $ do
       id <- S.param "id" :: S.ActionM String
       poll <- liftIO $ getPollById id
@@ -78,6 +87,12 @@ scottySite = do
         otherwise -> do
           voteForOptions name (optionIds options) choosen_opt_ids
           S.redirect $ T.pack $ "/polls/" ++ id
+    S.get "/polls/:id/edit" $ do
+      id <- S.param "id"
+      poll <- liftIO $ getPollById id
+      options <- liftIO $ getOptionsByPollId id
+      blaze $ Noodle.Views.Edit.render
+        (pollValues $ head poll) (optionsValues options) []
     S.get "/polls/:id" $ do
       id <- S.param "id"
       poll <- liftIO $ getPollById id
@@ -85,6 +100,19 @@ scottySite = do
       voters <- liftIO $ getVotersByOptionIds (optionIds options)
       blaze $ Noodle.Views.Show.render (pollValues $ head poll)
         (optionsValues options) (voterValues voters) []
+    S.post "/polls/:id/update" $ do
+      id <- S.param "id"
+      name <- S.param "name"
+      desc <- S.param "desc"
+      poll <- liftIO $ getPollById id
+      options <- liftIO $ getOptionsByPollId id
+      case name of
+        "" -> blaze $ Noodle.Views.Edit.render
+                (pollValues $ head poll) (optionsValues options)
+                [ "Poll needs a name" ]
+        otherwise -> do
+          updatePoll id name desc
+          S.redirect $ T.pack $ "/polls/" ++ id
     S.post "/polls/" $ do
       name <- S.param "name"
       desc <- S.param "desc"
@@ -101,12 +129,11 @@ scottySite = do
       options <- liftIO $ getOptionsByPollId pId
       voters <- liftIO $ getVotersByOptionIds (optionIds options)
       case name of
-        "" -> do blaze $ Noodle.Views.Show.render (pollValues $ head poll)
-                   (optionsValues options) (voterValues voters)
-                   [ "Option needs a name" ]
+        "" -> do blaze $ Noodle.Views.Edit.render (pollValues $ head poll)
+                   (optionsValues options) [ "Option needs a name" ]
         otherwise -> do
           createOption pId name desc
-          S.redirect $ T.pack $ "/polls/" ++ pId
+          S.redirect $ T.pack $ "/polls/" ++ pId ++ "/edit"
 
 initDb = do
   runSqlite "noodle.db" $ do
@@ -117,6 +144,11 @@ createPoll name desc = do
     id <- insert $ Poll name desc
     return id
 
+updatePoll id name desc = do
+  runSqlite "noodle.db" $ do
+    replace pollId $ Poll name desc
+    where pollId = (toSqlKey (read id))
+
 getNewPollId id = unSqlBackendKey $ unPollKey id
 
 allPolls = do
@@ -162,6 +194,14 @@ getVotersByOptionId oId =
   runSqlite "noodle.db" $ do
     selectList [VoteOptionId ==. (toSqlKey oId)] []
 
+deleteOptions ids = do
+  runSqlite "noodle.db" $ do
+    mapM_ (\id -> runSqlite "noodle.db" $ do
+      deleteWhere [VoteOptionId ==. id]
+      deleteWhere [OptionId ==. id]
+      ) choosen_ids
+  where choosen_ids = map (\x -> (toSqlKey (read x))) ids
+
 voteForOptions name opts c_opt_ids = do
   mapM_ (\id -> runSqlite "noodle.db" $ do
     deleteWhere [VoteOptionId ==. (toSqlKey id), VoteVoter ==. name]