diff --git a/src/Foundation.hs b/src/Foundation.hs index 888256d29..314229d96 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 @@ -181,8 +182,69 @@ instance Yesod UniWorX where _other -> return () return res - defaultLayout = defaultLinkLayout [] + defaultLayout widget = do + master <- getYesod + mmsgs <- getMessages + mcurrentRoute <- getCurrentRoute + + -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance. + (title, parents) <- breadcrumbs + + let + menu = defaultLinks ++ maybe [] pageActions mcurrentRoute + + menuTypes <- filterM (menuItemAccessCallback . menuItem) menu + + -- Lookup Favourites if possible + favourites' <- do + muid <- maybeAuthId + case muid of + Nothing -> return [] + (Just uid) -> runDB . E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do + E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse) + E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid) + 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 + -- value passed to hamletToRepHtml cannot be a widget, this allows + -- you to use normal widget features in default-layout. + + let + navbar :: Widget + navbar = $(widgetFile "widgets/navbar") + asidenav :: Widget + asidenav = $(widgetFile "widgets/asidenav") + breadcrumbs :: Widget + breadcrumbs = $(widgetFile "widgets/breadcrumbs") + pageactionprime :: Widget + pageactionprime = $(widgetFile "widgets/pageactionprime") + -- functions to determine if there are page-actions + isPageActionPrime :: MenuTypes -> Bool + isPageActionPrime (PageActionPrime _) = True + isPageActionPrime _ = False + hasPageActions :: Bool + hasPageActions = any isPageActionPrime menuTypes + + pc <- widgetToPageContent $ do + addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900" + addScript $ StaticR js_featureChecker_js + addStylesheet $ StaticR css_fonts_css + addStylesheet $ StaticR css_icons_css + $(widgetFile "default-layout") + $(widgetFile "standalone/modal") + $(widgetFile "standalone/showHide") + $(widgetFile "standalone/inputs") + withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") + -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR @@ -353,6 +415,40 @@ 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 (CourseR tid csh (SheetR SheetListR)) = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Neues Übungsblatt" + , menuItemIcon = Nothing + , menuItemRoute = CSheetR tid csh SheetNewR + , menuItemAccessCallback' = return True + } + ] +pageActions TermShowR = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Neues Semester" + , menuItemIcon = Nothing + , menuItemRoute = TermEditR + , menuItemAccessCallback' = return True + } + ] +pageActions (CourseListTermR _) = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Neuer Kurs" + , menuItemIcon = Just "book" + , menuItemRoute = CourseNewR + , menuItemAccessCallback' = return True + } + ] +pageActions _ = [] defaultLinks :: [MenuTypes] defaultLinks = -- Define the menu items of the header. @@ -406,70 +502,6 @@ defaultLinks = -- Define the menu items of the header. } ] -defaultLinkLayout :: [MenuTypes] -> Widget -> Handler Html -defaultLinkLayout = defaultMenuLayout . (defaultLinks ++) - -defaultMenuLayout :: [MenuTypes] -> Widget -> Handler Html -defaultMenuLayout menu widget = do - master <- getYesod - mmsgs <- getMessages - - mcurrentRoute <- getCurrentRoute - - -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance. - (title, parents) <- breadcrumbs - - menuTypes <- filterM (menuItemAccessCallback . menuItem) menu - - -- Lookup Favourites if possible - favourites <- do - muid <- maybeAuthId - case muid of - Nothing -> return [] - (Just uid) -> runDB . E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do - E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse) - E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid) - E.orderBy [ E.asc $ course E.^. CourseShorthand ] - return course - - -- 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 - -- value passed to hamletToRepHtml cannot be a widget, this allows - -- you to use normal widget features in default-layout. - - let - navbar :: Widget - navbar = $(widgetFile "widgets/navbar") - asidenav :: Widget - asidenav = $(widgetFile "widgets/asidenav") - breadcrumbs :: Widget - breadcrumbs = $(widgetFile "widgets/breadcrumbs") - pageactionprime :: Widget - pageactionprime = $(widgetFile "widgets/pageactionprime") - -- functions to determine if there are page-actions - isPageActionPrime :: MenuTypes -> Bool - isPageActionPrime (PageActionPrime _) = True - isPageActionPrime _ = False - hasPageActions :: Bool - hasPageActions = any isPageActionPrime menuTypes - - pc <- widgetToPageContent $ do - addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900" - addScript $ StaticR js_zepto_js - addScript $ StaticR js_fetchPolyfill_js - addScript $ StaticR js_urlPolyfill_js - addScript $ StaticR js_featureChecker_js - addScript $ StaticR js_tabber_js - addStylesheet $ StaticR css_tabber_css - addStylesheet $ StaticR css_fonts_css - addStylesheet $ StaticR css_icons_css - $(widgetFile "default-layout") - $(widgetFile "standalone/modal") - $(widgetFile "standalone/showHide") - $(widgetFile "standalone/inputs") - withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") - -- How to run database actions. instance YesodPersist UniWorX where type YesodPersistBackend UniWorX = SqlBackend diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 1945f323a..11103c0c6 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -63,16 +63,8 @@ getCourseListTermR tidini = do |] ) ] - let pageLinks = - [ PageActionPrime $ MenuItem - { menuItemLabel = "Neuer Kurs" - , menuItemIcon = Just "book" - , menuItemRoute = CourseNewR - , menuItemAccessCallback' = return True - } - ] let coursesTable = encodeWidgetTable tableSortable colonnadeTerms courses - defaultLinkLayout pageLinks $ do + defaultLayout $ do setTitle "Semesterkurse" $(widgetFile "courses") @@ -92,15 +84,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 + defaultLayout $ do setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|] $(widgetFile "course") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 81b6938ae..f42b277ca 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -191,15 +191,7 @@ getSheetList courseEnt = do let colSheets = if showAdmin then colBase `mappend` colAdmin else colBase - let pageActions = - [ PageActionPrime $ MenuItem - { menuItemLabel = "Neues Übungsblatt" - , menuItemIcon = Nothing - , menuItemRoute = CSheetR tid csh SheetNewR - , menuItemAccessCallback' = return True - } - ] - defaultLinkLayout pageActions $ do + defaultLayout $ do setTitle $ toHtml $ T.append "Übungsblätter " csh if null sheets then [whamlet|Es wurden noch keine Übungsblätter angelegt.|] diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 46f464cc1..0e6a2e505 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -89,15 +89,7 @@ getTermShowR = do , dbtAttrs = tableDefault , dbtIdent = "terms" :: Text } - let pageActions = - [ PageActionPrime $ MenuItem - { menuItemLabel = "Neues Semester" - , menuItemIcon = Nothing - , menuItemRoute = TermEditR - , menuItemAccessCallback' = return True - } - ] - defaultLinkLayout pageActions $ do + defaultLayout $ do setTitle "Freigeschaltete Semester" $(widgetFile "terms") 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