diff --git a/Handler/Achievements.hs b/Handler/Achievements.hs index 153906a..ff7c9d9 100644 --- a/Handler/Achievements.hs +++ b/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 diff --git a/stack.yaml b/stack.yaml index daf1215..3a341ec 100644 --- a/stack.yaml +++ b/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