Skip to content
Browse files

Poll closing

  • Loading branch information...
1 parent 8ef797e commit aec5265a33064430120902ca869014e013ac6b5c @snoyberg committed
Showing with 61 additions and 30 deletions.
  1. +21 −3 Handler/Poll.hs
  2. +1 −0 Haskellers.hs
  3. +1 −0 entities
  4. +37 −27 hamlet/poll.hamlet
  5. +1 −0 routes
View
24 Handler/Poll.hs
@@ -5,12 +5,14 @@ module Handler.Poll
, postPollsR
, getPollR
, postPollR
+ , postPollCloseR
) where
import Haskellers
-import Control.Monad (unless)
+import Control.Monad (unless, when)
import qualified Data.Text as T
import Data.Time (getCurrentTime)
+import Data.Maybe (isJust)
getPollsR :: Handler RepHtml
getPollsR = do
@@ -29,7 +31,7 @@ postPollsR = do
let (q:as) = ls
now <- liftIO getCurrentTime
pollid <- runDB $ do
- pollid <- insert $ Poll q now
+ pollid <- insert $ Poll q now False
mapM_ (\(a, i) -> insert $ PollOption pollid a i) $ zip as [1..]
return pollid
setMessage "Poll created"
@@ -57,7 +59,9 @@ toOI (poid, po) = do
getPollR :: PollId -> Handler RepHtml
getPollR pollid = do
- muid <- maybeAuthId
+ mu' <- maybeAuth
+ let muid = fmap fst mu'
+ let mu = fmap snd mu'
(poll, ois, options, manswer) <- runDB $ do
poll <- get404 pollid
options <- selectList [PollOptionPoll ==. pollid] [Asc PollOptionPriority]
@@ -73,11 +77,15 @@ getPollR pollid = do
po <- get404 $ pollAnswerOption pa
return $ Just $ pollOptionAnswer po
return (poll, ois, options, manswer)
+ let isAdmin = fmap userAdmin mu == Just True
+ showResults = pollClosed poll || isJust manswer
defaultLayout $(widgetFile "poll")
postPollR :: PollId -> Handler RepHtml
postPollR pollid = do
(uid, u) <- requireAuth
+ poll <- runDB $ get404 pollid
+ when (pollClosed poll) $ permissionDenied "Poll has already been closed"
oidText <- runInputPost $ ireq textField "option"
oid <-
case fromSinglePiece oidText of
@@ -88,3 +96,13 @@ postPollR pollid = do
res <- runDB $ insertBy $ PollAnswer pollid oid uid (userReal u)
setMessage $ either (const "You already voted") (const "Vote cast") res
redirect RedirectTemporary $ PollR pollid
+
+postPollCloseR :: PollId -> Handler ()
+postPollCloseR pollid = do
+ (_, u) <- requireAuth
+ unless (userAdmin u) $ permissionDenied "Must be an admin to close a poll"
+ runDB $ do
+ _ <- get404 pollid
+ update pollid [PollClosed =. True]
+ setMessage "Poll closed"
+ redirect RedirectTemporary $ PollR pollid
View
1 Haskellers.hs
@@ -376,6 +376,7 @@ instance YesodBreadcrumbs Haskellers where
breadcrumb DeleteTeamPackageR{} = return ("", Nothing)
breadcrumb TopicMessageR{} = return ("", Nothing)
breadcrumb LangR{} = return ("", Nothing)
+ breadcrumb PollCloseR{} = return ("", Nothing)
-- How to run database actions.
instance YesodPersist Haskellers where
View
1 entities
@@ -99,6 +99,7 @@ TopicMessage
Poll
question Text
created UTCTime
+ closed Bool default=false
PollOption
poll PollId
answer Text
View
64 hamlet/poll.hamlet
@@ -1,30 +1,40 @@
<h1>#{pollQuestion poll}
-$maybe _ <- muid
- $maybe answer <- manswer
- <p>You answered: #{answer}
- $nothing
- <form method=post>
- $forall option <- options
- $with oid <- fst option, o <- snd option
- <div>
- <input type=radio name=option id=#{toSinglePiece oid} value=#{toSinglePiece oid}>
- \ #
- <label for=#{toSinglePiece oid}>#{pollOptionAnswer o}
- <input type=submit value=Vote>
+$maybe answer <- manswer
+ <p>You answered: #{answer}
$nothing
- <p>You must be logged in to submit an answer.
+ $if pollClosed poll
+ <p>Poll has been closed.
+ $else
+ $maybe _ <- muid
+ <form method=post>
+ $forall option <- options
+ $with oid <- fst option, o <- snd option
+ <div>
+ <input type=radio name=option id=#{toSinglePiece oid} value=#{toSinglePiece oid}>
+ \ #
+ <label for=#{toSinglePiece oid}>#{pollOptionAnswer o}
+ <input type=submit value=Vote>
+ $nothing
+ <p>You must be logged in to submit an answer.
<h2>Results
-<ul>
- $forall oi <- ois
- <li>
- <span .answer>#{oiAnswer oi}
- \ #
- <span .all>
- #{show $ oiCount oi} votes #
- $maybe p <- oiPercent False oi ois
- (#{show p}%)
- \, #
- <span .real>
- #{show $ oiRealCount oi} verified votes #
- $maybe p <- oiPercent True oi ois
- (#{show p}%)
+$if showResults
+ <ul>
+ $forall oi <- ois
+ <li>
+ <span .answer>#{oiAnswer oi}
+ \ #
+ <span .all>
+ #{show $ oiCount oi} votes #
+ $maybe p <- oiPercent False oi ois
+ (#{show p}%)
+ \, #
+ <span .real>
+ #{show $ oiRealCount oi} verified votes #
+ $maybe p <- oiPercent True oi ois
+ (#{show p}%)
+$else
+ <p>Poll is still open, and you have not provided an answer.
+$if isAdmin
+ $if not $ pollClosed poll
+ <form method=post action=@{PollCloseR pollid}>
+ <input type=submit value="Close Poll">
View
1 routes
@@ -88,3 +88,4 @@
/poll PollsR GET POST
/poll/#PollId PollR GET POST
+/poll/#PollId/close PollCloseR POST

0 comments on commit aec5265

Please sign in to comment.
Something went wrong with that request. Please try again.