a user can start working on a task in a different course

Handler/Achievements.hs

@@ -114,8 +114,14 @@ getStartWorkingOnR :: AchievementId -> Handler Html
 getStartWorkingOnR achievementId = do
   (Entity userId user) <- requireAuth
 
+  achievement <- runDB $ get404 achievementId
+  let courseId = achievementCourse achievement
+
   alreadyWorkingOn <- runDB $ selectList [WorkingOnUser ==. userId, WorkingOnFinalSubmission ==. Nothing] []
-  if Import.null alreadyWorkingOn
+  achievementsWorkingOn <- runDB $ mapM (get404 . workingOnAchievement . entityVal) alreadyWorkingOn
+  let achievementsWorkingOnInTheSameCourse = Import.filter (\a -> achievementCourse a == courseId) achievementsWorkingOn
+
+  if Import.null achievementsWorkingOnInTheSameCourse
     then
        do
         es <- runDB $ selectList [WorkingOnAchievement ==. achievementId] []
@@ -123,8 +129,6 @@ getStartWorkingOnR achievementId = do
         users <- runDB $ mapM get404 userIds
         let userEnts = Import.map (\(k,v) -> (Entity k v)) $ Import.zip userIds users
 
-        achievement <- runDB $ get404 achievementId
-
         if determineWhetherCanStartWorkingOn (Just (Entity userId user)) userEnts (achievementMaxWinners achievement)
           then
            do
@@ -135,7 +139,7 @@ getStartWorkingOnR achievementId = do
             setMessage $ toHtml ("Too many people working on the achievement!" :: Text)
     else
        do
-        setMessage $ toHtml ("Already working on another achievement!" :: Text)
+        setMessage $ toHtml ("Already working on another achievement in the same course!" :: Text)
   redirect $ AchievementsR
 
 

stack.yaml

@@ -4,6 +4,5 @@ flags:
     dev: false
 packages:
 - '.'
-- '../geval'
-extra-deps: [markdown-0.1.13.2,geval-0.3.4.0,cond-0.4.1.1,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3,extra-1.4.10]
-resolver: lts-9.5
+extra-deps: [markdown-0.1.13.2,../geval,cond-0.4.1.1,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3,extra-1.4.10]
+resolver: lts-9.14