s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

give up option for achievements

Browse Source
This commit is contained in:
Filip Gralinski 2017-04-03 11:27:08 +02:00
parent 123cc2ba1a
commit d63223837e
2 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Handler/Achievements.hs
View File

@ -114,9 +114,12 @@ workingOnWidget ainfo = [whamlet|
$if canStartWorkingOn $if canStartWorkingOn
\ <a href=@{StartWorkingOnR (achievementInfoId ainfo)}>start working</a> \ <a href=@{StartWorkingOnR (achievementInfoId ainfo)}>start working</a>
$if canGiveUpWorkingOn
\ <a href=@{GiveUpWorkingOnR (achievementInfoId ainfo)}>give up</a>
|] |]
where srs = formatSubmitters $ achievementInfoWorkingOn ainfo where srs = formatSubmitters $ achievementInfoWorkingOn ainfo
canStartWorkingOn = determineWhetherCanStartWorkingOn (achievementInfoCurrentUser ainfo) (achievementInfoWorkingOn ainfo) (achievementInfoMaxWinners ainfo) canStartWorkingOn = determineWhetherCanStartWorkingOn (achievementInfoCurrentUser ainfo) (achievementInfoWorkingOn ainfo) (achievementInfoMaxWinners ainfo)
canGiveUpWorkingOn = determineWhetherCanGiveUpWorkingOn (achievementInfoCurrentUser ainfo) (achievementInfoWorkingOn ainfo)
getStartWorkingOnR :: AchievementId -> Handler Html getStartWorkingOnR :: AchievementId -> Handler Html
getStartWorkingOnR achievementId = do getStartWorkingOnR achievementId = do
@ -147,10 +150,35 @@ getStartWorkingOnR achievementId = do
redirect $ AchievementsR redirect $ AchievementsR
getGiveUpWorkingOnR :: AchievementId -> Handler Html
getGiveUpWorkingOnR achievementId = do
(Entity userId user) <- requireAuth
alreadyWorkingOn <- runDB $ selectList [WorkingOnUser ==. userId,
WorkingOnAchievement ==. achievementId,
WorkingOnFinalSubmission ==. Nothing] []
if not (Import.null alreadyWorkingOn)
then
do
runDB $ deleteWhere [WorkingOnUser ==. userId,
WorkingOnAchievement ==. achievementId,
WorkingOnFinalSubmission ==. Nothing]
setMessage $ toHtml ("OK, you can take another achievement now!" :: Text)
else
do
setMessage $ toHtml ("Not working on this achievement!" :: Text)
redirect $ AchievementsR
determineWhetherCanStartWorkingOn Nothing _ _ = False determineWhetherCanStartWorkingOn Nothing _ _ = False
determineWhetherCanStartWorkingOn (Just (Entity userId user)) peopleWorkingOn maxWinners = determineWhetherCanStartWorkingOn (Just (Entity userId user)) peopleWorkingOn maxWinners =
(Import.all (\e -> (userId /= entityKey e)) peopleWorkingOn) && (checkLimit peopleWorkingOn maxWinners) (Import.all (\e -> (userId /= entityKey e)) peopleWorkingOn) && (checkLimit peopleWorkingOn maxWinners)
determineWhetherCanGiveUpWorkingOn Nothing _ = False
determineWhetherCanGiveUpWorkingOn (Just (Entity userId user)) peopleWorkingOn =
(Import.any (\e -> (userId == entityKey e)) peopleWorkingOn)
checkLimit _ Nothing = True checkLimit _ Nothing = True
checkLimit peopleWorkingOn (Just m) = (Import.length peopleWorkingOn) < m checkLimit peopleWorkingOn (Just m) = (Import.length peopleWorkingOn) < m

1
config/routes
View File

@ -34,6 +34,7 @@
/tags TagsR GET POST /tags TagsR GET POST
/achievements AchievementsR GET POST /achievements AchievementsR GET POST
/start-working-on/#AchievementId StartWorkingOnR GET /start-working-on/#AchievementId StartWorkingOnR GET
/give-up-working-on/#AchievementId GiveUpWorkingOnR GET
/edit-submission/#SubmissionId EditSubmissionR GET POST /edit-submission/#SubmissionId EditSubmissionR GET POST