Merge branch 'feat/pageActions'
This commit is contained in:
Gregor Kleen
commit
ed1b3df2d9
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
|
||||
@ -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")
|
||||
|
||||
|
||||
@ -17,23 +17,17 @@ $newline never
|
||||
<h3 .asidenav__box-title>
|
||||
WiSe 17/18
|
||||
<ul .asidenav__list>
|
||||
$forall (Entity _ Course{..}) <- favourites
|
||||
$with route <- CourseR courseTermId courseShorthand CourseShowR
|
||||
<li .asidenav__list-item :Just route == mcurrentRoute:.asidenav__list-item--active>
|
||||
<a .asidenav__link-wrapper href=@{route}>
|
||||
<div .asidenav__link-shorthand>#{courseShorthand}
|
||||
<div .asidenav__link-label>#{courseName}
|
||||
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href="/course/S2018/ixd/show">
|
||||
<div .asidenav__link-shorthand>EXAMPLE
|
||||
<div .asidenav__link-label>Beispiel-Kurs
|
||||
<ul .asidenav__nested-list>
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href="/course/S2018/ixd/ex">Übungsblätter
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href="/course/S2018/ixd/show">Klausuren
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href="/course/S2018/ixd/show">Übungsgruppen
|
||||
$forall (Course{..}, courseRoute, pageActions) <- favourites
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href=@{courseRoute}>
|
||||
<div .asidenav__link-shorthand>#{courseShorthand}
|
||||
<div .asidenav__link-label>#{courseName}
|
||||
<ul .asidenav__nested-list>
|
||||
$forall action <- pageActions
|
||||
$case action
|
||||
$of PageActionPrime (MenuItem{..})
|
||||
<li .asidenav__list-item>
|
||||
<a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
|
||||
$of _
|
||||
|
||||
<div .asidenav__toggler>
|
||||
|
||||
Reference in New Issue
Block a user