From ad6f1ab19980a1daf0a3f77bbb3f2dad5d073a26 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 13 Apr 2018 16:03:06 +0200 Subject: [PATCH 1/2] Introduce `pageActions` and use in favourites --- src/Foundation.hs | 17 ++++++++++++++++- src/Handler/Course.hs | 10 +--------- templates/widgets/asidenav.hamlet | 30 ++++++++++++------------------ 3 files changed, 29 insertions(+), 28 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index b1f09c8ba..d389d15cb 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -9,6 +9,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} module Foundation where @@ -353,6 +354,15 @@ instance YesodBreadcrumbs UniWorX where breadcrumb ProfileR = return ("Profile", Just HomeR) breadcrumb _ = return ("home", Nothing) +pageActions :: Route UniWorX -> [MenuTypes] +pageActions (CourseR tid csh CourseShowR) = [ PageActionPrime $ MenuItem + { menuItemLabel = "Übungsblätter" + , menuItemIcon = Nothing + , menuItemRoute = CSheetR tid csh SheetListR + , menuItemAccessCallback' = return True + } + ] +pageActions _ = [] defaultLinks :: [MenuTypes] defaultLinks = -- Define the menu items of the header. @@ -422,7 +432,7 @@ defaultMenuLayout menu widget = do menuTypes <- filterM (menuItemAccessCallback . menuItem) menu -- Lookup Favourites if possible - favourites <- do + favourites' <- do muid <- maybeAuthId case muid of Nothing -> return [] @@ -432,6 +442,11 @@ defaultMenuLayout menu widget = do E.orderBy [ E.asc $ course E.^. CourseShorthand ] return course + favourites <- forM favourites' $ \(Entity _ c@Course{..}) + -> let + courseRoute = CourseR courseTermId courseShorthand CourseShowR + in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute) + -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and -- default-layout-wrapper is the entire page. Since the final diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 1945f323a..5c44562a8 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -92,15 +92,7 @@ getCourseShowR tid csh = do return $ (courseEnt,dependent) let course = entityVal courseEnt (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerButton $ mbRegistered - let pageActions = - [ PageActionPrime $ MenuItem - { menuItemLabel = "Übungsblätter" - , menuItemIcon = Nothing - , menuItemRoute = CSheetR tid csh SheetListR - , menuItemAccessCallback' = return True - } - ] - defaultLinkLayout pageActions $ do + defaultLinkLayout [] $ do setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|] $(widgetFile "course") diff --git a/templates/widgets/asidenav.hamlet b/templates/widgets/asidenav.hamlet index b19ab9d4f..8126fd770 100644 --- a/templates/widgets/asidenav.hamlet +++ b/templates/widgets/asidenav.hamlet @@ -17,23 +17,17 @@ $newline never

WiSe 17/18