From e589996530115b59122d628299154fde37ea5526 Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Sat, 15 Jun 2019 12:21:41 +0200 Subject: [PATCH] Add course summaries --- Handler/Score.hs | 28 ++++++++++++++++++++++++++++ config/models | 4 ++++ config/routes | 1 + messages/en.msg | 1 + templates/course-summary.hamlet | 6 ++++++ templates/courses-i-teach.hamlet | 3 +++ templates/default-layout.hamlet | 1 + templates/score-for-course.hamlet | 8 ++++++++ templates/score.hamlet | 8 +------- 9 files changed, 53 insertions(+), 7 deletions(-) create mode 100644 templates/course-summary.hamlet create mode 100644 templates/courses-i-teach.hamlet create mode 100644 templates/score-for-course.hamlet diff --git a/Handler/Score.hs b/Handler/Score.hs index d1a6734..7fca32c 100644 --- a/Handler/Score.hs +++ b/Handler/Score.hs @@ -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") diff --git a/config/models b/config/models index 71d52d9..42fead0 100644 --- a/config/models +++ b/config/models @@ -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 diff --git a/config/routes b/config/routes index f67f04a..b222948 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/messages/en.msg b/messages/en.msg index 1b7bff0..391f943 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -77,3 +77,4 @@ Test: test Dashboard: dashboard TargetName: target name ShowArchivedChallenges: show archived challenges +CoursesITeach: courses I teach diff --git a/templates/course-summary.hamlet b/templates/course-summary.hamlet new file mode 100644 index 0000000..c1c1b5d --- /dev/null +++ b/templates/course-summary.hamlet @@ -0,0 +1,6 @@ +

#{courseName course} + +$forall (student, score) <- Import.zip students scores +

#{userIdent $ entityVal student} / #{fromMaybe "" (userName $ entityVal student)} / #{fromMaybe "" (userLocalId $ entityVal student)} + + ^{scoreForCourse score} diff --git a/templates/courses-i-teach.hamlet b/templates/courses-i-teach.hamlet new file mode 100644 index 0000000..9d809cd --- /dev/null +++ b/templates/courses-i-teach.hamlet @@ -0,0 +1,3 @@ + +$forall (Entity courseId course) <- entCourses + ^{courseSummary (Entity courseId course)} diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 4d09fa4..f39ad09 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -27,6 +27,7 @@
  • _{MsgCreateChallenge}
  • _{MsgCreateResetLink}
  • _{MsgAddExtraPoints} +
  • _{MsgCoursesITeach}
  • _{MsgShowArchivedChallenges}
      diff --git a/templates/score-for-course.hamlet b/templates/score-for-course.hamlet new file mode 100644 index 0000000..bf6d64b --- /dev/null +++ b/templates/score-for-course.hamlet @@ -0,0 +1,8 @@ +^{Table.buildBootstrap scoreTable entries} + +$if not $ Import.null extras +

      Extra points + ^{Table.buildBootstrap extrasTable extras} + +

      Total #{points} +

      diff --git a/templates/score.hamlet b/templates/score.hamlet index ca2fd04..f26a079 100644 --- a/templates/score.hamlet +++ b/templates/score.hamlet @@ -2,11 +2,5 @@ $forall ((Entity _ course), (points, entries, extras)) <- courseInfos

      #{courseName course} - ^{Table.buildBootstrap scoreTable entries} - $if not $ Import.null extras -

      Extra points - ^{Table.buildBootstrap extrasTable extras} - -

      Total #{points} -

      \ No newline at end of file + ^{scoreForCourse (points, entries, extras)}