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

fix(course-visibility): fix favourites

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Foundation.hs
View File

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

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

@ -21,13 +21,13 @@ $newline never
<h3 .asidenav__box-subtitle> <h3 .asidenav__box-subtitle>
_{favReason} _{favReason}
<ul .asidenav__list.list--iconless> <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> <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
<a .asidenav__link-wrapper href=@{courseRoute}> <a .asidenav__link-wrapper href=@{courseRoute}>
<div .asidenav__link-shorthand>#{courseShorthand} <div .asidenav__link-shorthand>#{courseShorthand}
<div .asidenav__link-label> <div .asidenav__link-label>
#{courseName} #{courseName}
$if mayEdit && not isVisible $if mayEdit && not courseVisible
\ #{iconInvisible} \ #{iconInvisible}
<div .asidenav__nested-list-wrapper> <div .asidenav__nested-list-wrapper>
$maybe pageActions <- mPageActions $maybe pageActions <- mPageActions