diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index f09295bb2..4cc182a1c 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -48,11 +48,11 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault) -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. -type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School) +type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User]) colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseName}|] @@ -63,14 +63,14 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse) colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colDescription = sortable Nothing mempty - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> case courseDescription of Nothing -> mempty (Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr) colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseShorthand}|] -- colCShortDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) @@ -89,39 +89,39 @@ colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) colTerm :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colTerm = sortable (Just "term") (i18nCell MsgTerm) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|] colSchool :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _) } -> anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolName}|] colSchoolShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _) } -> anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|] colRegFrom :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> maybe mempty dateTimeCell courseRegisterFrom -- cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget colRegTo :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> maybe mempty dateTimeCell courseRegisterTo colMembers :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colMembers = sortable (Just "members") (i18nCell MsgCourseMembers) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, currentParticipants, _, _) } -> i18nCell $ case courseCapacity of + $ \DBRow{ dbrOutput=(Entity _ Course{..}, currentParticipants, _, _, _) } -> i18nCell $ case courseCapacity of Nothing -> MsgCourseMembersCount currentParticipants Just limit -> MsgCourseMembersCountLimited currentParticipants limit colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colRegistered = sortable (Just "registered") (i18nCell MsgRegistered) - $ \DBRow{ dbrOutput=(_, _, registered, _) } -> tickmarkCell registered + $ \DBRow{ dbrOutput=(_, _, registered, _, _) } -> tickmarkCell registered type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School) @@ -146,8 +146,14 @@ makeCourseTable whereClause colChoices psValidator = do let registered = course2Registered muid qin E.where_ $ whereClause (course, participants, registered) return (course, participants, registered, school) + lecturerQuery cid (user `E.InnerJoin` lecturer) = do + E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser + E.where_ $ E.val cid E.==. lecturer E.^. LecturerCourse + return user dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData - dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school) + dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do + lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ entityKey course + return (course, participants, registered, school, lecturerList) snd <$> dbTable psValidator DBTable { dbtSQLQuery , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId @@ -205,8 +211,8 @@ makeCourseTable whereClause colChoices psValidator = do ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout - -- DBSTCourse :: Lens' r (Entity Course) -> Traversal' r (Entity User) -> Lens' r Bool -> DBSTemplateMode r - , dbsCellTemplate = DBSTCourse (_dbrOutput . _1) ignored (_dbrOutput . _3) + -- DBSTCourse :: Lens' r (Entity Course) -> Traversal' r ([Entity User]) -> Lens' r Bool -> DBSTemplateMode r + , dbsCellTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) -- ^ course lens ^ lecturers traversal ^ isRegistered lens } , dbtParams = def diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index aeb94f621..8bc074b2e 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -391,7 +391,7 @@ data DBStyle r = DBStyle , dbsCellTemplate :: DBSTemplateMode r } -data DBSTemplateMode r = DBSTDefault | DBSTCourse (Lens' r (Entity Course)) (Traversal' r (Entity User)) (Lens' r Bool) +data DBSTemplateMode r = DBSTDefault | DBSTCourse (Lens' r (Entity Course)) (Traversal' r [Entity User]) (Lens' r Bool) instance Default (DBStyle r) where def = DBStyle @@ -853,7 +853,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db wRows <- forM (zip [0..length rows] rows) $ \(cid, row') -> let Course{..} = row' ^. c . _entityVal - lecturerUsers = toListOf l row' + lecturerUsers = row' ^. l courseLecturers = userSurname . entityVal <$> lecturerUsers isRegistered = row' ^. r courseSchoolName = unSchoolKey courseSchool diff --git a/templates/table/course/course-teaser.hamlet b/templates/table/course/course-teaser.hamlet index 6a48d3192..f513a4367 100644 --- a/templates/table/course/course-teaser.hamlet +++ b/templates/table/course/course-teaser.hamlet @@ -1,4 +1,4 @@ -