From c09b0d8619ec4a36e0026c574ba5aa939c8b475f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 27 Nov 2017 12:37:56 +0100 Subject: [PATCH] Cleanup --- src/Foundation.hs | 53 +++++++++++++----------------- src/Handler/Course.hs | 5 ++- src/Handler/Utils/StudyFeatures.hs | 2 -- templates/default-layout.hamlet | 21 ++++++++---- 4 files changed, 40 insertions(+), 41 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 4b76dc434..c000c625d 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -61,16 +61,6 @@ data UniWorX = UniWorX , appCryptoIDKey :: CryptoIDKey } -data MenuItem = MenuItem - { menuItemLabel :: Text - , menuItemRoute :: Route UniWorX - , menuItemAccessCallback :: Bool - } - -data MenuTypes - = NavbarLeft MenuItem - | NavbarRight MenuItem - -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: -- http://www.yesodweb.com/book/routing-and-handlers @@ -85,6 +75,17 @@ data MenuTypes -- type Widget = WidgetT UniWorX IO () mkYesodData "UniWorX" $(parseRoutesFile "routes") +data MenuItem = MenuItem + { menuItemLabel :: Text + , menuItemRoute :: Route UniWorX + , menuItemAccessCallback :: Handler Bool + } + +data MenuTypes + = NavbarLeft { menuItem :: MenuItem } + | NavbarRight { menuItem :: MenuItem } + | NavbarExtra { menuItem :: MenuItem } + -- | A convenient synonym for creating forms. type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget) @@ -113,7 +114,7 @@ instance Yesod UniWorX where -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. yesodMiddleware = defaultYesodMiddleware - defaultLayout = defaultMenuLayout defaultLinks + defaultLayout = defaultLinkLayout [] -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR @@ -206,57 +207,49 @@ instance YesodBreadcrumbs UniWorX where breadcrumb _ = return ("home", Nothing) -defaultLinks :: Maybe (UserId, User) -> [MenuTypes] -defaultLinks muser = -- Define the menu items of the header. +defaultLinks :: [MenuTypes] +defaultLinks = -- Define the menu items of the header. [ NavbarLeft $ MenuItem { menuItemLabel = "Home" , menuItemRoute = HomeR - , menuItemAccessCallback = True + , menuItemAccessCallback = return True } , NavbarLeft $ MenuItem { menuItemLabel = "Kurse" , menuItemRoute = CourseListR - , menuItemAccessCallback = True + , menuItemAccessCallback = return True } , NavbarRight $ MenuItem { menuItemLabel = "Profile" , menuItemRoute = ProfileR - , menuItemAccessCallback = isJust muser + , menuItemAccessCallback = isJust <$> maybeAuthPair } , NavbarRight $ MenuItem { menuItemLabel = "Login" , menuItemRoute = AuthR LoginR - , menuItemAccessCallback = isNothing muser + , menuItemAccessCallback = isNothing <$> maybeAuthPair } , NavbarRight $ MenuItem { menuItemLabel = "Logout" , menuItemRoute = AuthR LogoutR - , menuItemAccessCallback = isJust muser + , menuItemAccessCallback = isJust <$> maybeAuthPair } ] -defaultLinkLayout :: (Maybe (UserId, User) -> [MenuTypes]) -> Widget -> Handler Html -defaultLinkLayout menu = defaultMenuLayout defaultsPlusMenu - where - defaultsPlusMenu = (++) <$> defaultLinks <*> menu +defaultLinkLayout :: [MenuTypes] -> Widget -> Handler Html +defaultLinkLayout = defaultMenuLayout . (defaultLinks ++) -defaultMenuLayout :: (Maybe (UserId, User) -> [MenuTypes]) - -> Widget -> Handler Html +defaultMenuLayout :: [MenuTypes] -> Widget -> Handler Html defaultMenuLayout menu widget = do master <- getYesod mmsgs <- getMessages - muser <- maybeAuthPair mcurrentRoute <- getCurrentRoute -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance. (title, parents) <- breadcrumbs - let menuItems = menu muser - let navbarLeftMenuItems = [x | NavbarLeft x <- menuItems] - let navbarRightMenuItems = [x | NavbarRight x <- menuItems] - let navbarLeftFilteredMenuItems = [x | x <- navbarLeftMenuItems , menuItemAccessCallback x] - let navbarRightFilteredMenuItems = [x | x <- navbarRightMenuItems, menuItemAccessCallback x] + menuTypes <- filterM (menuItemAccessCallback . menuItem) menu -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 7bb536b6d..450800dcf 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -60,12 +60,11 @@ getCourseListTermR tidini = do |] ) ] - allowedNew <- isAuthorized CourseEditR False - let pageLinks muser = + let pageLinks = [ NavbarLeft $ MenuItem { menuItemLabel = "Neuer Kurs" , menuItemRoute = CourseEditR - , menuItemAccessCallback = Authorized == allowedNew + , menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseEditR False } ] defaultLinkLayout pageLinks $ do diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index 407f0a1a2..e4e8b38c7 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -8,8 +8,6 @@ module Handler.Utils.StudyFeatures import Import.NoFoundation hiding (try, (<|>)) -import Data.Bifunctor - import Text.Parsec import Text.Parsec.Text diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 0210af77e..46a2420c1 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -11,14 +11,23 @@