yogsototh/noodle
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Splitt edit of name and options

Browse source 
- this makes the button handling easier, the user gets less confussed
- try avoiding the button name back
This commit is contained in:
Konrad Merz 2015-03-30 14:36:26 +02:00
parent 66a902b16b
commit 4290e09861
6 changed files with 56 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
noodle.cabal
View file

@ -19,7 +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
Noodle.Views.Edit, Noodle.Views.EditName
-- other-extensions:
build-depends: base >=4.7 && <4.8, scotty, blaze-html, monads-tf,
persistent, persistent-sqlite, time, transformers,

25
src/Noodle/Views/Edit.hs
View file

@ -13,25 +13,8 @@ render (pollId, pollName, pollDesc) options errors = 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"
H.h3 $ toHtml $ "Edit options of " ++ pollName
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"
@ -45,8 +28,8 @@ render (pollId, pollName, pollDesc) options errors = do
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"
H.a ! A.class_ "btn" ! A.href (H.stringValue ("/polls/" ++ (show pollId))) $
"To poll"
where renderErrors error = do
H.p ! A.class_ "error" $ error
H.br
@ -57,5 +40,5 @@ render (pollId, pollName, pollDesc) options errors = do
A.type_ "checkbox"
H.td $ do
H.b $ H.toHtml $ name
H.br
H.td $ do
H.toHtml desc

38
src/Noodle/Views/EditName.hs Normal file
View file

@ -0,0 +1,38 @@
{-# LANGUAGE OverloadedStrings #-}
module Noodle.Views.EditName 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) 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.a ! A.class_ "btn" ! A.href (H.stringValue ("/polls/" ++ (show pollId))) $
"To poll"
where renderErrors error = do
H.p ! A.class_ "error" $ error
H.br

2
src/Noodle/Views/New.hs
View file

@ -28,8 +28,8 @@ render errors = do
H.td $ do
H.textarea ! A.name "desc" ! A.cols "50" ! A.rows "10" $ ""
H.div ! A.class_ "btns" $ do
H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Add Poll"
H.a ! A.class_ "btn" ! A.href "/polls" $ "Back"
H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Add Poll"
where renderErrors error = do
H.p ! A.class_ "error" $ error
H.br

7
src/Noodle/Views/Show.hs
View file

@ -17,6 +17,8 @@ render (pollId, pollName, pollDesc) options voters cants errors editVoter = do
H.h3 $ toHtml pollName
mapM_ (\x-> do H.toHtml x; H.br) (lines pollDesc)
H.br
H.a ! A.class_ "btn" ! A.href (
H.stringValue ("/polls/" ++ (show pollId) ++ "/edit_name")) $ "Edit"
mapM_ renderErrors errors
H.table $ do
H.tr $ do
@ -35,9 +37,10 @@ render (pollId, pollName, pollDesc) options voters cants errors editVoter = do
mapM_ renderCheckbox options
H.td $ 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 "/polls" $ "To overview"
H.a ! A.class_ "btn" !
A.href (H.stringValue ("/polls/" ++ (show pollId) ++ "/edit")) $ "Edit"
A.href (H.stringValue ("/polls/" ++ (show pollId) ++ "/edit")) $
"Edit Options"
where renderOption (id, name, desc) = do
H.td $ do
H.b $ H.toHtml $ name

11
src/main.hs
View file

@ -27,6 +27,7 @@ import qualified Noodle.Views.Index
import qualified Noodle.Views.Show
import qualified Noodle.Views.New
import qualified Noodle.Views.Edit
import qualified Noodle.Views.EditName
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Poll
@ -94,6 +95,10 @@ scottySite = do
options <- liftIO $ getOptionsByPollId id
blaze $ Noodle.Views.Edit.render
(pollValues $ head poll) (optionsValues options) []
S.get "/polls/:id/edit_name" $ do
id <- S.param "id"
poll <- liftIO $ getPollById id
blaze $ Noodle.Views.EditName.render (pollValues $ head poll) []
S.get "/polls/:id" $ do
id <- S.param "id"
showAction id [] ""
@ -112,10 +117,8 @@ scottySite = do
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)
"" -> blaze $ Noodle.Views.EditName.render (pollValues $ head poll)
[ "Poll needs a name" ]
otherwise -> do
updatePoll id name desc
@ -127,7 +130,7 @@ scottySite = do
"" -> blaze $ Noodle.Views.New.render [ "A Poll needs a name" ]
otherwise -> do
newId <- liftIO $ createPoll name desc
S.redirect $ T.pack $ "/polls/" ++ (show (getNewPollId newId))
S.redirect $ T.pack $ "/polls/" ++ (show (getNewPollId newId)) ++ "/edit"
S.post "/options/" $ do
name <- S.param "name" :: S.ActionM String
desc <- S.param "desc" :: S.ActionM String