From 5a8fa8648fe5247cd1299a5e9cba11d41c27f0cd Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 13 Mar 2019 20:35:46 +0100 Subject: [PATCH] Created AdminR page to remove clutter from homepage --- messages/uniworx/de.msg | 3 +- routes | 3 +- src/Foundation.hs | 75 +++++++++++++++++++++++++++++++++++------ src/Handler/Admin.hs | 10 ++++++ test/Database.hs | 7 +++- 5 files changed, 84 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 17602162c..9f3f4bf28 100644 --- a/messages/uniworx/de.msg +++ b/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 diff --git a/routes b/routes index a7961404f..9b15ab3b9 100644 --- a/routes +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 6e91611f3..adc685fa0 100644 --- a/src/Foundation.hs +++ b/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 AdminTestR = return ("Test" , Just HomeR) + breadcrumb UsersR = return ("Benutzer" , Just AdminR) 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 - , menuItemLabel = MsgMenuAdminTest + { menuItemType = PageActionPrime + , 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 diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 47bf781dd..414e2aba0 100644 --- a/src/Handler/Admin.hs +++ b/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) diff --git a/test/Database.hs b/test/Database.hs index df9afb496..084f6d3f1 100755 --- a/test/Database.hs +++ b/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