feat(course-visibility): display icon in course list for lecturers
This commit is contained in:
Sarah Vaupel
parent
cbb8e7217d
commit
17dbccf2a3
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user