achievement can be linked to a course now

This commit is contained in:
Filip Gralinski 2017-09-29 15:53:20 +02:00
parent 0a745175aa
commit f54dd4ec8f
3 changed files with 14 additions and 4 deletions

View File

@ -30,8 +30,8 @@ postAchievementsR = do
mUser <- maybeAuth mUser <- maybeAuth
when (checkIfAdmin mUser) $ do when (checkIfAdmin mUser) $ do
case result of case result of
FormSuccess (name, description, points, deadlineDay, deadlineTime, maxSubmitters, mTags, challengeId) -> do FormSuccess (name, description, points, deadlineDay, deadlineTime, maxSubmitters, mTags, challengeId, courseId) -> do
achievementId <- runDB $ insert $ Achievement name challengeId points description (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) maxSubmitters achievementId <- runDB $ insert $ Achievement name challengeId points description (UTCTime { utctDay = deadlineDay, utctDayTime = timeOfDayToTime deadlineTime }) maxSubmitters (Just courseId)
tids <- runDB $ tagsAsTextToTagIds mTags tids <- runDB $ tagsAsTextToTagIds mTags
@ -159,8 +159,8 @@ formatMaxSubmitters :: Maybe Int -> String
formatMaxSubmitters Nothing = "no limit" formatMaxSubmitters Nothing = "no limit"
formatMaxSubmitters (Just m) = show m formatMaxSubmitters (Just m) = show m
achievementForm :: Form (Text, Maybe Text, Int, Day, TimeOfDay, Maybe Int, Maybe Text, ChallengeId) achievementForm :: Form (Text, Maybe Text, Int, Day, TimeOfDay, Maybe Int, Maybe Text, ChallengeId, CourseId)
achievementForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,,) achievementForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,,,)
<$> areq textField (bfs MsgAchievementName) Nothing <$> areq textField (bfs MsgAchievementName) Nothing
<*> aopt textField (bfs MsgAchievementDescription) Nothing <*> aopt textField (bfs MsgAchievementDescription) Nothing
<*> areq intField (bfs MsgAchievementPoints) Nothing <*> areq intField (bfs MsgAchievementPoints) Nothing
@ -169,9 +169,17 @@ achievementForm = renderBootstrap3 BootstrapBasicForm $ (,,,,,,,)
<*> aopt intField (bfs MsgAchievementMaxWinners) Nothing <*> aopt intField (bfs MsgAchievementMaxWinners) Nothing
<*> aopt textField (tagsfs MsgAchievementTags) Nothing <*> aopt textField (tagsfs MsgAchievementTags) Nothing
<*> challengesSelectFieldList <*> challengesSelectFieldList
<*> coursesSelectFieldList
challengesSelectFieldList = areq (selectField challenges) (bfs MsgChallenge) Nothing challengesSelectFieldList = areq (selectField challenges) (bfs MsgChallenge) Nothing
where where
challenges = do challenges = do
challengeEnts <- runDB $ selectList [] [Asc ChallengeTitle] challengeEnts <- runDB $ selectList [] [Asc ChallengeTitle]
optionsPairs $ Import.map (\ch -> (challengeTitle $ entityVal ch, entityKey ch)) challengeEnts optionsPairs $ Import.map (\ch -> (challengeTitle $ entityVal ch, entityKey ch)) challengeEnts
coursesSelectFieldList = areq (selectField courses) (bfs MsgCourse) Nothing
where
courses = do
courseEnts <- runDB $ selectList [] [Asc CourseName]
optionsPairs $ Import.map (\ch -> (courseName $ entityVal ch, entityKey ch)) courseEnts

View File

@ -91,6 +91,7 @@ Achievement
description Text Maybe description Text Maybe
deadline UTCTime deadline UTCTime
maxWinners Int Maybe maxWinners Int Maybe
coarse CourseId Maybe
UniqueAchievementName name UniqueAchievementName name
AchievementTag AchievementTag
achievement AchievementId achievement AchievementId

View File

@ -49,3 +49,4 @@ YourScore: your score
PasswordForNewAccount: enter a password for your new account PasswordForNewAccount: enter a password for your new account
SubmissionDescriptionTooltip: the first non-empty line of the commit message will be used, if this is left empty SubmissionDescriptionTooltip: the first non-empty line of the commit message will be used, if this is left empty
Challenge: challenge Challenge: challenge
Course: course