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

This commit is contained in:
Filip Gralinski 2017-12-12 09:39:02 +01:00
parent 08b357fb64
commit 14c5c59aaa
2 changed files with 10 additions and 7 deletions

View File

@ -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

View File

@ -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