From 05e7b52f08354b9a83d5db1be9c084955a8cba97 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 15 Jul 2019 11:27:56 +0200
Subject: [PATCH 01/36] fix(exams): cleanup exam interface

BREAKING CHANGE: examStart and examPublishOccurrenceAssignments now optional
---
 messages/uniworx/de.msg             | 23 ++++++-----
 models/exams                        |  4 +-
 src/Foundation.hs                   |  2 +-
 src/Handler/Course.hs               | 10 +----
 src/Handler/Exam.hs                 | 61 +++++++++++++++++------------
 src/Handler/Home.hs                 | 10 +----
 src/Handler/Utils/DateTime.hs       | 46 +++++++++++++++++++++-
 src/Handler/Utils/Form.hs           |  4 +-
 src/Handler/Utils/Form/MassInput.hs |  2 -
 src/Import/NoModel.hs               |  2 +
 src/Utils/DateTime.hs               | 21 +++++++++-
 src/Utils/Form.hs                   | 10 +++++
 templates/exam-show.hamlet          | 14 +++----
 13 files changed, 139 insertions(+), 70 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index ef0003579..8ae874e40 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1069,9 +1069,9 @@ ExamRegisterFrom: Anmeldung ab
 ExamRegisterFromTip: Zeitpunkt ab dem sich Kursteilnehmer selbständig zur Klausur anmelden können; ohne Datum ist keine Anmeldung möglich
 ExamRegisterTo: Anmeldung bis
 ExamDeregisterUntil: Abmeldung bis
-ExamPublishOccurrenceAssignments: Terminzuteilung den Teilnehmern mitteilen um
-ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt Teilnehmer einsehen zu welchen Teilprüfungen (Räumen) sie angemeldet sind
-ExamPublishOccurrenceAssignmentsParticipant: Terminzuteilung einsehbar ab
+ExamPublishOccurrenceAssignments: Termin- bzw. Raumzuteilung den Teilnehmern mitteilen um
+ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt Teilnehmer einsehen zu welcher Teilprüfung bzw. welchen Raum sie angemeldet sind
+ExamPublishOccurrenceAssignmentsParticipant: Termin- bzw. Raumzuteilung einsehbar ab
 ExamFinished: Bewertung abgeschlossen ab
 ExamFinishedParticipant: Bewertung vorrausichtlich abgeschlossen
 ExamFinishedTip: Zeitpunkt zu dem Klausurergebnisse den Teilnehmern gemeldet werden
@@ -1082,7 +1082,7 @@ ExamShowGradesTip: Soll den Teilnehmern ihre genaue Note angezeigt werden, oder
 ExamPublicStatistics: Statistik veröffentlichen
 ExamPublicStatisticsTip: Soll die statistische Auswertung auch den Teilnehmer angezeigt werden, sobald diese ihre Noten einsehen können?
 ExamGradingRule: Notenberechnung
-ExamGradingManual': Manuell
+ExamGradingManual': Keine automatische Berechnung
 ExamGradingKey': Nach Schlüssel
 ExamGradingKey: Notenschlüssel
 ExamGradingKeyTip: Die Grenzen beziehen sich auf die effektive Maximalpunktzahl, nachdem etwaige Bonuspunkte aus dem Übungsbetrieb angerechnet und die Ergebnise der Teilaufgaben mit ihrem Gewicht multipliziert wurden
@@ -1092,7 +1092,7 @@ PointsMustBeMonotonic: Punktegrenzen müssen aufsteigend sein
 GradingFrom: Ab
 ExamNew: Neue Klausur
 ExamBonusRule: Klausurbonus aus Übungsbetrieb
-ExamNoBonus': Kein Bonus
+ExamNoBonus': Kein automatischer Bonus
 ExamBonusPoints': Umrechnung von Übungspunkten
 
 ExamEditHeading examn@ExamName: #{examn} bearbeiten
@@ -1101,8 +1101,8 @@ ExamBonusMaxPoints: Maximal erreichbare Klausur-Bonuspunkte
 ExamBonusMaxPointsNonPositive: Maximaler Klausurbonus muss positiv und größer null sein
 ExamBonusOnlyPassed: Bonus nur nach Bestehen anrechnen
 
-ExamOccurrenceRule: Automatische Terminzuteilung
-ExamOccurrenceRuleParticipant: Terminzuteilung
+ExamOccurrenceRule: Automatische Termin- bzw. Raumzuteilung
+ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilung
 ExamRoomManual': Keine automatische Zuteilung
 ExamRoomSurname': Nach Nachname
 ExamRoomMatriculation': Nach Matrikelnummer
@@ -1121,7 +1121,7 @@ ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe
 ExamRoomRegistered: Zugeteilt
 
 ExamFormTimes: Zeiten
-ExamFormOccurrences: Prüfungstermine
+ExamFormOccurrences: Prüfungstermine/Räume
 ExamFormAutomaticFunctions: Automatische Funktionen
 ExamFormCorrection: Korrektur
 ExamFormParts: Teile
@@ -1159,7 +1159,7 @@ ExamRegistration: Anmeldung
 
 ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
 ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
-ExamStartMustBeAfterPublishOccurrenceAssignments: Start muss nach Veröffentlichung der Terminzuordnung liegen
+ExamStartMustBeAfterPublishOccurrenceAssignments: Start muss nach Veröffentlichung der Termin- bzw. Raumzuordnung liegen
 ExamEndMustBeAfterStart: Beginn der Klausur muss vor ihrem Ende liegen
 ExamFinishedMustBeAfterEnd: "Bewertung abgeschlossen ab" muss nach Ende liegen
 ExamFinishedMustBeAfterStart: "Bewertung abgeschlossen ab" muss nach Start liegen
@@ -1167,6 +1167,11 @@ ExamClosedMustBeAfterFinished: "Noten stehen fest ab" muss nach "Bewertung abges
 ExamClosedMustBeAfterStart: "Noten stehen fest ab" muss nach Start liegen
 ExamClosedMustBeAfterEnd: "Noten stehen fest ab" muss nach Ende liegen
 
+ExamOccurrenceEndMustBeAfterStart eoRoom@Text eoRange@Text: Beginn des Termins #{eoRoom} #{eoRange} muss vor seinem Ende liegen
+ExamOccurrenceStartMustBeAfterExamStart eoRoom@Text eoRange@Text: Beginn des Termins #{eoRoom} #{eoRange} muss nach Beginn der Klausur liegen
+ExamOccurrenceEndMustBeBeforeExamEnd eoRoom@Text eoRange@Text: Ende des Termins #{eoRoom} #{eoRange} muss vor Ende der Klausur liegen
+ExamOccurrenceDuplicate eoRoom@Text eoRange@Text: Raum #{eoRoom}, Termin #{eoRange} kommt mehrfach mit der selben Beschreibung vor
+
 VersionHistory: Versionsgeschichte
 KnownBugs: Bekannte Bugs
 
diff --git a/models/exams b/models/exams
index 809ba3f1b..14cd8784b 100644
--- a/models/exams
+++ b/models/exams
@@ -8,8 +8,8 @@ Exam
   registerFrom UTCTime Maybe
   registerTo UTCTime Maybe
   deregisterUntil UTCTime Maybe
-  publishOccurrenceAssignments UTCTime
-  start UTCTime
+  publishOccurrenceAssignments UTCTime Maybe
+  start UTCTime Maybe
   end UTCTime Maybe
   finished UTCTime Maybe -- Grades shown to students, `ExamCorrector`s locked out
   closed UTCTime Maybe -- Prüfungsamt hat Einsicht (notification)
diff --git a/src/Foundation.hs b/src/Foundation.hs
index f16c9dc79..af6f3421d 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -678,7 +678,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
 
     case subRoute of
       EShowR     -> guard visible
-      EUsersR    -> guard $ examStart <= cTime
+      EUsersR    -> guard $ NTop examStart <= NTop (Just cTime)
                          && NTop (Just cTime) <= NTop examFinished
       ERegisterR
         | not registered -> guard $ visible
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 404338e73..ef99c06de 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -425,15 +425,7 @@ getCShowR tid ssh csh = do
           [ sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) (toWidget examName)
           , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
-          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> cell $ do
-              startT <- formatTime SelFormatDateTime examStart
-              endT <- traverse (\examEnd' -> formatTime (bool SelFormatDateTime SelFormatTime $ ((==) `on` utctDay) examStart examEnd') examEnd') examEnd
-              [whamlet|
-                $newline never
-                #{startT}
-                $maybe endT' <- endT
-                  \ – #{endT'}
-              |]
+          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
           , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
               mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
               isRegistered <- case mbAid of
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 1758e3ffa..1be2b99fa 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -56,15 +56,7 @@ getCExamListR tid ssh csh = do
           , (<$ guard mayCreate) . sortable (Just "visible") (i18nCell MsgExamVisibleFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty (dateTimeCellVisible now) examVisibleFrom
           , Just . sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , Just . sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
-          , Just . sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> cell $ do
-              startT <- formatTime SelFormatDateTime examStart
-              endT <- traverse (\examEnd' -> formatTime (bool SelFormatDateTime SelFormatTime $ ((==) `on` utctDay) examStart examEnd') examEnd') examEnd
-              [whamlet|
-                $newline never
-                #{startT}
-                $maybe endT' <- endT
-                  \ – #{endT'}
-              |]
+          , Just . sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
           ]
         dbtSorting = Map.fromList
           [ ("name", SortColumn $ \exam -> exam E.^. ExamName )
@@ -154,13 +146,13 @@ postECInviteR = invitationR examCorrectorInvitationConfig
 data ExamForm = ExamForm
   { efName :: ExamName
   , efDescription :: Maybe Html
-  , efStart :: UTCTime
+  , efStart :: Maybe UTCTime
   , efEnd :: Maybe UTCTime
   , efVisibleFrom :: Maybe UTCTime
   , efRegisterFrom :: Maybe UTCTime
   , efRegisterTo :: Maybe UTCTime
   , efDeregisterUntil :: Maybe UTCTime
-  , efPublishOccurrenceAssignments :: UTCTime
+  , efPublishOccurrenceAssignments :: Maybe UTCTime
   , efFinished :: Maybe UTCTime
   , efClosed :: Maybe UTCTime
   , efOccurrences :: Set ExamOccurrenceForm
@@ -189,6 +181,8 @@ data ExamPartForm = ExamPartForm
   , epfWeight :: Rational
   } deriving (Read, Show, Eq, Ord, Generic, Typeable)
 
+makeLenses_ ''ExamForm
+
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   } ''ExamPartForm
@@ -206,13 +200,13 @@ examForm template html = do
     <$> areq ciField (fslpI MsgExamName (mr MsgExamName) & setTooltip MsgExamNameTip) (efName <$> template)
     <*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslpI MsgExamDescription "Html") (efDescription <$> template))
     <*  aformSection MsgExamFormTimes
-    <*> areq utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template)
+    <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template)
     <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip MsgExamTimeTip) (efEnd <$> template)
     <*> aopt utcTimeField (fslpI MsgExamVisibleFrom (mr MsgDate) & setTooltip MsgExamVisibleFromTip) (efVisibleFrom <$> template)
     <*> aopt utcTimeField (fslpI MsgExamRegisterFrom (mr MsgDate) & setTooltip MsgExamRegisterFromTip) (efRegisterFrom <$> template)
     <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template)
     <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template)
-    <*> areq utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignments) (efPublishOccurrenceAssignments <$> template)
+    <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template)
     <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip MsgExamFinishedTip) (efFinished <$> template)
     <*> aopt utcTimeField (fslpI MsgExamClosed (mr MsgDate) & setTooltip MsgExamClosedTip) (efClosed <$> template)
     <*  aformSection MsgExamFormOccurrences
@@ -221,7 +215,7 @@ examForm template html = do
     <*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (Just . efShowGrades <$> template))
     <*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (Just . efPublicStatistics <$> template))
     <*> examGradingRuleForm (efGradingRule <$> template)
-    <*> bonusRuleForm (efBonusRule <$> template)
+    <*> examBonusRuleForm (efBonusRule <$> template)
     <*> examOccurrenceRuleForm (efOccurrenceRule <$> template)
     <*  aformSection MsgExamFormCorrection
     <*> examCorrectorsForm (efCorrectors <$> template)
@@ -272,7 +266,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
     miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()
     miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/examCorrectors/layout")
 
-  fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip MsgMassInputTip) True (Set.toList <$> mPrev)
+  fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip MsgMassInputTip) False (Set.toList <$> mPrev)
 
 examOccurrenceForm :: Maybe (Set ExamOccurrenceForm) -> AForm Handler (Set ExamOccurrenceForm)
 examOccurrenceForm prev = wFormToAForm $ do
@@ -281,7 +275,7 @@ examOccurrenceForm prev = wFormToAForm $ do
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
   
-  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences & setTooltip MsgMassInputTip) True $ Set.toList <$> prev
+  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
   where
     examOccurrenceForm' nudge mPrev csrf = do
       (eofIdRes, eofIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ eofId =<< mPrev)
@@ -321,7 +315,7 @@ examPartsForm prev = wFormToAForm $ do
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
   
-  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts & setTooltip MsgMassInputTip) True $ Set.toList <$> prev
+  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
   where
     examPartForm' nudge mPrev csrf = do
       (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)
@@ -436,8 +430,8 @@ examTemplate cid = runMaybeT $ do
     , efRegisterFrom     = dateOffset <$> examRegisterFrom oldExam
     , efRegisterTo       = dateOffset <$> examRegisterTo oldExam
     , efDeregisterUntil  = dateOffset <$> examDeregisterUntil oldExam
-    , efPublishOccurrenceAssignments = dateOffset $ examPublishOccurrenceAssignments oldExam
-    , efStart            = dateOffset $ examStart oldExam
+    , efPublishOccurrenceAssignments = dateOffset <$> examPublishOccurrenceAssignments oldExam
+    , efStart            = dateOffset <$> examStart oldExam
     , efEnd              = dateOffset <$> examEnd oldExam
     , efFinished         = dateOffset <$> examFinished oldExam
     , efClosed           = dateOffset <$> examClosed oldExam
@@ -456,14 +450,31 @@ validateExam = do
   
   guardValidation MsgExamRegisterToMustBeAfterRegisterFrom                 $ NTop efRegisterTo                   >= NTop efRegisterFrom
   guardValidation MsgExamDeregisterUntilMustBeAfterRegisterFrom            $ NTop efDeregisterUntil              >= NTop efRegisterFrom
-  guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      $ efStart                             >= efPublishOccurrenceAssignments
-  guardValidation MsgExamEndMustBeAfterStart                               $ NTop efEnd                          >= NTop (Just efStart)
+  guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      . fromMaybe True $ (>=) <$> efStart <*> efPublishOccurrenceAssignments
+  guardValidation MsgExamEndMustBeAfterStart                               $ NTop efEnd                          >= NTop efStart
   guardValidation MsgExamFinishedMustBeAfterEnd                            . fromMaybe True $ (>=) <$> efFinished <*> efEnd
-  guardValidation MsgExamFinishedMustBeAfterStart                          $ NTop efFinished                     >= NTop (Just efStart)
+  guardValidation MsgExamFinishedMustBeAfterStart                          $ NTop efFinished                     >= NTop efStart
   guardValidation MsgExamClosedMustBeAfterFinished                         . fromMaybe True $ (>=) <$> efClosed <*> efFinished
-  guardValidation MsgExamClosedMustBeAfterStart                            $ NTop efClosed                       >= NTop (Just efStart)
+  guardValidation MsgExamClosedMustBeAfterStart                            $ NTop efClosed                       >= NTop efStart
   guardValidation MsgExamClosedMustBeAfterEnd                              . fromMaybe True $ (>=) <$> efClosed <*> efEnd
 
+  forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
+    eofRange' <- formatTimeRange SelFormatDateTime eofStart eofEnd
+    
+    guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofRoom eofRange') $ NTop eofEnd >= NTop (Just eofStart)
+    guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofRoom eofRange') $ NTop (Just eofStart) >= NTop efStart
+    guardValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofRoom eofRange') $ NTop eofEnd <= NTop efEnd
+
+  forM_ [ (a, b) | a <- Set.toAscList efOccurrences, b <- Set.toAscList efOccurrences, b > a ] $ \(a, b) -> do
+    eofRange' <- formatTimeRange SelFormatDateTime (eofStart a) (eofEnd a)
+
+    guardValidation (MsgExamOccurrenceDuplicate (eofRoom a) eofRange') $ any (\f -> f a b)
+      [ (/=) `on` eofRoom
+      , (/=) `on` eofStart
+      , (/=) `on` eofEnd
+      , (/=) `on` fmap renderHtml . eofDescription
+      ]
+
 
 getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamNewR = postCExamNewR
@@ -669,7 +680,7 @@ getEShowR tid ssh csh examn = do
     let gradingVisible = NTop (Just cTime) >= NTop examFinished
     gradingShown <- or2M (return gradingVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
-    let occurrenceAssignmentsVisible = cTime >= examPublishOccurrenceAssignments
+    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments
     occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
     parts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
@@ -703,7 +714,7 @@ getEShowR tid ssh csh examn = do
 
     return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister))
 
-  let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
+  let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
       registerWidget
         | Just isRegistered <- registered
         , mayRegister = Just $ do
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 7103afe14..4033e8ae1 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -231,15 +231,7 @@ homeUpcomingExams uid = do
               indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) (toWidget examName)
           , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
-          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = view lensExam -> Entity _ Exam{..} } -> cell $ do
-              startT <- formatTime SelFormatDateTime examStart
-              endT <- traverse (\examEnd' -> formatTime (bool SelFormatDateTime SelFormatTime $ ((==) `on` utctDay) examStart examEnd') examEnd') examEnd
-              [whamlet|
-                $newline never
-                #{startT}
-                $maybe endT' <- endT
-                  \ – #{endT'}
-              |]
+          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
           {- NOTE: We do not want thoughtless exam registrations, since many people click "register" and don't show up, causing logistic problems.
              Hence we force them here to click twice. Maybe add a captcha where users have to distinguish pictures showing pink elephants and course lecturers.
           , sortable Nothing mempty $ \DBRow{ dbrOutput } -> sqlCell $ do
diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs
index 8297f7266..f0ba27edb 100644
--- a/src/Handler/Utils/DateTime.hs
+++ b/src/Handler/Utils/DateTime.hs
@@ -3,10 +3,11 @@ module Handler.Utils.DateTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)
   , toMidnight, beforeMidnight, toMidday, toMorning
   , formatDiffDays
-  , formatTime, formatTime', formatTimeW
+  , formatTime'
+  , formatTime, formatTimeW, formatTimeMail
+  , formatTimeRange, formatTimeRangeW, formatTimeRangeMail
   , getTimeLocale, getDateTimeFormat
   , validDateTimeFormats, dateTimeFormatOptions
-  , formatTimeMail
   , addOneWeek, addWeeks
   , weeksToAdd
   , setYear
@@ -236,3 +237,44 @@ ceilingMinuteBy margin roundto utct = addUTCTime bonus utct
     newMin  = roundToNearestMultiple roundto $ oldMin + margin
     newTime = oldTime { todMin = newMin, todSec = 0 } -- might be invalid, but correctly treated by `timeOfDayToTime`
     bonus   = realToFrac $ timeOfDayToTime newTime - timeOfDayToTime oldTime
+
+
+formatTimeRange' :: ( HasLocalTime t, HasLocalTime t'
+                    , Monad m
+                    )
+                 => (forall t2. HasLocalTime t2 => SelDateTimeFormat -> t2 -> m Text) -- ^ @formatTime@
+                 -> SelDateTimeFormat
+                 -> t -- ^ Start
+                 -> Maybe t' -- ^ End
+                 -> m Text
+formatTimeRange' cont proj startT endT = do
+  startT' <- cont proj startT
+  let
+    endProj = (/\ proj) $ if
+      | Just endT' <- endT
+      , ((==) `on` localDay) (toLocalTime startT) (toLocalTime endT')
+      -> SelFormatTime
+      | otherwise
+      -> SelFormatDateTime
+  endT' <- for endT $ cont endProj
+
+  return $ case endT' of
+    Nothing     -> startT'
+    Just endT'' -> [st|#{startT'} – #{endT''}|]
+
+
+formatTimeRange :: ( HasLocalTime t, HasLocalTime t'
+                   , MonadHandler m
+                   , HandlerSite m ~ UniWorX
+                   )
+                => SelDateTimeFormat
+                -> t -- ^ Start
+                -> Maybe t' -- ^ End
+                -> m Text
+formatTimeRange = formatTimeRange' formatTime
+
+formatTimeRangeW :: (HasLocalTime t, HasLocalTime t') => SelDateTimeFormat -> t -> Maybe t' -> Widget
+formatTimeRangeW s t t' = toWidget =<< formatTimeRange s t t'
+
+formatTimeRangeMail :: (MonadMail m, HasLocalTime t, HasLocalTime t') => SelDateTimeFormat -> t -> Maybe t' -> m Text
+formatTimeRangeMail = formatTimeRange' formatTimeMail
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 58ea2ffaf..76a0a1a31 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -463,8 +463,8 @@ classifyBonusRule = \case
   ExamNoBonus       -> ExamNoBonus'
   ExamBonusPoints{} -> ExamBonusPoints'
 
-bonusRuleForm :: Maybe ExamBonusRule -> AForm Handler ExamBonusRule
-bonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classifyBonusRule <$> prev
+examBonusRuleForm :: Maybe ExamBonusRule -> AForm Handler ExamBonusRule
+examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classifyBonusRule <$> prev
   where
     actions :: Map ExamBonusRule' (AForm Handler ExamBonusRule)
     actions = Map.fromList
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index ae87527bf..c8a869514 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -21,8 +21,6 @@ import Utils.Lens
 import Handler.Utils.Form.MassInput.Liveliness
 import Handler.Utils.Form.MassInput.TH
 
-import Algebra.Lattice hiding (join)
-
 import Text.Blaze (Markup)
 
 import qualified Data.Text as Text
diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs
index bb7c5dd78..cd1bd66c2 100644
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@@ -77,6 +77,8 @@ import Data.Aeson.Types as Import (FromJSON(..), ToJSON(..), FromJSONKey(..), To
 import Data.Constraint as Import (Dict(..))
 import Data.Void as Import (Void)
 
+import Algebra.Lattice as Import hiding (meet, join)
+
 import Language.Haskell.TH.Instances as Import ()
 import Data.List.NonEmpty.Instances as Import ()
 import Data.NonNull.Instances as Import ()
diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs
index 3f66c65ee..97b73481d 100644
--- a/src/Utils/DateTime.hs
+++ b/src/Utils/DateTime.hs
@@ -34,6 +34,9 @@ import Data.Aeson.TH
 import Utils.PathPiece
 
 import Data.Time.Format.Instances ()
+
+import Algebra.Lattice
+import Algebra.Lattice.Ordered
   
 
 -- $(timeLocaleMap _) :: [Lang] -> TimeLocale
@@ -78,7 +81,7 @@ newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
 
 instance Hashable DateTimeFormat
 
-data SelDateTimeFormat = SelFormatDateTime | SelFormatDate | SelFormatTime
+data SelDateTimeFormat = SelFormatDate | SelFormatTime | SelFormatDateTime
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic, Typeable)
 
 instance Universe SelDateTimeFormat
@@ -98,3 +101,19 @@ instance {-# OVERLAPPING #-} Default (SelDateTimeFormat -> DateTimeFormat) where
   def SelFormatDateTime = "%c"
   def SelFormatDate     = "%F"
   def SelFormatTime     = "%T"
+
+instance JoinSemiLattice SelDateTimeFormat where
+  a \/ b = getOrdered $ ((\/) `on` Ordered) a b
+
+instance MeetSemiLattice SelDateTimeFormat where
+  a /\ b = getOrdered $ ((/\) `on` Ordered) a b
+
+instance Lattice SelDateTimeFormat
+
+instance BoundedJoinSemiLattice SelDateTimeFormat where
+  bottom = SelFormatTime
+  
+instance BoundedMeetSemiLattice SelDateTimeFormat where
+  top = SelFormatDateTime
+
+instance BoundedLattice SelDateTimeFormat
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 1749dd51a..ae9cb5325 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 module Utils.Form where
@@ -832,9 +833,18 @@ deriving newtype instance Monad m => Applicative (FormValidator r m)
 deriving newtype instance Monad m => Monad (FormValidator r m)
 deriving newtype instance Monad m => MonadState r (FormValidator r m)
 deriving newtype instance MonadFix m => MonadFix (FormValidator r m)
+deriving newtype instance MonadResource m => MonadResource (FormValidator r m)
+deriving newtype instance MonadThrow m => MonadThrow (FormValidator r m)
+deriving newtype instance MonadIO m => MonadIO (FormValidator r m)
+instance MonadBase b m => MonadBase b (FormValidator r m) where
+  liftBase = lift . liftBase
 instance MonadTrans (FormValidator r) where
   lift = FormValidator . lift
 
+instance MonadHandler m => MonadHandler (FormValidator r m) where
+  type HandlerSite (FormValidator r m) = HandlerSite m
+  liftHandlerT = lift . liftHandlerT
+
 validateForm :: MonadHandler m
              => FormValidator a m ()
              -> (Markup -> MForm m (FormResult a, xml))
diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet
index 3603fee38..56b8b0fd1 100644
--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@@ -44,14 +44,14 @@ $maybe desc <- examDescription
     $maybe deregUntil <- examDeregisterUntil
       <dt .deflist__dt>_{MsgExamDeregisterUntil}
       <dd .deflist__dd>^{formatTimeW SelFormatDateTime deregUntil}
-    <dt .deflist__dt>_{MsgExamPublishOccurrenceAssignmentsParticipant}
-    <dd .deflist__dd>^{formatTimeW SelFormatDateTime examPublishOccurrenceAssignments}
+    $maybe publishAssignments <- examPublishOccurrenceAssignments
+      <dt .deflist__dt>_{MsgExamPublishOccurrenceAssignmentsParticipant}
+      <dd .deflist__dd>^{formatTimeW SelFormatDateTime publishAssignments}
     $if examTimes
       <dt .deflist__dt>_{MsgExamTime}
       <dd .deflist__dd>
-        ^{formatTimeW SelFormatDateTime examStart}
-        $maybe end <- examEnd
-          \ – ^{formatTimeW (bool SelFormatDateTime SelFormatTime ((on (==) utctDay) examStart end)) end}
+        $maybe start <- examStart
+          ^{formatTimeRangeW SelFormatDateTime start examEnd}
     $maybe finished <- examFinished
       <dt .deflist__dt>_{MsgExamFinishedParticipant}
       <dd .deflist__dd>^{formatTimeW SelFormatDateTime finished}
@@ -108,9 +108,7 @@ $if not (null occurrences)
             <td .table__td>#{examOccurrenceRoom}
             $if not examTimes
               <td .table__td>
-                ^{formatTimeW SelFormatDateTime examOccurrenceStart}
-                $maybe end <- examOccurrenceEnd
-                  \ – ^{formatTimeW (bool SelFormatDateTime SelFormatTime ((on (==) utctDay) examStart end)) end}
+                ^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
             <td .table__td>
               $maybe desc <- examOccurrenceDescription
                 #{desc}

From 379a7edd12b16ed55d39e99637de647a51fb4267 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 15 Jul 2019 15:38:37 +0200
Subject: [PATCH 02/36] feat(exams): introduce examOccurrenceName

BREAKING CHANGE: examOccurrenceName
---
 messages/uniworx/de.msg                       |  9 ++--
 models/exams                                  |  2 +
 src/Data/CaseInsensitive/Instances.hs         | 12 ++++-
 src/Data/UUID/Instances.hs                    | 15 +++++-
 src/Handler/Corrections.hs                    |  2 +-
 src/Handler/Course.hs                         |  4 +-
 src/Handler/Exam.hs                           | 37 ++++++++++-----
 src/Handler/Home.hs                           | 10 ++--
 src/Handler/Sheet.hs                          |  2 +-
 src/Handler/SystemMessage.hs                  |  2 +-
 src/Handler/Tutorial.hs                       |  2 +-
 src/Handler/Utils/Table/Cells.hs              |  8 ++--
 src/Handler/Utils/Table/Pagination.hs         | 46 ++++++++++---------
 src/Model/Migration.hs                        | 34 ++++++++++++--
 src/Model/Types/Common.hs                     | 25 +++++-----
 templates/default-layout.lucius               |  5 ++
 templates/exam-show.hamlet                    |  8 +++-
 templates/table/cell/link.hamlet              |  4 +-
 .../widgets/massinput/examRooms/form.hamlet   |  3 +-
 .../widgets/massinput/examRooms/layout.hamlet |  1 +
 20 files changed, 156 insertions(+), 75 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 8ae874e40..8d72c3384 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1108,8 +1108,10 @@ ExamRoomSurname': Nach Nachname
 ExamRoomMatriculation': Nach Matrikelnummer
 ExamRoomRandom': Zufällig pro Teilnehmer
 
+ExamOccurrence: Termin/Raum
 ExamOccurrences: Prüfungen
 ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
+ExamRoomName: Interne Bezeichnung
 ExamRoom: Raum
 ExamRoomCapacity: Kapazität
 ExamRoomCapacityNegative: Kapazität darf nicht negativ sein
@@ -1167,10 +1169,11 @@ ExamClosedMustBeAfterFinished: "Noten stehen fest ab" muss nach "Bewertung abges
 ExamClosedMustBeAfterStart: "Noten stehen fest ab" muss nach Start liegen
 ExamClosedMustBeAfterEnd: "Noten stehen fest ab" muss nach Ende liegen
 
-ExamOccurrenceEndMustBeAfterStart eoRoom@Text eoRange@Text: Beginn des Termins #{eoRoom} #{eoRange} muss vor seinem Ende liegen
-ExamOccurrenceStartMustBeAfterExamStart eoRoom@Text eoRange@Text: Beginn des Termins #{eoRoom} #{eoRange} muss nach Beginn der Klausur liegen
-ExamOccurrenceEndMustBeBeforeExamEnd eoRoom@Text eoRange@Text: Ende des Termins #{eoRoom} #{eoRange} muss vor Ende der Klausur liegen
+ExamOccurrenceEndMustBeAfterStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss vor seinem Ende liegen
+ExamOccurrenceStartMustBeAfterExamStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss nach Beginn der Klausur liegen
+ExamOccurrenceEndMustBeBeforeExamEnd eoName@ExamOccurrenceName: Ende des Termins #{eoName} muss vor Ende der Klausur liegen
 ExamOccurrenceDuplicate eoRoom@Text eoRange@Text: Raum #{eoRoom}, Termin #{eoRange} kommt mehrfach mit der selben Beschreibung vor
+ExamOccurrenceDuplicateName eoName@ExamOccurrenceName: Interne Terminbezeichnung #{eoName} kommt mehrfach vor
 
 VersionHistory: Versionsgeschichte
 KnownBugs: Bekannte Bugs
diff --git a/models/exams b/models/exams
index 14cd8784b..a98a427ca 100644
--- a/models/exams
+++ b/models/exams
@@ -25,11 +25,13 @@ ExamPart
   UniqueExamPart exam name
 ExamOccurrence
   exam ExamId
+  name ExamOccurrenceName
   room Text
   capacity Natural
   start UTCTime
   end UTCTime Maybe
   description Html Maybe
+  UniqueExamOccurrence exam name
 ExamRegistration
   exam ExamId
   user UserId
diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs
index b6b69fa02..4fb1bf0a2 100644
--- a/src/Data/CaseInsensitive/Instances.hs
+++ b/src/Data/CaseInsensitive/Instances.hs
@@ -29,6 +29,8 @@ import Web.HttpApiData
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
 
+import qualified Data.Csv as Csv
+
 
 instance PersistField (CI Text) where
   toPersistValue ciText = PersistDbSpecific . Text.encodeUtf8 $ CI.original ciText
@@ -86,11 +88,11 @@ instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where
   fromPathPiece = fmap CI.mk . fromPathPiece
   toPathPiece = toPathPiece . CI.original
 
-instance ToHttpApiData (CI Text) where
+instance ToHttpApiData s => ToHttpApiData (CI s) where
   toUrlPiece = toUrlPiece . CI.original
   toEncodedUrlPiece = toEncodedUrlPiece . CI.original
 
-instance FromHttpApiData (CI Text) where
+instance (CI.FoldCase s, FromHttpApiData s) => FromHttpApiData (CI s) where
   parseUrlPiece = fmap CI.mk . parseUrlPiece
 
 instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
@@ -101,3 +103,9 @@ instance (CI.FoldCase s, Binary s) => Binary (CI s) where
   get = CI.mk <$> Binary.get
   put = Binary.put . CI.original
   putList = Binary.putList . map CI.original
+
+instance Csv.ToField s => Csv.ToField (CI s) where
+  toField = Csv.toField . CI.original
+
+instance (CI.FoldCase s, Csv.FromField s) => Csv.FromField (CI s) where
+  parseField = fmap CI.original . Csv.parseField
diff --git a/src/Data/UUID/Instances.hs b/src/Data/UUID/Instances.hs
index 8a00de5e3..38b20d104 100644
--- a/src/Data/UUID/Instances.hs
+++ b/src/Data/UUID/Instances.hs
@@ -3,12 +3,13 @@
 module Data.UUID.Instances
   () where
 
-import ClassyPrelude
+import ClassyPrelude.Yesod
 import Data.UUID (UUID)
 import qualified Data.UUID as UUID
 
 import Database.Persist.Sql
-import Web.PathPieces
+
+import Text.Blaze (ToMarkup(..))
   
 
 instance PathPiece UUID where
@@ -25,3 +26,13 @@ instance PersistField UUID where
 
 instance PersistFieldSql UUID where
   sqlType _ = SqlOther "uuid"
+
+instance ToMarkup UUID where
+  toMarkup uuid = [shamlet|
+                    $newline never
+                    <span .uuid>
+                      #{UUID.toText uuid}
+                  |]
+
+instance ToWidget site UUID where
+  toWidget = toWidget . toMarkup
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index f1d5085a5..3e0a5a825 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -168,7 +168,7 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB
 
 colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
-  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
+  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer)
   in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
 
 colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index ef99c06de..0c72416e5 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -422,7 +422,7 @@ getCShowR tid ssh csh = do
           guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR
           return r
         dbtColonnade = dbColonnade $ mconcat
-          [ sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) (toWidget examName)
+          [ sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) examName
           , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
           , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
@@ -1053,7 +1053,7 @@ colUserComment tid ssh csh =
     sortable (Just "note") (i18nCell MsgCourseUserNote)
       $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } ->
         maybeEmpty mbNoteKey $ const $
-          anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True)
+          anchorCellM (courseLink <$> encrypt uid) (hasComment True)
   where
     courseLink = CourseR tid ssh csh . CUserR
 
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 1be2b99fa..03d92e282 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -52,7 +52,7 @@ getCExamListR tid ssh csh = do
           guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR
           return x
         dbtColonnade = dbColonnade . mconcat $ catMaybes
-          [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> anchorCell (CExamR tid ssh csh examName EShowR) $ toWidget examName
+          [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> anchorCell (CExamR tid ssh csh examName EShowR) examName
           , (<$ guard mayCreate) . sortable (Just "visible") (i18nCell MsgExamVisibleFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty (dateTimeCellVisible now) examVisibleFrom
           , Just . sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , Just . sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
@@ -167,6 +167,7 @@ data ExamForm = ExamForm
 
 data ExamOccurrenceForm = ExamOccurrenceForm
   { eofId :: Maybe CryptoUUIDExamOccurrence
+  , eofName :: ExamOccurrenceName
   , eofRoom :: Text
   , eofCapacity :: Natural
   , eofStart :: UTCTime
@@ -279,7 +280,8 @@ examOccurrenceForm prev = wFormToAForm $ do
   where
     examOccurrenceForm' nudge mPrev csrf = do
       (eofIdRes, eofIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ eofId =<< mPrev)
-      (eofRoomRes, eofRoomView) <- mpreq textField ("" & addName (nudge "name")) (eofRoom <$> mPrev)
+      (eofNameRes, eofNameView) <- mpreq ciField ("" & addName (nudge "name")) (eofName <$> mPrev)
+      (eofRoomRes, eofRoomView) <- mpreq textField ("" & addName (nudge "room")) (eofRoom <$> mPrev)
       (eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) ("" & addName (nudge "capacity")) (eofCapacity <$> mPrev)
       (eofStartRes, eofStartView) <- mpreq utcTimeField ("" & addName (nudge "start")) (eofStart <$> mPrev)
       (eofEndRes, eofEndView) <- mopt utcTimeField ("" & addName (nudge "end")) (eofEnd <$> mPrev)
@@ -287,6 +289,7 @@ examOccurrenceForm prev = wFormToAForm $ do
 
       return ( ExamOccurrenceForm
                  <$> eofIdRes
+                 <*> eofNameRes
                  <*> eofRoomRes
                  <*> eofCapacityRes
                  <*> eofStartRes
@@ -375,6 +378,7 @@ examFormTemplate (Entity eId Exam{..}) = do
         (Just -> eofId, ExamOccurrence{..}) <- occurrences'
         return ExamOccurrenceForm
           { eofId
+          , eofName        = examOccurrenceName
           , eofRoom        = examOccurrenceRoom
           , eofCapacity    = examOccurrenceCapacity
           , eofStart       = examOccurrenceStart
@@ -459,11 +463,9 @@ validateExam = do
   guardValidation MsgExamClosedMustBeAfterEnd                              . fromMaybe True $ (>=) <$> efClosed <*> efEnd
 
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
-    eofRange' <- formatTimeRange SelFormatDateTime eofStart eofEnd
-    
-    guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofRoom eofRange') $ NTop eofEnd >= NTop (Just eofStart)
-    guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofRoom eofRange') $ NTop (Just eofStart) >= NTop efStart
-    guardValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofRoom eofRange') $ NTop eofEnd <= NTop efEnd
+    guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName) $ NTop eofEnd >= NTop (Just eofStart)
+    guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofName) $ NTop (Just eofStart) >= NTop efStart
+    guardValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofName) $ NTop eofEnd <= NTop efEnd
 
   forM_ [ (a, b) | a <- Set.toAscList efOccurrences, b <- Set.toAscList efOccurrences, b > a ] $ \(a, b) -> do
     eofRange' <- formatTimeRange SelFormatDateTime (eofStart a) (eofEnd a)
@@ -475,6 +477,8 @@ validateExam = do
       , (/=) `on` fmap renderHtml . eofDescription
       ]
 
+    guardValidation (MsgExamOccurrenceDuplicateName $ eofName a) $ ((/=) `on` eofName) a b
+
 
 getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamNewR = postCExamNewR
@@ -521,6 +525,7 @@ postCExamNewR tid ssh csh = do
           [ ExamOccurrence{..}
           | ExamOccurrenceForm{..} <- Set.toList efOccurrences
           , let examOccurrenceExam        = examid
+                examOccurrenceName        = eofName
                 examOccurrenceRoom        = eofRoom
                 examOccurrenceCapacity    = eofCapacity
                 examOccurrenceStart       = eofStart
@@ -594,6 +599,7 @@ postEEditR tid ssh csh examn = do
           ExamOccurrenceForm{ eofId = Nothing, .. } -> insert_
             ExamOccurrence
               { examOccurrenceExam = eId
+              , examOccurrenceName = eofName
               , examOccurrenceRoom = eofRoom
               , examOccurrenceCapacity = eofCapacity
               , examOccurrenceStart = eofStart
@@ -607,6 +613,7 @@ postEEditR tid ssh csh examn = do
             guard $ examOccurrenceExam oldOcc == eId
             lift $ replace eofId' ExamOccurrence
               { examOccurrenceExam = eId
+              , examOccurrenceName = eofName
               , examOccurrenceRoom = eofRoom
               , examOccurrenceCapacity = eofCapacity
               , examOccurrenceStart = eofStart
@@ -672,7 +679,7 @@ getEShowR tid ssh csh examn = do
   cTime <- liftIO getCurrentTime
   mUid <- maybeAuthId
   
-  (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister)) <- runDB $ do
+  (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
     exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
 
     let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
@@ -712,7 +719,9 @@ getEShowR tid ssh csh examn = do
     registered <- for mUid $ existsBy . UniqueExamRegistration eId
     mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
 
-    return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister))
+    occurrenceNamesShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
+
+    return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown)
 
   let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
       registerWidget
@@ -772,6 +781,9 @@ queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
 queryExamRegistration :: ExamUserTableExpr -> E.SqlExpr (Entity ExamRegistration)
 queryExamRegistration = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
 
+queryExamOccurrence :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamOccurrence))
+queryExamOccurrence = $(sqlLOJproj 3 2)
+
 queryStudyDegree :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
 queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
   
@@ -800,7 +812,7 @@ data ExamUserTableCsv = ExamUserTableCsv
   , csvUserField :: Maybe Text
   , csvUserDegree :: Maybe Text
   , csvUserSemester :: Maybe Int
-  , csvUserRoom :: Maybe Text
+  , csvUserOccurrence :: Maybe (CI Text)
   }
   deriving (Generic)
 
@@ -843,7 +855,7 @@ postEUsersR tid ssh csh examn = do
           , colField            resultStudyField
           , colDegreeShort      resultStudyDegree
           , colFeaturesSemester resultStudyFeatures
-          , sortable (Just "room") (i18nCell MsgExamRoom) (maybe mempty (cell . toWgt . examOccurrenceRoom . entityVal) . view _userTableOccurrence)
+          , sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
           ] 
         dbtSorting = Map.fromList
           [ sortUserNameLink     queryUser
@@ -853,6 +865,7 @@ postEUsersR tid ssh csh examn = do
           , sortField            queryStudyField
           , sortDegreeShort      queryStudyDegree
           , sortFeaturesSemester queryStudyFeatures
+          , ("occurrence", SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
           ]
         dbtFilter = Map.fromList
           [ fltrUserNameEmail    queryUser
@@ -880,7 +893,7 @@ postEUsersR tid ssh csh examn = do
           <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
           <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
           <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
-          <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceRoom)
+          <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
         dbtCsvDecode = Nothing
 
     examUsersDBTableValidator = def
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 4033e8ae1..e7c2ca93a 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -47,7 +47,7 @@ homeOpenCourses = do
             let tid = courseTerm      course
                 ssh = courseSchool    course
                 csh = courseShorthand course
-            anchorCell (CourseR tid ssh csh CShowR) (toWidget csh)
+            anchorCell (CourseR tid ssh csh CShowR) csh
         , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
             cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
         ]
@@ -130,9 +130,9 @@ homeUpcomingSheets uid = do
         , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
             textCell $ toMessage ssh
         , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
-            anchorCell (CourseR tid ssh csh CShowR) (toWidget csh)
+            anchorCell (CourseR tid ssh csh CShowR) csh
         , sortable (Just "sheet")  (i18nCell MsgSheet)  $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
-            anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget shn)
+            anchorCell (CSheetR tid ssh csh shn SShowR) shn
         , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
             cell $ formatTime SelFormatDateTime deadline >>= toWidget
         , sortable (Just "done")   (i18nCell MsgDone)   $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
@@ -142,7 +142,7 @@ homeUpcomingSheets uid = do
                 whenM (hasWriteAccessTo submitRoute) $
                   modal [whamlet|_{MsgMenuSubmissionNew}|] . Left $ SomeRoute submitRoute
               (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
-                                        (toWidget $ hasTickmark True)
+                                        (hasTickmark True)
         ]
   let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
   sheetTable <- liftHandlerT . runDB $ dbTableWidget' validator DBTable
@@ -228,7 +228,7 @@ homeUpcomingExams uid = do
           , sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput } -> do
               let Entity _ Exam{..}   = view lensExam   dbrOutput
                   Entity _ Course{..} = view lensCourse dbrOutput
-              indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) (toWidget examName)
+              indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) examName
           , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
           , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index df31ec398..8194ef410 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -206,7 +206,7 @@ getSheetListR tid ssh csh = do
     sheetCol = widgetColonnade . mconcat $
       [ -- dbRow ,
         sortable (Just "name") (i18nCell MsgSheet)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) sheetName
       , sortable (Just "last-edit") (i18nCell MsgLastEdit)
           $ \DBRow{dbrOutput=(_, E.Value mEditTime, _, _)} -> foldMap dateTimeCell mEditTime
       , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 273e33d6d..ae1c7f757 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -165,7 +165,7 @@ postMessageListR = do
     dbtColonnade = mconcat
       [ dbSelect (applying _2) id $ \DBRow{ dbrOutput = (Entity smId _, _) } -> encrypt smId
       , dbRow
-      , sortable Nothing (i18nCell MsgSystemMessageId) $ \DBRow{ dbrOutput = (Entity smId _, _) } -> anchorCellM' (encrypt smId) MessageR (toWidget . tshow . ciphertext)
+      , sortable Nothing (i18nCell MsgSystemMessageId) $ \DBRow{ dbrOutput = (Entity smId _, _) } -> anchorCellM' (encrypt smId) MessageR ciphertext
       , sortable (Just "from") (i18nCell MsgSystemMessageFrom) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ maybe mempty (formatTimeW SelFormatDateTime) systemMessageFrom
       , sortable (Just "to") (i18nCell MsgSystemMessageTo) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ maybe mempty (formatTimeW SelFormatDateTime) systemMessageTo
       , sortable (Just "authenticated") (i18nCell MsgSystemMessageAuthenticatedOnly) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> tickmarkCell systemMessageAuthenticatedOnly
diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs
index 1f56bcc8d..2f4123a22 100644
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@@ -61,7 +61,7 @@ getCTutorialListR tid ssh csh = do
                            <li>
                              ^{nameEmailWidget' tutor}
                      |]
-          , sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, n) } -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) . toWidget $ tshow n
+          , sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, n) } -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) $ tshow n
           , sortable (Just "capacity") (i18nCell MsgTutorialCapacity) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybe mempty (textCell . tshow) tutorialCapacity
           , sortable (Just "room") (i18nCell MsgTutorialRoom) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> textCell tutorialRoom
           , sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> occurrencesCell tutorialTime
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index df62bbdbb..8262140eb 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -91,7 +91,7 @@ ifCell decision cTrue cFalse x
   | otherwise  = cFalse x
 
 linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
-linkEmptyCell link wgt = linkEitherCell link (wgt,mempty)
+linkEmptyCell = anchorCell
 
 msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
 msgCell = textCell . toMessage
@@ -123,7 +123,7 @@ isNewCell = cell . toWidget . isNew
 commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
 commentCell Nothing     = mempty
 commentCell (Just link) = anchorCell link icon
-  where icon = toWidget $ hasComment True
+  where icon = hasComment True
 
 -- | whether something is visible or hidden
 isVisibleCell :: (IsDBTable m a) => Bool -> DBCell m a
@@ -134,11 +134,11 @@ isVisibleCell False = (cell . toWidget $ isVisible False) & addUrgencyClass
 
 -- | for simple file downloads
 fileCell :: IsDBTable m a => Route UniWorX -> DBCell m a
-fileCell route = anchorCell route $ toWidget fileDownload
+fileCell route = anchorCell route fileDownload
 
 -- | for zip-archive downloads
 zipCell :: IsDBTable m a => Route UniWorX -> DBCell m a
-zipCell route = anchorCell route $ toWidget zipDownload
+zipCell route = anchorCell route zipDownload
 
 -- | Display an icon that opens a modal upon clicking
 modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 91c2bc24d..272c9ffaa 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -971,43 +971,47 @@ cellTooltip msg = cellContents.mapped %~ (<> tipWdgt)
 
 -- | Always display widget; maybe a link if user is Authorized.
 --   Also see variant `linkEmptyCell`
-anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
+anchorCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => url -> wgt -> DBCell m a
 anchorCell = anchorCellM . return
 
-{-# DEPRECATED anchorCell' "For compatibility with Colonnade; better use anchorCell instead." #-}
-anchorCell' :: IsDBTable m a
-           => (r -> Route UniWorX)
-           -> (r -> Widget)
+anchorCell' :: ( IsDBTable m a
+               , ToWidget UniWorX wgt
+               , HasRoute UniWorX url
+               )
+           => (r -> url)
+           -> (r -> wgt)
            -> (r -> DBCell m a)
 anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val)
 
-anchorCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> Widget -> DBCell m a
+anchorCellM :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a, HandlerSite m ~ UniWorX) => WidgetT UniWorX IO url -> wgt -> DBCell m a
 anchorCellM routeM widget = anchorCellM' routeM id (const widget)
 
-anchorCellM' :: IsDBTable m a => WidgetT UniWorX IO x -> (x -> Route UniWorX) -> (x -> Widget) -> DBCell m a
-anchorCellM' xM x2route x2widget = cell $ do
-  x <- xM
-  let route  = x2route  x
-      widget = x2widget x
-  authResult <- liftHandlerT $ isAuthorized route False
-  case authResult of
-    Authorized -> $(widgetFile "table/cell/link") -- show allowed link
-    _otherwise -> widget                          -- don't show prohibited link
+anchorCellM' :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a, HandlerSite m ~ UniWorX) => WidgetT UniWorX IO x -> (x -> url) -> (x -> wgt) -> DBCell m a
+anchorCellM' xM x2route x2widget = linkEitherCellM' xM x2route (x2widget, x2widget)
 
 -- | Variant of `anchorCell` that displays different widgets depending whether the route is authorized for current user
-linkEitherCell :: IsDBTable m a => Route UniWorX -> (Widget, Widget) -> DBCell m a
+linkEitherCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, ToWidget UniWorX wgt', IsDBTable m a, HandlerSite m ~ UniWorX) => url -> (wgt, wgt') -> DBCell m a
 linkEitherCell = linkEitherCellM . return
 
-linkEitherCellM :: IsDBTable m a => WidgetT UniWorX IO (Route UniWorX) -> (Widget, Widget) -> DBCell m a
+linkEitherCellM :: (HasRoute UniWorX url, ToWidget UniWorX wgt, ToWidget UniWorX wgt', IsDBTable m a, HandlerSite m ~ UniWorX) => WidgetT UniWorX IO url -> (wgt, wgt') -> DBCell m a
 linkEitherCellM routeM (widgetAuth,widgetUnauth) = linkEitherCellM' routeM id (const widgetAuth, const widgetUnauth)
 
-linkEitherCellM' :: IsDBTable m a => WidgetT UniWorX IO x -> (x -> Route UniWorX) -> (x -> Widget, x -> Widget) -> DBCell m a
+linkEitherCellM' :: forall m url wgt wgt' a x.
+                    ( HasRoute UniWorX url
+                    , ToWidget UniWorX wgt
+                    , ToWidget UniWorX wgt'
+                    , IsDBTable m a
+                    , HandlerSite m ~ UniWorX
+                    )
+                 => WidgetT UniWorX IO x -> (x -> url) -> (x -> wgt, x -> wgt') -> DBCell m a
 linkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = cell $ do
   x <- xM
   let route        = x2route        x
-      widget       = x2widgetAuth   x
-      widgetUnauth = x2widgetUnauth x
-  authResult <- liftHandlerT $ isAuthorized route False
+      widget, widgetUnauth :: WidgetT UniWorX IO ()
+      widget       = toWidget $ x2widgetAuth   x
+      widgetUnauth = toWidget $ x2widgetUnauth x
+  authResult <- liftHandlerT $ isAuthorized (urlRoute route) False
+  linkUrl <- toTextUrl route
   case authResult of
     Authorized -> $(widgetFile "table/cell/link") -- show allowed link
     _otherwise -> widgetUnauth                    -- show alternative widget
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index e24c93de3..755434aa3 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -28,6 +28,8 @@ import Control.Monad.Trans.Reader (mapReaderT)
 import Control.Monad.Except (MonadError(..))
 import Utils (exceptT)
 
+import Numeric.Natural
+
 -- Database versions must follow https://pvp.haskell.org:
 --   - Breaking changes are instances where manual migration is necessary (via customMigrations; i.e. changing a columns format)
 --   - Non-breaking changes are instances where the automatic migration done by persistent is sufficient (i.e. adding a column or table)
@@ -57,7 +59,11 @@ share [mkPersist sqlSettings, mkMigrate "migrateDBVersioning"]
       deriving Show Eq Ord
   |]
 
-migrateAll :: (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m ()
+migrateAll :: ( MonadLogger m
+              , MonadBaseControl IO m
+              , MonadIO m
+              )
+           => ReaderT SqlBackend m ()
 migrateAll = do
   $logDebugS "Migration" "Initial migration"
   mapM_ ($logInfoS "Migration") =<< runMigrationSilent initialMigration
@@ -77,14 +83,19 @@ migrateAll = do
   $logDebugS "Migration" "Persistent automatic migration"
   mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAll'
 
-requiresMigration :: forall m. (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m Bool
+requiresMigration :: forall m.
+                     ( MonadLogger m
+                     , MonadBaseControl IO m
+                     , MonadIO m
+                     )
+                  => ReaderT SqlBackend m Bool
 requiresMigration = mapReaderT (exceptT return return) $ do
   initial <- either id (map snd) <$> parseMigration initialMigration
   when (not $ null initial) $ do
     $logInfoS "Migration" $ intercalate "; " initial
     throwError True
 
-  customs <- getMissingMigrations @_ @m
+  customs <- mapReaderT lift $ getMissingMigrations @_ @m
   when (not $ Map.null customs) $ do
     $logInfoS "Migration" . intercalate ", " . map tshow $ Map.keys customs
     throwError True
@@ -123,7 +134,8 @@ getMissingMigrations = do
 -}
 
 
-customMigrations :: MonadIO m => Map (Key AppliedMigration) (ReaderT SqlBackend m ())
+customMigrations :: ( MonadIO m
+                    ) => Map (Key AppliedMigration) (ReaderT SqlBackend m ())
 customMigrations = Map.fromListWith (>>)
   [ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|]
     , whenM (columnExists "user" "theme") $ do -- New theme format
@@ -292,6 +304,20 @@ customMigrations = Map.fromListWith (>>)
     , whenM (tableExists "exam") $ -- Exams were an unused stub before
         tableDropEmpty "exam"
     )
+  , ( AppliedMigrationKey [migrationVersion|13.0.0|] [version|14.0.0|]
+    , whenM ((&&) <$> tableExists "exam_occurrence" <*> (not <$> columnExists "exam_occurrence" "name")) $ do
+        examOccurrences <- [sqlQQ| SELECT "id" FROM "exam_occurrence" ORDER BY "exam"; |]
+        [executeQQ|
+          ALTER TABLE "exam_occurrence" ADD COLUMN "name" citext DEFAULT null;
+        |]
+        forM_ (zip [0..] examOccurrences) $ \(n :: Natural, Single eoId :: Single ExamOccurrenceId) -> do
+          let name = [st|occ-#{tshow n}|]
+          [executeQQ| UPDATE "exam_occurrence" SET "name" = #{name} WHERE "id" = #{eoId} |]
+        [executeQQ|
+          ALTER TABLE "exam_occurrence" ALTER COLUMN "name" DROP DEFAULT;
+          ALTER TABLE "exam_occurrence" ALTER COLUMN "name" SET NOT NULL;
+        |]
+    )
   ]
 
 
diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs
index c0cd4a30b..2d8e8b1d0 100644
--- a/src/Model/Types/Common.hs
+++ b/src/Model/Types/Common.hs
@@ -16,19 +16,20 @@ import qualified Yesod.Auth.Util.PasswordStore as PWStore
 type Count  = Sum Integer
 type Points = Centi
 
-type Email           = Text
+type Email              = Text
 
-type SchoolName      = CI Text
-type SchoolShorthand = CI Text
-type CourseName      = CI Text
-type CourseShorthand = CI Text
-type SheetName       = CI Text
-type MaterialName    = CI Text
-type UserEmail       = CI Email
-type UserIdent       = CI Text
-type TutorialName    = CI Text
-type ExamName        = CI Text
-type ExamPartName    = CI Text
+type SchoolName         = CI Text
+type SchoolShorthand    = CI Text
+type CourseName         = CI Text
+type CourseShorthand    = CI Text
+type SheetName          = CI Text
+type MaterialName       = CI Text
+type UserEmail          = CI Email
+type UserIdent          = CI Text
+type TutorialName       = CI Text
+type ExamName           = CI Text
+type ExamPartName       = CI Text
+type ExamOccurrenceName = CI Text
 
 type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
 type InstanceId      = UUID
diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index 2fdc1b3de..57d417402 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -637,3 +637,8 @@ section {
   font-weight: var(--weight, 600);
   background-color: rgba(var(--red), var(--green), 0, var(--opacity));
 }
+
+
+.uuid {
+  font-family: monospace;
+}
diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet
index 56b8b0fd1..e7d2a777b 100644
--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@@ -93,6 +93,10 @@ $if not (null occurrences)
     <table .table .table--striped .table--hover>
       <thead>
         <tr .table__row .table__row--head>
+          $if occurrenceNamesShown
+            <th .table__th>
+              _{MsgExamRoomName}
+              ^{isVisible False}
           <th .table__th>_{MsgExamRoom}
           $if not examTimes
             <th .table__th>_{MsgExamRoomTime}
@@ -103,8 +107,10 @@ $if not (null occurrences)
               $if not occurrenceAssignmentsVisible
                 \ ^{isVisible False}
       <tbody>
-        $forall (Entity _occId ExamOccurrence{examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription}, registered) <- occurrences
+        $forall (Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription}, registered) <- occurrences
           <tr .table__row :occurrenceAssignmentsShown && not registered:.occurrence--not-registered>
+            $if occurrenceNamesShown
+              <td .table__td #exam-occurrence__#{examOccurrenceName}>#{examOccurrenceName}
             <td .table__td>#{examOccurrenceRoom}
             $if not examTimes
               <td .table__td>
diff --git a/templates/table/cell/link.hamlet b/templates/table/cell/link.hamlet
index cdf41888f..2d9a2b1a0 100644
--- a/templates/table/cell/link.hamlet
+++ b/templates/table/cell/link.hamlet
@@ -1,3 +1,3 @@
 $newline never
-<a href=@{route}>
-  ^{widget}
\ No newline at end of file
+<a href=#{linkUrl}>
+  ^{widget}
diff --git a/templates/widgets/massinput/examRooms/form.hamlet b/templates/widgets/massinput/examRooms/form.hamlet
index bd0fd06ed..4df09253e 100644
--- a/templates/widgets/massinput/examRooms/form.hamlet
+++ b/templates/widgets/massinput/examRooms/form.hamlet
@@ -1,5 +1,6 @@
 $newline never
-<td>#{csrf}^{fvInput eofIdView}^{fvInput eofRoomView}
+<td>#{csrf}^{fvInput eofIdView}^{fvInput eofNameView}
+<td>^{fvInput eofRoomView}
 <td>^{fvInput eofCapacityView}
 <td>^{fvInput eofStartView}
 <td>^{fvInput eofEndView}
diff --git a/templates/widgets/massinput/examRooms/layout.hamlet b/templates/widgets/massinput/examRooms/layout.hamlet
index cc4211e5c..c8a4bf270 100644
--- a/templates/widgets/massinput/examRooms/layout.hamlet
+++ b/templates/widgets/massinput/examRooms/layout.hamlet
@@ -1,6 +1,7 @@
 $newline never
 <table>
   <thead>
+    <th>_{MsgExamRoomName}
     <th>_{MsgExamRoom}
     <th>_{MsgExamRoomCapacity}
     <th>_{MsgExamRoomStart}

From 643cc4165fdec197ae8f744f193a731e731f537b Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 16 Jul 2019 09:33:54 +0200
Subject: [PATCH 03/36] feat(sheetlist): sort sheet file types in db by haskell
 Ord

---
 src/Database/Esqueleto/Utils.hs | 14 +++++++++++++-
 src/Handler/Sheet.hs            |  8 ++++++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index cc8ffbb24..8381869b8 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -10,10 +10,14 @@ module Database.Esqueleto.Utils
   , mkContainsFilter, mkContainsFilterWith
   , mkExistsFilter
   , anyFilter, allFilter
+  , orderByOrd, orderByEnum
   ) where
 
+
 import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
+import Data.Universe
 import qualified Data.Set as Set
+import qualified Data.List as List
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
@@ -113,7 +117,7 @@ mkContainsFilter :: E.SqlString a
                  -> Set.Set a                     -- ^ needle collection
                  -> E.SqlExpr (E.Value Bool)
 mkContainsFilter = mkContainsFilterWith id
-  
+
 -- | like `mkContainsFiler` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
 mkContainsFilterWith :: E.SqlString b
                      => (a -> b)
@@ -153,3 +157,11 @@ allFilter :: (Foldable f)
 allFilter fltrs needle criterias = F.foldr aux true fltrs
   where
     aux fltr acc = fltr needle criterias E.&&. acc
+
+
+orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
+orderByOrd = let sortUni = zipWith (,) [1..] $ List.sort universeF in -- memoize this, might not work due to polymorphism
+    \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val (-1))
+
+orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
+orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))
\ No newline at end of file
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index df31ec398..792fd11ef 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -29,6 +29,7 @@ import qualified Data.Conduit.List as C
 -- import qualified Data.CaseInsensitive as CI
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 -- import qualified Database.Esqueleto.Internal.Sql as E
 
 import Control.Monad.Writer (MonadWriter(..), execWriterT)
@@ -393,7 +394,7 @@ getSShowR tid ssh csh shn = do
     , dbtIdent = "files" :: Text
     , dbtSorting = Map.fromList
       [ ( "type"
-        , SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType
+        , SortColumn $ \(sheetFile `E.InnerJoin` _file) -> E.orderByEnum $ sheetFile E.^. SheetFileType
         )
       , ( "path"
         , SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
@@ -819,7 +820,10 @@ correctorForm shid = wFormToAForm $ do
         postProcess' (Right sheetCorrectorUser, (sheetCorrectorState, sheetCorrectorLoad)) = Right SheetCorrector{..}
         postProcess' (Left email, (state, load)) = Left (email, shid, (InvDBDataSheetCorrector load state, InvTokenDataSheetCorrector))
 
-  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True (Just . Map.fromList . zip [0..] $ Map.toList loads)
+    filledData :: Maybe (Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)))
+    filledData = Just . Map.fromList . zip [0..] $ Map.toList loads -- TODO orderBy Name?!
+
+  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True filledData
 
 getSCorrR, postSCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 postSCorrR = getSCorrR

From 2b23600a2287e96e5b482c4e53125a55b64bbb93 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 10:10:21 +0200
Subject: [PATCH 04/36] feat(exams): show exam bonus in webinterface

---
 messages/uniworx/de.msg          |   8 +-
 src/Handler/Exam.hs              | 152 +++++++++++++++++--------------
 src/Handler/Utils/Exam.hs        |  36 ++++++++
 src/Handler/Utils/Table/Cells.hs |   3 +
 src/Model/Types/Sheet.hs         |  28 ++++--
 src/Utils.hs                     |   6 ++
 6 files changed, 157 insertions(+), 76 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 8d72c3384..783f75491 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -433,7 +433,9 @@ HasCorrector: Korrektor zugeteilt
 AssignedTime: Zuteilung
 AchievedBonusPoints: Erreichte Bonuspunkte
 AchievedNormalPoints: Erreichte Punkte
-AchievedPassPoints: Erreichte Punkte
+AchievedPoints: Erreichte Punkte
+AchievedPassPoints: Erreichte Punkte zum Bestehen
+AchievedPasses: Bestandene Blätter
 AchievedOf achieved@Points possible@Points: #{achieved} von #{possible}
 PassAchievedOf points@Points passingPoints@Points maxPoints@Points: #{points} von #{maxPoints} (Bestanden ab #{passingPoints})
 PassedResult: Ergebnis
@@ -1185,4 +1187,6 @@ CsvModifyExisting: Existierende Einträge angleichen
 CsvAddNew: Neue Einträge einfügen
 CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
-BtnCsvImport: CSV-Datei importieren
\ No newline at end of file
+BtnCsvImport: CSV-Datei importieren
+
+Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
\ No newline at end of file
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 03d92e282..230bb405c 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -831,73 +831,93 @@ instance DefaultOrdered ExamUserTableCsv where
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
-  Entity eid Exam{..} <- runDB $ fetchExam tid ssh csh examn
-  
-  let
-    examUsersDBTable = DBTable{..}
-      where
-        dbtSQLQuery ((examRegistration `E.InnerJoin` user) `E.LeftOuterJoin` occurrence `E.LeftOuterJoin` (courseParticipant `E.LeftOuterJoin` (studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyField))) = do
-          E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
-          E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
-          E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
-          E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
-           E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
-          E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
-           E.&&. occurrence E.?. ExamOccurrenceId   E.==. examRegistration E.^. ExamRegistrationOccurrence
-          E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
-          E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid
-          return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField)
-        dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
-        dbtProj = return
-        dbtColonnade = dbColonnade $ mconcat
-          [ colUserNameLink (CourseR tid ssh csh . CUserR)
-          , colUserMatriclenr
-          , colField            resultStudyField
-          , colDegreeShort      resultStudyDegree
-          , colFeaturesSemester resultStudyFeatures
-          , sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
-          ] 
-        dbtSorting = Map.fromList
-          [ sortUserNameLink     queryUser
-          , sortUserSurname      queryUser
-          , sortUserDisplayName  queryUser
-          , sortUserMatriclenr   queryUser
-          , sortField            queryStudyField
-          , sortDegreeShort      queryStudyDegree
-          , sortFeaturesSemester queryStudyFeatures
-          , ("occurrence", SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
-          ]
-        dbtFilter = Map.fromList
-          [ fltrUserNameEmail    queryUser
-          , fltrUserMatriclenr   queryUser
-          , fltrField            queryStudyField
-          , fltrDegree           queryStudyDegree
-          , fltrFeaturesSemester queryStudyFeatures
-          ]
-        dbtFilterUI mPrev = mconcat
-          [ fltrUserNameEmailUI    mPrev
-          , fltrUserMatriclenrUI   mPrev
-          , fltrFieldUI            mPrev
-          , fltrDegreeUI           mPrev
-          , fltrFeaturesSemesterUI mPrev
-          ]
-        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
-        dbtParams = def
-        dbtIdent :: Text
-        dbtIdent = "exam-users"
-        dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
-        dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
-          <$> view (resultUser . _entityVal . _userSurname)
-          <*> view (resultUser . _entityVal . _userDisplayName)
-          <*> view (resultUser . _entityVal . _userMatrikelnummer)
-          <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
-          <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
-          <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
-          <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
-        dbtCsvDecode = Nothing
+  ((), examUsersTable) <- runDB $ do
+    exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn
+    bonus <- examBonus exam
 
-    examUsersDBTableValidator = def
-  ((), examUsersTable) <- runDB $ dbTable examUsersDBTableValidator examUsersDBTable
+    let
+      allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus
+      showPasses     = numSheetsPasses allBoni /= 0
+      showPoints     = getSum (numSheetsPoints allBoni) - getSum (numSheetsPassPoints allBoni) /= 0
+      showPassPoints = numSheetsPassPoints allBoni /= 0
+
+    let
+      examUsersDBTable = DBTable{..}
+        where
+          dbtSQLQuery ((examRegistration `E.InnerJoin` user) `E.LeftOuterJoin` occurrence `E.LeftOuterJoin` (courseParticipant `E.LeftOuterJoin` (studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyField))) = do
+            E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
+            E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
+            E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
+            E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
+             E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
+            E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
+             E.&&. occurrence E.?. ExamOccurrenceId   E.==. examRegistration E.^. ExamRegistrationOccurrence
+            E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
+            E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid
+            return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField)
+          dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
+          dbtProj = return
+          dbtColonnade = dbColonnade . mconcat $ catMaybes
+            [ pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
+            , pure   colUserMatriclenr
+            , pure $ colField            resultStudyField
+            , pure $ colDegreeShort      resultStudyDegree
+            , pure $ colFeaturesSemester resultStudyFeatures
+            , pure $ sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
+            , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
+                SheetGradeSummary{achievedPasses} <- examBonusAchieved uid bonus
+                SheetGradeSummary{numSheetsPasses} <- examBonusPossible uid bonus
+                return $ propCell (getSum achievedPasses) (getSum numSheetsPasses)
+            , guardOn showPassPoints $ sortable Nothing (i18nCell MsgAchievedPassPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
+                SheetGradeSummary{achievedPassPoints} <- examBonusAchieved uid bonus
+                SheetGradeSummary{sumSheetsPassPoints} <- examBonusPossible uid bonus
+                return $ propCell (getSum achievedPassPoints) (getSum sumSheetsPassPoints)
+            , guardOn showPoints $ sortable Nothing (i18nCell MsgAchievedPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
+                SheetGradeSummary{achievedPoints, achievedPassPoints} <- examBonusAchieved uid bonus
+                SheetGradeSummary{sumSheetsPoints, sumSheetsPassPoints} <- examBonusPossible uid bonus
+                return $ propCell (getSum achievedPoints - getSum achievedPassPoints) (getSum sumSheetsPoints - getSum sumSheetsPassPoints)
+            ] 
+          dbtSorting = Map.fromList
+            [ sortUserNameLink     queryUser
+            , sortUserSurname      queryUser
+            , sortUserDisplayName  queryUser
+            , sortUserMatriclenr   queryUser
+            , sortField            queryStudyField
+            , sortDegreeShort      queryStudyDegree
+            , sortFeaturesSemester queryStudyFeatures
+            , ("occurrence", SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
+            ]
+          dbtFilter = Map.fromList
+            [ fltrUserNameEmail    queryUser
+            , fltrUserMatriclenr   queryUser
+            , fltrField            queryStudyField
+            , fltrDegree           queryStudyDegree
+            , fltrFeaturesSemester queryStudyFeatures
+            ]
+          dbtFilterUI mPrev = mconcat
+            [ fltrUserNameEmailUI    mPrev
+            , fltrUserMatriclenrUI   mPrev
+            , fltrFieldUI            mPrev
+            , fltrDegreeUI           mPrev
+            , fltrFeaturesSemesterUI mPrev
+            ]
+          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+          dbtParams = def
+          dbtIdent :: Text
+          dbtIdent = "exam-users"
+          dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
+          dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
+            <$> view (resultUser . _entityVal . _userSurname)
+            <*> view (resultUser . _entityVal . _userDisplayName)
+            <*> view (resultUser . _entityVal . _userMatrikelnummer)
+            <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
+            <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
+            <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
+            <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
+          dbtCsvDecode = Nothing
+
+      examUsersDBTableValidator = def
+    dbTable examUsersDBTableValidator examUsersDBTable
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading
diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index 3d1d43845..f3cda795c 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -1,6 +1,7 @@
 module Handler.Utils.Exam
   ( fetchExamAux
   , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam
+  , examBonus, examBonusPossible, examBonusAchieved
   ) where
 
 import Import.NoFoundation
@@ -12,6 +13,10 @@ import Database.Esqueleto.Utils.TH
 
 import Utils.Lens
 
+import qualified Data.Conduit.List as C
+
+import qualified Data.Map as Map
+
 
 fetchExamAux :: ( SqlBackendCanRead backend
                 , E.SqlSelect b a
@@ -45,3 +50,34 @@ fetchCourseIdExamId tid ssh cid examn = $(unValueN 2) <$> fetchExamAux (\tutoria
 
 fetchCourseIdExam  :: MonadHandler m => TermId -> SchoolId -> CourseShorthand -> ExamName -> ReaderT SqlBackend m (Key Course, Entity Exam)
 fetchCourseIdExam tid ssh cid examn = over _1 E.unValue <$> fetchExamAux (\tutorial course -> (course E.^. CourseId, tutorial)) tid ssh cid examn
+
+
+examBonus :: MonadHandler m => Entity Exam -> ReaderT SqlBackend m (Map UserId SheetTypeSummary)
+examBonus (Entity eId Exam{..}) = runConduit $
+  let
+    rawData = E.selectSource . E.from $ \((examRegistration `E.LeftOuterJoin` examOccurrence) `E.InnerJoin` (sheet `E.InnerJoin` submission)) -> E.distinctOnOrderBy [ E.asc $ examRegistration E.^. ExamRegistrationUser, E.asc $ sheet E.^. SheetId ] $ do
+      E.on $ submission E.?. SubmissionSheet E.==. E.just (sheet E.^. SheetId)
+      E.on $ E.exists (E.from $ \submissionUser -> E.where_ $ submissionUser E.^. SubmissionUserUser E.==. examRegistration E.^. ExamRegistrationUser
+                                                        E.&&. E.just (submissionUser E.^. SubmissionUserSubmission) E.==. submission E.?. SubmissionId
+                      )
+      E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. examOccurrence E.?. ExamOccurrenceId
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val examCourse
+           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val eId
+      E.where_ $ E.case_ 
+        [ E.when_
+            ( E.not_ . E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence )
+          E.then_
+            (       E.just (sheet E.^. SheetActiveTo) E.<=. examOccurrence E.?. ExamOccurrenceStart
+              E.&&. sheet E.^. SheetVisibleFrom E.<=. examOccurrence E.?. ExamOccurrenceStart
+            )
+        ]
+        ( E.else_ . E.not_ . E.isNothing $ sheet E.^. SheetVisibleFrom
+        )
+      return (examRegistration E.^. ExamRegistrationUser, sheet E.^. SheetType, submission)
+    accum = C.fold ?? Map.empty $ \acc (E.Value uid, E.Value sheetType, fmap entityVal -> sub) ->
+      Map.unionWith mappend acc . Map.singleton uid . sheetTypeSum sheetType . (>>= submissionRatingPoints) $ assertM submissionRatingDone sub
+   in rawData .| accum
+
+examBonusPossible, examBonusAchieved :: UserId -> Map UserId SheetTypeSummary -> Maybe SheetGradeSummary
+examBonusPossible uid bonusMap = normalSummary <$> Map.lookup uid bonusMap
+examBonusAchieved uid bonusMap = (mappend <$> normalSummary <*> bonusSummary) <$> Map.lookup uid bonusMap
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index 8262140eb..948febc54 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -214,6 +214,9 @@ maybeDateTimeCell = maybe mempty dateTimeCell
 numCell :: (IsDBTable m a, Num b, ToMessage b) => b -> DBCell m a
 numCell = textCell . toMessage
 
+propCell :: (IsDBTable m a, Real b, ToMessage b) => b -> b -> DBCell m a
+propCell curr max' = i18nCell $ MsgProportion (toMessage curr) (toMessage max') (toRational curr / toRational max')
+
 int64Cell :: (IsDBTable m a) => Int64-> DBCell m a
 int64Cell = numCell
 
diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs
index b4a6b0a90..4a6c60a32 100644
--- a/src/Model/Types/Sheet.hs
+++ b/src/Model/Types/Sheet.hs
@@ -12,6 +12,7 @@ import Model.Types.Common
 import Utils.Lens.TH
 
 import Control.Lens
+import Control.Lens.Extras (is)
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 import Data.Set (Set)
@@ -40,6 +41,7 @@ deriveJSON defaultOptions
 derivePersistFieldJSON ''SheetGrading
 
 makeLenses_ ''SheetGrading
+makePrisms ''SheetGrading
 
 _passingBound :: Fold SheetGrading (Either () Points)
 _passingBound = folding passPts
@@ -57,17 +59,22 @@ gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
 
 data SheetGradeSummary = SheetGradeSummary
   { numSheets       :: Count       -- Total number of sheets, includes all
-  , numSheetsPasses :: Count       -- Number of sheets required to pass FKA: numGradePasses
-  , numSheetsPoints :: Count       -- Number of sheets having points    FKA: sumGradePointsd
+  , numSheetsPasses :: Count       -- Number of sheets admitting passing FKA: numGradePasses
+  , numSheetsPoints :: Count       -- Number of sheets having points     FKA: sumGradePointsd
+  , numSheetsPassPoints :: Count   -- Number of sheets where passing is by points
   , sumSheetsPoints :: Sum Points  -- Total of all points in all sheets
+  , sumSheetsPassPoints :: Sum Points -- Achieved points within marked sheets where passing is by points
   -- Marking dependend
   , numMarked       :: Count       -- Number of already marked sheets
   , numMarkedPasses :: Count       -- Number of already marked sheets with passes
   , numMarkedPoints :: Count       -- Number of already marked sheets with points
+  , numMarkedPassPoints :: Count   -- Number of already marked sheets where passing is by points
   , sumMarkedPoints :: Sum Points  -- Achieveable points within marked sheets
+  , sumMarkedPassPoints :: Sum Points -- Achieved points within marked sheets where passing is by points
   --
   , achievedPasses :: Count        -- Achieved passes (within marked sheets)
   , achievedPoints :: Sum Points   -- Achieved points (within marked sheets)
+  , achievedPassPoints :: Sum Points -- Achieved points within marked sheets where passing is by points
   } deriving (Generic, Read, Show, Eq)
 
 instance Monoid SheetGradeSummary where
@@ -82,19 +89,24 @@ makeLenses_ ''SheetGradeSummary
 sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
 sheetGradeSum gr Nothing  = mempty
   { numSheets = 1
-  , numSheetsPasses = bool  mempty   1 $ has _passingBound gr
-  , numSheetsPoints = bool  mempty   1 $ has _maxPoints    gr
+  , numSheetsPasses     = bool  mempty   1 $ has _passingBound gr
+  , numSheetsPoints     = bool  mempty   1 $ has _maxPoints    gr
+  , numSheetsPassPoints = bool  mempty   1 $ is  _PassPoints   gr
   , sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints
+  , sumSheetsPassPoints = maybe mempty Sum . (<* guard (is _PassPoints gr)) $ gr ^? _maxPoints
   }
 sheetGradeSum gr (Just p) =
   let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
   in  unmarked
-        { numMarked       = numSheets
-        , numMarkedPasses = numSheetsPasses
-        , numMarkedPoints = numSheetsPoints
-        , sumMarkedPoints = sumSheetsPoints
+        { numMarked           = numSheets
+        , numMarkedPasses     = numSheetsPasses
+        , numMarkedPoints     = numSheetsPoints
+        , numMarkedPassPoints = numSheetsPassPoints
+        , sumMarkedPoints     = sumSheetsPoints
+        , sumMarkedPassPoints = sumSheetsPassPoints
         , achievedPasses  = maybe mempty (bool 0 1) (gradingPassed gr p)
         , achievedPoints  = bool mempty (Sum p) $ has _maxPoints gr
+        , achievedPassPoints = bool mempty (Sum p) $ is _PassPoints gr
         }
 
 
diff --git a/src/Utils.hs b/src/Utils.hs
index 96dd4535e..06639a3c1 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -262,6 +262,9 @@ rationalToFixed = MkFixed . round . (* (fromIntegral $ resolution (Proxy :: HasR
 
 rationalToFixed3 :: Rational -> Fixed E3
 rationalToFixed3 = rationalToFixed
+  
+rationalToFixed2 :: Rational -> Fixed E2
+rationalToFixed2 = rationalToFixed
 
 -- | Convert `part` and `whole` into percentage including symbol
 --   showing trailing zeroes and to decimal digits
@@ -693,6 +696,9 @@ assertM_ f x = guard . f =<< x
 assertM' :: Alternative m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)
 
+guardOn :: Alternative m => Bool -> a -> m a
+guardOn b x = x <$ guard b
+
 -- Some Utility Functions from Agda.Utils.Monad
 -- | Monadic if-then-else.
 ifM :: Monad m => m Bool -> m a -> m a -> m a

From cf040ce6863488f4708c1c2059f783413b1183d1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 10:29:39 +0200
Subject: [PATCH 05/36] feat(exams): filter on occurrence

---
 src/Handler/Exam.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 230bb405c..b9ebc0893 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -893,6 +893,7 @@ postEUsersR tid ssh csh examn = do
             , fltrField            queryStudyField
             , fltrDegree           queryStudyDegree
             , fltrFeaturesSemester queryStudyFeatures
+            , ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
             ]
           dbtFilterUI mPrev = mconcat
             [ fltrUserNameEmailUI    mPrev
@@ -900,6 +901,7 @@ postEUsersR tid ssh csh examn = do
             , fltrFieldUI            mPrev
             , fltrDegreeUI           mPrev
             , fltrFeaturesSemesterUI mPrev
+            , prismAForm (singletonFilter "occurrence") mPrev $ aopt textField (fslI MsgExamOccurrence)
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = def

From ad825b66b80dc6676c2f881f70630ac293162aec Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 16 Jul 2019 11:17:27 +0200
Subject: [PATCH 06/36] fix(course and exam registration): distinguish
 registrations buttons

registration buttons for course and exam carry different texts and icons

Closes #416
---
 messages/uniworx/de.msg         |  4 ++
 src/Database/Esqueleto/Utils.hs |  2 +-
 src/Handler/Course.hs           | 72 ++++++++++++++++++++++++---------
 src/Handler/Exam.hs             | 61 ++++++++++++++++++----------
 src/Handler/Home.hs             |  2 +-
 src/Utils.hs                    | 18 ++++++++-
 6 files changed, 114 insertions(+), 45 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 8ae874e40..792c2468c 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -5,6 +5,10 @@ BtnAbort: Abbrechen
 BtnDelete: Löschen
 BtnRegister: Anmelden
 BtnDeregister: Abmelden
+BtnCourseRegister: Zum Kurs anmelden
+BtnCourseDeregister: Vom Kurs abmelden
+BtnExamRegister: Klasuranmeldung
+BtnExamDeregister: Abmeldung von der Klausur
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
 PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert.
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 8381869b8..3d4d12510 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -160,7 +160,7 @@ allFilter fltrs needle criterias = F.foldr aux true fltrs
 
 
 orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
-orderByOrd = let sortUni = zipWith (,) [1..] $ List.sort universeF in -- memoize this, might not work due to polymorphism
+orderByOrd = let sortUni = zip [1..] $ List.sort universeF in -- memoize this, might not work due to polymorphism
     \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val (-1))
 
 orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index ef99c06de..af7a9df41 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -46,6 +46,21 @@ import Control.Monad.Except (MonadError(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 
+-- Dedicated CourseRegistrationButton
+data ButtonCourseRegister = BtnCourseRegister | BtnCourseDeregister
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonCourseRegister
+instance Finite ButtonCourseRegister
+nullaryPathPiece ''ButtonCourseRegister $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''ButtonCourseRegister id
+instance Button UniWorX ButtonCourseRegister where
+  btnClasses BtnCourseRegister   = [BCIsButton, BCPrimary]
+  btnClasses BtnCourseDeregister = [BCIsButton, BCDanger]
+
+  btnLabel  BtnCourseRegister   = [whamlet|#{iconEnrol True}  _{MsgBtnCourseRegister}|]
+  btnLabel  BtnCourseDeregister = [whamlet|#{iconEnrol False} _{MsgBtnCourseDeregister}|]
+
+
 -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
 type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School)
 
@@ -330,7 +345,7 @@ getCShowR tid ssh csh = do
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
   mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
-  (regWidget, regEnctype) <- generateFormPost $ registerForm mbAid registration defSFid $ courseRegisterSecret course
+  (regWidget, regEnctype) <- generateFormPost $ courseRegisterForm mbAid registration defSFid $ courseRegisterSecret course
   let regForm = wrapForm regWidget def
         { formAction = Just . SomeRoute $ CourseR tid ssh csh CRegisterR
         , formEncoding = regEnctype
@@ -426,21 +441,30 @@ getCShowR tid ssh csh = do
           , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
           , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
-          , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
+          , sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
               mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
               isRegistered <- case mbAid of
                 Nothing  -> return False
                 Just uid -> existsBy $ UniqueExamRegistration eId uid
-              if
-                | mayRegister -> do
-                    (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
-                    return $ wrapForm examRegisterForm def
-                      { formAction = Just . SomeRoute $ CExamR tid ssh csh examName ERegisterR
-                      , formEncoding = examRegisterEnctype
-                      , formSubmit = FormNoSubmit
-                      }
-                | isRegistered -> return [whamlet|_{MsgExamRegistered}|]
-                | otherwise -> return mempty
+              let label   = bool MsgExamNotRegistered MsgExamRegistered isRegistered
+                  examUrl = CExamR tid ssh csh examName EShowR
+              if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
+                 | otherwise   -> return [whamlet|_{label}|]
+          -- , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
+          --     mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
+          --     isRegistered <- case mbAid of
+          --       Nothing  -> return False
+          --       Just uid -> existsBy $ UniqueExamRegistration eId uid
+          --     if
+          --       | mayRegister -> do
+          --           (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
+          --           return $ wrapForm examRegisterForm def
+          --             { formAction = Just . SomeRoute $ CExamR tid ssh csh examName ERegisterR
+          --             , formEncoding = examRegisterEnctype
+          --             , formSubmit = FormNoSubmit
+          --             }
+          --       | isRegistered -> return [whamlet|_{MsgExamRegistered}|]
+          --       | otherwise -> return mempty
           ]
         dbtSorting = Map.fromList
           [ ("name", SortColumn $ \exam -> exam E.^. ExamName )
@@ -448,6 +472,14 @@ getCShowR tid ssh csh = do
           , ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
           , ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
           , ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
+          , ("registered", SortColumn $ \exam ->
+              case mbAid of
+                Nothing -> E.false
+                Just uid ->
+                  E.exists $ E.from $ \reg -> do
+                    E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid
+                    E.where_ $ reg E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+            )
           ]
         dbtFilter = Map.empty
         dbtFilterUI = const mempty
@@ -470,9 +502,9 @@ getCShowR tid ssh csh = do
 -- , maybe existing features if already registered
 -- , maybe some default study features
 -- , maybe a course secret
-registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
+courseRegisterForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
 -- unfinished WIP: must take study features if registred and show as mforced field
-registerForm loggedin participant defSFid msecret = identifyForm FIDcourseRegister $ \extra -> do
+courseRegisterForm loggedin participant defSFid msecret = identifyForm FIDcourseRegister $ \extra -> do
     -- secret fields
     (msecretRes', msecretView) <- case msecret of
       (Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
@@ -486,7 +518,7 @@ registerForm loggedin participant defSFid msecret = identifyForm FIDcourseRegist
         _other  -> mreq    (studyFeaturesPrimaryFieldFor False [ ]    loggedin) (fslI MsgCourseStudyFeature
                                                                  & setTooltip  MsgCourseStudyFeatureTooltip) (Just defSFid)
     -- button de-/register
-    (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister isRegistered) "buttonField ignores settings anyway" Nothing
+    (btnRes, btnView) <- mreq (buttonField $ bool BtnCourseRegister BtnCourseDeregister isRegistered) "buttonField ignores settings anyway" Nothing
 
     let widget = $(widgetFile "widgets/register-form/register-form")
     let msecretRes | Just res <- msecretRes' = Just <$> res
@@ -521,7 +553,7 @@ postCRegisterR tid ssh csh = do
       registration <- getBy (UniqueParticipant aid cid)
       return (cid, course, entityVal <$> registration)
   let isRegistered  = isJust registration
-  ((regResult,_), _) <- runFormPost $ registerForm (Just aid) registration Nothing $ courseRegisterSecret course
+  ((regResult,_), _) <- runFormPost $ courseRegisterForm (Just aid) registration Nothing $ courseRegisterSecret course
   formResult regResult $ \(mbSfId,codeOk) -> if
       | isRegistered -> do
           runDB $ deleteBy $ UniqueParticipant aid cid
@@ -1367,8 +1399,8 @@ postCUserR tid ssh csh uCId = do
       redirect $ currentRoute :#: registrationFieldFrag
 
   let regButton
-        | Just _ <- mRegistration = BtnDeregister
-        | otherwise = BtnRegister
+        | Just _ <- mRegistration = BtnCourseDeregister
+        | otherwise = BtnCourseRegister
   ((regButtonRes, regButtonView), regButtonEnctype) <- runFormPost . identifyForm FIDcRegButton $ buttonForm' [regButton]
 
   let registrationButtonFrag :: Text
@@ -1382,7 +1414,7 @@ postCUserR tid ssh csh uCId = do
         , formAnchor = Just registrationButtonFrag
         }
   formResult regButtonRes $ \case
-    BtnDeregister
+    BtnCourseDeregister
       | Just (Entity pId _) <- mRegistration
         -> do
           runDB $ delete pId
@@ -1390,7 +1422,7 @@ postCUserR tid ssh csh uCId = do
           redirect $ CourseR tid ssh csh CUsersR
       | otherwise
         -> invalidArgs ["User not registered"]
-    BtnRegister -> do
+    BtnCourseRegister -> do
       now <- liftIO getCurrentTime
       let primaryField
             | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesType == FieldPrimary && studyFeaturesValid) studies
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 1be2b99fa..0ce4cb352 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -35,6 +35,23 @@ import qualified Data.Csv as Csv
 import qualified Data.Conduit.List as C
 
 
+
+-- Dedicated ExamRegistrationButton
+data ButtonExamRegister = BtnExamRegister | BtnExamDeregister
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonExamRegister
+instance Finite ButtonExamRegister
+nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''ButtonExamRegister id
+instance Button UniWorX ButtonExamRegister where
+  btnClasses BtnExamRegister   = [BCIsButton, BCPrimary]
+  btnClasses BtnExamDeregister = [BCIsButton, BCDanger]
+
+  btnLabel  BtnExamRegister   = [whamlet|#{iconExamRegister True}  _{MsgBtnExamRegister}|]
+  btnLabel  BtnExamDeregister = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|]
+
+
+
 getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamListR tid ssh csh = do
   Entity cid Course{..} <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
@@ -82,7 +99,7 @@ getCExamListR tid ssh csh = do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamsHeading
     $(widgetFile "exam-list")
 
-  
+
 instance IsInvitableJunction ExamCorrector where
   type InvitationFor ExamCorrector = Exam
   data InvitableJunction ExamCorrector = JunctionExamCorrector
@@ -274,7 +291,7 @@ examOccurrenceForm prev = wFormToAForm $ do
   let
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
-  
+
   fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
   where
     examOccurrenceForm' nudge mPrev csrf = do
@@ -294,7 +311,7 @@ examOccurrenceForm prev = wFormToAForm $ do
                  <*> (assertM (not . null . renderHtml) <$> eofDescRes)
              , $(widgetFile "widgets/massinput/examRooms/form")
              )
-    
+
     miAdd' nudge submitView csrf = do
       MsgRenderer mr <- getMsgRenderer
       (res, formWidget) <- examOccurrenceForm' nudge Nothing csrf
@@ -314,7 +331,7 @@ examPartsForm prev = wFormToAForm $ do
   let
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
-  
+
   fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
   where
     examPartForm' nudge mPrev csrf = do
@@ -330,7 +347,7 @@ examPartsForm prev = wFormToAForm $ do
                  <*> epfWeightRes
              , $(widgetFile "widgets/massinput/examParts/form")
              )
-    
+
     miAdd' nudge submitView csrf = do
       MsgRenderer mr <- getMsgRenderer
       (res, formWidget) <- examPartForm' nudge Nothing csrf
@@ -342,7 +359,7 @@ examPartsForm prev = wFormToAForm $ do
     miCell' nudge dat = examPartForm' nudge (Just dat)
     miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/examParts/layout")
     miIdent' :: Text
-    miIdent' = "exam-parts"   
+    miIdent' = "exam-parts"
 
 examFormTemplate :: Entity Exam -> DB ExamForm
 examFormTemplate (Entity eId Exam{..}) = do
@@ -400,7 +417,7 @@ examFormTemplate (Entity eId Exam{..}) = do
 examTemplate :: CourseId -> DB (Maybe ExamForm)
 examTemplate cid = runMaybeT $ do
   newCourse <- MaybeT $ get cid
-  
+
   [(Entity _ oldCourse, Entity _ oldExam)] <- lift . E.select . E.from $ \(course `E.InnerJoin` exam) -> do
     E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
     E.where_ $ (       course E.^. CourseShorthand E.==. E.val (courseShorthand newCourse)
@@ -419,7 +436,7 @@ examTemplate cid = runMaybeT $ do
   newTerm <- MaybeT . get $ courseTerm newCourse
 
   let
-    dateOffset = over _utctDay . addDays $ (diffDays `on` termLectureEnd) newTerm oldTerm 
+    dateOffset = over _utctDay . addDays $ (diffDays `on` termLectureEnd) newTerm oldTerm
 
   return ExamForm
     { efName             = examName oldExam
@@ -447,7 +464,7 @@ examTemplate cid = runMaybeT $ do
 validateExam :: (MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExamForm m ()
 validateExam = do
   ExamForm{..} <- State.get
-  
+
   guardValidation MsgExamRegisterToMustBeAfterRegisterFrom                 $ NTop efRegisterTo                   >= NTop efRegisterFrom
   guardValidation MsgExamDeregisterUntilMustBeAfterRegisterFrom            $ NTop efDeregisterUntil              >= NTop efRegisterFrom
   guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      . fromMaybe True $ (>=) <$> efStart <*> efPublishOccurrenceAssignments
@@ -460,7 +477,7 @@ validateExam = do
 
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
     eofRange' <- formatTimeRange SelFormatDateTime eofStart eofEnd
-    
+
     guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofRoom eofRange') $ NTop eofEnd >= NTop (Just eofStart)
     guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofRoom eofRange') $ NTop (Just eofStart) >= NTop efStart
     guardValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofRoom eofRange') $ NTop eofEnd <= NTop efEnd
@@ -483,7 +500,7 @@ postCExamNewR tid ssh csh = do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     template <- examTemplate cid
     return (cid, template)
-  
+
   ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm validateExam $ examForm template
 
   formResult newExamResult $ \ExamForm{..} -> do
@@ -527,7 +544,7 @@ postCExamNewR tid ssh csh = do
                 examOccurrenceEnd         = eofEnd
                 examOccurrenceDescription = eofDescription
           ]
-       
+
         let (invites, adds) = partitionEithers $ Set.toList efCorrectors
         insertMany_ [ ExamCorrector{..}
                     | examCorrectorUser <- adds
@@ -665,13 +682,13 @@ postEEditR tid ssh csh examn = do
         , formEncoding = editExamEnctype
         }
     $(widgetFile "exam-edit")
-    
+
 
 getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEShowR tid ssh csh examn = do
   cTime <- liftIO getCurrentTime
   mUid <- maybeAuthId
-  
+
   (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister)) <- runDB $ do
     exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
 
@@ -718,7 +735,7 @@ getEShowR tid ssh csh examn = do
       registerWidget
         | Just isRegistered <- registered
         , mayRegister = Just $ do
-            (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
+            (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
             [whamlet|
               <p>
                 $if isRegistered
@@ -768,13 +785,13 @@ queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
 
 queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
 queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
-  
+
 queryExamRegistration :: ExamUserTableExpr -> E.SqlExpr (Entity ExamRegistration)
 queryExamRegistration = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
 
 queryStudyDegree :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
 queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
-  
+
 queryStudyField :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
 queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
 
@@ -786,7 +803,7 @@ resultStudyFeatures = _dbrOutput . _4 . _Just
 
 resultStudyDegree :: Traversal' ExamUserTableData (Entity StudyDegree)
 resultStudyDegree = _dbrOutput . _5 . _Just
-  
+
 resultStudyField :: Traversal' ExamUserTableData (Entity StudyTerms)
 resultStudyField = _dbrOutput . _6 . _Just
 
@@ -820,7 +837,7 @@ getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName ->
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
   Entity eid Exam{..} <- runDB $ fetchExam tid ssh csh examn
-  
+
   let
     examUsersDBTable = DBTable{..}
       where
@@ -844,7 +861,7 @@ postEUsersR tid ssh csh examn = do
           , colDegreeShort      resultStudyDegree
           , colFeaturesSemester resultStudyFeatures
           , sortable (Just "room") (i18nCell MsgExamRoom) (maybe mempty (cell . toWgt . examOccurrenceRoom . entityVal) . view _userTableOccurrence)
-          ] 
+          ]
         dbtSorting = Map.fromList
           [ sortUserNameLink     queryUser
           , sortUserSurname      queryUser
@@ -908,14 +925,14 @@ postERegisterR tid ssh csh examn = do
   ((btnResult, _), _) <- runFormPost buttonForm
 
   formResult btnResult $ \case
-    BtnRegister -> do
+    BtnExamRegister -> do
       runDB $ do
         now <- liftIO getCurrentTime
         insert_ $ ExamRegistration eId uid Nothing now
         audit' $ TransactionExamRegister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
       addMessageI Success $ MsgExamRegisteredSuccess examn
       redirect $ CExamR tid ssh csh examn EShowR
-    BtnDeregister -> do
+    BtnExamDeregister -> do
       runDB $ do
         deleteBy $ UniqueExamRegistration eId uid
         audit' $ TransactionExamDeregister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 4033e8ae1..a19e3b563 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -251,7 +251,7 @@ homeUpcomingExams uid = do
                 | otherwise -> return mempty
             -}
           , sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput } -> sqlCell $ do
-              let Entity eId Exam{..}   = view lensExam   dbrOutput
+              let Entity eId Exam{..} = view lensExam   dbrOutput
                   Entity _ Course{..} = view lensCourse dbrOutput
               mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
               isRegistered <- existsBy $ UniqueExamRegistration eId uid
diff --git a/src/Utils.hs b/src/Utils.hs
index 96dd4535e..aee2890fb 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -153,6 +153,22 @@ iconProblem = fontAwesomeIcon "bolt"
 iconHint :: Markup
 iconHint = fontAwesomeIcon "life-ring"
 
+-- Icons for Course
+iconCourse :: Markup
+iconCourse = fontAwesomeIcon "graduation-cap"
+
+iconExam :: Markup
+iconExam = fontAwesomeIcon "file-invoice"
+
+iconEnrol :: Bool -> Markup
+iconEnrol True  = fontAwesomeIcon "user-plus"
+iconEnrol False = fontAwesomeIcon "user-slash"
+
+iconExamRegister :: Bool -> Markup
+iconExamRegister True  = fontAwesomeIcon "calendar-check"
+iconExamRegister False = fontAwesomeIcon "calendar-times"
+
+
 -- Icons for SheetFileType
 iconSolution :: Markup
 iconSolution =fontAwesomeIcon "exclamation-circle"
@@ -170,7 +186,7 @@ iconCSV :: Markup
 iconCSV = fontAwesomeIcon "file-csv"
 
 
--- Conditional icons
+-- Generic Conditional icons
 
 isVisible :: Bool -> Markup
 -- ^ Display an icon that denotes that something™ is visible or invisible

From 9dbef1fe0f2d69eef5f6ff830d5ac338b84aa0f7 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 16 Jul 2019 11:36:50 +0200
Subject: [PATCH 07/36] fix(sheet type info): give better tooltips and name to
 sheet types

Closes #402
---
 messages/uniworx/de.msg      | 11 ++++++-----
 src/Handler/Sheet.hs         |  2 +-
 src/Handler/Utils/Form.hs    |  2 +-
 src/Model/Migration/Types.hs |  8 ++++----
 4 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 792c2468c..50e9cb9bf 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -678,10 +678,11 @@ SheetGradingPassBinary': Bestanden/Nicht bestanden
 
 SheetTypeBonus grading@SheetGrading: Bonus
 SheetTypeNormal grading@SheetGrading: Normal
-SheetTypeInformational grading@SheetGrading: Keine Wertung
-SheetTypeNotGraded: Unbewertet
-SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer.
+SheetTypeInformational grading@SheetGrading: Ohne Anrechung
+SheetTypeNotGraded: Keine Korrektur
+SheetTypeInfoNotGraded: Keine Korrektur bedeutet, dass es gar kein Feedback gibt.
 SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter.
+SheetTypeInfoInformational: Blätter ohne Anrechnung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer.
 SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt.
 SummaryTitle: Zusammenfassung über
 SheetGradingSummaryTitle intgr@Integer: #{intgr} #{pluralDE intgr "Blatt" "Blätter"}
@@ -689,8 +690,8 @@ SubmissionGradingSummaryTitle intgr@Integer: #{intgr} #{pluralDE intgr "Abgabe"
 
 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal
-SheetTypeInformational': Keine Wertung
-SheetTypeNotGraded': Unbewertet
+SheetTypeInformational': Ohne Anrechung
+SheetTypeNotGraded': Keine Korrektur
 
 SheetGradingMaxPoints: Maximalpunktzahl
 SheetGradingPassingPoints: Notwendig zum Bestehen
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 792fd11ef..0c57bb7af 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -123,7 +123,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
             & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
       <* aformSection MsgSheetFormType
       <*> sheetTypeAFormReq   (fslI MsgSheetType
-            & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
+            & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus, MsgSheetTypeInfoInformational, MsgSheetTypeInfoNotGraded]))
                                                           (sfType        <$> template)
       <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
       <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 76a0a1a31..4243a318c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -681,7 +681,7 @@ nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'")
 embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)
 
 
-data SheetType' = NotGraded' | Normal' | Bonus' | Informational'
+data SheetType' = Normal' | Bonus' | Informational' | NotGraded'
   deriving (Eq, Ord, Read, Show, Enum, Bounded)
 
 instance Universe SheetType'
diff --git a/src/Model/Migration/Types.hs b/src/Model/Migration/Types.hs
index e5ed53362..2126ce178 100644
--- a/src/Model/Migration/Types.hs
+++ b/src/Model/Migration/Types.hs
@@ -1,4 +1,4 @@
-module Model.Migration.Types where 
+module Model.Migration.Types where
 
 import ClassyPrelude.Yesod
 import Data.Aeson
@@ -13,8 +13,8 @@ import Data.Universe
 
 
 data SheetType
-  = Bonus  { maxPoints :: Current.Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
-  | Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben
+  = Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben
+  | Bonus  { maxPoints :: Current.Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
   | Pass   { maxPoints, passingPoints :: Current.Points }
   | NotGraded
   deriving (Show, Read, Eq)
@@ -58,7 +58,7 @@ instance Finite SheetSubmissionMode
 
 nullaryPathPiece ''SheetSubmissionMode camelToPathPiece
 
-  
+
 {- TODO:
   * RenderMessage instance for newtype(SheetType) if needed
 -}

From 2218103cbd6a021fd24629f9215c71dd115f08e4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 11:45:21 +0200
Subject: [PATCH 08/36] feat(exams): csv-export exercise data

---
 src/Data/Fixed/Instances.hs | 15 ++++++++++++++-
 src/Handler/Exam.hs         | 32 ++++++++++++++++++++++----------
 2 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/src/Data/Fixed/Instances.hs b/src/Data/Fixed/Instances.hs
index 03afaeb0e..53696e9e6 100644
--- a/src/Data/Fixed/Instances.hs
+++ b/src/Data/Fixed/Instances.hs
@@ -9,5 +9,18 @@ import Data.Fixed
 
 import Text.Blaze (ToMarkup(..))
 
+import qualified Data.Csv as Csv
+
+import Data.Proxy (Proxy(..))
+
+import Data.Scientific
+  
+
 instance HasResolution a => ToMarkup (Fixed a) where
-  toMarkup = toMarkup . showFixed True
\ No newline at end of file
+  toMarkup = toMarkup . showFixed True
+
+
+instance HasResolution a => Csv.ToField (Fixed a) where
+  toField = Csv.toField . (realToFrac :: Fixed a -> Scientific)
+instance HasResolution a => Csv.FromField (Fixed a) where
+  parseField = fmap (MkFixed . (round :: Scientific -> Integer) . (* fromInteger (resolution $ Proxy @a))) . Csv.parseField
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index b9ebc0893..4add0d9ba 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -34,6 +34,8 @@ import qualified Data.Csv as Csv
 
 import qualified Data.Conduit.List as C
 
+import Numeric.Lens (integral)
+
 
 getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamListR tid ssh csh = do
@@ -806,18 +808,22 @@ resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
 resultExamOccurrence = _dbrOutput . _3 . _Just
 
 data ExamUserTableCsv = ExamUserTableCsv
-  { csvUserSurname :: Text
-  , csvUserName :: Text
-  , csvUserMatriculation :: Maybe Text
-  , csvUserField :: Maybe Text
-  , csvUserDegree :: Maybe Text
-  , csvUserSemester :: Maybe Int
-  , csvUserOccurrence :: Maybe (CI Text)
+  { csvEUserSurname :: Maybe Text
+  , csvEUserName :: Maybe Text
+  , csvEUserMatriculation :: Maybe Text
+  , csvEUserField :: Maybe Text
+  , csvEUserDegree :: Maybe Text
+  , csvEUserSemester :: Maybe Int
+  , csvEUserOccurrence :: Maybe (CI Text)
+  , csvEUserExercisePoints, csvEUserExercisePassPoints :: Maybe Points
+  , csvEUserExercisePasses :: Maybe Int
+  , csvEUserExercisePointsMax, csvEUserExercisePassPointsMax :: Maybe Points
+  , csvEUserExercisePassesMax :: Maybe Int
   }
   deriving (Generic)
 
 examUserTableCsvOptions :: Csv.Options
-examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 1 }
+examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
 
 instance ToNamedRecord ExamUserTableCsv where
   toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions
@@ -909,13 +915,19 @@ postEUsersR tid ssh csh examn = do
           dbtIdent = "exam-users"
           dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
           dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
-            <$> view (resultUser . _entityVal . _userSurname)
-            <*> view (resultUser . _entityVal . _userDisplayName)
+            <$> view (resultUser . _entityVal . _userSurname . to Just)
+            <*> view (resultUser . _entityVal . _userDisplayName . to Just)
             <*> view (resultUser . _entityVal . _userMatrikelnummer)
             <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
             <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
             <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
             <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
+            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped)
+            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPassPoints . _Wrapped)
+            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
+            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
+            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPassPoints . _Wrapped)
+            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
           dbtCsvDecode = Nothing
 
       examUsersDBTableValidator = def

From c8874425d22293794a10717c61865ae9a7a91051 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 11:58:37 +0200
Subject: [PATCH 09/36] chore(release): 3.0.0

---
 CHANGELOG.md      | 27 +++++++++++++++++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e1e07c871..8efa52dd4 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,33 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [3.0.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v2.1.1...v3.0.0) (2019-07-16)
+
+
+### Bug Fixes
+
+* **course and exam registration:** distinguish registrations buttons ([ad825b6](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ad825b6)), closes [#416](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/416)
+* **exam participant download:** fix icon not being shown ([a075b16](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a075b16))
+* **exams:** cleanup exam interface ([05e7b52](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/05e7b52))
+* **sheet type info:** give better tooltips and name to sheet types ([9dbef1f](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/9dbef1f)), closes [#402](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/402)
+
+
+### Features
+
+* **exams:** csv-export exercise data ([2218103](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2218103))
+* **exams:** filter on occurrence ([cf040ce](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/cf040ce))
+* **exams:** introduce examOccurrenceName ([379a7ed](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/379a7ed))
+* **exams:** show exam bonus in webinterface ([2b23600](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2b23600))
+* **sheetlist:** sort sheet file types in db by haskell Ord ([643cc41](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/643cc41))
+
+
+### BREAKING CHANGES
+
+* **exams:** examOccurrenceName
+* **exams:** examStart and examPublishOccurrenceAssignments now optional
+
+
+
 ### [2.1.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v2.1.0...v2.1.1) (2019-07-10)
 
 
diff --git a/package-lock.json b/package-lock.json
index 0478626f8..e7842c7e3 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "2.1.1",
+  "version": "3.0.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 4d88cf8bc..c85dea54d 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "2.1.1",
+  "version": "3.0.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index edeaae4b1..51307e805 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 2.1.1
+version: 3.0.0
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From e9b86cd3fbd4de9a588ca159ec4edf94333b3a46 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 13:00:30 +0200
Subject: [PATCH 10/36] chore: enforce running of tests before release

---
 package.json | 1 +
 1 file changed, 1 insertion(+)

diff --git a/package.json b/package.json
index c85dea54d..8aa37bfff 100644
--- a/package.json
+++ b/package.json
@@ -20,6 +20,7 @@
     "frontend:test:watch": "karma start --conf karma.conf.js --single-run false",
     "frontend:build": "webpack",
     "frontend:build:watch": "webpack --watch",
+    "prerelease": "npm run test",
     "release": "standard-version -a"
   },
   "husky": {

From c8dca945cfac12453bcc74bdfea321d7b4cb3053 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 15:43:11 +0200
Subject: [PATCH 11/36] feat(csv): add column explanations

BREAKING CHANGE: CsvColumnsExplained now required
---
 frontend/src/utils/modal/modal.scss           |  4 ++
 messages/uniworx/de.msg                       | 16 ++++-
 src/Handler/Exam.hs                           | 34 +++++----
 src/Handler/Utils/Table/Pagination.hs         | 14 +++-
 .../Table/Pagination/CsvColumnExplanations.hs | 70 +++++++++++++++++++
 templates/default-layout.lucius               | 22 +++++-
 .../table/csv-column-explanations.hamlet      |  7 ++
 templates/table/csv-transcode.hamlet          |  1 +
 templates/table/layout.lucius                 |  2 +
 templates/widgets/modal/modal.hamlet          |  2 +-
 10 files changed, 153 insertions(+), 19 deletions(-)
 create mode 100644 src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs
 create mode 100644 templates/table/csv-column-explanations.hamlet

diff --git a/frontend/src/utils/modal/modal.scss b/frontend/src/utils/modal/modal.scss
index 2cecac941..50054aaaf 100644
--- a/frontend/src/utils/modal/modal.scss
+++ b/frontend/src/utils/modal/modal.scss
@@ -83,6 +83,10 @@
   cursor: pointer;
 }
 
+div.modal__trigger {
+  display: inline-block;
+}
+
 .modal__trigger-label {
   font-style: italic;
   text-decoration: underline;
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index eed2e6f17..2deccb636 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1194,4 +1194,18 @@ CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
 
-Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
\ No newline at end of file
+Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
+
+CsvColumnsExplanationsLabel: Spalten
+CsvColumnsExplanationsTip: Bedeutung der in der CSV-Datei enthaltenen Spalten
+CsvColumnExamUserSurname: Nachname des Teilnehmers
+CsvColumnExamUserName: Voller Name des Teilnehmers (inkl. Nachname)
+CsvColumnExamUserMatriculation: Matrikelnummer des Teilnehmers
+CsvColumnExamUserField: Hauptfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
+CsvColumnExamUserDegree: Abschluss, den der Teilnehmer im assoziierten Hauptfach anstrebt
+CsvColumnExamUserSemester: Fachsemester des Teilnehmers im assoziierten Hauptfach
+CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angemeldet ist
+CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat
+CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Klausurtermin erreichen hätte können
+CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
+CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
\ No newline at end of file
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 0d70440b0..b3ad24767 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -832,9 +832,9 @@ data ExamUserTableCsv = ExamUserTableCsv
   , csvEUserDegree :: Maybe Text
   , csvEUserSemester :: Maybe Int
   , csvEUserOccurrence :: Maybe (CI Text)
-  , csvEUserExercisePoints, csvEUserExercisePassPoints :: Maybe Points
+  , csvEUserExercisePoints :: Maybe Points
   , csvEUserExercisePasses :: Maybe Int
-  , csvEUserExercisePointsMax, csvEUserExercisePassPointsMax :: Maybe Points
+  , csvEUserExercisePointsMax :: Maybe Points
   , csvEUserExercisePassesMax :: Maybe Int
   }
   deriving (Generic)
@@ -851,6 +851,21 @@ instance FromNamedRecord ExamUserTableCsv where
 instance DefaultOrdered ExamUserTableCsv where
   headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions
 
+instance CsvColumnsExplained ExamUserTableCsv where
+  csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
+    [ ('csvEUserSurname          , MsgCsvColumnExamUserSurname           )
+    , ('csvEUserName             , MsgCsvColumnExamUserName              )
+    , ('csvEUserMatriculation    , MsgCsvColumnExamUserMatriculation     )
+    , ('csvEUserField            , MsgCsvColumnExamUserField             )
+    , ('csvEUserDegree           , MsgCsvColumnExamUserDegree            )
+    , ('csvEUserSemester         , MsgCsvColumnExamUserSemester          )
+    , ('csvEUserOccurrence       , MsgCsvColumnExamUserOccurrence        )
+    , ('csvEUserExercisePoints   , MsgCsvColumnExamUserExercisePoints    ) 
+    , ('csvEUserExercisePasses   , MsgCsvColumnExamUserExercisePasses    ) 
+    , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax ) 
+    , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) 
+    ]
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -861,8 +876,7 @@ postEUsersR tid ssh csh examn = do
     let
       allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus
       showPasses     = numSheetsPasses allBoni /= 0
-      showPoints     = getSum (numSheetsPoints allBoni) - getSum (numSheetsPassPoints allBoni) /= 0
-      showPassPoints = numSheetsPassPoints allBoni /= 0
+      showPoints     = getSum (numSheetsPoints allBoni) /= 0
 
     let
       examUsersDBTable = DBTable{..}
@@ -891,14 +905,10 @@ postEUsersR tid ssh csh examn = do
                 SheetGradeSummary{achievedPasses} <- examBonusAchieved uid bonus
                 SheetGradeSummary{numSheetsPasses} <- examBonusPossible uid bonus
                 return $ propCell (getSum achievedPasses) (getSum numSheetsPasses)
-            , guardOn showPassPoints $ sortable Nothing (i18nCell MsgAchievedPassPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
-                SheetGradeSummary{achievedPassPoints} <- examBonusAchieved uid bonus
-                SheetGradeSummary{sumSheetsPassPoints} <- examBonusPossible uid bonus
-                return $ propCell (getSum achievedPassPoints) (getSum sumSheetsPassPoints)
             , guardOn showPoints $ sortable Nothing (i18nCell MsgAchievedPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
-                SheetGradeSummary{achievedPoints, achievedPassPoints} <- examBonusAchieved uid bonus
-                SheetGradeSummary{sumSheetsPoints, sumSheetsPassPoints} <- examBonusPossible uid bonus
-                return $ propCell (getSum achievedPoints - getSum achievedPassPoints) (getSum sumSheetsPoints - getSum sumSheetsPassPoints)
+                SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus
+                SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus
+                return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints)
             ] 
           dbtSorting = Map.fromList
             [ sortUserNameLink     queryUser
@@ -940,10 +950,8 @@ postEUsersR tid ssh csh examn = do
             <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
             <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
             <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped)
-            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPassPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
-            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPassPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
           dbtCsvDecode = Nothing
 
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 272c9ffaa..4f6676899 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -6,6 +6,7 @@ module Handler.Utils.Table.Pagination
   , FilterColumn(..), IsFilterColumn
   , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
   , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
+  , module Handler.Utils.Table.Pagination.CsvColumnExplanations
   , DBTCsvEncode, DBTCsvDecode
   , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
@@ -34,6 +35,7 @@ module Handler.Utils.Table.Pagination
   ) where
 
 import Handler.Utils.Table.Pagination.Types
+import Handler.Utils.Table.Pagination.CsvColumnExplanations
 import Handler.Utils.Form
 import Handler.Utils.Csv
 import Handler.Utils.ContentDisposition
@@ -439,7 +441,7 @@ instance PathPiece x => PathPiece (WithIdent x) where
     WithIdent <$> pure ident <*> fromPathPiece rest
 
 
-type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv) (Conduit r' (YesodDB UniWorX) csv)
+type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
 type DBTCsvDecode csv = DictMaybe (FromNamedRecord csv) (Sink csv (YesodDB UniWorX) ())
 
 data DBTable m x = forall a r r' h i t k k' csv.
@@ -462,7 +464,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtIdent :: i
   }
 
-noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void) (Conduit r' (YesodDB UniWorX) Void)
+noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void, CsvColumnsExplained Void) (Conduit r' (YesodDB UniWorX) Void)
 noCsvEncode = Nothing
 
 class (MonadHandler m, HandlerSite m ~ UniWorX, Monoid' x, Monoid' (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where
@@ -768,7 +770,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       { formMethod = GET
       , formAction = Just $ tblLink id
       , formEncoding = csvExportEnctype
-      , formAttrs = [("target", "_blank")]
+      , formAttrs = [("target", "_blank"), ("class", "form--inline")]
       , formSubmit = FormNoSubmit
       , formAnchor = Nothing :: Maybe Text
       }
@@ -780,6 +782,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , formSubmit = FormSubmit
       , formAnchor = Nothing :: Maybe Text
       }
+    csvColExplanations = case dbtCsvEncode of
+      (Just (Dict, _) :: DBTCsvEncode _ csv) -> assertM' (not . null) . Map.toList . csvColumnsExplanations $ Proxy @csv
+      Nothing -> Nothing
+    csvColExplanations' = case csvColExplanations of
+      Just csvColExplanations'' -> modal [whamlet|_{MsgCsvColumnsExplanationsLabel}|] $ Right $(widgetFile "table/csv-column-explanations")
+      Nothing -> mempty
 
 
   rows' <- E.select . E.from $ \t -> do
diff --git a/src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs b/src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs
new file mode 100644
index 000000000..460a9414b
--- /dev/null
+++ b/src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs
@@ -0,0 +1,70 @@
+module Handler.Utils.Table.Pagination.CsvColumnExplanations
+  ( CsvColumnsExplained(..)
+  , genericCsvColumnsExplanations
+  ) where
+
+import Import
+
+import qualified Data.Csv as Csv
+import GHC.Generics
+import qualified GHC.Generics as Generics
+
+import Language.Haskell.TH
+-- import Language.Haskell.TH.Datatype
+-- import Language.Haskell.TH.Lib
+
+import qualified Data.Map as Map
+import qualified Data.ByteString.Char8 as B8
+
+
+class CsvColumnsExplained csv where
+  csvColumnsExplanations :: forall p. p csv -> Map Csv.Name Widget
+  csvColumnsExplanations _ = Map.empty
+
+genericCsvColumnsExplanations :: forall msg p csv.
+                                 ( Generic csv
+                                 , GCsvColumnsExplained (Rep csv)
+                                 , RenderMessage UniWorX msg
+                                 )
+                              => Csv.Options
+                              -> Map Name msg
+                              -> p csv
+                              -> Map Csv.Name Widget
+genericCsvColumnsExplanations opts msgMap' _ = Map.mapMaybe (fmap (toWidget <=< ap getMessageRender . pure) . flip Map.lookup msgMap) headerNames
+  where
+    msgMap :: Map String msg
+    msgMap = Map.mapKeys nameBase msgMap'
+    headerNames :: Map Csv.Name String
+    headerNames = gCsvColumnsExplanations opts $ Generics.from (error "proxy" :: csv)
+
+class GCsvColumnsExplained a where
+  gCsvColumnsExplanations :: Csv.Options -> a p -> Map Csv.Name String
+
+instance GCsvColumnsExplained U1 where
+  gCsvColumnsExplanations _ _ = Map.empty
+
+instance (GCsvColumnsExplained a, GCsvColumnsExplained b) => GCsvColumnsExplained (a :*: b) where
+  gCsvColumnsExplanations opts _ = Map.unionWithKey (\h f1 f2 -> error $ "Column header ‘" ++ B8.unpack h ++ "’ is produced by both ‘" ++ f1 ++ "’ and ‘" ++ f2 ++ "’")
+    (gCsvColumnsExplanations opts (error "proxy" :: a p))
+    (gCsvColumnsExplanations opts (error "proxy" :: b p))
+    
+
+instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 D c a) where
+  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)
+
+instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 C c a) where
+  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)
+
+-- | Instance to ensure that you cannot derive DefaultOrdered for
+-- constructors without selectors.
+instance CsvColumnsExplained (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a ())
+      => GCsvColumnsExplained (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)
+   where
+     gCsvColumnsExplanations _ _ =
+        error "You cannot derive CsvColumnsExplanations for constructors without selectors."
+
+instance Selector s => GCsvColumnsExplained (M1 S s a) where
+  gCsvColumnsExplanations (Csv.fieldLabelModifier -> f) m
+    | null name = error "Cannot derive CsvColumnsExplanations for constructors without selectors"
+    | otherwise = Map.singleton (B8.pack $ f name) name
+    where name = selName m
diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index 57d417402..720407eff 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -329,7 +329,22 @@ input[type="button"].btn-info:hover,
 .scrolltable {
   overflow: auto;
   box-shadow: 0 0 1px 1px var(--color-grey-light);
-  margin-bottom: 15px;
+}
+
+.csv-export, .csv-import {
+  box-shadow: 0 0 1px 1px var(--color-grey);
+
+  * {
+    margin-right: 10px;
+  }
+
+  *:last-child {
+    margin-right: 0;
+
+    &.modal__trigger {
+      margin-right: 10px;
+    }
+  }
 }
 
 @media (max-width: 425px) {
@@ -642,3 +657,8 @@ section {
 .uuid {
   font-family: monospace;
 }
+
+
+.form--inline {
+  display: inline-block;
+}
diff --git a/templates/table/csv-column-explanations.hamlet b/templates/table/csv-column-explanations.hamlet
new file mode 100644
index 000000000..c39403fe7
--- /dev/null
+++ b/templates/table/csv-column-explanations.hamlet
@@ -0,0 +1,7 @@
+<h3>_{MsgCsvColumnsExplanationsTip}
+<dl .deflist>
+  $forall (colName, colExplanation) <- csvColExplanations''
+    <dt .deflist__dt>#{decodeUtf8 colName}
+    <dd .deflist__dd>^{colExplanation}
+<div>
+  ^{csvExportWdgt'}
diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet
index dd4576e25..10eedfc63 100644
--- a/templates/table/csv-transcode.hamlet
+++ b/templates/table/csv-transcode.hamlet
@@ -5,3 +5,4 @@ $if is _Just dbtCsvDecode
 $if is _Just dbtCsvEncode
   <div .csv-export>
     ^{csvExportWdgt'}
+    ^{csvColExplanations'}
diff --git a/templates/table/layout.lucius b/templates/table/layout.lucius
index 0c402442b..943edbc15 100644
--- a/templates/table/layout.lucius
+++ b/templates/table/layout.lucius
@@ -3,6 +3,7 @@
   display: flex;
   flex-flow: row-reverse;
   justify-content: space-between;
+  margin-bottom: 15px;
 }
 
 /* TABLE FOOTER */
@@ -10,6 +11,7 @@
   display: flex;
   flex-flow: row-reverse;
   justify-content: space-between;
+  margin-top: 15px;
 }
 
 /* PAGINATION */
diff --git a/templates/widgets/modal/modal.hamlet b/templates/widgets/modal/modal.hamlet
index b801967f6..c24010078 100644
--- a/templates/widgets/modal/modal.hamlet
+++ b/templates/widgets/modal/modal.hamlet
@@ -1,5 +1,5 @@
 $newline never
-<div uw-modal data-modal-trigger=#{triggerId'} data-modal-closeable>
+<div .modal uw-modal data-modal-trigger=#{triggerId'} data-modal-closeable>
   $case modalContent
     $of Right content
       <div .modal__content>

From 0f81f7332e1cc9119ade1acf8366fbf4ff99bcbf Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 15:51:05 +0200
Subject: [PATCH 12/36] chore(release): 4.0.0

---
 CHANGELOG.md      | 14 ++++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8efa52dd4..94c1ac3a6 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,20 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [4.0.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v3.0.0...v4.0.0) (2019-07-16)
+
+
+### Features
+
+* **csv:** add column explanations ([c8dca94](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c8dca94))
+
+
+### BREAKING CHANGES
+
+* **csv:** CsvColumnsExplained now required
+
+
+
 ## [3.0.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v2.1.1...v3.0.0) (2019-07-16)
 
 
diff --git a/package-lock.json b/package-lock.json
index e7842c7e3..b7ddd1f50 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "3.0.0",
+  "version": "4.0.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 8aa37bfff..ea4cfbe26 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "3.0.0",
+  "version": "4.0.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index 51307e805..f6f55a37b 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 3.0.0
+version: 4.0.0
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From a9e74ca4af31e6f392fc79ae30d2a771800828d3 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 17:22:42 +0200
Subject: [PATCH 13/36] fix(exams): fix caculation of maximum exercise points

---
 src/Handler/Utils/Exam.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index f3cda795c..3f53325a8 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -8,6 +8,7 @@ import Import.NoFoundation
 
 import Database.Persist.Sql (SqlBackendCanRead)
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
@@ -55,11 +56,12 @@ fetchCourseIdExam tid ssh cid examn = over _1 E.unValue <$> fetchExamAux (\tutor
 examBonus :: MonadHandler m => Entity Exam -> ReaderT SqlBackend m (Map UserId SheetTypeSummary)
 examBonus (Entity eId Exam{..}) = runConduit $
   let
-    rawData = E.selectSource . E.from $ \((examRegistration `E.LeftOuterJoin` examOccurrence) `E.InnerJoin` (sheet `E.InnerJoin` submission)) -> E.distinctOnOrderBy [ E.asc $ examRegistration E.^. ExamRegistrationUser, E.asc $ sheet E.^. SheetId ] $ do
+    rawData = E.selectSource . E.from $ \(((examRegistration `E.LeftOuterJoin` examOccurrence) `E.InnerJoin` sheet) `E.LeftOuterJoin` submission) -> E.distinctOnOrderBy [ E.asc $ examRegistration E.^. ExamRegistrationUser, E.asc $ sheet E.^. SheetId ] $ do
       E.on $ submission E.?. SubmissionSheet E.==. E.just (sheet E.^. SheetId)
-      E.on $ E.exists (E.from $ \submissionUser -> E.where_ $ submissionUser E.^. SubmissionUserUser E.==. examRegistration E.^. ExamRegistrationUser
+       E.&&. E.exists (E.from $ \submissionUser -> E.where_ $ submissionUser E.^. SubmissionUserUser E.==. examRegistration E.^. ExamRegistrationUser
                                                         E.&&. E.just (submissionUser E.^. SubmissionUserSubmission) E.==. submission E.?. SubmissionId
                       )
+      E.on E.true
       E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. examOccurrence E.?. ExamOccurrenceId
       E.where_ $ sheet E.^. SheetCourse E.==. E.val examCourse
            E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val eId

From fccd2a49b1537f5befd95b33e217052b6e93d1ca Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 16 Jul 2019 17:30:09 +0200
Subject: [PATCH 14/36] chore(release): 4.0.1

---
 CHANGELOG.md      | 9 +++++++++
 package-lock.json | 2 +-
 package.json      | 2 +-
 package.yaml      | 2 +-
 4 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 94c1ac3a6..73f7f25ab 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,15 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+### [4.0.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.0.0...v4.0.1) (2019-07-16)
+
+
+### Bug Fixes
+
+* **exams:** fix caculation of maximum exercise points ([a9e74ca](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a9e74ca))
+
+
+
 ## [4.0.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v3.0.0...v4.0.0) (2019-07-16)
 
 
diff --git a/package-lock.json b/package-lock.json
index b7ddd1f50..60a0af49f 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.0.0",
+  "version": "4.0.1",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index ea4cfbe26..9d27bb43b 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.0.0",
+  "version": "4.0.1",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index f6f55a37b..acf84b689 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 4.0.0
+version: 4.0.1
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From 1b532c4e4d2aa90da93a08dd4f1dbaf8626e8077 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 11:14:15 +0200
Subject: [PATCH 15/36] feat(exams): allow forced deregistration

---
 messages/uniworx/de.msg |  2 ++
 routes                  |  2 +-
 src/Handler/Exam.hs     | 51 +++++++++++++++++++++++++++++++++++++----
 3 files changed, 49 insertions(+), 6 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 2deccb636..88a2d6821 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1186,6 +1186,8 @@ VersionHistory: Versionsgeschichte
 KnownBugs: Bekannte Bugs
 
 ExamUsersHeading: Klausurteilnehmer
+ExamUserDeregister: Teilnehmer von Klausur abmelden
+ExamUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
 
 CsvFile: CSV-Datei
 CsvModifyExisting: Existierende Einträge angleichen
diff --git a/routes b/routes
index a6241127d..3b1aa5262 100644
--- a/routes
+++ b/routes
@@ -143,7 +143,7 @@
     /show                       EShowR         GET             !time
     /edit                       EEditR         GET POST
     /corrector-invite           ECInviteR      GET POST
-    /users                      EUsersR        GET POST        !timeANDcorrector
+    /users                      EUsersR        GET POST
     /users/new                  EAddUserR      GET POST
     /users/invite               EInviteR       GET POST
     /register                   ERegisterR         POST        !timeANDcourse-registered !timeANDexam-registered
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index b3ad24767..73c323d4d 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -36,6 +36,8 @@ import qualified Data.Conduit.List as C
 
 import Numeric.Lens (integral)
 
+import Database.Persist.Sql (deleteWhereCount)
+
 
 
 -- Dedicated ExamRegistrationButton
@@ -809,6 +811,9 @@ queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
 queryStudyField :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
 queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 3 3)
 
+resultExamRegistration :: Lens' ExamUserTableData (Entity ExamRegistration)
+resultExamRegistration = _dbrOutput . _1
+
 resultUser :: Lens' ExamUserTableData (Entity User)
 resultUser = _dbrOutput . _2
 
@@ -866,10 +871,18 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) 
     ]
 
+data ExamUserAction = ExamUserDeregister
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe ExamUserAction
+instance Finite ExamUserAction
+nullaryPathPiece ''ExamUserAction $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''ExamUserAction id
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
-  ((), examUsersTable) <- runDB $ do
+  (registrationResult, examUsersTable) <- runDB $ do
     exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn
     bonus <- examBonus exam
 
@@ -894,8 +907,9 @@ postEUsersR tid ssh csh examn = do
             return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField)
           dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
           dbtProj = return
-          dbtColonnade = dbColonnade . mconcat $ catMaybes
-            [ pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
+          dbtColonnade = mconcat $ catMaybes
+            [ pure $ dbSelect (applying _2) id $ return . view (resultExamRegistration . _entityKey)
+            , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
             , pure   colUserMatriclenr
             , pure $ colField            resultStudyField
             , pure $ colDegreeShort      resultStudyDegree
@@ -937,7 +951,20 @@ postEUsersR tid ssh csh examn = do
             , prismAForm (singletonFilter "occurrence") mPrev $ aopt textField (fslI MsgExamOccurrence)
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
-          dbtParams = def
+          dbtParams = DBParamsForm
+            { dbParamsFormMethod = POST
+            , dbParamsFormAction = Just . SomeRoute $ CExamR tid ssh csh examn EUsersR
+            , dbParamsFormAttrs  = []
+            , dbParamsFormSubmit = FormSubmit
+            , dbParamsFormAdditional = \csrf -> do
+                (res, vw) <- mreq (selectField optionsFinite) "" Nothing
+                let formWgt = toWidget csrf <> fvInput vw
+                    formRes = (, mempty) . First . Just <$> res
+                return (formRes, formWgt)
+            , dbParamsFormEvaluate = liftHandlerT . runFormPost
+            , dbParamsFormResult   = id
+            , dbParamsFormIdent    = def
+            }
           dbtIdent :: Text
           dbtIdent = "exam-users"
           dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
@@ -956,7 +983,21 @@ postEUsersR tid ssh csh examn = do
           dbtCsvDecode = Nothing
 
       examUsersDBTableValidator = def
-    dbTable examUsersDBTableValidator examUsersDBTable
+
+      postprocess :: FormResult (First ExamUserAction, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserAction, Set ExamRegistrationId)
+      postprocess inp = do
+        (First (Just act), regMap) <- inp
+        let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
+        return (act, regSet)
+    over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
+
+  formResult registrationResult $ \case
+    (ExamUserDeregister, selectedRegistrations) -> do
+      nrDel <- runDB $ deleteWhereCount
+        [ ExamRegistrationId <-. Set.toList selectedRegistrations
+        ]
+      addMessageI Success $ MsgExamUsersDeregistered nrDel
+      redirect $ CExamR tid ssh csh examn EUsersR
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading

From a14152d1bcfd94aa6baf6f697792874ce239f522 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 11:24:22 +0200
Subject: [PATCH 16/36] chore(release): 4.1.0

---
 CHANGELOG.md      | 9 +++++++++
 package-lock.json | 2 +-
 package.json      | 2 +-
 package.yaml      | 2 +-
 4 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 73f7f25ab..ecdf9d07e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,15 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [4.1.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.0.1...v4.1.0) (2019-07-17)
+
+
+### Features
+
+* **exams:** allow forced deregistration ([1b532c4](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/1b532c4))
+
+
+
 ### [4.0.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.0.0...v4.0.1) (2019-07-16)
 
 
diff --git a/package-lock.json b/package-lock.json
index 60a0af49f..c68e097cf 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.0.1",
+  "version": "4.1.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 9d27bb43b..38f1bce87 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.0.1",
+  "version": "4.1.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index acf84b689..126894c4f 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 4.0.1
+version: 4.1.0
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From 8e0c379c71ca1226590b333f9a740c6cc0aa98be Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 11:49:19 +0200
Subject: [PATCH 17/36] fix(submissions): only notify submittors if rating is
 done

---
 src/Handler/Utils/Submission.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 812c2ff66..6d6879648 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -522,7 +522,7 @@ sinkSubmission userId mExists isUpdate = do
   
           mapM_ throwM $ validateRating sheetType r'
 
-          when (isNothing submissionRatingTime) $ tellSt mempty { sinkSubmissionNotifyRating = Any True }
+          when (submissionRatingDone r') $ tellSt mempty { sinkSubmissionNotifyRating = Any True }
           lift $ update submissionId
             [ SubmissionRatingPoints  =. ratingPoints
             , SubmissionRatingComment =. ratingComment

From bf20d6f4e84353d7d83626377ccf41204832ac2c Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 17 Jul 2019 11:52:09 +0200
Subject: [PATCH 18/36] fix(submissions): submitting produces an success alert
 now

Closes #286
---
 messages/uniworx/de.msg   | 4 +++-
 src/Handler/Submission.hs | 2 ++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 88a2d6821..3e89d21a4 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -7,7 +7,7 @@ BtnRegister: Anmelden
 BtnDeregister: Abmelden
 BtnCourseRegister: Zum Kurs anmelden
 BtnCourseDeregister: Vom Kurs abmelden
-BtnExamRegister: Klasuranmeldung
+BtnExamRegister: Klausuranmeldung
 BtnExamDeregister: Abmeldung von der Klausur
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
@@ -582,6 +582,8 @@ SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahr
 
 SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
 SubmissionReplace: Abgabe ersetzen
+SubmissionCreated: Abgabe erfolgreich angelegt
+SubmissionUpdated: Abgabe erfolgreich ersetzt
 
 AdminFeaturesHeading: Studiengänge
 StudyTerms: Studiengänge
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 6dd006d40..cd367b493 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -451,6 +451,8 @@ submissionHelper tid ssh csh shn mcid = do
           deleteWhere [InvitationFor ==. invRef @SubmissionUser smid, InvitationEmail /<-. subEmails]
           insertMany_ $ map (flip SubmissionUser smid) subUids
           sinkInvitationsF submissionUserInvitationConfig $ map (\lEmail -> (lEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))) subEmails
+          addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
+                                   | otherwise        -> MsgSubmissionUpdated
           return smid
         cID <- encrypt smid
         return $ Just cID

From 63f6d016191fd1529ad7545b795bd4d174e6586a Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 17 Jul 2019 13:31:01 +0200
Subject: [PATCH 19/36] fix(aform): show info about required fields in all
 aforms

info is only shown in forms that actually have required fields

Closes #418
---
 frontend/src/utils/inputs/inputs.scss |  8 +++-----
 messages/uniworx/de.msg               |  1 +
 src/Auth/Dummy.hs                     |  1 +
 src/Auth/LDAP.hs                      |  3 ++-
 src/Auth/PWHash.hs                    |  1 +
 src/Foundation.hs                     |  2 ++
 src/Utils/Form.hs                     | 11 +++++++----
 templates/widgets/aform/aform.hamlet  |  4 ++++
 8 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss
index 817534357..7bd86c059 100644
--- a/frontend/src/utils/inputs/inputs.scss
+++ b/frontend/src/utils/inputs/inputs.scss
@@ -36,11 +36,9 @@
   font-size: 0.9rem;
 }
 
-.form-group--required {
-  .form-group-label__caption::after {
-    content: ' *';
-    color: var(--color-error);
-  }
+.form-group--required .form-group-label__caption::after, .form-group__required-marker::before {
+  content: ' *';
+  color: var(--color-error);
 }
 
 .form-group--optional {
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 3e89d21a4..e6081f4d2 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -523,6 +523,7 @@ NotificationSettings: Erwünschte Benachrichtigungen
 FormNotifications: Benachrichtigungen
 FormBehaviour: Verhalten
 FormCosmetics: Oberfläche
+FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen
 
 ActiveAuthTags: Aktivierte Authorisierungsprädikate
 
diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs
index 5987caa4f..9f6ad4964 100644
--- a/src/Auth/Dummy.hs
+++ b/src/Auth/Dummy.hs
@@ -32,6 +32,7 @@ dummyLogin :: ( YesodAuth site
               , YesodPersist site
               , SqlBackendCanRead (YesodPersistBackend site)
               , RenderMessage site FormMessage
+              , RenderMessage site AFormMessage
               , RenderMessage site DummyMessage
               , Button site ButtonSubmit
               ) => AuthPlugin site
diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs
index 9ea9d02e5..4f003471a 100644
--- a/src/Auth/LDAP.hs
+++ b/src/Auth/LDAP.hs
@@ -73,6 +73,7 @@ campusLogin :: forall site.
                ( YesodAuth site
                , RenderMessage site FormMessage
                , RenderMessage site CampusMessage
+               , RenderMessage site AFormMessage
                , Button site ButtonSubmit
                ) => LdapConf -> LdapPool -> AuthPlugin site
 campusLogin conf@LdapConf{..} pool = AuthPlugin{..}
@@ -91,7 +92,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..}
             Ldap.bind ldap ldapDn ldapPassword
             searchResults <- findUser conf ldap campusIdent [userPrincipalName]
             case searchResults of
-              [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs] 
+              [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs]
                 | Just [principalName] <- lookup userPrincipalName userAttrs
                 , Right credsIdent <- Text.decodeUtf8' principalName
                 -> Right (userDN, credsIdent) <$ Ldap.bind ldap (Ldap.Dn credsIdent) (Ldap.Password $ Text.encodeUtf8 campusPassword)
diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs
index a4eb42057..d6f5bf4e8 100644
--- a/src/Auth/PWHash.hs
+++ b/src/Auth/PWHash.hs
@@ -40,6 +40,7 @@ hashLogin :: ( YesodAuth site
              , SqlBackendCanRead (YesodPersistBackend site)
              , RenderMessage site FormMessage
              , RenderMessage site PWHashMessage
+             , RenderMessage site AFormMessage
              , Button site ButtonSubmit
              ) => PWHashAlgorithm -> AuthPlugin site
 hashLogin pwHashAlgo = AuthPlugin{..}
diff --git a/src/Foundation.hs b/src/Foundation.hs
index af6f3421d..8103ebfda 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -294,6 +294,8 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr
      in verbMap . splitCamel
 embedRenderMessage ''UniWorX ''UploadModeDescr id
 embedRenderMessage ''UniWorX ''SecretJSONFieldException id
+embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
+
 
 newtype SheetTypeHeader = SheetTypeHeader SheetType
 embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ae9cb5325..ecbf65f1a 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -602,7 +602,7 @@ fileFieldMultiple = Field
       [whamlet|
         $newline never
         <input type="file" uw-file-input id=#{id'} name=#{name} *{attrs} multiple :isReq:required="required">
-      |]                                  
+      |]
   , fieldEnctype = Multipart
   }
 
@@ -652,13 +652,16 @@ wrapForm' btn formWidget FormSettings{..} = do
 -- | Use this type to pass information to the form template
 data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize | FormDBTableCsvImport
 
-renderAForm :: Monad m => FormLayout -> FormRender m a
+data AFormMessage = MsgAFormFieldRequiredTip
+
+renderAForm :: (RenderMessage (HandlerSite m) AFormMessage, Monad m) => FormLayout -> FormRender m a
 renderAForm formLayout aform fragment = do
   (res, ($ []) -> fieldViews) <- aFormToForm aform
-  let widget = $(widgetFile "widgets/aform/aform")
+  let formHasRequiredFields = any fvRequired fieldViews
+      widget = $(widgetFile "widgets/aform/aform")
   return (res, widget)
 
-renderWForm :: MonadHandler m => FormLayout -> WForm m (FormResult a) -> -- Form a   -- (Synonym unavailable here)
+renderWForm :: (RenderMessage (HandlerSite m) AFormMessage, MonadHandler m) => FormLayout -> WForm m (FormResult a) -> -- Form a   -- (Synonym unavailable here)
   (Markup -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
 renderWForm formLayout = renderAForm formLayout . wFormToAForm
 
diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet
index 460ca1ba7..b51adbf2c 100644
--- a/templates/widgets/aform/aform.hamlet
+++ b/templates/widgets/aform/aform.hamlet
@@ -22,3 +22,7 @@ $case formLayout
             ^{fvInput view}
             $maybe err <- fvErrors view
               <div .form-error>#{err}
+    $if formHasRequiredFields
+      <div .form-section-title>
+        <span .form-group__required-marker>
+        _{MsgAFormFieldRequiredTip}

From 5f4925a4ccf9b6d19eb81a0c416bfeca2f1c3ac6 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 17 Jul 2019 15:24:25 +0200
Subject: [PATCH 20/36] refactor(exam registration): visually distinct
 de-/registration

users only see a green box but dont read it hence a different alert class is used now
---
 src/Handler/Exam.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 73c323d4d..5b0e634c5 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -699,7 +699,7 @@ getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEShowR tid ssh csh examn = do
   cTime <- liftIO getCurrentTime
   mUid <- maybeAuthId
-  
+
   (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
     exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
 
@@ -865,10 +865,10 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , ('csvEUserDegree           , MsgCsvColumnExamUserDegree            )
     , ('csvEUserSemester         , MsgCsvColumnExamUserSemester          )
     , ('csvEUserOccurrence       , MsgCsvColumnExamUserOccurrence        )
-    , ('csvEUserExercisePoints   , MsgCsvColumnExamUserExercisePoints    ) 
-    , ('csvEUserExercisePasses   , MsgCsvColumnExamUserExercisePasses    ) 
-    , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax ) 
-    , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) 
+    , ('csvEUserExercisePoints   , MsgCsvColumnExamUserExercisePoints    )
+    , ('csvEUserExercisePasses   , MsgCsvColumnExamUserExercisePasses    )
+    , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax )
+    , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax )
     ]
 
 data ExamUserAction = ExamUserDeregister
@@ -923,7 +923,7 @@ postEUsersR tid ssh csh examn = do
                 SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus
                 SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus
                 return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints)
-            ] 
+            ]
           dbtSorting = Map.fromList
             [ sortUserNameLink     queryUser
             , sortUserSurname      queryUser
@@ -1032,7 +1032,7 @@ postERegisterR tid ssh csh examn = do
       runDB $ do
         deleteBy $ UniqueExamRegistration eId uid
         audit' $ TransactionExamDeregister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
-      addMessageI Success $ MsgExamDeregisteredSuccess examn
+      addMessageI Info $ MsgExamDeregisteredSuccess examn -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! Maybe make it even a warning?!
       redirect $ CExamR tid ssh csh examn EShowR
 
   invalidArgs ["Register/Deregister button required"]

From 4f1162c363d15d9577302d064e4dd352111fd628 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 17:35:12 +0200
Subject: [PATCH 21/36] fix(submissions): only notify submittors if rating
 changes doneness

---
 src/Handler/Utils/Submission.hs | 39 +++++++++++++++++----------------
 1 file changed, 20 insertions(+), 19 deletions(-)

diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 6d6879648..345f8a4b1 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -491,17 +491,20 @@ sinkSubmission userId mExists isUpdate = do
         alreadySeen <- gets $ is (_Wrapped . _Just) . sinkSeenRating
         when alreadySeen $ throwM DuplicateRating
 
-        Submission{..} <- lift $ getJust submissionId
+        submission <- lift $ getJust submissionId
 
         now <- liftIO getCurrentTime
         let
-          rated = submissionRatingBy == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files
-          r' = let Rating'{..} = r
-                in Rating'
-                   { ratingTime = now <$ guard rated
-                   , ..
-                   }
-        let Rating'{..} = r'
+          rated = submissionRatingBy submission == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files
+          r'@Rating'{..} = r
+            { ratingTime = now <$ guard rated -- Ignore `ratingTime` from result @r@ of `parseRating` to ensure plausible timestamps (`parseRating` returns file modification time for consistency with `ratingFile`)
+            }
+          submission' = submission
+            { submissionRatingPoints  = ratingPoints
+            , submissionRatingComment = ratingComment
+            , submissionRatingTime    = ratingTime
+            , submissionRatingBy      = userId <$ guard rated -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
+            }
         tellSt $ mempty{ sinkSeenRating = Last $ Just r' }
 
         unless isUpdate $ throwM RatingWithoutUpdate
@@ -510,25 +513,23 @@ sinkSubmission userId mExists isUpdate = do
         --
         -- 'fileModified' is simply stored and never inspected while
         -- 'submissionChanged' is always set to @now@.
-        let anyChanges = or $
-              [ submissionRatingPoints /= ratingPoints
-              , submissionRatingComment /= ratingComment
+        let anyChanges = any (\f -> f submission submission') $
+              [ (/=) `on` submissionRatingPoints
+              , (/=) `on` submissionRatingComment
+              , (/=) `on` submissionRatingDone
+              , (/=) `on` submissionRatingBy
               ]
 
         when anyChanges $ do
           touchSubmission
 
-          Sheet{..} <- lift $ getJust submissionSheet
+          Sheet{..} <- lift . getJust $ submissionSheet submission'
   
           mapM_ throwM $ validateRating sheetType r'
 
-          when (submissionRatingDone r') $ tellSt mempty { sinkSubmissionNotifyRating = Any True }
-          lift $ update submissionId
-            [ SubmissionRatingPoints  =. ratingPoints
-            , SubmissionRatingComment =. ratingComment
-            , SubmissionRatingTime    =. ratingTime
-            , SubmissionRatingBy      =. (userId <$ guard rated) -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
-            ]
+          when (submissionRatingDone submission' && not (submissionRatingDone submission)) $
+            tellSt mempty { sinkSubmissionNotifyRating = Any True }
+          lift $ replace submissionId submission'
       where
         a /~ b = not $ a ~~ b
 

From 5ecaaeefe29a4539e5a39ec9b86c732ca8a8d5cf Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 17:37:12 +0200
Subject: [PATCH 22/36] chore(release): automatically push new releases

---
 package.json | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/package.json b/package.json
index 38f1bce87..fde501c72 100644
--- a/package.json
+++ b/package.json
@@ -21,7 +21,8 @@
     "frontend:build": "webpack",
     "frontend:build:watch": "webpack --watch",
     "prerelease": "npm run test",
-    "release": "standard-version -a"
+    "release": "standard-version -a",
+    "postrelease": "git push --follow-tags origin master"
   },
   "husky": {
     "hooks": {

From c19ced53024f5c90b94a6fea03c552d8459eab48 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 17:42:56 +0200
Subject: [PATCH 23/36] chore(release): 4.1.1

---
 CHANGELOG.md      | 12 ++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ecdf9d07e..defc88681 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,18 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+### [4.1.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.1.0...v4.1.1) (2019-07-17)
+
+
+### Bug Fixes
+
+* **aform:** show info about required fields in all aforms ([63f6d01](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/63f6d01)), closes [#418](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/418)
+* **submissions:** only notify submittors if rating changes doneness ([4f1162c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/4f1162c))
+* **submissions:** only notify submittors if rating is done ([8e0c379](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/8e0c379))
+* **submissions:** submitting produces an success alert now ([bf20d6f](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/bf20d6f)), closes [#286](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/286)
+
+
+
 ## [4.1.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.0.1...v4.1.0) (2019-07-17)
 
 
diff --git a/package-lock.json b/package-lock.json
index c68e097cf..990afd127 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.0",
+  "version": "4.1.1",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index fde501c72..0cdc485e2 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.0",
+  "version": "4.1.1",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index 126894c4f..4d0829239 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 4.1.0
+version: 4.1.1
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From 93855957e62b7764f001a83a77419fdeb465326b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 18:06:21 +0200
Subject: [PATCH 24/36] fix(corrections): properly link corrector emails

---
 .../Handler/SendNotification/SubmissionRated.hs    | 14 +++++++++++---
 templates/correction-user.hamlet                   |  4 ++--
 templates/mail/submissionRated.hamlet              |  4 ++--
 3 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
index 75314e786..ff9a45f5a 100644
--- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs
+++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
@@ -7,8 +7,7 @@ module Jobs.Handler.SendNotification.SubmissionRated
 import Import
 
 import Utils.Lens
-import Handler.Utils.DateTime
-import Handler.Utils.Mail
+import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 
 import Text.Hamlet
@@ -23,6 +22,9 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
     course <- belongsToJust sheetCourse sheet
     corrector <- traverse getJust submissionRatingBy
     return (course, sheet, submission, corrector)
+
+  whenIsJust corrector $ \corrector' -> 
+    addMailHeader "Reply-To" . renderAddress $ userAddress corrector'
   replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
   setSubjectI $ MsgMailSubjectSubmissionRated courseShorthand
 
@@ -45,7 +47,13 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
       , "submission-rating-points" Aeson..= (guard (sheetType /= NotGraded) *> submissionRatingPoints)
       , "submission-rating-comment" Aeson..= submissionRatingComment
       , "submission-rating-time" Aeson..= submissionRatingTime
-      , "submission-rating-by" Aeson..= (userDisplayName <$> corrector)
+      , (Aeson..=) "submission-rating-by" $ do
+          corrector' <- corrector
+          return $ Aeson.object
+            [ "display-name" Aeson..= userDisplayName corrector'
+            , "surname" Aeson..= userSurname corrector'
+            , "email" Aeson..= userEmail corrector'
+            ]
       , "submission-rating-passed" Aeson..= join (gradingPassed <$> sheetType ^? _grading <*> submissionRatingPoints)      
       , "sheet-name" Aeson..= sheetName
       , "sheet-type" Aeson..= sheetType
diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet
index 78a4533b2..252b9d046 100644
--- a/templates/correction-user.hamlet
+++ b/templates/correction-user.hamlet
@@ -3,10 +3,10 @@
     <tr .table__row>
       <th .table__th>_{MsgSubmission}
       <td .table__td>#{cid}
-    $maybe Entity _ User{userDisplayName} <- corrector
+    $maybe Entity _ User{userDisplayName, userSurname, userEmail} <- corrector
       <tr .table__row>
         <th .table__th>_{MsgRatingBy}
-        <td .table__td>#{userDisplayName}
+        <td .table__td>^{nameEmailWidget userEmail userDisplayName userSurname}
     $maybe time <- submissionRatingTime
       <tr .table__row>
         <th .table__th>_{MsgRatingTime}
diff --git a/templates/mail/submissionRated.hamlet b/templates/mail/submissionRated.hamlet
index 51f675e70..e21c3f5b1 100644
--- a/templates/mail/submissionRated.hamlet
+++ b/templates/mail/submissionRated.hamlet
@@ -23,11 +23,11 @@ $newline never
       <dd>
         <a href=@{CSubmissionR tid ssh csh shn csid SubShowR}>
           #{csid}
-      $maybe User{userDisplayName} <- corrector
+      $maybe User{userDisplayName, userSurname, userEmail} <- corrector
         <dt>
           _{MsgRatingBy}
         <dd>
-          #{userDisplayName}
+          #{nameEmailHtml userEmail userDisplayName userSurname}
       $maybe time <- submissionRatingTime'
         <dt>
           _{MsgRatingTime}

From 4dfe72c46bc271db0eb73ebd6e271c54acc9e07a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 17 Jul 2019 18:26:50 +0200
Subject: [PATCH 25/36] chore(release): 4.1.2

---
 CHANGELOG.md      | 9 +++++++++
 package-lock.json | 2 +-
 package.json      | 2 +-
 package.yaml      | 2 +-
 4 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index defc88681..112f864e7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,15 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+### [4.1.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.1.1...v4.1.2) (2019-07-17)
+
+
+### Bug Fixes
+
+* **corrections:** properly link corrector emails ([9385595](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/9385595))
+
+
+
 ### [4.1.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.1.0...v4.1.1) (2019-07-17)
 
 
diff --git a/package-lock.json b/package-lock.json
index 990afd127..babb18337 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.1",
+  "version": "4.1.2",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 0cdc485e2..6d55ced32 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.1",
+  "version": "4.1.2",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index 4d0829239..82f577bbc 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 4.1.1
+version: 4.1.2
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

From ce615287180976d24f24abd16ec8bac79a4a881d Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Thu, 18 Jul 2019 09:02:19 +0200
Subject: [PATCH 26/36] fix(exam registration): icons added to exam register
 message

---
 messages/uniworx/de.msg | 20 ++++++++++----------
 src/Handler/Exam.hs     | 12 ++++++++++--
 src/Utils.hs            |  2 +-
 3 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index e6081f4d2..e8b34b43a 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -7,8 +7,8 @@ BtnRegister: Anmelden
 BtnDeregister: Abmelden
 BtnCourseRegister: Zum Kurs anmelden
 BtnCourseDeregister: Vom Kurs abmelden
-BtnExamRegister: Klausuranmeldung
-BtnExamDeregister: Abmeldung von der Klausur
+BtnExamRegister: Anmelden zur Klausur
+BtnExamDeregister: Von der Klausur abmelden
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
 PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert.
@@ -665,7 +665,7 @@ MailSubjectCorrectorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand shn@S
 
 MailSubjectTutorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand tutn@TutorialName: [#{tid}-#{ssh}-#{csh}] Einladung zum Tutor für #{tutn}
 
-MailSubjectExamCorrectorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: [#{tid}-#{ssh}-#{csh}] Einladung zum Korrektor für Klausur #{examn}
+MailSubjectExamCorrectorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: [#{tid}-#{ssh}-#{csh}] Einladung zum Korrektor für #{examn}
 
 MailSubjectSubmissionUserInvitation tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: [#{tid}-#{ssh}-#{csh}] Einladung zu einer Abgabe für #{shn}
 
@@ -966,9 +966,9 @@ TutorInvitationDeclined tutn@TutorialName: Sie haben die Einladung, Tutor für #
 TutorInviteHeading tutn@TutorialName: Einladung zum Tutor für #{tutn}
 TutorInviteExplanation: Sie wurden eingeladen, Tutor zu sein.
 
-ExamCorrectorInvitationAccepted examn@ExamName: Sie wurden als Korrektor für Klausur #{examn} eingetragen
-ExamCorrectorInvitationDeclined examn@ExamName: Sie haben die Einladung, Korrektor für Klausur #{examn} zu werden, abgelehnt
-ExamCorrectorInviteHeading examn@ExamName: Einladung zum Korrektor für Klausur #{examn}
+ExamCorrectorInvitationAccepted examn@ExamName: Sie wurden als Korrektor für #{examn} eingetragen
+ExamCorrectorInvitationDeclined examn@ExamName: Sie haben die Einladung, Korrektor für  #{examn} zu werden, abgelehnt
+ExamCorrectorInviteHeading examn@ExamName: Einladung zum Korrektor für #{examn}
 ExamCorrectorInviteExplanation: Sie wurden eingeladen, Klausur-Korrektor zu sein.
 
 SubmissionUserInvitationAccepted shn@SheetName: Sie wurden als Mitabgebende(r) für eine Abgabe zu #{shn} eingetragen
@@ -1150,8 +1150,8 @@ ExamPartWeight: Gewichtung
 ExamPartResultPoints: Erreichte Punkte
 
 ExamNameTaken exam@ExamName: Es existiert bereits eine Klausur mit Namen #{exam}
-ExamCreated exam@ExamName: Klausur #{exam} erfolgreich angelegt
-ExamEdited exam@ExamName: Klausur #{exam} erfolgreich bearbeitet
+ExamCreated exam@ExamName: #{exam} erfolgreich angelegt
+ExamEdited exam@ExamName: #{exam} erfolgreich bearbeitet
 
 ExamNoShow: Nicht erschienen
 ExamVoided: Entwertet
@@ -1163,8 +1163,8 @@ ExamPassed: Bestanden
 ExamNotPassed: Nicht bestanden
 ExamResult: Klausurergebnis
 
-ExamRegisteredSuccess exam@ExamName: Erfolgreich zur Klausur #{exam} angemeldet
-ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der Klausur #{exam} abgemeldet
+ExamRegisteredSuccess exam@ExamName: Erfolgreich zur #{exam} angemeldet
+ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der #{exam} abgemeldet
 ExamRegistered: Angemeldet
 ExamNotRegistered: Nicht angemeldet
 ExamRegistration: Anmeldung
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 5b0e634c5..835da05c2 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -1026,13 +1026,21 @@ postERegisterR tid ssh csh examn = do
         now <- liftIO getCurrentTime
         insert_ $ ExamRegistration eId uid Nothing now
         audit' $ TransactionExamRegister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
-      addMessageI Success $ MsgExamRegisteredSuccess examn
+      addMessageWidget Success [whamlet|
+          <div>#{iconExamRegister True}
+          <div>&nbsp;
+          <div>_{MsgExamRegisteredSuccess   examn}
+          |]
       redirect $ CExamR tid ssh csh examn EShowR
     BtnExamDeregister -> do
       runDB $ do
         deleteBy $ UniqueExamRegistration eId uid
         audit' $ TransactionExamDeregister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
-      addMessageI Info $ MsgExamDeregisteredSuccess examn -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! Maybe make it even a warning?!
+      addMessageWidget Info [whamlet|
+        <div>#{iconExamRegister False}
+        <div>&nbsp;
+        <div>_{MsgExamDeregisteredSuccess examn}
+        |] -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! See discussion on commit 5f4925a4
       redirect $ CExamR tid ssh csh examn EShowR
 
   invalidArgs ["Register/Deregister button required"]
diff --git a/src/Utils.hs b/src/Utils.hs
index 8dc77580c..7fbe88857 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -278,7 +278,7 @@ rationalToFixed = MkFixed . round . (* (fromIntegral $ resolution (Proxy :: HasR
 
 rationalToFixed3 :: Rational -> Fixed E3
 rationalToFixed3 = rationalToFixed
-  
+
 rationalToFixed2 :: Rational -> Fixed E2
 rationalToFixed2 = rationalToFixed
 

From e1996ac2e51d74db09c833b6c57a80fcdcb9f6bf Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 18 Jul 2019 09:35:42 +0200
Subject: [PATCH 27/36] feat(exams): allow assigning exam participants to
 occurrences

---
 messages/uniworx/de.msg   |  6 +++++-
 src/Handler/Exam.hs       | 34 ++++++++++++++++++++++++++++------
 src/Handler/Utils/Form.hs | 10 ++++++++++
 3 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index e6081f4d2..5aeb92255 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1190,7 +1190,9 @@ KnownBugs: Bekannte Bugs
 
 ExamUsersHeading: Klausurteilnehmer
 ExamUserDeregister: Teilnehmer von Klausur abmelden
+ExamUserAssignOccurrence: Termin/Raum zuweisen
 ExamUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
+ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
 
 CsvFile: CSV-Datei
 CsvModifyExisting: Existierende Einträge angleichen
@@ -1213,4 +1215,6 @@ CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angeme
 CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat
 CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Klausurtermin erreichen hätte können
 CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
-CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
\ No newline at end of file
+CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
+
+Action: Aktion
\ No newline at end of file
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 5b0e634c5..5116add70 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -36,7 +36,7 @@ import qualified Data.Conduit.List as C
 
 import Numeric.Lens (integral)
 
-import Database.Persist.Sql (deleteWhereCount)
+import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
 
 
 
@@ -872,6 +872,7 @@ instance CsvColumnsExplained ExamUserTableCsv where
     ]
 
 data ExamUserAction = ExamUserDeregister
+                    | ExamUserAssignOccurrence
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe ExamUserAction
@@ -879,6 +880,9 @@ instance Finite ExamUserAction
 nullaryPathPiece ''ExamUserAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''ExamUserAction id
 
+data ExamUserActionData = ExamUserDeregisterData
+                        | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -957,9 +961,19 @@ postEUsersR tid ssh csh examn = do
             , dbParamsFormAttrs  = []
             , dbParamsFormSubmit = FormSubmit
             , dbParamsFormAdditional = \csrf -> do
-                (res, vw) <- mreq (selectField optionsFinite) "" Nothing
-                let formWgt = toWidget csrf <> fvInput vw
-                    formRes = (, mempty) . First . Just <$> res
+                let
+                  actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData)
+                  actionMap = Map.fromList
+                    [ ( ExamUserDeregister
+                      , pure ExamUserDeregisterData
+                      )
+                    , ( ExamUserAssignOccurrence
+                      , ExamUserAssignOccurrenceData
+                        <$> aopt (examOccurrenceField eid) (fslI MsgExamOccurrence) (Just Nothing)
+                      )
+                    ]
+                (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
+                let formRes = (, mempty) . First . Just <$> res
                 return (formRes, formWgt)
             , dbParamsFormEvaluate = liftHandlerT . runFormPost
             , dbParamsFormResult   = id
@@ -984,7 +998,7 @@ postEUsersR tid ssh csh examn = do
 
       examUsersDBTableValidator = def
 
-      postprocess :: FormResult (First ExamUserAction, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserAction, Set ExamRegistrationId)
+      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserActionData, Set ExamRegistrationId)
       postprocess inp = do
         (First (Just act), regMap) <- inp
         let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
@@ -992,12 +1006,20 @@ postEUsersR tid ssh csh examn = do
     over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
 
   formResult registrationResult $ \case
-    (ExamUserDeregister, selectedRegistrations) -> do
+    (ExamUserDeregisterData, selectedRegistrations) -> do
       nrDel <- runDB $ deleteWhereCount
         [ ExamRegistrationId <-. Set.toList selectedRegistrations
         ]
       addMessageI Success $ MsgExamUsersDeregistered nrDel
       redirect $ CExamR tid ssh csh examn EUsersR
+    (ExamUserAssignOccurrenceData occId, selectedRegistrations) -> do
+      nrUpdated <- runDB $ updateWhereCount
+        [ ExamRegistrationId <-. Set.toList selectedRegistrations
+        ]
+        [ ExamRegistrationOccurrence =. occId
+        ]
+      addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated
+      redirect $ CExamR tid ssh csh examn EUsersR
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 4243a318c..b7548543c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -913,6 +913,16 @@ optionsPersistCryptoId filts ords toDisplay = fmap mkOptionList $ do
                  , optionExternalValue = toPathPiece (cId :: CryptoID UUID (Key a))
                  }) cPairs
 
+examOccurrenceField :: ( MonadHandler m
+                       , HandlerSite m ~ UniWorX
+                       )
+                    => ExamId
+                    -> Field m ExamOccurrenceId
+examOccurrenceField eid
+  = hoistField liftHandlerT . selectField . (fmap $ fmap entityKey)
+    $ optionsPersistCryptoId [ ExamOccurrenceExam ==. eid ] [ Asc ExamOccurrenceName ] examOccurrenceName
+
+
 formResultModal :: (MonadHandler m, RedirectUrl (HandlerSite m) route) => FormResult a -> route -> (a -> WriterT [Message] m ()) -> m ()
 formResultModal res finalDest handler = maybeT_ $ do
   messages <- case res of

From 996bc2ac27bf8fccadcd5d30876dbd3263963cc1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Fri, 19 Jul 2019 14:45:44 +0200
Subject: [PATCH 28/36] feat(csv): implement csv import

---
 frontend/src/utils/inputs/file-input.js       |   1 +
 frontend/src/utils/inputs/file-input.scss     |   3 +
 frontend/src/utils/inputs/inputs.scss         |   5 +
 messages/uniworx/de.msg                       |  23 +-
 src/Handler/Exam.hs                           |  54 ++++-
 src/Handler/Utils/Table/Pagination.hs         | 222 +++++++++++++++---
 src/Utils/Form.hs                             |  34 ++-
 src/Utils/Parameters.hs                       |   9 +-
 .../csv-import-confirmation-wrapper.hamlet    |   4 +
 templates/csv-import-confirmation.hamlet      |  21 ++
 templates/csv-import-confirmation.julius      |  81 +++++++
 templates/csv-import-confirmation.lucius      |  52 ++++
 templates/default-layout.lucius               |  16 --
 templates/table/csv-transcode.hamlet          |  12 +-
 templates/table/csv-transcode.lucius          |  21 ++
 templates/table/layout-filter-default.hamlet  |   3 +-
 templates/table/layout.hamlet                 |   1 -
 templates/widgets/aform/aform.hamlet          |   7 +-
 18 files changed, 497 insertions(+), 72 deletions(-)
 create mode 100644 frontend/src/utils/inputs/file-input.scss
 create mode 100644 templates/csv-import-confirmation-wrapper.hamlet
 create mode 100644 templates/csv-import-confirmation.hamlet
 create mode 100644 templates/csv-import-confirmation.julius
 create mode 100644 templates/csv-import-confirmation.lucius
 create mode 100644 templates/table/csv-transcode.lucius

diff --git a/frontend/src/utils/inputs/file-input.js b/frontend/src/utils/inputs/file-input.js
index 676d6ff2c..568e1baf4 100644
--- a/frontend/src/utils/inputs/file-input.js
+++ b/frontend/src/utils/inputs/file-input.js
@@ -1,4 +1,5 @@
 import { Utility } from '../../core/utility';
+import './file-input.scss';
 
 const FILE_INPUT_CLASS = 'file-input';
 const FILE_INPUT_INITIALIZED_CLASS = 'file-input--initialized';
diff --git a/frontend/src/utils/inputs/file-input.scss b/frontend/src/utils/inputs/file-input.scss
new file mode 100644
index 000000000..7bf23248d
--- /dev/null
+++ b/frontend/src/utils/inputs/file-input.scss
@@ -0,0 +1,3 @@
+.file-input__list:empty {
+  display: none;
+}
diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss
index 7bd86c059..643902d08 100644
--- a/frontend/src/utils/inputs/inputs.scss
+++ b/frontend/src/utils/inputs/inputs.scss
@@ -25,6 +25,11 @@
   color: var(--color-fontsec);
 }
 
+.form-section-legend {
+  color: var(--color-fontsec);
+  margin: 7px 0;
+}
+
 .form-group-label {
   font-weight: 600;
   padding-top: 6px;
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 92bcd7821..5fef09aba 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -933,6 +933,8 @@ CommTutorialHeading: Tutorium-Mitteilung
 RecipientCustom: Weitere Empfänger
 RecipientToggleAll: Alle/Keine
 
+DBCsvImportActionToggleAll: Alle/Keine
+
 RGCourseParticipants: Kursteilnehmer
 RGCourseLecturers: Kursverwalter
 RGCourseCorrectors: Korrektoren
@@ -1200,6 +1202,14 @@ CsvAddNew: Neue Einträge einfügen
 CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
+BtnCsvImportConfirm: CSV-Import abschließen
+
+CsvImportNotConfigured: CSV-Import nicht vorgesehen
+CsvImportConfirmationHeading: CSV-Import abschließen
+CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten Änderungen vorgenommen. Bitte überprüfen Sie diese zunächst sorgfältig.
+CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen werden
+CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt
+CsvImportAborted: CSV-Import abgebrochen
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 
@@ -1217,4 +1227,15 @@ CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilneh
 CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
 CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
 
-Action: Aktion
\ No newline at end of file
+Action: Aktion
+
+DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen Datensatz und können daher nicht verarbeitet werden.
+DBCsvDuplicateKeyTip: Entfernen Sie ein der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
+
+ExamUserCsvRegister: Teilnehmer zur Klausur anmelden
+ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
+ExamUserCsvDeregister: Teilnehmer von der Klausur abmelden
+
+TableHeadingFilter: Filter
+TableHeadingCsvImport: CSV-Import
+TableHeadingCsvExport: CSV-Export
\ No newline at end of file
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index f649c0e75..574f13531 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -22,6 +22,9 @@ import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
+import qualified Data.Text as Text
+import qualified Data.Text.Lens as Text
+
 import Data.Aeson hiding (Result(..))
 import Text.Hamlet (ihamlet)
 import Text.Blaze.Html.Renderer.String (renderHtml)
@@ -883,6 +886,31 @@ embedRenderMessage ''UniWorX ''ExamUserAction id
 data ExamUserActionData = ExamUserDeregisterData
                         | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
 
+data ExamUserCsvActionClass
+  = ExamUserCsvRegister
+  | ExamUserCsvAssignOccurrence
+  | ExamUserCsvDeregister
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
+
+data ExamUserCsvAction
+  = ExamUserCsvRegisterData
+    { examUserCsvUser :: UserId
+    }
+  | ExamUserCsvAssignOccurrenceData
+    { examUserCsvRegistration :: ExamRegistrationId
+    , examUserCsvOccurrence :: ExamOccurrenceId
+    }
+  | ExamUserCsvDeregisterData
+    { examUserCsvRegistration :: ExamRegistrationId
+    }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel
+  , fieldLabelModifier = camelToPathPiece' 3
+  , sumEncoding = TaggedObject "action" "data"
+  } ''ExamUserCsvAction
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -994,7 +1022,31 @@ postEUsersR tid ssh csh examn = do
             <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
-          dbtCsvDecode = Nothing
+          dbtCsvDecode = Just DBTCsvDecode
+            { dbtCsvRowKey = \ExamUserTableCsv{} -> mzero -- FIXME: guess user from csv row and do lookup via UniqueExamRegistration
+            , dbtCsvComputeActions = awaitForever $ \case
+                DBCsvDiffMissing{dbCsvOldKey} -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
+                _other -> return () -- FIXME: compute edit on existing rows & add rows
+            , dbtCsvClassifyAction = \case
+                ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
+                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
+                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
+            , dbtCsvCoarsenActionClass = \case
+                ExamUserCsvRegister   -> DBCsvActionNew
+                ExamUserCsvDeregister -> DBCsvActionMissing
+                _other                -> DBCsvActionExisting 
+            , dbtCsvExecuteActions = do
+                C.mapM_ $ \case
+                  ExamUserCsvDeregisterData{..} -> delete examUserCsvRegistration
+                  _other -> return () -- FIXME
+                return $ CExamR tid ssh csh examn EUsersR
+            , dbtCsvRenderKey = \existing -> \case
+                ExamUserCsvDeregisterData{..}
+                  -> let Entity _ User{..} = view resultUser $ existing ! E.Value examUserCsvRegistration
+                      in nameWidget userDisplayName userSurname
+                _other -> mempty -- FIXME
+            , dbtCsvRenderActionClass = \c -> [whamlet|_{c}|]
+            }
 
       examUsersDBTableValidator = def
 
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 4f6676899..7997741b1 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -7,7 +7,9 @@ module Handler.Utils.Table.Pagination
   , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
   , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
   , module Handler.Utils.Table.Pagination.CsvColumnExplanations
-  , DBTCsvEncode, DBTCsvDecode
+  , DBCsvActionMode(..)
+  , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
+  , DBTCsvEncode, DBTCsvDecode(..)
   , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
   , DBParams(..)
@@ -50,23 +52,29 @@ import qualified Database.Esqueleto.Internal.Language as E (From)
 
 import qualified Network.Wai as Wai
 
-import Control.Monad.RWS hiding ((<>), mapM_)
-import Control.Monad.Writer hiding ((<>), mapM_)
+import Control.Monad.RWS (RWST(..), execRWS)
+import Control.Monad.Writer (WriterT(..))
 import Control.Monad.Reader (ReaderT(..), mapReaderT)
+import Control.Monad.State (StateT(..), evalStateT)
 import Control.Monad.Trans.Maybe
+import Control.Monad.State.Class (modify)
+import qualified Control.Monad.State.Class as State
 
 import Data.Foldable (Foldable(foldMap))
 
-import Data.Map (Map)
+import Data.Map (Map, (!))
 import qualified Data.Map as Map
 
 import qualified Data.Set as Set
 
 import qualified Data.CaseInsensitive as CI
 
+import Data.Csv (NamedRecord)
+import qualified Data.Csv as Csv (encodeByName)
+
 import Colonnade hiding (bool, fromMaybe, singleton)
 import qualified Colonnade (singleton)
-import Colonnade.Encode
+import Colonnade.Encode hiding (row)
 
 import Text.Hamlet (hamletFile)
 
@@ -97,6 +105,8 @@ import Data.Semigroup as Sem (Semigroup(..))
 
 import qualified Data.Conduit.List as C
 
+import qualified Control.Monad.Catch as Catch
+
 
 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@@ -271,8 +281,19 @@ piIsUnset PaginationInput{..} = and
   , isNothing piPage
   ]
 
+  
+data DBCsvActionMode = DBCsvActionNew | DBCsvActionExisting | DBCsvActionMissing
+  deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, Typeable)
+instance Universe DBCsvActionMode
+instance Finite DBCsvActionMode
 
-data ButtonCsvMode = BtnCsvExport | BtnCsvImport
+nullaryPathPiece ''DBCsvActionMode $ camelToPathPiece' 3
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 3
+  } ''DBCsvActionMode
+
+
+data ButtonCsvMode = BtnCsvExport | BtnCsvImport | BtnCsvImportConfirm
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonCsvMode
 instance Finite ButtonCsvMode
@@ -288,21 +309,45 @@ instance Button UniWorX ButtonCsvMode where
         #{iconCSV}
         \ _{BtnCsvExport}
       |]
-  btnLabel BtnCsvImport
-    = [whamlet|
-        $newline never
-        _{BtnCsvImport}
-      |]
-
-data DBCsvMode = DBCsvNormal
-               | DBCsvExport
-               | DBCsvImport
-                 { _dbCsvFiles :: [FileInfo]
-                 , _dbCsvModifyExisting, _dbCsvAddNew, _dbCsvDeleteMissing :: Bool
-                 }
+  btnLabel x = [whamlet|_{x}|]
 
 
-type DBTableKey k' = (ToJSON k', FromJSON k', Ord k', Binary k')
+data DBCsvMode
+  = DBCsvNormal
+  | DBCsvExport
+  | DBCsvImport
+    { dbCsvFiles :: [FileInfo]
+    }
+
+data DBCsvDiff r' csv k'
+  = DBCsvDiffNew
+    { dbCsvNewKey :: Maybe k'
+    , dbCsvNew :: csv
+    }
+  | DBCsvDiffExisting
+    { dbCsvOldKey :: k'
+    , dbCsvOld :: r'
+    , dbCsvNew :: csv
+    }
+  | DBCsvDiffMissing
+    { dbCsvOldKey :: k'
+    , dbCsvOld :: r'
+    }
+
+makeLenses_ ''DBCsvDiff
+makePrisms ''DBCsvDiff
+
+data DBCsvException k'
+  = DBCsvDuplicateKey
+    { dbCsvDuplicateKey :: k'
+    , dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB :: NamedRecord
+    }
+  deriving (Show, Typeable)
+
+instance (Typeable k', Show k') => Exception (DBCsvException k')
+
+
+type DBTableKey k' = (Show k', ToJSON k', FromJSON k', Ord k', Binary k', Typeable k')
 data DBRow r = forall k'. DBTableKey k' => DBRow
   { dbrKey :: k'
   , dbrOutput :: r
@@ -440,9 +485,23 @@ instance PathPiece x => PathPiece (WithIdent x) where
     (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
     WithIdent <$> pure ident <*> fromPathPiece rest
 
-
 type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
-type DBTCsvDecode csv = DictMaybe (FromNamedRecord csv) (Sink csv (YesodDB UniWorX) ())
+data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass.
+  ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
+  , DBTableKey k'
+  , RedirectUrl UniWorX route
+  , Typeable csv
+  , Ord csvAction, FromJSON csvAction, ToJSON csvAction
+  , Ord csvActionClass
+  ) => DBTCsvDecode
+  { dbtCsvRowKey :: csv -> MaybeT (YesodDB UniWorX) k'
+  , dbtCsvComputeActions :: Conduit (DBCsvDiff r' csv k') (YesodDB UniWorX) csvAction
+  , dbtCsvClassifyAction :: csvAction -> csvActionClass
+  , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode
+  , dbtCsvExecuteActions :: Sink csvAction (YesodDB UniWorX) route
+  , dbtCsvRenderKey :: Map k' r' -> csvAction -> Widget
+  , dbtCsvRenderActionClass :: csvActionClass -> Widget
+  }
 
 data DBTable m x = forall a r r' h i t k k' csv.
   ( ToSortable h, Functor h
@@ -460,7 +519,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtStyle :: DBStyle
   , dbtParams :: DBParams m x
   , dbtCsvEncode :: DBTCsvEncode r' csv
-  , dbtCsvDecode :: DBTCsvDecode csv
+  , dbtCsvDecode :: Maybe (DBTCsvDecode r' k' csv)
   , dbtIdent :: i
   }
 
@@ -756,9 +815,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
   ((csvExportRes, csvExportWdgt), csvExportEnctype) <- lift . runFormGet . identifyForm FIDDBTableCsvExport . set (mapped . mapped . _1 . mapped) DBCsvExport $ buttonForm' [BtnCsvExport]
   ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
     <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing
-    <*> apopt checkBoxField (fslI MsgCsvModifyExisting) (Just True)
-    <*> apopt checkBoxField (fslI MsgCsvAddNew) (Just True)
-    <*> apopt checkBoxField (fslI MsgCsvDeleteMissing) (Just False)
 
   let
     csvMode = asum
@@ -826,13 +882,97 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   formResult csvMode $ \case
     DBCsvExport
-      | Just (Dict, dbtCsvEncode') <- dbtCsvEncode
-        -> do
-          setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv
-          sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode'
-    DBCsvImport{}
-      | Just (Dict, _dbtCsvDecode) <- dbtCsvDecode
-        -> error "dbCsvImport"
+      | Just (Dict, dbtCsvEncode') <- dbtCsvEncode -> do
+        setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv
+        sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode'
+    DBCsvImport{..}
+      | Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass
+                          , ..
+                          } :: DBTCsvDecode r' k' csv) <- dbtCsvDecode -> do
+        let existing = Map.fromList $ zip currentKeys rows
+            sourceDiff :: Source (StateT (Map k' csv) (YesodDB UniWorX)) (DBCsvDiff r' csv k')
+            sourceDiff = do
+              let
+                toDiff :: csv -> StateT (Map k' csv) (YesodDB UniWorX) (DBCsvDiff r' csv k')
+                toDiff row = do
+                  rowKey <- lift . runMaybeT $ dbtCsvRowKey row
+                  seenKeys <- State.get
+                  (<* modify (maybe id (flip Map.insert row) rowKey)) $ if
+                    | Just rowKey' <- rowKey
+                    , Just oldRow <- Map.lookup rowKey' seenKeys
+                      -> throwM $ DBCsvDuplicateKey rowKey' (toNamedRecord oldRow) (toNamedRecord row)
+                    | Just rowKey' <- rowKey
+                    , Just oldRow <- Map.lookup rowKey' existing
+                      -> return $ DBCsvDiffExisting rowKey' oldRow row
+                    | otherwise
+                      -> return $ DBCsvDiffNew rowKey row
+              mapM_ fileSourceCsv dbCsvFiles .| C.mapM toDiff
+              
+              seen <- State.get
+              forM_ (Map.toList existing) $ \(rowKey, oldRow) -> if
+                | Map.member rowKey seen -> return ()
+                | otherwise -> yield $ DBCsvDiffMissing rowKey oldRow
+
+            accActionMap :: Map csvActionClass (Set csvAction) -> csvAction -> Map csvActionClass (Set csvAction)
+            accActionMap acc csvAct = Map.insertWith Set.union (dbtCsvClassifyAction csvAct) (Set.singleton csvAct) acc
+
+            importCsv = do
+              actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions .| C.fold accActionMap Map.empty
+
+              when (Map.null actionMap) $ do
+                addMessageI Info MsgCsvImportUnnecessary
+                redirect $ tblLink id
+
+              liftHandlerT . (>>= sendResponse) $
+                siteLayoutMsg MsgCsvImportConfirmationHeading $ do
+                  setTitleI MsgCsvImportConfirmationHeading
+
+                  let
+                    precomputeIdents :: forall f m'. (Eq (Element f), MonoFoldable f, MonadHandler m') => f -> m' (Element f -> Text)
+                    precomputeIdents = foldM (\f act -> (\id' x -> bool (f x) id' $ act == x) <$> newIdent) (\_ -> error "No id precomputed") 
+                  actionClassIdent <- precomputeIdents $ Map.keys actionMap
+                  actionIdent <- precomputeIdents . Set.unions $ Map.elems actionMap
+
+                  let defaultChecked actClass = case dbtCsvCoarsenActionClass actClass of
+                        DBCsvActionMissing -> False
+                        _other             -> True
+                      csvActionCheckBox :: [(Text, Text)] -> csvAction -> Widget
+                      csvActionCheckBox vAttrs act = do
+                        let
+                          sJsonField :: Field (HandlerT UniWorX IO) csvAction
+                          sJsonField = secretJsonField' $ \theId name attrs val _isReq ->
+                            [whamlet|
+                              $newline never
+                              <input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} :defaultChecked (dbtCsvClassifyAction act):checked>
+                            |]
+                        fieldView sJsonField (actionIdent act) (toPathPiece PostDBCsvImportAction) vAttrs (Right act) False
+                  (csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandlerT . generateFormPost . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
+                  let csvImportConfirmForm = wrapForm' BtnCsvImportConfirm csvImportConfirmForm' FormSettings
+                        { formMethod = POST
+                        , formAction = Just $ tblLink id
+                        , formEncoding = csvImportConfirmEnctype
+                        , formAttrs = []
+                        , formSubmit = FormSubmit
+                        , formAnchor = Nothing :: Maybe Text
+                        }
+                      
+                  $(widgetFile "csv-import-confirmation-wrapper")
+        catches importCsv
+          [ Catch.Handler $ \case
+              (DBCsvDuplicateKey{..} :: DBCsvException k')
+                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
+                     let offendingCsv = decodeUtf8 $ Csv.encodeByName (headerOrder (error "not to be forced" :: csv)) [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
+
+                     mr <- getMessageRender
+
+                     siteLayoutMsg (ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]) $
+                       [whamlet|
+                         <p>_{MsgDBCsvDuplicateKey}
+                         <p>_{MsgDBCsvDuplicateKeyTip}
+                         <pre style="white-space: pre; font-family: monospace">
+                           #{offendingCsv}
+                       |]
+          ]
     _other      -> return ()
 
   let
@@ -889,7 +1029,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
     csvWdgt = $(widgetFile "table/csv-transcode")
 
-    uiLayout table = dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
+    uiLayout table = csvWdgt <> dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
 
     dbInvalidateResult' = foldr (<=<) return . catMaybes $
       [ do
@@ -898,6 +1038,22 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           return . dbInvalidateResult dbtParams . DBTIRowsMissing $ length previousKeys - length currentKeys
       ]
 
+  ((csvImportConfirmRes, ()), _enctype) <- case dbtCsvDecode of
+    Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
+      lift . runFormPost . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
+        acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
+        return . (, ()) $ if
+          | null acts -> FormSuccess $ do
+              addMessageI Info MsgCsvImportAborted
+              redirect $ tblLink id
+          | otherwise -> FormSuccess $ do
+              finalDest <- runConduit $ C.sourceList acts .| dbtCsvExecuteActions
+              addMessageI Success . MsgCsvImportSuccessful $ length acts
+              E.transactionSave
+              redirect finalDest
+    _other -> return ((FormMissing, ()), mempty)
+  formResult csvImportConfirmRes id
+
   dbInvalidateResult' <=< bool (dbHandler (Proxy @m) (Proxy @x) $ (\table -> $(widgetFile "table/layout-wrapper")) . uiLayout) (sendResponse <=< tblLayout . uiLayout <=< dbWidget (Proxy @m) (Proxy @x)) psShortcircuit <=< runDBTable dbtable paginationInput currentKeys . fmap swap $ runWriterT table'
   where
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ecbf65f1a..73e6473e4 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -199,6 +199,7 @@ data FormIdentifier
   | FIDDBTable
   | FIDDBTableCsvExport
   | FIDDBTableCsvImport
+  | FIDDBTableCsvImportConfirm
   | FIDDelete
   | FIDCourseRegister
   | FIDuserRights
@@ -567,7 +568,26 @@ data SecretJSONFieldException = SecretJSONFieldDecryptFailure
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Exception SecretJSONFieldException
 
-secretJsonField :: ( ToJSON a, FromJSON a
+secretJsonField' :: ( ToJSON a, FromJSON a
+                    , MonadHandler m
+                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                    , RenderMessage (HandlerSite m) FormMessage
+                    , RenderMessage (HandlerSite m) SecretJSONFieldException
+                    )
+                 => FieldViewFunc m Text -> Field m a
+secretJsonField' fieldView' = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      fieldView' theId name attrs val' isReq
+    fieldEnctype = UrlEncoded
+
+secretJsonField :: forall m a.
+                   ( ToJSON a, FromJSON a
                    , MonadHandler m
                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
@@ -575,17 +595,7 @@ secretJsonField :: ( ToJSON a, FromJSON a
                    , RenderMessage (HandlerSite m) SecretJSONFieldException
                    )
                 => Field m a
-secretJsonField = Field{..}
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        <input id=#{theId} name=#{name} *{attrs} type=hidden value=#{either id id val'}>
-      |]
-    fieldEnctype = UrlEncoded
+secretJsonField = secretJsonField' $ fieldView (hiddenField :: Field m Text)
 
 htmlFieldSmall :: forall m. (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m Html
 htmlFieldSmall = checkMMap sanitize (pack . renderHtml) textField
diff --git a/src/Utils/Parameters.hs b/src/Utils/Parameters.hs
index 57d1a0cff..6a66df6e1 100644
--- a/src/Utils/Parameters.hs
+++ b/src/Utils/Parameters.hs
@@ -6,7 +6,7 @@ module Utils.Parameters
   , GlobalPostParam(..)
   , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
   , lookupGlobalPostParamForm, hasGlobalPostParamForm
-  , globalPostParamField
+  , globalPostParamField, globalPostParamFields
   ) where
 
 import ClassyPrelude.Yesod
@@ -55,6 +55,7 @@ data GlobalPostParam = PostFormIdentifier
                      | PostDeleteTarget
                      | PostMassInputShape
                      | PostBearer
+                     | PostDBCsvImportAction
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe GlobalPostParam
@@ -84,3 +85,9 @@ globalPostParamField ident Field{fieldParse} = runMaybeT $ do
   ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
   fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
   MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
+
+globalPostParamFields :: Monad m => GlobalPostParam -> Field m a -> MForm m [a]
+globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT $ do
+  ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
+  fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
+  forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ either (const Nothing) id <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)
diff --git a/templates/csv-import-confirmation-wrapper.hamlet b/templates/csv-import-confirmation-wrapper.hamlet
new file mode 100644
index 000000000..b5459079b
--- /dev/null
+++ b/templates/csv-import-confirmation-wrapper.hamlet
@@ -0,0 +1,4 @@
+<section>
+  <p>_{MsgCsvImportConfirmationTip}
+<section>
+  ^{csvImportConfirmForm}
diff --git a/templates/csv-import-confirmation.hamlet b/templates/csv-import-confirmation.hamlet
new file mode 100644
index 000000000..473a2c101
--- /dev/null
+++ b/templates/csv-import-confirmation.hamlet
@@ -0,0 +1,21 @@
+$newline never
+#{csrf}
+<div .actions>
+  $forall actionClass <- sortOn dbtCsvCoarsenActionClass (Map.keys actionMap)
+    <div .action>
+      <input type=checkbox id=#{actionClassIdent actionClass} .action__checkbox :defaultChecked actionClass:checked>
+      <label .action__label for=#{actionClassIdent actionClass}>
+        ^{dbtCsvRenderActionClass actionClass}
+
+      <fieldset .action__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{actionClassIdent actionClass}>
+        <div .action__checked-counter>
+        <div .action__toggle-all>
+          <input type=checkbox id=#{actionClassIdent actionClass}-toggle-all>
+          <label for=#{actionClassIdent actionClass}-toggle-all .action__option-label>
+            _{MsgDBCsvImportActionToggleAll}
+        <div .action__options>
+          $forall action <- Set.toList (actionMap ! actionClass)
+            <div .action__option>
+              ^{csvActionCheckBox [] action}
+              <label .action__option-label for=#{actionIdent action}>
+                ^{dbtCsvRenderKey existing action}
diff --git a/templates/csv-import-confirmation.julius b/templates/csv-import-confirmation.julius
new file mode 100644
index 000000000..6c3da0203
--- /dev/null
+++ b/templates/csv-import-confirmation.julius
@@ -0,0 +1,81 @@
+(function() {
+
+  var IMPORT_ACTIONS_SELECTOR = '.actions';
+  var IMPORT_ACTION_SELECTOR = '.action';
+  var IMPORT_ACTION_CHECKBOX_SELECTOR = '.action__checkbox ';
+  var IMPORT_ACTION_OPTIONS_SELECTOR = '.action__options';
+  var IMPORT_ACTION_TOGGLE_ALL_SELECTOR = '.action__toggle-all [type="checkbox"]';
+  var IMPORT_ACTION_CHECKED_COUNTER_SELECTOR = '.action__checked-counter';
+
+  var importActionsElement;
+
+  document.addEventListener('DOMContentLoaded', function() {
+    importActionsElement = document.querySelector(IMPORT_ACTIONS_SELECTOR);
+
+    setupActions();
+  });
+
+  function setupActions() {
+    var actionElements = Array.from(importActionsElement.querySelectorAll(IMPORT_ACTION_SELECTOR));
+
+    actionElements.forEach(function(element) {
+      setupAction(element);
+    });
+  }
+
+  function setupAction(actionElement) {
+    var actionCheckbox = actionElement.querySelector(IMPORT_ACTION_CHECKBOX_SELECTOR);
+    var actionOptions = actionElement.querySelector(IMPORT_ACTION_OPTIONS_SELECTOR);
+    if (actionOptions) {
+      var actionCheckboxes = Array.from(actionOptions.querySelectorAll('[type="checkbox"]'));
+      var toggleAllCheckbox = actionElement.querySelector(IMPORT_ACTION_TOGGLE_ALL_SELECTOR);
+
+      // setup action checkbox to toggle all child checkboxes if changed
+      actionCheckbox.addEventListener('change', function() {
+        actionCheckboxes.forEach(function(checkbox) {
+          checkbox.checked = actionCheckbox.checked;
+        });
+        updateCheckedCounter(actionElement, actionCheckboxes);
+        updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+      });
+
+      // update counter and toggle checkbox initially
+      updateCheckedCounter(actionElement, actionCheckboxes);
+      updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+
+      // register change listener for individual checkboxes
+      actionCheckboxes.forEach(function(checkbox) {
+        checkbox.addEventListener('change', function() {
+          updateCheckedCounter(actionElement, actionCheckboxes);
+          updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+        });
+      });
+
+      // register change listener for toggle all checkbox
+      if (toggleAllCheckbox) {
+        toggleAllCheckbox.addEventListener('change', function() {
+          actionCheckboxes.forEach(function(checkbox) {
+            checkbox.checked = toggleAllCheckbox.checked;
+          });
+          updateCheckedCounter(actionElement, actionCheckboxes);
+        });
+      }
+    }
+  }
+
+  // update checked state of toggle all checkbox based on all other checkboxes
+  function updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes) {
+    var allChecked = actionCheckboxes.reduce(function(acc, checkbox) {
+      return acc && checkbox.checked;
+    }, true);
+    toggleAllCheckbox.checked = allChecked;
+  }
+
+  // update value of checked counter
+  function updateCheckedCounter(actionElement, actionCheckboxes) {
+    var checkedCounter = actionElement.querySelector(IMPORT_ACTION_CHECKED_COUNTER_SELECTOR);
+    var checkedCheckboxes = actionCheckboxes.reduce(function(acc, checkbox) { return checkbox.checked ? acc + 1 : acc; }, 0);
+    checkedCounter.innerHTML = checkedCheckboxes + '/' + actionCheckboxes.length;
+  }
+
+})();
diff --git a/templates/csv-import-confirmation.lucius b/templates/csv-import-confirmation.lucius
new file mode 100644
index 000000000..2569e0836
--- /dev/null
+++ b/templates/csv-import-confirmation.lucius
@@ -0,0 +1,52 @@
+.action {
+  max-width: 800px;
+  padding: 3px 0;
+
+  &:not(:last-child) {
+    margin-bottom: 7px;
+  }
+
+  &:not(:first-child) {
+    margin-top: 7px;
+  }
+}
+
+.action__options {
+  max-height: 450px;
+  overflow-y: auto;
+}
+
+.action__option {
+  display: flex;
+
+  &:not(:last-child) {
+    margin-bottom: 10px;
+  }
+}
+
+.action__label,
+.action__option-label {
+  margin-left: 15px;
+  vertical-align: top;
+}
+
+.action__fieldset {
+  margin: 7px 0 5px 9px;
+  padding: 5px 0 10px;
+  border-left: 1px solid #bcbcbc;
+  padding-left: 16px;
+  position: relative;
+}
+
+.action__toggle-all {
+  display: flex;
+  border-bottom: 1px solid #bcbcbc;
+  padding-bottom: 8px;
+  margin-bottom: 8px;
+}
+
+.action__checked-counter {
+  position: absolute;
+  right: 5px;
+  top: 5px;
+}
diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index 720407eff..a6c943279 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -331,22 +331,6 @@ input[type="button"].btn-info:hover,
   box-shadow: 0 0 1px 1px var(--color-grey-light);
 }
 
-.csv-export, .csv-import {
-  box-shadow: 0 0 1px 1px var(--color-grey);
-
-  * {
-    margin-right: 10px;
-  }
-
-  *:last-child {
-    margin-right: 0;
-
-    &.modal__trigger {
-      margin-right: 10px;
-    }
-  }
-}
-
 @media (max-width: 425px) {
 
   .scrolltable {
diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet
index 10eedfc63..11586a227 100644
--- a/templates/table/csv-transcode.hamlet
+++ b/templates/table/csv-transcode.hamlet
@@ -1,8 +1,14 @@
 $newline never
 $if is _Just dbtCsvDecode
   <div .csv-import>
-    ^{csvImportWdgt'}
+    <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-import data-show-hide-collapsed>
+      _{MsgTableHeadingCsvImport}
+    <div .csv-import__content>
+      ^{csvImportWdgt'}
 $if is _Just dbtCsvEncode
   <div .csv-export>
-    ^{csvExportWdgt'}
-    ^{csvColExplanations'}
+    <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-export>
+      _{MsgTableHeadingCsvExport}
+    <div .csv-export__content>
+      ^{csvExportWdgt'}
+      ^{csvColExplanations'}
diff --git a/templates/table/csv-transcode.lucius b/templates/table/csv-transcode.lucius
new file mode 100644
index 000000000..7c6de1c2a
--- /dev/null
+++ b/templates/table/csv-transcode.lucius
@@ -0,0 +1,21 @@
+.csv-export {
+  margin-bottom: 13px;
+    
+  .csv-export__content {
+    display: flex;
+    align-content: space-between;
+    align-items: center;
+
+    & > * {
+      margin-right: 10px;
+
+      &:last-child {
+        margin-right: 0;
+      }
+    }
+  }
+}
+
+.csv-import {
+  margin-bottom: 13px;
+}
diff --git a/templates/table/layout-filter-default.hamlet b/templates/table/layout-filter-default.hamlet
index 7a87d28a1..5f40d067a 100644
--- a/templates/table/layout-filter-default.hamlet
+++ b/templates/table/layout-filter-default.hamlet
@@ -1,6 +1,7 @@
 $newline never
 <div .table-filter>
-  <h3 .table-filter__toggle uw-show-hide data-show-hide-id=table-filter data-show-hide-collapsed>Filter
+  <h3 .table-filter__toggle uw-show-hide data-show-hide-id=table-filter data-show-hide-collapsed>
+    _{MsgTableHeadingFilter}
   <div>
     ^{filterForm}
 ^{scrolltable}
diff --git a/templates/table/layout.hamlet b/templates/table/layout.hamlet
index 836f5810c..eb8baadcb 100644
--- a/templates/table/layout.hamlet
+++ b/templates/table/layout.hamlet
@@ -5,7 +5,6 @@ $else
   <div .table-header>
     <div .table__row-count>
       _{MsgRowCount rowCount}
-    ^{csvWdgt}
 
   ^{table}
 
diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet
index b51adbf2c..c5d02a929 100644
--- a/templates/widgets/aform/aform.hamlet
+++ b/templates/widgets/aform/aform.hamlet
@@ -3,8 +3,9 @@ $newline never
 $case formLayout
   $of FormDBTablePagesize
     $forall view <- fieldViews
-      <label .form-group-label.label-pagesize for=#{fvId view}>#{fvLabel view}
-      ^{fvInput view}
+      <div>
+        <label .form-group-label.label-pagesize for=#{fvId view}>#{fvLabel view}
+        ^{fvInput view}
   $of _
     $forall view <- fieldViews
       $if fvId view == idFormSectionNoinput
@@ -23,6 +24,6 @@ $case formLayout
             $maybe err <- fvErrors view
               <div .form-error>#{err}
     $if formHasRequiredFields
-      <div .form-section-title>
+      <div .form-section-legend>
         <span .form-group__required-marker>
         _{MsgAFormFieldRequiredTip}

From e35fed6b85fd5734834e4a4590276c6d3df34f83 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 22 Jul 2019 18:36:25 +0200
Subject: [PATCH 29/36] feat(csv): finish implementing csv import

---
 messages/uniworx/de.msg               |  16 +-
 src/Data/CaseInsensitive/Instances.hs |   2 +-
 src/Database/Esqueleto/Utils.hs       |  18 +-
 src/Handler/Exam.hs                   | 238 +++++++++++++++++++++++---
 src/Handler/Utils/Csv.hs              |  34 +++-
 src/Handler/Utils/Table/Pagination.hs |  57 ++++--
 templates/widgets/csvRendered.hamlet  |  14 ++
 templates/widgets/csvRendered.lucius  |   3 +
 8 files changed, 344 insertions(+), 38 deletions(-)
 create mode 100644 templates/widgets/csvRendered.hamlet
 create mode 100644 templates/widgets/csvRendered.lucius

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 5fef09aba..7bd44ebf8 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -91,6 +91,7 @@ CourseDeregisterOk: Erfolgreich abgemeldet
 CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
 CourseStudyFeature: Assoziiertes Hauptfach
 CourseStudyFeatureUpdated: Assoziiertes Hauptfach geändert
+CourseStudyFeatureNone: Kein assoziiertes Hauptfach
 CourseTutorial: Tutorium
 CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
 CourseSecretWrong: Falsches Kennwort
@@ -1064,7 +1065,7 @@ HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
 CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
 CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
 CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
-CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
+CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden ohne assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
 CourseParticipantsRegistered n@Int: #{n} Teilnehmer erfolgreich angemeldet
 CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen
 
@@ -1121,6 +1122,7 @@ ExamRoomMatriculation': Nach Matrikelnummer
 ExamRoomRandom': Zufällig pro Teilnehmer
 
 ExamOccurrence: Termin/Raum
+ExamNoOccurrence: Kein Termin/Raum
 ExamOccurrences: Prüfungen
 ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
 ExamRoomName: Interne Bezeichnung
@@ -1230,11 +1232,19 @@ CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die de
 Action: Aktion
 
 DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen Datensatz und können daher nicht verarbeitet werden.
-DBCsvDuplicateKeyTip: Entfernen Sie ein der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
+DBCsvDuplicateKeyTip: Entfernen Sie eine der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
+DBCsvKeyException: Für eine Zeile der CSV-Dateien konnte nicht festgestellt werden, ob sie zu einem bestehenden internen Datensatz korrespondieren.
+DBCsvException: Bei der Berechnung der auszuführenden Aktionen für einen Datensatz ist ein Fehler aufgetreten. 
 
-ExamUserCsvRegister: Teilnehmer zur Klausur anmelden
+ExamUserCsvCourseRegister: Benutzer zum Kurs und zur Klausur anmelden
+ExamUserCsvRegister: Kursteilnehmer zur Klausur anmelden
 ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
 ExamUserCsvDeregister: Teilnehmer von der Klausur abmelden
+ExamUserCsvSetCourseField: Kurs-assoziiertes Hauptfach ändern
+
+ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
+ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Hauptfach des Kursteilnehmers zugeordnet werden
+ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
 
 TableHeadingFilter: Filter
 TableHeadingCsvImport: CSV-Import
diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs
index 4fb1bf0a2..937fb2c46 100644
--- a/src/Data/CaseInsensitive/Instances.hs
+++ b/src/Data/CaseInsensitive/Instances.hs
@@ -108,4 +108,4 @@ instance Csv.ToField s => Csv.ToField (CI s) where
   toField = Csv.toField . CI.original
 
 instance (CI.FoldCase s, Csv.FromField s) => Csv.FromField (CI s) where
-  parseField = fmap CI.original . Csv.parseField
+  parseField = fmap CI.mk . Csv.parseField
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 3d4d12510..832a2c5d6 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -4,6 +4,7 @@ module Database.Esqueleto.Utils
   ( true, false
   , isJust
   , isInfixOf, hasInfix
+  , or, and
   , any, all
   , SqlIn(..)
   , mkExactFilter, mkExactFilterWith
@@ -11,15 +12,17 @@ module Database.Esqueleto.Utils
   , mkExistsFilter
   , anyFilter, allFilter
   , orderByOrd, orderByEnum
+  , lower, ciEq
   ) where
 
 
-import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust)
 import Data.Universe
 import qualified Data.Set as Set
 import qualified Data.List as List
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
 
@@ -58,6 +61,10 @@ hasInfix :: ( E.Esqueleto query expr backend
          => expr (E.Value s2) -> expr (E.Value s1) -> expr (E.Value Bool)
 hasInfix = flip isInfixOf
 
+and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
+and = F.foldr (\b acc -> acc E.&&. b) true
+or = F.foldr (\b acc -> acc E.||. b) false
+
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
 any :: Foldable f =>
@@ -164,4 +171,11 @@ orderByOrd = let sortUni = zip [1..] $ List.sort universeF in -- memoize this, m
     \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val (-1))
 
 orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
-orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))
\ No newline at end of file
+orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))
+
+
+lower :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
+lower = E.unsafeSqlFunction "LOWER"
+
+ciEq :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+ciEq a b = lower a E.==. lower b
diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs
index 574f13531..e8c2b8ea4 100644
--- a/src/Handler/Exam.hs
+++ b/src/Handler/Exam.hs
@@ -13,7 +13,7 @@ import Handler.Utils.Csv
 import Jobs.Queue
 
 import Utils.Lens hiding (parts)
-
+  
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
@@ -32,6 +32,7 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Control.Monad.State.Class as State
+import Control.Arrow (Kleisli(..))
 
 import qualified Data.Csv as Csv
 
@@ -887,22 +888,34 @@ data ExamUserActionData = ExamUserDeregisterData
                         | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
 
 data ExamUserCsvActionClass
-  = ExamUserCsvRegister
+  = ExamUserCsvCourseRegister
+  | ExamUserCsvRegister
   | ExamUserCsvAssignOccurrence
+  | ExamUserCsvSetCourseField
   | ExamUserCsvDeregister
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
 
 data ExamUserCsvAction
-  = ExamUserCsvRegisterData
-    { examUserCsvUser :: UserId
+  = ExamUserCsvCourseRegisterData
+    { examUserCsvActUser :: UserId
+    , examUserCsvActCourseField :: Maybe StudyFeaturesId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
+    }
+  | ExamUserCsvRegisterData
+    { examUserCsvActUser :: UserId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
     }
   | ExamUserCsvAssignOccurrenceData
-    { examUserCsvRegistration :: ExamRegistrationId
-    , examUserCsvOccurrence :: ExamOccurrenceId
+    { examUserCsvActRegistration :: ExamRegistrationId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
+    }
+  | ExamUserCsvSetCourseFieldData
+    { examUserCsvActCourseParticipant :: CourseParticipantId
+    , examUserCsvActCourseField :: Maybe StudyFeaturesId
     }
   | ExamUserCsvDeregisterData
-    { examUserCsvRegistration :: ExamRegistrationId
+    { examUserCsvActRegistration :: ExamRegistrationId
     }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 deriveJSON defaultOptions
@@ -911,6 +924,16 @@ deriveJSON defaultOptions
   , sumEncoding = TaggedObject "action" "data"
   } ''ExamUserCsvAction
 
+data ExamUserCsvException
+  = ExamUserCsvExceptionNoMatchingUser
+  | ExamUserCsvExceptionNoMatchingStudyFeatures
+  | ExamUserCsvExceptionNoMatchingOccurrence
+  deriving (Show, Generic, Typeable)
+
+instance Exception ExamUserCsvException
+
+embedRenderMessage ''UniWorX ''ExamUserCsvException id
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -1023,30 +1046,203 @@ postEUsersR tid ssh csh examn = do
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
           dbtCsvDecode = Just DBTCsvDecode
-            { dbtCsvRowKey = \ExamUserTableCsv{} -> mzero -- FIXME: guess user from csv row and do lookup via UniqueExamRegistration
-            , dbtCsvComputeActions = awaitForever $ \case
-                DBCsvDiffMissing{dbCsvOldKey} -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
-                _other -> return () -- FIXME: compute edit on existing rows & add rows
+            { dbtCsvRowKey = \csv -> do
+                uid <- lift $ view _2 <$> guessUser csv
+                fmap E.Value . MaybeT . getKeyBy $ UniqueExamRegistration eid uid
+            , dbtCsvComputeActions = \case
+                DBCsvDiffMissing{dbCsvOldKey}
+                  -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
+                DBCsvDiffNew{dbCsvNewKey = Just _}
+                  -> fail "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
+                DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
+                  (isPart, uid) <- lift $ guessUser dbCsvNew
+                  if
+                    | isPart -> do
+                        yieldM $ ExamUserCsvRegisterData <$> pure uid <*> lookupOccurrence dbCsvNew
+                        newFeatures <- lift $ lookupStudyFeatures dbCsvNew
+                        Just (Entity cpId CourseParticipant{ courseParticipantField = oldFeatures }) <- lift . getBy $ UniqueParticipant uid examCourse
+                        when (newFeatures /= oldFeatures) $
+                          yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
+                    | otherwise ->
+                        yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupStudyFeatures dbCsvNew <*> lookupOccurrence dbCsvNew
+                DBCsvDiffExisting{..} -> do
+                  newOccurrence <- lift $ lookupOccurrence dbCsvNew
+                  when (newOccurrence /= dbCsvOld ^? resultExamOccurrence . _entityKey) $
+                    yield $ ExamUserCsvAssignOccurrenceData (E.unValue dbCsvOldKey) newOccurrence
+
+                  newFeatures <- lift $ lookupStudyFeatures dbCsvNew
+                  when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $ do
+                    Just (Entity cpId _) <- lift . getBy . flip UniqueParticipant examCourse $ dbCsvOld ^. resultUser . _entityKey
+                    yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
             , dbtCsvClassifyAction = \case
+                ExamUserCsvCourseRegisterData{}   -> ExamUserCsvCourseRegister
                 ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
                 ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                 ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
+                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
             , dbtCsvCoarsenActionClass = \case
-                ExamUserCsvRegister   -> DBCsvActionNew
-                ExamUserCsvDeregister -> DBCsvActionMissing
-                _other                -> DBCsvActionExisting 
+                ExamUserCsvCourseRegister -> DBCsvActionNew
+                ExamUserCsvRegister       -> DBCsvActionNew
+                ExamUserCsvDeregister     -> DBCsvActionMissing
+                _other                    -> DBCsvActionExisting 
             , dbtCsvExecuteActions = do
                 C.mapM_ $ \case
-                  ExamUserCsvDeregisterData{..} -> delete examUserCsvRegistration
-                  _other -> return () -- FIXME
+                  ExamUserCsvCourseRegisterData{..} -> do
+                    now <- liftIO getCurrentTime
+                    insert_ CourseParticipant
+                      { courseParticipantCourse = examCourse
+                      , courseParticipantUser = examUserCsvActUser
+                      , courseParticipantRegistration = now
+                      , courseParticipantField = examUserCsvActCourseField
+                      }
+                    insert_ ExamRegistration
+                      { examRegistrationExam = eid
+                      , examRegistrationUser = examUserCsvActUser
+                      , examRegistrationOccurrence = examUserCsvActOccurrence
+                      , examRegistrationTime = now
+                      }
+                  ExamUserCsvRegisterData{..} -> do
+                    examRegistrationTime <- liftIO getCurrentTime
+                    insert_ ExamRegistration
+                      { examRegistrationExam = eid
+                      , examRegistrationUser = examUserCsvActUser
+                      , examRegistrationOccurrence = examUserCsvActOccurrence
+                      , ..
+                      }
+                  ExamUserCsvAssignOccurrenceData{..} ->
+                    update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
+                  ExamUserCsvSetCourseFieldData{..} ->
+                    update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
+                  ExamUserCsvDeregisterData{..} -> delete examUserCsvActRegistration
                 return $ CExamR tid ssh csh examn EUsersR
-            , dbtCsvRenderKey = \existing -> \case
+            , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
+                ExamUserCsvCourseRegisterData{..} -> do
+                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe features <- examUserCsvActCourseField
+                      , ^{studyFeaturesWidget features}
+                    $nothing
+                      , _{MsgCourseStudyFeatureNone}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvRegisterData{..} -> do
+                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvAssignOccurrenceData{..} -> do
+                  occ <- for examUserCsvActOccurrence $ liftHandlerT . runDB . getJust
+                  [whamlet|
+                    $newline never
+                    ^{registeredUserName' examUserCsvActRegistration}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvSetCourseFieldData{..} -> do
+                  User{..} <- liftHandlerT . runDB $ getJust . courseParticipantUser =<< getJust examUserCsvActCourseParticipant
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe features <- examUserCsvActCourseField
+                      , ^{studyFeaturesWidget features}
+                    $nothing
+                      , _{MsgCourseStudyFeatureNone}
+                  |]
                 ExamUserCsvDeregisterData{..}
-                  -> let Entity _ User{..} = view resultUser $ existing ! E.Value examUserCsvRegistration
-                      in nameWidget userDisplayName userSurname
-                _other -> mempty -- FIXME
-            , dbtCsvRenderActionClass = \c -> [whamlet|_{c}|]
+                  -> registeredUserName' examUserCsvActRegistration
+            , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
+            , dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
             }
+            where
+              studyFeaturesWidget :: StudyFeaturesId -> Widget
+              studyFeaturesWidget featId = do
+                (StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandlerT . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
+                [whamlet|
+                  $newline never
+                  _{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester}
+                |]
+               
+              registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
+              registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
+                where
+                  Entity _ User{..} = view resultUser $ existing ! registration
+              
+              guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
+              guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
+                users <- E.select . E.from $ \user -> do
+                  E.where_ . E.and $ catMaybes
+                    [ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
+                    , (user E.^. UserDisplayName E.==.) . E.val <$> csvEUserName
+                    , (user E.^. UserSurname E.==.) . E.val <$> csvEUserSurname
+                    ]
+                  let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
+                        E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
+                             E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
+                  E.limit 2
+                  return $ (isCourseParticipant, user E.^. UserId)
+                case users of
+                  (filter . view $ _1 . _Value -> [(E.Value isPart, E.Value uid)])
+                    -> return (isPart, uid)
+                  [(E.Value isPart, E.Value uid)]
+                    -> return (isPart, uid)
+                  _other
+                    -> throwM ExamUserCsvExceptionNoMatchingUser
+
+              lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)
+              lookupOccurrence ExamUserTableCsv{..} = $cachedHereBinary (CI.foldedCase <$> csvEUserOccurrence) . for csvEUserOccurrence $ \occName -> do
+                occIds <- selectKeysList [ ExamOccurrenceName ==. occName, ExamOccurrenceExam ==. eid ] []
+                case occIds of
+                  [occId] -> return occId
+                  _other  -> throwM ExamUserCsvExceptionNoMatchingOccurrence
+
+              lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
+              lookupStudyFeatures csv@ExamUserTableCsv{..} = do
+                uid <- view _2 <$> guessUser csv
+                studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do
+                  E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
+                  E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
+                  E.where_ . E.and $ catMaybes 
+                    [ do
+                        field <- csvEUserField
+                        return . E.or $ catMaybes
+                          [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
+                          , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
+                          , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
+                          ]
+                    , do
+                        degree <- csvEUserDegree
+                        return . E.or $ catMaybes
+                          [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
+                          , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
+                          , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
+                          ]
+                    , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
+                    ]
+                  E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+                       E.&&. studyFeatures E.^. StudyFeaturesType E.==. E.val FieldPrimary
+                       E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
+                  E.limit 2
+                  return $ studyFeatures E.^. StudyFeaturesId
+                case studyFeatures of
+                  [E.Value fid] -> return $ Just fid
+                  _other
+                    | is _Nothing csvEUserField
+                    , is _Nothing csvEUserDegree
+                    , is _Nothing csvEUserSemester
+                    -> return Nothing
+                  _other        -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures
 
       examUsersDBTableValidator = def
 
diff --git a/src/Handler/Utils/Csv.hs b/src/Handler/Utils/Csv.hs
index 27299f655..4bb875d02 100644
--- a/src/Handler/Utils/Csv.hs
+++ b/src/Handler/Utils/Csv.hs
@@ -10,9 +10,11 @@ module Handler.Utils.Csv
   , ToNamedRecord(..), FromNamedRecord(..)
   , DefaultOrdered(..)
   , ToField(..), FromField(..)
+  , CsvRendered(..)
+  , toCsvRendered
   ) where
 
-import Import
+import Import hiding (Header)
 
 import Data.Csv
 import Data.Csv.Conduit
@@ -21,6 +23,8 @@ import qualified Data.Conduit.List as C
 import qualified Data.Conduit.Combinators as C (sourceLazy)
 
 import qualified Data.Map as Map
+import qualified Data.Vector as Vector
+import qualified Data.HashMap.Strict as HashMap
 
 
 deriving instance Typeable CsvParseError
@@ -69,3 +73,31 @@ fileSourceCsv :: ( FromNamedRecord csv
               => FileInfo
               -> Source m csv
 fileSourceCsv = (.| decodeCsv) . fileSource
+
+
+data CsvRendered = CsvRendered
+  { csvRenderedHeader :: Header
+  , csvRenderedData :: [NamedRecord]
+  } deriving (Eq, Read, Show, Generic, Typeable)
+
+instance ToWidget UniWorX CsvRendered where
+  toWidget CsvRendered{..} = liftWidgetT $(widgetFile "widgets/csvRendered")
+    where
+      csvData = [ [ decodeUtf8 <$> HashMap.lookup columnKey row
+                  | columnKey <- Vector.toList csvRenderedHeader
+                  ]
+                | row <- csvRenderedData
+                ]
+
+      headers = decodeUtf8 <$> Vector.toList csvRenderedHeader
+
+toCsvRendered :: forall mono.
+                 ( ToNamedRecord (Element mono)
+                 , DefaultOrdered (Element mono)
+                 , MonoFoldable mono
+                 )
+              => mono -> CsvRendered
+toCsvRendered (otoList -> csvs) = CsvRendered{..}
+  where
+    csvRenderedHeader = headerOrder (error "not forced" :: Element mono)
+    csvRenderedData   = map toNamedRecord csvs
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 7997741b1..e36c0672b 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -70,7 +70,6 @@ import qualified Data.Set as Set
 import qualified Data.CaseInsensitive as CI
 
 import Data.Csv (NamedRecord)
-import qualified Data.Csv as Csv (encodeByName)
 
 import Colonnade hiding (bool, fromMaybe, singleton)
 import qualified Colonnade (singleton)
@@ -342,8 +341,14 @@ data DBCsvException k'
     { dbCsvDuplicateKey :: k'
     , dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB :: NamedRecord
     }
+  | DBCsvException
+    { dbCsvExceptionRow :: NamedRecord
+    , dbCsvException :: Text
+    }
   deriving (Show, Typeable)
 
+makeLenses_ ''DBCsvException
+
 instance (Typeable k', Show k') => Exception (DBCsvException k')
 
 
@@ -486,21 +491,23 @@ instance PathPiece x => PathPiece (WithIdent x) where
     WithIdent <$> pure ident <*> fromPathPiece rest
 
 type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
-data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass.
+data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
   ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
   , DBTableKey k'
   , RedirectUrl UniWorX route
   , Typeable csv
   , Ord csvAction, FromJSON csvAction, ToJSON csvAction
   , Ord csvActionClass
+  , Exception csvException
   ) => DBTCsvDecode
   { dbtCsvRowKey :: csv -> MaybeT (YesodDB UniWorX) k'
-  , dbtCsvComputeActions :: Conduit (DBCsvDiff r' csv k') (YesodDB UniWorX) csvAction
+  , dbtCsvComputeActions :: DBCsvDiff r' csv k' -> Source (YesodDB UniWorX) csvAction
   , dbtCsvClassifyAction :: csvAction -> csvActionClass
   , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode
   , dbtCsvExecuteActions :: Sink csvAction (YesodDB UniWorX) route
   , dbtCsvRenderKey :: Map k' r' -> csvAction -> Widget
   , dbtCsvRenderActionClass :: csvActionClass -> Widget
+  , dbtCsvRenderException :: csvException -> YesodDB UniWorX Text
   }
 
 data DBTable m x = forall a r r' h i t k k' csv.
@@ -895,7 +902,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
               let
                 toDiff :: csv -> StateT (Map k' csv) (YesodDB UniWorX) (DBCsvDiff r' csv k')
                 toDiff row = do
-                  rowKey <- lift . runMaybeT $ dbtCsvRowKey row
+                  rowKey <- lift $
+                    handle (throwM . (DBCsvException (toNamedRecord row) :: Text -> DBCsvException k') <=< dbtCsvRenderException) . runMaybeT $ dbtCsvRowKey row
                   seenKeys <- State.get
                   (<* modify (maybe id (flip Map.insert row) rowKey)) $ if
                     | Just rowKey' <- rowKey
@@ -917,7 +925,18 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
             accActionMap acc csvAct = Map.insertWith Set.union (dbtCsvClassifyAction csvAct) (Set.singleton csvAct) acc
 
             importCsv = do
-              actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions .| C.fold accActionMap Map.empty
+              let
+                dbtCsvComputeActions' :: Sink (DBCsvDiff r' csv k') (YesodDB UniWorX) (Map csvActionClass (Set csvAction))
+                dbtCsvComputeActions' = do
+                  let innerAct = awaitForever $ \x
+                        -> let doHandle
+                                 | Just inpCsv <- x ^? _dbCsvNew
+                                 = handle $ throwM . (DBCsvException (toNamedRecord inpCsv) :: Text -> DBCsvException k') <=< dbtCsvRenderException
+                                 | otherwise            
+                                 = id
+                            in yieldM . doHandle . runConduit $ dbtCsvComputeActions x .| C.fold accActionMap Map.empty
+                  innerAct .| C.foldMap id
+              actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions'
 
               when (Map.null actionMap) $ do
                 addMessageI Info MsgCsvImportUnnecessary
@@ -957,20 +976,38 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                         }
                       
                   $(widgetFile "csv-import-confirmation-wrapper")
+
+        let defaultHeaderOrder = headerOrder (error "not to be forced" :: csv)
         catches importCsv
           [ Catch.Handler $ \case
               (DBCsvDuplicateKey{..} :: DBCsvException k')
                 -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
-                     let offendingCsv = decodeUtf8 $ Csv.encodeByName (headerOrder (error "not to be forced" :: csv)) [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
-
                      mr <- getMessageRender
 
-                     siteLayoutMsg (ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]) $
+                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
+                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]
+
+                     siteLayoutMsg heading $ do
+                       setTitleI heading
                        [whamlet|
                          <p>_{MsgDBCsvDuplicateKey}
                          <p>_{MsgDBCsvDuplicateKeyTip}
-                         <pre style="white-space: pre; font-family: monospace">
-                           #{offendingCsv}
+                         ^{offendingCsv}
+                       |]
+              (DBCsvException{..} :: DBCsvException k')
+                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
+                     mr <- getMessageRender
+
+                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvExceptionRow ]
+                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvException]
+
+                     siteLayoutMsg heading $ do
+                       setTitleI heading
+                       [whamlet|
+                         <p>_{MsgDBCsvException}
+                         $if not (Text.null dbCsvException)
+                           <p>#{dbCsvException}
+                         ^{ offendingCsv}
                        |]
           ]
     _other      -> return ()
diff --git a/templates/widgets/csvRendered.hamlet b/templates/widgets/csvRendered.hamlet
new file mode 100644
index 000000000..91ffee919
--- /dev/null
+++ b/templates/widgets/csvRendered.hamlet
@@ -0,0 +1,14 @@
+$newline never
+<table .table .table--striped .table--hover>
+  <thead>
+    <tr .table__row .table__row--head>
+      $forall header <- headers
+        <th .table__th .table__th--csv>
+          #{header}
+  <tbody>
+    $forall row <- csvData
+      <tr .table__row>
+        $forall cell <- row
+          <td .table__td .table__td--csv>
+            $maybe cellText <- cell
+              #{cellText}
diff --git a/templates/widgets/csvRendered.lucius b/templates/widgets/csvRendered.lucius
new file mode 100644
index 000000000..1187b7160
--- /dev/null
+++ b/templates/widgets/csvRendered.lucius
@@ -0,0 +1,3 @@
+.table__td--csv, .table__th--csv {
+  font-family: monospace;
+}

From 5cb9404b7d2eaaf674a9f80ca323f052b2a1d3eb Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 09:18:27 +0200
Subject: [PATCH 30/36] fix(exams): change heading to rooms if no occurrence
 times are shown

---
 messages/uniworx/de.msg    | 1 +
 templates/exam-show.hamlet | 5 ++++-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 7bd44ebf8..99ed87ddf 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -1124,6 +1124,7 @@ ExamRoomRandom': Zufällig pro Teilnehmer
 ExamOccurrence: Termin/Raum
 ExamNoOccurrence: Kein Termin/Raum
 ExamOccurrences: Prüfungen
+ExamRooms: Räume
 ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
 ExamRoomName: Interne Bezeichnung
 ExamRoom: Raum
diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet
index e7d2a777b..6a0d8321e 100644
--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@@ -89,7 +89,10 @@ $maybe desc <- examDescription
 $if not (null occurrences)
   <section>
     <h2>
-      _{MsgExamOccurrences}
+      $if examTimes
+        _{MsgExamOccurrences}
+      $else
+        _{MsgExamRooms}
     <table .table .table--striped .table--hover>
       <thead>
         <tr .table__row .table__row--head>

From 68a54470c900c5bdb9a6b617d47569ad70b78887 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 09:25:59 +0200
Subject: [PATCH 31/36] chore(changelog): describe csv-import

---
 templates/i18n/changelog/de.hamlet | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet
index 5202a50d5..d32d6a27c 100644
--- a/templates/i18n/changelog/de.hamlet
+++ b/templates/i18n/changelog/de.hamlet
@@ -1,5 +1,10 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>23.07.2019
+  <dd .deflist__dd>
+    <ul>
+      <li>Import & Export von CSV-Dateien für Klausurteilnehmer
+
   <dt .deflist__dt>26.06.2019
   <dd .deflist__dd> 
     <ul>

From b4b55da61f6cc7c1e33486feeb5858e6d818be7b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 09:51:41 +0200
Subject: [PATCH 32/36] refactor: fix hlint

---
 src/Database/Esqueleto/Utils.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 832a2c5d6..02846faec 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -62,8 +62,8 @@ hasInfix :: ( E.Esqueleto query expr backend
 hasInfix = flip isInfixOf
 
 and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
-and = F.foldr (\b acc -> acc E.&&. b) true
-or = F.foldr (\b acc -> acc E.||. b) false
+and = F.foldr (E.&&.) true
+or = F.foldr (E.||.) false
 
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)

From 03795115450a8aa957d75dce711b047af10605db Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 09:56:10 +0200
Subject: [PATCH 33/36] refactor(esqueleto-utils): define any and all in terms
 of or and and

---
 src/Database/Esqueleto/Utils.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 02846faec..6ddf7edd3 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -67,15 +67,13 @@ or = F.foldr (E.||.) false
 
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
-any :: Foldable f =>
-  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
-any test = F.foldr (\needle acc -> acc E.||. test needle) false
+any :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
+any test = or . map test . otoList
 
 -- | Given a test and a set of values, check whether all succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `&&` is short curcuited (i.e. lazily evaluated)
-all :: Foldable f =>
-  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
-all test = F.foldr (\needle acc -> acc E.&&. test needle) true
+all :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
+all test = and . map test . otoList
 
 
 -- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples

From caf4092d12ce1785bf153a372609f6d64b9c19cd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 13:06:38 +0200
Subject: [PATCH 34/36] fix: fix build

---
 src/Database/Esqueleto/Utils.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 6ddf7edd3..132a11d2c 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -141,7 +141,7 @@ mkExistsFilter :: PathPiece a
                -> E.SqlExpr (E.Value Bool)
 mkExistsFilter query row criterias
   | Set.null criterias = true
-  | otherwise = any (E.exists . query row) criterias
+  | otherwise = any (E.exists . query row) $ Set.toList criterias
 
 -- | Combine several filters, using logical or
 anyFilter :: (Foldable f)

From bcc22a2361fed924e1bedace94f94a8d03591cfb Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 13:19:12 +0200
Subject: [PATCH 35/36] refactor: quiet hlint

---
 src/Database/Esqueleto/Utils.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 132a11d2c..a3bf2192a 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -25,6 +25,9 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
+{-# ANN any ("HLint: ignore Use any" :: String) #-}
+{-# ANN all ("HLint: ignore Use all" :: String) #-}
+
 
 --
 -- Description : Convenience for using `Esqueleto`,

From 30e22bae74ad3a75e31b552cb39fa08a296ad52f Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 23 Jul 2019 13:23:10 +0200
Subject: [PATCH 36/36] chore(release): 4.2.0

---
 CHANGELOG.md      | 18 ++++++++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 112f864e7..ce0147d38 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,24 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [4.2.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.1.2...v4.2.0) (2019-07-23)
+
+
+### Bug Fixes
+
+* **exam registration:** icons added to exam register message ([ce61528](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ce61528))
+* **exams:** change heading to rooms if no occurrence times are shown ([5cb9404](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/5cb9404))
+* fix build ([caf4092](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/caf4092))
+
+
+### Features
+
+* **csv:** finish implementing csv import ([e35fed6](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/e35fed6))
+* **csv:** implement csv import ([996bc2a](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/996bc2a))
+* **exams:** allow assigning exam participants to occurrences ([e1996ac](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/e1996ac))
+
+
+
 ### [4.1.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v4.1.1...v4.1.2) (2019-07-17)
 
 
diff --git a/package-lock.json b/package-lock.json
index babb18337..ec336c331 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.2",
+  "version": "4.2.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 6d55ced32..2e27c53a7 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "4.1.2",
+  "version": "4.2.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index 82f577bbc..cf631c001 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 4.1.2
+version: 4.2.0
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage