diff --git a/src/Handler/Course/List.hs b/src/Handler/Course/List.hs index 50e6ec153..7b065505b 100644 --- a/src/Handler/Course/List.hs +++ b/src/Handler/Course/List.hs @@ -22,39 +22,39 @@ import qualified Database.Esqueleto.Utils as E -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. -type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation)) +type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation), Bool) 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}|] 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}|] 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}|] 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}|] 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) @@ -115,12 +115,18 @@ makeCourseTable whereClause colChoices psValidator = do E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser E.where_ $ cid E.==. lecturer E.^. LecturerCourse E.&&. lecturer E.^. LecturerType E.==. E.val CourseLecturer return user + isLecturerQuery cid (user `E.InnerJoin` lecturer) = do + E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser + E.where_ $ cid E.==. lecturer E.^. LecturerCourse + E.&&. E.just (user E.^. UserId) E.==. E.val muid + return user dbtProj :: DBRow _ -> DB CourseTableData dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do lecturerList <- E.select $ E.from $ lecturerQuery $ E.val $ entityKey course courseAlloc <- getBy (UniqueAllocationCourse $ entityKey course) >>= traverse (getJustEntity . allocationCourseAllocation . entityVal) - return (course, participants, registered, school, lecturerList, courseAlloc) + isLecturerList <- E.select $ E.from $ isLecturerQuery $ E.val $ entityKey course + return (course, participants, registered, school, lecturerList, courseAlloc, not $ null isLecturerList) snd <$> dbTable psValidator DBTable { dbtSQLQuery , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId @@ -209,8 +215,13 @@ makeCourseTable whereClause colChoices psValidator = do ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout - , dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) (_dbrOutput . _6 . _Just) - -- ^ course ^ lecturer list ^ isRegistered ^ school ^ allocation + , dbsTemplate = DBSTCourse + (_dbrOutput . _1) -- course + (_dbrOutput . _5) -- lecturer list + (_dbrOutput . _3) -- isRegistered + (_dbrOutput . _4) -- school + (_dbrOutput . _6 . _Just) -- allocation + (_dbrOutput . _7) -- isLecturer } , dbtParams = def , dbtIdent = "courses" :: Text diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 9a22aab88..e9ca08981 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -529,7 +529,7 @@ data DBStyle r = DBStyle } data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNumber :: Int64 -> Bool } - | DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) (Traversal' r (Entity Allocation)) + | DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) (Traversal' r (Entity Allocation)) (Lens' r Bool) instance Default (DBStyle r) where def = DBStyle @@ -1323,13 +1323,17 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db DBSTDefault{} -> return $(widgetFile "table/cell/header") in do wHeaders <- maybe (return Nothing) (fmap Just . genHeaders (dbtColonnade ^. _Cornice)) pSortable + now <- liftIO getCurrentTime case dbsTemplate of - DBSTCourse c l r s a -> do + DBSTCourse c l r s a l' -> do wRows <- forM rows $ \row' -> let Course{..} = row' ^. c . _entityVal lecturerUsers = row' ^. l courseLecturers = userSurname . entityVal <$> lecturerUsers isRegistered = row' ^. r + isLecturer = row' ^. l' + nmnow = NTop $ Just now + courseIsVisible = NTop courseVisibleFrom <= nmnow && nmnow <= NTop courseVisibleTo courseSchoolName = schoolName $ row' ^. s . _entityVal courseSemester = (termToText . unTermKey) courseTerm courseAllocation = row' ^? a diff --git a/templates/table/course/course-teaser.hamlet b/templates/table/course/course-teaser.hamlet index 72e49742e..5db2cf4b0 100644 --- a/templates/table/course/course-teaser.hamlet +++ b/templates/table/course/course-teaser.hamlet @@ -9,6 +9,8 @@