s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

show extra points

Browse Source
This commit is contained in:
Filip Gralinski 2018-01-02 20:37:11 +01:00
parent ffd746d51a
commit 9f947e79f9
2 changed files with 29 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Handler/Score.hs
View File

@ -35,6 +35,12 @@ scoreTable = mempty
++ Table.linked "submission" (submissionDescription . entityVal . fst . snd) (EditSubmissionR . entityKey . fst . snd)
++ Table.text "status" getStatus
extrasTable :: Table.Table App ExtraPoints
extrasTable = mempty
++ Table.text "reason" extraPointsDescription
++ timestampCell "added" extraPointsPosted
++ Table.int "points" extraPointsPoints
getStatus :: (AchievementInfo, (Entity Submission, Bool)) -> Text
getStatus (_, (_, False)) = ""
getStatus (aInfo, (_, True)) = T.pack $ show $ achievementInfoPoints aInfo
@ -47,25 +53,34 @@ doScore :: Entity User -> Handler Html
doScore userEnt@(Entity userId user) = do
courses <- runDB $ selectList [CourseClosed ==. False] [Asc CourseName]
courseAchievementInfos <- mapM (userScoreForCourse userEnt) courses
courseUserInfos <- mapM (userScoreForCourse userEnt) courses
let courseInfos = Import.filter (\(_, (points, _)) -> points > 0) $ Import.zip courses courseAchievementInfos
let courseInfos = Import.filter (\(_, (points, _, _)) -> points > 0) $ Import.zip courses courseUserInfos
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
userScoreForCourse :: Entity User -> Entity Course -> Handler (Int, [(AchievementInfo, (Entity Submission, Bool))], [ExtraPoints])
userScoreForCourse userEnt@(Entity userId user) courseEnt@(Entity courseId course) = do
achievementEntries <- userAchievementsForCourse userEnt courseId
let achievementTotal = sum $ Import.map getPoints achievementEntries
return (achievementTotal, achievementEntries)
extraEntries <- userExtraPointsForCourse userId courseId
let extraTotal = sum $ Import.map extraPointsPoints extraEntries
userAchievementsForCourse :: Entity User -> Entity Course -> Handler [(AchievementInfo, (Entity Submission, Bool))]
userAchievementsForCourse (Entity userId user) (Entity courseId course) = do
let total = achievementTotal + extraTotal
return (total, achievementEntries, extraEntries)
userExtraPointsForCourse :: UserId -> CourseId -> Handler [ExtraPoints]
userExtraPointsForCourse userId courseId = do
entries <- runDB $ selectList [ExtraPointsUser ==. userId, ExtraPointsCourse ==. courseId] [Asc ExtraPointsPosted]
return $ Import.map entityVal entries
userAchievementsForCourse :: Entity User -> CourseId -> Handler [(AchievementInfo, (Entity Submission, Bool))]
userAchievementsForCourse (Entity userId user) courseId = do
entries <- runDB $ E.select
$ E.from $ \(working_on, achievement, submission) -> do
E.where_ (working_on ^. WorkingOnAchievement E.==. achievement ^. AchievementId

6
templates/score.hamlet
View File

@ -1,8 +1,12 @@
<h1>Score for #{formatSubmitter user}
$forall ((Entity _ course), (points, entries)) <- courseInfos
$forall ((Entity _ course), (points, entries, extras)) <- courseInfos
<h2>#{courseName course}
^{Table.buildBootstrap scoreTable entries}
$if not $ Import.null extras
<h4>Extra points
^{Table.buildBootstrap extrasTable extras}
<p class="well">Total <span class="badge">#{points}</span>
<hr>