Migrate everything to new system of pageActions
This commit is contained in:
Gregor Kleen
parent
ad6f1ab199
commit
6644af809e
@ -182,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
|
||||
|
||||
@ -355,13 +416,38 @@ instance YesodBreadcrumbs UniWorX where
|
||||
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 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]
|
||||
@ -416,72 +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
|
||||
|
||||
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
|
||||
addScript $ StaticR js_fetchPolyfill_js
|
||||
addScript $ StaticR js_urlPolyfill_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")
|
||||
|
||||
-- How to run database actions.
|
||||
instance YesodPersist UniWorX where
|
||||
type YesodPersistBackend UniWorX = SqlBackend
|
||||
|
||||
@ -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,7 +84,7 @@ getCourseShowR tid csh = do
|
||||
return $ (courseEnt,dependent)
|
||||
let course = entityVal courseEnt
|
||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerButton $ mbRegistered
|
||||
defaultLinkLayout [] $ do
|
||||
defaultLayout $ do
|
||||
setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
|
||||
$(widgetFile "course")
|
||||
|
||||
|
||||
@ -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.|]
|
||||
|
||||
@ -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")
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user