fix(course-visibility): fix favourites

This commit is contained in:
Sarah Vaupel 2020-08-05 22:53:32 +02:00
parent 7569195c8b
commit 1ac3c08d01
2 changed files with 11 additions and 10 deletions

View File

@ -2039,10 +2039,11 @@ siteLayout' headingOverride widget = do
return (course, reason, courseVisible)
favCourses' <- forM favCourses'' $ \(course@(Entity _ Course{..}), reason, E.Value courseVisible) -> do
mayView <- hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CShowR
mayEdit <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
return (course, reason, courseVisible, mayEdit)
return (course, reason, courseVisible, mayView, mayEdit)
let favCourses = favCourses' & filter (\(_, _, courseVisible, _) -> courseVisible)
let favCourses = favCourses' & filter (\(_, _, _, mayView, _) -> mayView)
return ( favCourses
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
@ -2050,9 +2051,9 @@ siteLayout' headingOverride widget = do
)
let favouriteTerms :: [TermIdentifier]
favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Entity _ Course{..}, _, _, _) -> Set.singleton $ unTermKey courseTerm) favourites'
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, mayEdit, courseVisible)
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, courseVisible, mayView, mayEdit)
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
@ -2074,7 +2075,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, mayEdit, courseVisible)
return (c, courseRoute, items, favouriteReason, courseVisible, mayView, mayEdit)
nav'' <- mconcat <$> sequence
[ defaultLinks
@ -2106,10 +2107,10 @@ siteLayout' headingOverride widget = do
navItems = map (view _2) favourites ++ toListOf (folded . typesUsing @NavChildren @NavLink . to urlRoute) nav
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map (view _2) favourites) crumbs
highlightNav = (||) <$> navForceActive <*> highlight
favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, Maybe [(Text, Text)], FavouriteReason, Bool, Bool)]
favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, Maybe [(Text, Text)], FavouriteReason, Bool, Bool, Bool)]
favouriteTermReason tid favReason' = favourites
& filter (\(Course{..}, _, _, favReason, _, _) -> unTermKey courseTerm == tid && favReason == favReason')
& sortOn (\(Course{..}, _, _, _, _, _) -> courseName)
& filter (\(Course{..}, _, _, favReason, _, _, _) -> unTermKey courseTerm == tid && favReason == favReason')
& sortOn (\(Course{..}, _, _, _, _, _, _) -> courseName)
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and

View File

@ -21,13 +21,13 @@ $newline never
<h3 .asidenav__box-subtitle>
_{favReason}
<ul .asidenav__list.list--iconless>
$forall (Course{courseShorthand, courseName}, courseRoute, mPageActions, _, mayEdit, isVisible) <- favouriteTermReason tid favReason
$forall (Course{courseShorthand, courseName}, courseRoute, mPageActions, _, courseVisible, _, mayEdit) <- 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 mayEdit && not isVisible
$if mayEdit && not courseVisible
\ #{iconInvisible}
<div .asidenav__nested-list-wrapper>
$maybe pageActions <- mPageActions