fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(course-visibility): (more) correct visibility check for favourites

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-28 12:37:07 +02:00
parent d86fed7a32
commit 796a8066aa
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Foundation.hs
View File

@ -1984,7 +1984,7 @@ siteLayout' headingOverride widget = do
(favourites', maxFavouriteTerms, currentTheme) <- do
muid <- maybeAuthPair
favCourses <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
favCourses'' <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid)
@ -2023,14 +2023,16 @@ siteLayout' headingOverride widget = do
E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
E.where_ $ (E.isJust (course E.^. CourseVisibleFrom)
E.&&. course E.^. CourseVisibleFrom E.<=. E.val (Just now)
E.&&. (E.isNothing (course E.^. CourseVisibleTo)
E.||. E.val (Just now) E.<=. course E.^. CourseVisibleTo
)
) E.||. isAssociated
return (course, reason, isAssociated)
return (course, reason, isLecturer)
favCourses' <- forM favCourses'' $ \(course@(Entity _ Course{..}), reason, isAssociated) -> do
mayEditCourse <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
return (course, reason, isAssociated, mayEditCourse)
-- remove invisible courses
let favCourses = favCourses'
& filter (\(Entity _ Course{..}, _, E.Value isAssociated, mayEditCourse) -> mayEditCourse || isAssociated || NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo)
& map (\(course, reason, _, mayEditCourse) -> (course, reason, mayEditCourse))
return ( favCourses
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
@ -2040,7 +2042,7 @@ siteLayout' headingOverride widget = do
let favouriteTerms :: [TermIdentifier]
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites'
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, E.Value isLecturer)
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, mayEditCourse)
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
@ -2062,7 +2064,7 @@ siteLayout' headingOverride widget = do
$logDebugS "FavouriteQuickActions" $ tshow cK <> " Done."
return items
$logDebugS "FavouriteQuickActions" $ tshow cK <> " returning " <> tshow (is _Just items)
return (c, courseRoute, items, favouriteReason, isLecturer)
return (c, courseRoute, items, favouriteReason, mayEditCourse)
nav'' <- mconcat <$> sequence
[ defaultLinks

4
templates/widgets/asidenav/asidenav.hamlet
View File

@ -21,13 +21,13 @@ $newline never
<h3 .asidenav__box-subtitle>
_{favReason}
<ul .asidenav__list.list--iconless>
$forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, isLecturer) <- favouriteTermReason tid favReason
$forall (course@Course{courseShorthand, courseName}, courseRoute, mPageActions, _, mayEditCourse) <- favouriteTermReason tid favReason
<li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
<a .asidenav__link-wrapper href=@{courseRoute}>
<div .asidenav__link-shorthand>#{courseShorthand}
<div .asidenav__link-label>
#{courseName}
$if not (courseIsVisible course) && isLecturer
$if not (courseIsVisible course) && mayEditCourse
\ #{iconInvisible}
<div .asidenav__nested-list-wrapper>
$maybe pageActions <- mPageActions