Created AdminR page to remove clutter from homepage

messages/uniworx/de.msg

@@ -345,6 +345,8 @@ MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufget
 NoTableContent: Kein Tabelleninhalt
 NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
 
+AdminHeading: Administration
+AdminFeaturesHeading: Studiengänge
 AdminUserHeading: Benutzeradministration
 AccessRightsFor: Berechtigungen für
 AdminFor: Administrator
@@ -353,7 +355,6 @@ LecturersFor: Dozenten
 ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
 UserListTitle: Komprehensive Benutzerliste
 AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
-AdminFeaturesHeading: Studiengänge
 
 Date: Datum
 DateTimeFormat: Datums- und Uhrzeitformat

routes

@@ -38,8 +38,9 @@
 /users                        UsersR            GET           -- no tags, i.e. admins only
 /users/#CryptoUUIDUser        AdminUserR        GET POST      !development
 /users/#CryptoUUIDUser/hijack AdminHijackUserR  POST          !adminANDno-escalation
-/admin/test                   AdminTestR        GET POST
+/admin                        AdminR            GET
 /admin/features               AdminFeaturesR    GET POST
+/admin/test                   AdminTestR        GET POST
 /admin/errMsg                 AdminErrMsgR      GET POST
 
 /info                         InfoR             GET            !free

src/Foundation.hs

@@ -1077,9 +1077,12 @@ applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .|
 instance YesodBreadcrumbs UniWorX where
   breadcrumb (AuthR _)        = return ("Login"        , Just HomeR)
   breadcrumb HomeR            = return ("Uni2work"     , Nothing)
-  breadcrumb UsersR           = return ("Benutzer"     , Just HomeR)
+  breadcrumb UsersR           = return ("Benutzer"     , Just AdminR)
-  breadcrumb AdminTestR       = return ("Test"         , Just HomeR)
   breadcrumb (AdminUserR _)   = return ("Users"        , Just UsersR)
+  breadcrumb AdminR           = return ("Administration", Nothing)
+  breadcrumb AdminFeaturesR   = return ("Test"         , Just AdminR)
+  breadcrumb AdminTestR       = return ("Test"         , Just AdminR)
+  breadcrumb AdminErrMsgR     = return ("Test"         , Just AdminR)
 
   breadcrumb InfoR            = return ("Information"  , Nothing)
   breadcrumb InfoLecturerR    = return ("Veranstalter" , Just InfoR)
@@ -1134,7 +1137,7 @@ instance YesodBreadcrumbs UniWorX where
     return $ if
       | mayList   -> ("Statusmeldung", Just MessageListR)
       | otherwise -> ("Statusmeldung", Just HomeR)
-  breadcrumb (MessageListR) = return ("Statusmeldungen", Just HomeR)
+  breadcrumb (MessageListR) = return ("Statusmeldungen", Just AdminR)
   breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
 submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
@@ -1253,6 +1256,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       , menuItemModal = False
       , menuItemAccessCallback' = return True -- Creates a LOOP: (Authorized ==) <$> isAuthorized UsersR False
       }
+  , return MenuItem
+      { menuItemType  = NavbarAside
+      , menuItemLabel = MsgAdminHeading
+      , menuItemIcon  = Just "screwdriver"
+      , menuItemRoute = SomeRoute AdminR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
   ]
 
 
@@ -1274,33 +1285,75 @@ pageActions (HomeR) =
       , menuItemAccessCallback' = return True
       }
   ,  MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
-      , menuItemLabel = MsgMenuAdminTest
+      , menuItemLabel = MsgAdminHeading
       , menuItemIcon  = Just "screwdriver"
-      , menuItemRoute = SomeRoute AdminTestR
+      , menuItemRoute = SomeRoute AdminR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ,  MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgAdminFeaturesHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminFeaturesR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgMenuMessageList
-      , menuItemIcon = Nothing
+      , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute MessageListR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgMenuAdminErrMsg
-      , menuItemIcon = Nothing
+      , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute AdminErrMsgR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   ]
+pageActions (AdminR) =
+  [ MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgAdminFeaturesHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminFeaturesR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgErrMsgHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminErrMsgR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuUsers
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute UsersR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionSecondary
+      , menuItemLabel = MsgMenuAdminTest
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminTestR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions (InfoR) = [
     MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgInfoLecturerTitle
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute InfoLecturerR

src/Handler/Admin.hs

@@ -28,6 +28,16 @@ import Database.Persist.Sql (fromSqlKey)
 
 import Control.Monad.Trans.Writer (mapWriterT)
 
+
+getAdminR :: Handler Html
+getAdminR = -- do
+   siteLayoutMsg MsgAdminHeading $ do
+      setTitleI MsgAdminHeading
+      [whamlet|
+        This shall become the Administrators' overview page.
+        Its current purpose is to provide links to some important admin functions
+      |]
+
 -- BEGIN - Buttons needed only here
 data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)

test/Database.hs

@@ -233,7 +233,7 @@ fillDb = do
     sdChem2 = StudyTermsKey' 113
   repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatik")
   repsert sdMath  $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
-  repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Medieninformatik") -- intentionally left unknown
+  repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Fehler hier")
   repsert sdPhys  $ StudyTerms 128  Nothing        Nothing                  -- intentionally left unknown
   repsert sdBioI1 $ StudyTerms 221  Nothing        Nothing                  -- intentionally left unknown
   repsert sdBioI2 $ StudyTerms 228  Nothing        Nothing                  -- intentionally left unknown
@@ -278,6 +278,11 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence7 228 "Bioinformatik"
   void . insert $ StudyTermCandidate incidence7 128 "Physik"
   void . insert $ StudyTermCandidate incidence7 128 "Bioinformatik"
+  incidence8 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence8 128 "Physik"
+  void . insert $ StudyTermCandidate incidence8 128 "Medieninformatik"
+  void . insert $ StudyTermCandidate incidence8 121 "Physik"
+  void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik"
 
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster