organize score per course

This commit is contained in:
Filip Gralinski 2018-01-02 19:34:23 +01:00
parent f3b6f4b050
commit 0243665bb0
2 changed files with 35 additions and 6 deletions

View File

@ -39,21 +39,45 @@ getStatus :: (AchievementInfo, (Entity Submission, Bool)) -> Text
getStatus (_, (_, False)) = "" getStatus (_, (_, False)) = ""
getStatus (aInfo, (_, True)) = T.pack $ show $ achievementInfoPoints aInfo getStatus (aInfo, (_, True)) = T.pack $ show $ achievementInfoPoints aInfo
getPoints :: (AchievementInfo, (Entity Submission, Bool)) -> Int
getPoints (_, (_, False)) = 0
getPoints (aInfo, (_, True)) = achievementInfoPoints aInfo
doScore :: Entity User -> Handler Html doScore :: Entity User -> Handler Html
doScore (Entity userId user) = do doScore userEnt@(Entity userId user) = do
courses <- runDB $ selectList [CourseClosed ==. False] [Asc CourseName]
courseAchievementInfos <- mapM (userScoreForCourse userEnt) courses
let courseInfos = Import.filter (\(_, (points, _)) -> points > 0) $ Import.zip courses courseAchievementInfos
defaultLayout $ do
setTitle "Score"
$(widgetFile "score")
userScoreForCourse :: Entity User -> Entity Course -> Handler (Int, [(AchievementInfo, (Entity Submission, Bool))])
userScoreForCourse userEnt courseEnt = do
achievementEntries <- userAchievementsForCourse userEnt courseEnt
let achievementTotal = sum $ Import.map getPoints achievementEntries
return (achievementTotal, achievementEntries)
userAchievementsForCourse :: Entity User -> Entity Course -> Handler [(AchievementInfo, (Entity Submission, Bool))]
userAchievementsForCourse (Entity userId user) (Entity courseId course) = do
entries <- runDB $ E.select entries <- runDB $ E.select
$ E.from $ \(working_on, achievement, submission) -> do $ E.from $ \(working_on, achievement, submission) -> do
E.where_ (working_on ^. WorkingOnAchievement E.==. achievement ^. AchievementId E.where_ (working_on ^. WorkingOnAchievement E.==. achievement ^. AchievementId
E.&&. E.just (submission ^. SubmissionId) E.==. working_on ^. WorkingOnFinalSubmission E.&&. E.just (submission ^. SubmissionId) E.==. working_on ^. WorkingOnFinalSubmission
E.&&. working_on ^. WorkingOnUser E.==. E.val userId) E.&&. working_on ^. WorkingOnUser E.==. E.val userId
E.&&. achievement ^. AchievementCourse E.==. E.val courseId)
E.orderBy [E.asc (submission ^. SubmissionStamp)] E.orderBy [E.asc (submission ^. SubmissionStamp)]
return (achievement, submission) return (achievement, submission)
entries' <- mapM (processEntry (Entity userId user)) entries entries' <- mapM (processEntry (Entity userId user)) entries
defaultLayout $ do return entries'
setTitle "Score"
$(widgetFile "score")
processEntry :: Entity User -> (Entity Achievement, Entity Submission) -> Handler (AchievementInfo, (Entity Submission, Bool)) processEntry :: Entity User -> (Entity Achievement, Entity Submission) -> Handler (AchievementInfo, (Entity Submission, Bool))
processEntry entUser (entAchievement, entSubmission) = do processEntry entUser (entAchievement, entSubmission) = do

View File

@ -1,3 +1,8 @@
<h1>Score for #{formatSubmitter user} <h1>Score for #{formatSubmitter user}
^{Table.buildBootstrap scoreTable entries'} $forall ((Entity _ course), (points, entries)) <- courseInfos
<h2>#{courseName course}
^{Table.buildBootstrap scoreTable entries}
<p class="well">Total <span class="badge">#{points}</span>
<hr>