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

feat(course-visibility): hide invisible courses from favourites + icon

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-25 18:20:00 +02:00
parent 9686907990
commit d86fed7a32
2 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Foundation.hs
View File

@ -1977,6 +1977,8 @@ siteLayout' headingOverride widget = do
-- isParent r = r == (fst parents)
isAuth <- isJust <$> maybeAuthId
now <- liftIO getCurrentTime
-- Lookup Favourites & Theme if possible
(favourites', maxFavouriteTerms, currentTheme) <- do
@ -2021,7 +2023,14 @@ siteLayout' headingOverride widget = do
E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
return (course, reason)
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, isLecturer)
return ( favCourses
, maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
@ -2029,9 +2038,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)
favourites <- fmap catMaybes . forM favourites' $ \(Entity cId c@Course{..}, E.Value mFavourite, E.Value isLecturer)
-> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
favouriteReason = fromMaybe FavouriteCurrent mFavourite
in runMaybeT . guardOnM (unTermKey courseTerm `elem` favouriteTerms) . lift $ do
@ -2053,7 +2062,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)
return (c, courseRoute, items, favouriteReason, isLecturer)
nav'' <- mconcat <$> sequence
[ defaultLinks
@ -2085,10 +2094,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)]
favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, Maybe [(Text, Text)], FavouriteReason, 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
@ -2187,7 +2196,9 @@ siteLayout' headingOverride widget = do
isNavHeaderSecondary = has $ _1 . _navHeaderRole . only NavHeaderSecondary
asidenav :: Widget
asidenav = $(widgetFile "widgets/asidenav/asidenav")
where logo = preEscapedToMarkup $ decodeUtf8 $(embedFile "assets/lmu/logo.svg")
where
logo = preEscapedToMarkup $ decodeUtf8 $(embedFile "assets/lmu/logo.svg")
courseIsVisible Course{courseVisibleFrom,courseVisibleTo} = NTop courseVisibleFrom <= NTop (Just now) && NTop (Just now) <= NTop courseVisibleTo
footer :: Widget
footer = $(widgetFile "widgets/footer/footer")
where isNavFooter = has $ _1 . _NavFooter

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

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