diff --git a/messages/de.msg b/messages/de.msg index cb01caae3..ea407972e 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -3,6 +3,7 @@ BtnAbort: Abbrechen BtnDelete: Löschen BtnRegister: Anmelden BtnDeregister: Abmelden +BtnHijack: Sitzung übernehmen RegisterFrom: Anmeldungen von RegisterTo: Anmeldungen bis @@ -187,4 +188,11 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben CourseMembers: Teilnehmer CourseMembersCount num@Int64: #{display num} -CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} \ No newline at end of file +CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} + +NoTableContent: Kein Tabelleninhalt +NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter + +AdminFor: Administrator +LecturerFor: Dozent +UserListTitle: Komprehensive Benutzerliste \ No newline at end of file diff --git a/models b/models index 90b554663..909a72610 100644 --- a/models +++ b/models @@ -12,6 +12,7 @@ User json UserAdmin user UserId school SchoolId + UniqueUserAdmin user school UserLecturer user UserId school SchoolId diff --git a/routes b/routes index 48cc4578b..778805719 100644 --- a/routes +++ b/routes @@ -35,6 +35,7 @@ /users UsersR GET -- no tags, i.e. admins only /admin/test AdminTestR GET POST /admin/user/#CryptoUUIDUser AdminUserR GET +/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST /info VersionR GET !free /profile ProfileR GET POST !free !free diff --git a/src/Foundation.hs b/src/Foundation.hs index 8f56b2117..8a307908b 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -459,7 +459,6 @@ instance Yesod UniWorX where defaultLayout widget = do master <- getYesod mmsgs <- getMessages - messageRender <- getMessageRender -- needed, since there is no i18n interpolation in Julius mcurrentRoute <- getCurrentRoute @@ -493,10 +492,10 @@ instance Yesod UniWorX where in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute) let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority - highlight = let crumbs = mcons mcurrentRoute $ fst <$> parents - actFav = List.intersect (snd3 <$> favourites) crumbs - highRs = if null actFav then crumbs else actFav - in \r -> r `elem` highRs + highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents + navItems = map snd3 favourites ++ map (menuItemRoute . menuItem) menuTypes + highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs + in \r -> Just r == highR favouriteTerms :: [TermIdentifier] favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])] @@ -655,7 +654,7 @@ submissionList tid csh shn uid = E.select . E.from $ \(course `E.InnerJoin` shee defaultLinks :: [MenuTypes] defaultLinks = -- Define the menu items of the header. - [ NavbarRight $ MenuItem + [ NavbarAside $ MenuItem { menuItemLabel = "Home" , menuItemIcon = Just "home" , menuItemRoute = HomeR diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 360ceba5a..0fc43773d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -170,7 +170,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False) ) ] - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "corrections" :: Text } diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 93b5b0874..d4e2c529b 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -85,7 +85,7 @@ getTermCourseListR tid = do ) ] , dbtFilter = mempty - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "courses" :: Text } diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index f68263d7e..bf3e4f68e 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -95,7 +95,7 @@ homeAnonymous = do | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) ) ] -} - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "upcomingdeadlines" :: Text } let features = $(widgetFile "featureList") @@ -184,7 +184,7 @@ homeUser uid = do | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) ) ] -} - , dbtAttrs = tableDefault + , dbtStyle = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines } , dbtIdent = "upcomingdeadlines" :: Text } defaultLayout $ do diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index e5fa8e23a..7bd1e6160 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -232,7 +232,7 @@ getSShowR tid csh shn = do fileTable <- dbTable def $ DBTable { dbtSQLQuery = fileData , dbtColonnade = colonnadeFiles - , dbtAttrs = tableDefault + , dbtStyle = def , dbtFilter = Map.empty , dbtIdent = "files" :: Text -- TODO: Add column for and visibility date diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index aa574d5d6..5ff6058a1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -288,7 +288,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do smid2ArchiveTable (smid,cid) = DBTable { dbtSQLQuery = submissionFiles smid , dbtColonnade = colonnadeFiles cid - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "files" :: Text , dbtSorting = [ ( "path" , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle] diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index b3a6a3f5a..22782165f 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -99,7 +99,7 @@ getTermShowR = do E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs ) ] - , dbtAttrs = tableDefault + , dbtStyle = def , dbtIdent = "terms" :: Text } defaultLayout $ do diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 17aadafb9..9d3965c57 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -4,6 +4,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} module Handler.Users where @@ -11,39 +12,100 @@ import Import -- import Data.Text import Handler.Utils -import Colonnade hiding (fromMaybe) -import Yesod.Colonnade +import qualified Data.Map as Map +import qualified Data.Set as Set --- import qualified Database.Esqueleto as E --- import Database.Esqueleto ((^.)) +import qualified Database.Esqueleto as E +hijackUserForm :: UserId -> Form UserId +hijackUserForm uid csrf = do + cID <- encrypt uid + (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser) + (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing + + return (uid <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView]) + getUsersR :: Handler Html getUsersR = do - -- TODO: Esqueleto, combine the two queries into one - (users,schools) <- runDB $ (,) - <$> (selectList [] [Asc UserDisplayName] - >>= mapM (\usr -> (,,) - <$> pure usr - <*> selectList [UserAdminUser ==. entityKey usr] [Asc UserAdminSchool] - <*> selectList [UserLecturerUser ==. entityKey usr] [Asc UserLecturerSchool] - )) - <*> selectList [] [Asc SchoolShorthand] - let schoolnames = entities2map schools - let getSchoolname = \sid -> - case lookup sid schoolnames of - Nothing -> "???" - (Just school) -> schoolShorthand school - let colonnadeUsers = mconcat $ - [ headed "User" $ \u -> do - cID <- encrypt $ entityKey $ fst3 u - let name = display $ userDisplayName $ entityVal $ fst3 u - [whamlet|#{name}|] - , headed "Admin" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool .entityVal) $ snd3 u) - , headed "Lecturer" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u) + let + colonnadeUsers = dbColonnade . mconcat $ + [ dbRow + , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM + (AdminUserR <$> encrypt uid) + (toWidget . display $ userDisplayName) + , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty + { dbCellContents = do + schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do + E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool + E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid + E.orderBy [E.asc $ school E.^. SchoolShorthand] + return $ school E.^. SchoolShorthand + return [whamlet| +