feat(course-visibility): display icon in course list for lecturers

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)
+      , dbsTemplate = DBSTCourse
-      --                             ^ course          ^ lecturer list   ^ isRegistered    ^ school        ^ allocation
+                        (_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

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

templates/table/course/course-teaser.hamlet

@@ -9,6 +9,8 @@
   <div .course-teaser__title>
     <a href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
       _{courseName}
+      $if not courseIsVisible && isLecturer
+        \ #{iconInvisible}
   $if isRegistered
     <div .course-teaser__registration>
       <span>_{MsgRegistered}