diff --git a/src/Foundation.hs b/src/Foundation.hs index 22014a05e..8a9c3a666 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -49,6 +49,7 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.List (foldr1) +import qualified Data.List as List import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map, (!?)) @@ -110,17 +111,6 @@ type MsgRenderer = MsgRendererS UniWorX -- see Utils pattern CSheetR tid csh shn ptn = CourseR tid csh (SheetR shn ptn) --- Change this to use breadcrumbs, but only last breadcrumb should match -isSubrouteOf :: Maybe (Route UniWorX) -> (Route UniWorX -> Bool) -- DEPRECATED -isSubrouteOf Nothing _ = False -isSubrouteOf (Just (CourseR t2 s2 _)) (CourseR t1 s1 _) = t1 == t2 && s1 == s2 -isSubrouteOf (Just (TermEditR)) (TermShowR) = True -isSubrouteOf (Just (TermEditExistR _)) (TermShowR) = True -isSubrouteOf (Just r2) r1 = r1 == r2 - --- isSubrouteOf _ _ = False - - -- Menus and Favourites data MenuItem = MenuItem { menuItemLabel :: Text @@ -195,8 +185,8 @@ liftAR op sc apdb apg@(APHandler _) = liftAR op sc apg apdb trueAP,falseAP :: AccessPredicate trueAP = APPure . const $ return Authorized -falseAP = APPure . const $ Unauthorized . ($ MsgUnauthorized) . render <$> ask --- TODO: I believe falseAP := adminAP +falseAP = APPure . const $ Unauthorized . ($ MsgUnauthorized) . render <$> ask -- always use adminAP instead + adminAP :: AccessPredicate -- access for admins (of appropriate school in case of course-routes) adminAP = APDB $ \case @@ -363,9 +353,6 @@ evalAccess r = case route2ap r of (APHandler p) -> p r (APDB p) -> runDB $ p r --- TODO: isAuthorized = evalAccess' - - -- Please see the documentation for the Yesod typeclass. There are a number @@ -454,10 +441,11 @@ instance Yesod UniWorX where courseRoute = CourseR courseTerm courseShorthand CShowR in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute) - let highlight :: Route UniWorX -> Bool - highlight = isSubrouteOf mcurrentRoute -- TODO - -- IDEA: highlight on last route in breadcrumbs only - -- toHighlight = undefined -- TODO: last breadcrumb in order only + let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs only + highlight = let crumbs = mcons mcurrentRoute $ fst <$> parents + actFav = List.intersect (snd3 <$> favourites) crumbs + highRs = if null actFav then crumbs else actFav + in \r -> r `elem` highRs -- TODO: Lookup theme in Cookie/DB and set variable accordingly -- let currentTheme = "theme--default" diff --git a/src/Utils.hs b/src/Utils.hs index e753dcbf2..7f6ef4442 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -87,6 +87,11 @@ maybeT x m = runMaybeT m >>= maybe x return catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a catchIfMaybeT p act = catchIf p (lift act) (const mzero) +mcons :: Maybe a -> [a] -> [a] +mcons Nothing xs = xs +mcons (Just x) xs = x:xs + + --------------- -- Exception -- ---------------