Display pseudonyms & anonymise submission page

Fixes #118

messages/uniworx/de.msg

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

src/Handler/Corrections.hs

@@ -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
+  cell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
-    anchorCellM (link <$> encrypt userId) (nameWidget userDisplayName userSurname)
+    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
+      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) -> 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

templates/submission.hamlet

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