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

Fix NavBar-Highlighting

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-08 22:10:33 +02:00
parent 7ba1c41843
commit 4c86306bfd
1 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Foundation.hs
View File

@ -493,9 +493,9 @@ instance Yesod UniWorX where
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
highlight = let crumbs = mcons mcurrentRoute $ fst <$> parents highlight = let crumbs = mcons mcurrentRoute $ fst <$> parents
actFav = List.intersect (snd3 <$> favourites) crumbs navItems = map snd3 favourites ++ map (menuItemRoute . menuItem) menuTypes
highRs = if null actFav then crumbs else actFav highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs
in \r -> r `elem` highRs in \r -> Just r == highR
favouriteTerms :: [TermIdentifier] favouriteTerms :: [TermIdentifier]
favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])] favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]