Add course summaries

This commit is contained in:
Filip Gralinski 2019-06-15 12:21:41 +02:00
parent f58121b407
commit e589996530
9 changed files with 53 additions and 7 deletions

View File

@ -61,6 +61,7 @@ doScore userEnt@(Entity userId user) = do
setTitle "Score"
$(widgetFile "score")
scoreForCourse (points, entries, extras) = $(widgetFile "score-for-course")
userScoreForCourse :: Entity User -> Entity Course -> Handler (Int, [(AchievementInfo, (Entity Submission, Bool))], [ExtraPoints])
userScoreForCourse userEnt@(Entity userId user) courseEnt@(Entity courseId course) = do
@ -111,3 +112,30 @@ checkSubmissionTag (Entity submissionId _) (Entity tagId _) = do
Just b -> b
Nothing -> False
Nothing -> False
courseSummary :: Entity Course -> Widget
courseSummary entCourse@(Entity courseId course) = do
students <- handlerToWidget $
runDB $ E.select
$ E.from $ \(participant, user) -> do
E.where_ (participant ^. ParticipantCourse E.==. E.val courseId
E.&&. participant ^. ParticipantUser E.==. user ^. UserId)
E.orderBy [E.asc (user ^. UserIdent)]
return user
scores <- mapM (handlerToWidget . ((flip userScoreForCourse) entCourse)) students
$(widgetFile "course-summary")
getCoursesITeachR :: Handler Html
getCoursesITeachR = do
(Entity userId _) <- requireAuth
teacherCourses <- runDB $ selectList [TeacherUser ==. userId] []
let coursesIds = Import.map (teacherCourse . entityVal) teacherCourses
courses <- runDB $ mapM get404 coursesIds
let entCourses' = Import.map (\(k, v) -> Entity k v) $ Import.zip coursesIds courses
let entCourses = sortBy (\e1 e2 -> (courseName $ entityVal e1) `compare` (courseName $ entityVal e2)) entCourses'
defaultLayout $ do
setTitle "Courses I teach"
$(widgetFile "courses-i-teach")

View File

@ -152,6 +152,10 @@ Participant
user UserId
course CourseId
UniqueUserCourse user course
Teacher
user UserId
course CourseId
UniqueTeacherCourse user course
-- for "KPI" dashboard
Indicator
test TestId

View File

@ -57,6 +57,7 @@
/score/#UserId ScoreR GET
/my-score MyScoreR GET
/courses-i-teach CoursesITeachR GET
/dashboard DashboardR GET POST
/edit-indicator/#IndicatorId EditIndicatorR GET POST

View File

@ -77,3 +77,4 @@ Test: test
Dashboard: dashboard
TargetName: target name
ShowArchivedChallenges: show archived challenges
CoursesITeach: courses I teach

View File

@ -0,0 +1,6 @@
<h2>#{courseName course}
$forall (student, score) <- Import.zip students scores
<h3>#{userIdent $ entityVal student} / #{fromMaybe "" (userName $ entityVal student)} / #{fromMaybe "" (userLocalId $ entityVal student)}
^{scoreForCourse score}

View File

@ -0,0 +1,3 @@
$forall (Entity courseId course) <- entCourses
^{courseSummary (Entity courseId course)}

View File

@ -27,6 +27,7 @@
<li><a href="@{CreateChallengeR}">_{MsgCreateChallenge}</a>
<li><a href="@{CreateResetLinkR}">_{MsgCreateResetLink}</a>
<li><a href="@{ExtraPointsR}">_{MsgAddExtraPoints}</a>
<li><a href="@{CoursesITeachR}">_{MsgCoursesITeach}</a>
<li><a href="@{ListArchivedChallengesR}">_{MsgShowArchivedChallenges}</a>
<ul class="nav navbar-nav navbar-collapse collapse navbar-right">

View File

@ -0,0 +1,8 @@
^{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>

View File

@ -2,11 +2,5 @@
$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>
^{scoreForCourse (points, entries, extras)}