asidenav.hamlet restored to previous version, bug in Foundation fixed.

src/Foundation.hs

@@ -110,6 +110,28 @@ type MsgRenderer = MsgRendererS UniWorX -- see Utils
 pattern CSheetR tid csh shn ptn
   = CourseR tid csh (SheetR shn ptn)
 
+
+-- Menus and Favourites
+data MenuItem = MenuItem
+    { menuItemLabel :: Text
+    , menuItemIcon :: Maybe Text
+    , menuItemRoute :: Route UniWorX
+    , menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
+    }
+
+menuItemAccessCallback :: MenuItem -> Handler Bool
+menuItemAccessCallback MenuItem{..} = (&&) <$> ((==) Authorized <$> authCheck) <*> menuItemAccessCallback'
+  where
+    authCheck = handleAny (\_ -> return . Unauthorized $ error "authCheck caught exception") $ isAuthorized menuItemRoute False
+
+data MenuTypes                                 -- Semantische Rolle:
+    = NavbarAside         { menuItem :: MenuItem } --   TODO
+    | NavbarExtra         { menuItem :: MenuItem } --   TODO
+    | NavbarRight         { menuItem :: MenuItem } --   Generell, nahezu immer sichtbar
+    | NavbarSecondary     { menuItem :: MenuItem } --   Generell, nahezu immer sichtbar
+    | PageActionPrime     { menuItem :: MenuItem } --   Seitenspezifische Aktion, häufig
+    | PageActionSecondary { menuItem :: MenuItem } --   Seitenspezifische Aktion, selten
+
 -- Messages
 mkMessage "UniWorX" "messages" "de"
 
@@ -124,8 +146,8 @@ instance RenderMessage UniWorX TermIdentifier where
     Winter -> renderMessage' $ MsgWinterTerm year
     where renderMessage' = renderMessage foundation ls
 
--- Access Control
 
+-- Access Control
 data AccessPredicate
   = APPure     (Route UniWorX -> Reader MsgRenderer AuthResult)
   | APHandler  (Route UniWorX -> Handler AuthResult)
@@ -224,8 +246,8 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
 
 tag2ap :: Text -> AccessPredicate
 tag2ap t = case Map.lookup (CI.mk t) knownTags of
-    (Just ap) -> ap
+    (Just acp) -> acp
-    Nothing   -> APHandler $ \r -> do --TODO: can this be pure like falseAP?
+    Nothing   -> APHandler $ \_route -> do --TODO: can this be pure like falseAP?
       $logWarnS "AccessControl" ("route tag unknown for access control")
       unauthorizedI $ MsgUnauthorized
 
@@ -247,30 +269,9 @@ evalAccess r = case route2ap r of
   (APHandler p) -> p r
   (APDB      p) -> runDB $ p r
 
-
 -- TODO: isAuthorized = evalAccess'
 
 
--- Menus and Favourites
-data MenuItem = MenuItem
-    { menuItemLabel :: Text
-    , menuItemIcon :: Maybe Text
-    , menuItemRoute :: Route UniWorX
-    , menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
-    }
-
-menuItemAccessCallback :: MenuItem -> Handler Bool
-menuItemAccessCallback MenuItem{..} = (&&) <$> ((==) Authorized <$> authCheck) <*> menuItemAccessCallback'
-  where
-    authCheck = handleAny (\_ -> return . Unauthorized $ error "authCheck caught exception") $ isAuthorized menuItemRoute False
-
-data MenuTypes                                 -- Semantische Rolle:
-    = NavbarAside         { menuItem :: MenuItem } --   TODO
-    | NavbarExtra         { menuItem :: MenuItem } --   TODO
-    | NavbarRight         { menuItem :: MenuItem } --   Generell, nahezu immer sichtbar
-    | NavbarSecondary     { menuItem :: MenuItem } --   Generell, nahezu immer sichtbar
-    | PageActionPrime     { menuItem :: MenuItem } --   Seitenspezifische Aktion, häufig
-    | PageActionSecondary { menuItem :: MenuItem } --   Seitenspezifische Aktion, selten
 
 
 -- Please see the documentation for the Yesod typeclass. There are a number
@@ -309,7 +310,7 @@ instance Yesod UniWorX where
               cid  <- MaybeT . getKeyBy $ CourseTermShort tid csh
               user <- MaybeT $ get uid
               -- update Favourites
-              lift $ upsertBy
+              void . lift $ upsertBy
                       (UniqueCourseFavourite uid cid)
                       (CourseFavourite uid now cid)
                       [CourseFavouriteTime =. now]

templates/widgets/asidenav.hamlet

@@ -5,12 +5,12 @@ $newline never
       <ul .asidenav__list>
         $forall menuType <- menuTypes
           $case menuType
-            $of NavbarAside mi
+            $of NavbarAside (MenuItem label mIcon route _)
-              <li .asidenav__list-item :Just (menuItemRoute mi) == mcurrentRoute:.asidenav__list-item--active>
+              <li .asidenav__list-item :Just route == mcurrentRoute:.asidenav__list-item--active>
-                <a .asidenav__link-wrapper href=@{menuItemRoute mi}>
+                <a .asidenav__link-wrapper href=@{route}>
-                  $if isJust (menuItemIcon mi)
+                  $if isJust mIcon
-                    <div .glyphicon.glyphicon--#{fromMaybe "" (menuItemIcon mi)}>
+                    <div .glyphicon.glyphicon--#{fromMaybe "" mIcon}>
-                  <div .asidenav__link-label>#{menuItemLabel mi}
+                  <div .asidenav__link-label>#{label}
             $of _
 
     <div .asidenav__box>
@@ -25,9 +25,9 @@ $newline never
             <ul .asidenav__nested-list>
               $forall action <- pageActions
                 $case action
-                  $of PageActionPrime mi
+                  $of PageActionPrime (MenuItem{..})
                     <li .asidenav__list-item>
-                      <a .asidenav__link-wrapper href=@{menuItemRoute mi}>#{menuItemLabel mi}
+                      <a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
                   $of _
 
   <div .asidenav__toggler>