From d63223837e8cb749f1b8f7ed8b5a2b3b38289e30 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Mon, 3 Apr 2017 11:27:08 +0200
Subject: [PATCH] give up option for achievements

---
 Handler/Achievements.hs | 28 ++++++++++++++++++++++++++++
 config/routes           |  1 +
 2 files changed, 29 insertions(+)

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
    \ <a href=@{StartWorkingOnR (achievementInfoId ainfo)}>start working</a>
+$if canGiveUpWorkingOn
+   \ <a href=@{GiveUpWorkingOnR (achievementInfoId ainfo)}>give up</a>
 |]
   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