fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Created AdminR page to remove clutter from homepage

Browse Source
This commit is contained in:
SJost 2019-03-13 20:35:46 +01:00
parent 0917b2c580
commit 5a8fa8648f
5 changed files with 84 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/de.msg
View File

@ -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

3
routes
View File

@ -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

75
src/Foundation.hs
View File

@ -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

10
src/Handler/Admin.hs
View File

@ -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)

7
test/Database.hs
View File

@ -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