diff --git a/src/Foundation.hs b/src/Foundation.hs index 30498f0f3..fbdc03690 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -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 diff --git a/templates/widgets/asidenav/asidenav.hamlet b/templates/widgets/asidenav/asidenav.hamlet index d765c5b66..7ebd97cdc 100644 --- a/templates/widgets/asidenav/asidenav.hamlet +++ b/templates/widgets/asidenav/asidenav.hamlet @@ -21,13 +21,13 @@ $newline never