Merge branch 'feat/pageActions'

src/Foundation.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 
 module Foundation where
@@ -181,7 +182,68 @@ 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

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 =
+  defaultLayout $ do
-        [ PageActionPrime $ MenuItem
-          { menuItemLabel = "Übungsblätter"
-          , menuItemIcon  = Nothing
-          , menuItemRoute = CSheetR tid csh SheetListR
-          , menuItemAccessCallback' = return True
-          }
-        ]
-  defaultLinkLayout pageActions $ do
     setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
     $(widgetFile "course")
 

src/Handler/Sheet.hs

@@ -191,15 +191,7 @@ getSheetList courseEnt = do
   let colSheets = if showAdmin
         then colBase `mappend` colAdmin
         else colBase
-  let pageActions =
+  defaultLayout $ do
-        [ PageActionPrime $ MenuItem
-          { menuItemLabel = "Neues Übungsblatt"
-          , menuItemIcon  = Nothing
-          , menuItemRoute = CSheetR tid csh SheetNewR
-          , menuItemAccessCallback' = return True
-          }
-        ]
-  defaultLinkLayout pageActions $ do
     setTitle $ toHtml $ T.append "Übungsblätter " csh
     if null sheets
       then [whamlet|Es wurden noch keine Übungsblätter angelegt.|]

src/Handler/Term.hs

@@ -89,15 +89,7 @@ getTermShowR = do
         , dbtAttrs = tableDefault
         , dbtIdent = "terms" :: Text
         }
-      let pageActions =
+      defaultLayout $ do
-            [ PageActionPrime $ MenuItem
-              { menuItemLabel = "Neues Semester"
-              , menuItemIcon  = Nothing
-              , menuItemRoute = TermEditR
-              , menuItemAccessCallback' = return True
-              }
-            ]
-      defaultLinkLayout pageActions $ do
         setTitle "Freigeschaltete Semester"
         $(widgetFile "terms")
 

templates/widgets/asidenav.hamlet

@@ -17,23 +17,17 @@ $newline never
       <h3 .asidenav__box-title>
         WiSe 17/18
       <ul .asidenav__list>
-        $forall (Entity _ Course{..}) <- favourites
+        $forall (Course{..}, courseRoute, pageActions) <- favourites
-          $with route <- CourseR courseTermId courseShorthand CourseShowR
+          <li .asidenav__list-item>
-            <li .asidenav__list-item :Just route == mcurrentRoute:.asidenav__list-item--active>
+            <a .asidenav__link-wrapper href=@{courseRoute}>
-              <a .asidenav__link-wrapper href=@{route}>
+              <div .asidenav__link-shorthand>#{courseShorthand}
-                <div .asidenav__link-shorthand>#{courseShorthand}
+              <div .asidenav__link-label>#{courseName}
-                <div .asidenav__link-label>#{courseName}
+            <ul .asidenav__nested-list>
-
+              $forall action <- pageActions
-        <li .asidenav__list-item>
+                $case action
-          <a .asidenav__link-wrapper href="/course/S2018/ixd/show">
+                  $of PageActionPrime (MenuItem{..})
-            <div .asidenav__link-shorthand>EXAMPLE
+                    <li .asidenav__list-item>
-            <div .asidenav__link-label>Beispiel-Kurs
+                      <a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
-          <ul .asidenav__nested-list>
+                  $of _
-            <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
 
   <div .asidenav__toggler>