diff --git a/Handler/Achievements.hs b/Handler/Achievements.hs
index 87b1ad5..99ab872 100644
--- a/Handler/Achievements.hs
+++ b/Handler/Achievements.hs
@@ -114,9 +114,12 @@ workingOnWidget ainfo = [whamlet|
$if canStartWorkingOn
\ start working
+$if canGiveUpWorkingOn
+ \ give up
|]
where srs = formatSubmitters $ achievementInfoWorkingOn ainfo
canStartWorkingOn = determineWhetherCanStartWorkingOn (achievementInfoCurrentUser ainfo) (achievementInfoWorkingOn ainfo) (achievementInfoMaxWinners ainfo)
+ canGiveUpWorkingOn = determineWhetherCanGiveUpWorkingOn (achievementInfoCurrentUser ainfo) (achievementInfoWorkingOn ainfo)
getStartWorkingOnR :: AchievementId -> Handler Html
getStartWorkingOnR achievementId = do
@@ -147,10 +150,35 @@ getStartWorkingOnR achievementId = do
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 (Just (Entity userId user)) 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 peopleWorkingOn (Just m) = (Import.length peopleWorkingOn) < m
diff --git a/config/routes b/config/routes
index 622df0b..98aa6bd 100644
--- a/config/routes
+++ b/config/routes
@@ -34,6 +34,7 @@
/tags TagsR GET POST
/achievements AchievementsR GET POST
/start-working-on/#AchievementId StartWorkingOnR GET
+/give-up-working-on/#AchievementId GiveUpWorkingOnR GET
/edit-submission/#SubmissionId EditSubmissionR GET POST