forked from filipg/gonito
show extra points
This commit is contained in:
parent
ffd746d51a
commit
9f947e79f9
@ -35,6 +35,12 @@ scoreTable = mempty
|
|||||||
++ Table.linked "submission" (submissionDescription . entityVal . fst . snd) (EditSubmissionR . entityKey . fst . snd)
|
++ Table.linked "submission" (submissionDescription . entityVal . fst . snd) (EditSubmissionR . entityKey . fst . snd)
|
||||||
++ Table.text "status" getStatus
|
++ 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 :: (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
|
||||||
@ -47,25 +53,34 @@ doScore :: Entity User -> Handler Html
|
|||||||
doScore userEnt@(Entity userId user) = do
|
doScore userEnt@(Entity userId user) = do
|
||||||
courses <- runDB $ selectList [CourseClosed ==. False] [Asc CourseName]
|
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
|
defaultLayout $ do
|
||||||
setTitle "Score"
|
setTitle "Score"
|
||||||
$(widgetFile "score")
|
$(widgetFile "score")
|
||||||
|
|
||||||
|
|
||||||
userScoreForCourse :: Entity User -> Entity Course -> Handler (Int, [(AchievementInfo, (Entity Submission, Bool))])
|
userScoreForCourse :: Entity User -> Entity Course -> Handler (Int, [(AchievementInfo, (Entity Submission, Bool))], [ExtraPoints])
|
||||||
userScoreForCourse userEnt courseEnt = do
|
userScoreForCourse userEnt@(Entity userId user) courseEnt@(Entity courseId course) = do
|
||||||
achievementEntries <- userAchievementsForCourse userEnt courseEnt
|
achievementEntries <- userAchievementsForCourse userEnt courseId
|
||||||
|
|
||||||
let achievementTotal = sum $ Import.map getPoints achievementEntries
|
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))]
|
let total = achievementTotal + extraTotal
|
||||||
userAchievementsForCourse (Entity userId user) (Entity courseId course) = do
|
|
||||||
|
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
|
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
|
||||||
|
@ -1,8 +1,12 @@
|
|||||||
<h1>Score for #{formatSubmitter user}
|
<h1>Score for #{formatSubmitter user}
|
||||||
|
|
||||||
$forall ((Entity _ course), (points, entries)) <- courseInfos
|
$forall ((Entity _ course), (points, entries, extras)) <- courseInfos
|
||||||
<h2>#{courseName course}
|
<h2>#{courseName course}
|
||||||
^{Table.buildBootstrap scoreTable entries}
|
^{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>
|
<p class="well">Total <span class="badge">#{points}</span>
|
||||||
<hr>
|
<hr>
|
Loading…
Reference in New Issue
Block a user