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

Display pseudonyms & anonymise submission page

Browse Source 
Fixes #118
This commit is contained in:
Gregor Kleen 2018-10-21 12:08:01 +02:00
parent bd260d1a38
commit 353e958755
3 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/de.msg
View File

@ -258,6 +258,7 @@ RatingPercent: Erreicht
RatingFiles: Korrigierte Dateien
PointsNotPositive: Punktzahl darf nicht negativ sein
RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist
Pseudonyms: Pseudonyme
FileTitle: Dateiname
FileModified: Letzte Änderung

27
src/Handler/Corrections.hs
View File

@ -91,7 +91,7 @@ sheetIs :: Key Sheet -> CorrectionsWhere
sheetIs shid (_course,sheet,_submission) = sheet E.^. SheetId E.==. E.val shid
type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId User)
type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym))
colTerm :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colTerm = sortable (Just "term") (i18nCell MsgTerm)
@ -143,13 +143,15 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp
tid = course ^. _3
ssh = course ^. _4
link cid = CourseR tid ssh csh $ CUserR cid
cell = listCell (Map.toList users) $ \(userId, User{..}) -> do
anchorCellM (link <$> encrypt userId) (nameWidget userDisplayName userSurname)
cell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
anchorCellM (link <$> encrypt userId) $ case mPseudo of
Nothing -> nameWidget userDisplayName userSurname
Just p -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review pseudonymText p})|]
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
colSMatrikel :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
cell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
@ -171,6 +173,12 @@ colRated :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
maybe mempty timeCell submissionRatingTime
colPseudonyms :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo ->
cell [whamlet|#{review pseudonymText pseudo}|]
in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
@ -191,14 +199,16 @@ makeCorrectionsTable whereClause colChoices psValidator = do
)
return (submission, sheet, crse, corrector)
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData
dbtProj = traverse $ \(submission@(Entity sId _), sheet, (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do
submittors <- lift . E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do
submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
E.orderBy [E.asc $ user E.^. UserId]
return user
return (user, pseudonym E.?. SheetPseudonymPseudonym)
let
submittorMap = foldr (\(Entity userId user) -> Map.insert userId user) Map.empty submittors
submittorMap = foldr (\((Entity userId user, E.Value pseudo)) -> Map.insert userId (user, pseudo)) Map.empty submittors
return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, submittorMap)
dbTable psValidator $ DBTable
{ dbtSQLQuery
@ -383,6 +393,7 @@ postCorrectionsR = do
, colTerm
, colCourse
, colSheet
, colPseudonyms
, colSubmissionLink
, colAssigned
, colRating

2
templates/submission.hamlet
View File

@ -13,7 +13,7 @@ $maybe cID <- mcid
<p>
_{MsgSubmissionNoUploadExpected}
$if not (null lastEdits)
$if maySubmit && not (null lastEdits)
<h3>_{MsgLastEdits}
<ul>
$forall (mbName,time) <- lastEdits