feat(exams): csv-import of ExamPartResults

BREAKING CHANGE: Introduces ExamPartNumbers
2019-09-16 17:53:45 +02:00 · 2019-09-16 17:53:45 +02:00 · 29f4e28536
commit 29f4e28536
parent 42b253ad18
25 changed files with 612 additions and 114 deletions
--- a/frontend/src/utils/inputs/inputs.scss
+++ b/frontend/src/utils/inputs/inputs.scss
@ -33,11 +33,14 @@
  margin: 7px 0;
 }

-.form-section-title__hint {
-  margin-top: 7px;
+.form-group__hint, .form-section-title__hint {
  color: var(--color-fontsec);
  font-size: 0.9rem;
  font-weight: 600;
+}
+
+.form-section-title__hint {
+  margin-top: 7px;

  + .form-group {
    margin-top: 11px;
@ -58,6 +61,7 @@
 .form-group--required .form-group-label__caption::after, .form-group__required-marker::before {
  content: ' *';
  color: var(--color-error);
+  font-weight: 600;
 }

 .form-group--optional {
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -1387,9 +1387,13 @@ ExamCorrectorAlreadyAdded: Ein Korrektor mit dieser E-Mail ist bereits für dies
 ExamParts: Teilaufgaben
 ExamPartWeightNegative: Gewicht aller Teilaufgaben muss größer oder gleich Null sein
 ExamPartAlreadyExists: Teilaufgabe mit diesem Namen existiert bereits
+ExamPartNumber: Nummer
+ExamPartNumberTip: Wird als interne Bezeichnung z.B. bei CSV-Export verwendet
 ExamPartName: Name
+ExamPartNameTip: Wird den Studierenden angezeigt
 ExamPartMaxPoints: Maximalpunktzahl
 ExamPartWeight: Gewichtung
+ExamPartWeightTip: Wird vor Anzeige oder Notenberechnung mit der erreichten Punktzahl und der Maximalpunktzahl multipliziert; Änderungen hier passen auch bestehende Korrekturergebnisse an
 ExamPartResultPoints: Erreichte Punkte

 ExamNameTaken exam@ExamName: Es existiert bereits eine Prüfung mit Namen #{exam}
@ -1518,7 +1522,9 @@ ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden
 ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
 ExamUserCsvDeregister: Teilnehmer von der Prüfung abmelden
 ExamUserCsvSetCourseField: Kurs-assoziiertes Studienfach ändern
+ExamUserCsvOverrideResult: Ergebnis entgegen automatischer Notenberechnung überschreiben
 ExamUserCsvSetResult: Ergebnis eintragen
+ExamUserCsvSetPartResult: Ergebnis einer Teilaufgabe eintragen
 ExamUserCsvSetCourseNote: Teilnehmer-Notizen anpassen

 ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
--- a/models/exams
+++ b/models/exams
@ -19,10 +19,12 @@ Exam
  UniqueExam course name
 ExamPart
  exam ExamId
-  name (CI Text)
+  number ExamPartNumber
+  name ExamPartName
  maxPoints Points Maybe
  weight Rational
-  UniqueExamPart exam name
+  UniqueExamPartNumber exam number
+  UniqueExamPartName exam name
 ExamOccurrence
  exam ExamId
  name ExamOccurrenceName
@ -42,6 +44,7 @@ ExamPartResult
  examPart ExamPartId
  user UserId
  result ExamResultPoints
+  lastChanged UTCTime default=now()
  UniqueExamPartResult examPart user
 ExamResult
  exam ExamId
--- a/src/Audit/Types.hs
+++ b/src/Audit/Types.hs
@ -23,6 +23,15 @@ data Transaction
    { transactionExam   :: ExamId
    , transactionUser   :: UserId
    }
+  
+  | TransactionExamPartResultEdit
+    { transactionExamPart :: ExamPartId
+    , transactionUser     :: UserId
+    }
+  | TransactionExamPartResultDeleted
+    { transactionExamPart :: ExamPartId
+    , transactionUser     :: UserId
+    }

  | TransactionExamResultEdit
    { transactionExam   :: ExamId
--- a/src/Database/Persist/Class/Instances.hs
+++ b/src/Database/Persist/Class/Instances.hs
@ -8,11 +8,14 @@ module Database.Persist.Class.Instances
 import ClassyPrelude

 import Database.Persist.Class
+import Database.Persist.Types (HaskellName, DBName, PersistValue)
 import Database.Persist.Types.Instances ()

 import Data.Binary (Binary)
 import qualified Data.Binary as Binary

+import qualified Data.Map as Map
+

 instance PersistEntity record => Hashable (Key record) where
  hashWithSalt s = hashWithSalt s . toPersistValue
@ -24,3 +27,13 @@ instance PersistEntity record => Binary (Key record) where

 instance PersistEntity record => NFData (Key record) where
  rnf = rnf . keyToValues
+
+
+uniqueToMap :: PersistEntity record => Unique record -> Map (HaskellName, DBName) PersistValue
+uniqueToMap = fmap Map.fromList $ zip <$> persistUniqueToFieldNames <*> persistUniqueToValues
+
+instance PersistEntity record => Eq (Unique record) where
+  (==) = (==) `on` uniqueToMap
+  
+instance PersistEntity record => Show (Unique record) where
+  showsPrec p = showsPrec p . uniqueToMap
--- a/src/Handler/Exam/Edit.hs
+++ b/src/Handler/Exam/Edit.hs
@ -85,6 +85,7 @@ postEEditR tid ssh csh examn = do
          ExamPartForm{ epfId = Nothing, .. } -> insert_
            ExamPart
              { examPartExam = eId
+              , examPartNumber = epfNumber
              , examPartName = epfName
              , examPartMaxPoints = epfMaxPoints
              , examPartWeight = epfWeight
@ -96,6 +97,7 @@ postEEditR tid ssh csh examn = do
            guard $ examPartExam oldPart == eId
            lift $ replace epfId' ExamPart
              { examPartExam = eId
+              , examPartNumber = epfNumber
              , examPartName = epfName
              , examPartMaxPoints = epfMaxPoints
              , examPartWeight = epfWeight
--- a/src/Handler/Exam/Form.hs
+++ b/src/Handler/Exam/Form.hs
@ -56,6 +56,7 @@ data ExamOccurrenceForm = ExamOccurrenceForm

 data ExamPartForm = ExamPartForm
  { epfId :: Maybe CryptoUUIDExamPart
+  , epfNumber :: ExamPartNumber
  , epfName :: ExamPartName
  , epfMaxPoints :: Maybe Points
  , epfWeight :: Rational
@ -200,12 +201,14 @@ examPartsForm prev = wFormToAForm $ do
  where
    examPartForm' nudge mPrev csrf = do
      (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)
+      (epfNumberRes, epfNumberView) <- mpreq (isoField (from _ExamPartNumber) $ textField & cfStrip & cfCI) ("" & addName (nudge "number") & addPlaceholder "1, 6a, 3.1.4, ...") (epfNumber <$> mPrev)
      (epfNameRes, epfNameView) <- mpreq (textField & cfStrip & cfCI) ("" & addName (nudge "name")) (epfName <$> mPrev)
      (epfMaxPointsRes, epfMaxPointsView) <- mopt pointsField ("" & addName (nudge "max-points")) (epfMaxPoints <$> mPrev)
      (epfWeightRes, epfWeightView) <- mpreq (checkBool (>= 0) MsgExamPartWeightNegative rationalField) ("" & addName (nudge "weight")) (epfWeight <$> mPrev <|> Just 1)

      return ( ExamPartForm
                 <$> epfIdRes
+                 <*> epfNumberRes
                 <*> epfNameRes
                 <*> epfMaxPointsRes
                 <*> epfWeightRes
@ -266,6 +269,7 @@ examFormTemplate (Entity eId Exam{..}) = do
        (Just -> epfId, ExamPart{..}) <- examParts'
        return ExamPartForm
          { epfId
+          , epfNumber    = examPartNumber
          , epfName      = examPartName
          , epfMaxPoints = examPartMaxPoints
          , epfWeight    = examPartWeight
--- a/src/Handler/Exam/New.hs
+++ b/src/Handler/Exam/New.hs
@ -50,6 +50,7 @@ postCExamNewR tid ssh csh = do
          [ ExamPart{..}
          | ExamPartForm{..} <- Set.toList efExamParts
          , let examPartExam      = examid
+                examPartNumber    = epfNumber
                examPartName      = epfName
                examPartMaxPoints = epfMaxPoints
                examPartWeight    = epfWeight
--- a/src/Handler/Exam/Show.hs
+++ b/src/Handler/Exam/Show.hs
@ -33,7 +33,7 @@ getEShowR tid ssh csh examn = do
    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments
    occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR

-    examParts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
+    examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]

    resultsRaw <- for mUid $ \uid ->
      E.select . E.from $ \examPartResult -> do
@ -86,6 +86,9 @@ getEShowR tid ssh csh examn = do
        | fromMaybe False registered = Just [whamlet|_{MsgExamRegistered}|]
        | otherwise = Nothing

+      showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
+      showAchievedPoints = not $ null results
+
  let heading = prependCourseTitle tid ssh csh $ CI.original examName

  siteLayoutMsg heading $ do
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@ -4,7 +4,7 @@ module Handler.Exam.Users
  ( getEUsersR, postEUsersR
  ) where

-import Import
+import Import hiding ((<.), (.>))

 import Handler.Utils
 import Handler.Utils.Exam
@ -18,11 +18,13 @@ import Database.Esqueleto.Utils.TH

 import qualified Data.Csv as Csv

-import Data.Map ((!))
+import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.HashMap.Lazy as HashMap

 import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Lens as Text

 import qualified Data.Conduit.List as C
@ -33,9 +35,31 @@ import Numeric.Lens (integral)

 import Database.Persist.Sql (deleteWhereCount, updateWhereCount)

+import Control.Lens.Indexed ((<.), (.>))

-type ExamUserTableExpr = (E.SqlExpr (Entity ExamRegistration) `E.InnerJoin` E.SqlExpr (Entity User)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence)) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity CourseParticipant)) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)))) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
-type ExamUserTableData = DBRow (Entity ExamRegistration, Entity User, Maybe (Entity ExamOccurrence), Maybe (Entity StudyFeatures), Maybe (Entity StudyDegree), Maybe (Entity StudyTerms), Maybe (Entity ExamResult), Maybe (Entity CourseUserNote))
+
+type ExamUserTableExpr = (              E.SqlExpr (Entity ExamRegistration)
+                          `E.InnerJoin` E.SqlExpr (Entity User)
+                         )
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence))
+       `E.LeftOuterJoin` (                  E.SqlExpr (Maybe (Entity CourseParticipant))
+                          `E.LeftOuterJoin` (              E.SqlExpr (Maybe (Entity StudyFeatures))
+                                             `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
+                                             `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
+                                            )
+                         )
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult))
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
+type ExamUserTableData = DBRow ( Entity ExamRegistration
+                               , Entity User
+                               , Maybe (Entity ExamOccurrence)
+                               , Maybe (Entity StudyFeatures)
+                               , Maybe (Entity StudyDegree)
+                               , Maybe (Entity StudyTerms)
+                               , Maybe (Entity ExamResult)
+                               , Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult))
+                               , Maybe (Entity CourseUserNote)
+                               )

 instance HasEntity ExamUserTableData User where
  hasEntity = _dbrOutput . _2
@ -91,8 +115,32 @@ resultExamOccurrence = _dbrOutput . _3 . _Just
 resultExamResult :: Traversal' ExamUserTableData (Entity ExamResult)
 resultExamResult = _dbrOutput . _7 . _Just

+resultExamParts :: IndexedTraversal' ExamPartId ExamUserTableData (ExamPart, Maybe (Entity ExamPartResult))
+resultExamParts = _dbrOutput . _8 . itraversed
+
+-- resultExamParts' :: Traversal' ExamUserTableData (Entity ExamPart)
+-- resultExamParts' = (resultExamParts <. _1) . withIndex . from _Entity
+
+-- resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult))
+-- resultExamPartResult epId = _dbrOutput . _8 . unsafeSingular (ix epId) . _2
+
+-- resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult))
+-- resultExamPartResults = resultExamParts <. _2
+
 resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote)
-resultCourseNote = _dbrOutput . _8 . _Just
+resultCourseNote = _dbrOutput . _9 . _Just
+
+
+csvExamPartHeader :: Prism' Csv.Name ExamPartNumber
+csvExamPartHeader = prism' toHeader fromHeader
+  where
+    toHeader pName = encodeUtf8 $ partPrefix <> CI.foldedCase (pName ^. _ExamPartNumber)
+    fromHeader hdr = do
+      tHdr <- either (const Nothing) Just $ Text.decodeUtf8' hdr
+      review _ExamPartNumber . CI.mk <$> stripPrefix partPrefix tHdr
+
+    partPrefix = "part-"
+  

 data ExamUserTableCsv = ExamUserTableCsv
  { csvEUserSurname :: Maybe Text
@ -107,20 +155,38 @@ data ExamUserTableCsv = ExamUserTableCsv
  , csvEUserExerciseNumPasses :: Maybe Int
  , csvEUserExercisePointsMax :: Maybe Points
  , csvEUserExerciseNumPassesMax :: Maybe Int
+  , csvEUserExamPartResults :: Map ExamPartNumber (Maybe ExamResultPoints)
  , csvEUserExamResult :: Maybe ExamResultPassedGrade
  , csvEUserCourseNote :: Maybe Html
  }
  deriving (Generic)
 makeLenses_ ''ExamUserTableCsv

-examUserTableCsvOptions :: Csv.Options
-examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
-
 instance ToNamedRecord ExamUserTableCsv where
-  toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions
+  toNamedRecord ExamUserTableCsv{..} = Csv.namedRecord $
+    [ "surname" Csv..= csvEUserSurname
+    , "first-name" Csv..= csvEUserFirstName
+    , "name" Csv..= csvEUserName
+    , "matriculation" Csv..= csvEUserMatriculation
+    , "field" Csv..= csvEUserField
+    , "degree" Csv..= csvEUserDegree
+    , "semester" Csv..= csvEUserSemester
+    , "occurrence" Csv..= csvEUserOccurrence
+    , "exercise-points" Csv..= csvEUserExercisePoints
+    , "exercise-num-passes" Csv..= csvEUserExerciseNumPasses
+    , "exercise-points-max" Csv..= csvEUserExercisePointsMax
+    , "exercise-num-passes-max" Csv..= csvEUserExerciseNumPassesMax
+    ] ++ examPartResults ++
+    [ "exam-result" Csv..= csvEUserExamResult
+    , "course-note" Csv..= csvEUserCourseNote
+    ]
+    where
+      examPartResults
+        = flip ifoldMap csvEUserExamPartResults $
+            \pNumber pResult -> pure $ (csvExamPartHeader # pNumber) Csv..= pResult

 instance FromNamedRecord ExamUserTableCsv where
-  parseNamedRecord csv -- Manually defined awaiting issue #427
+  parseNamedRecord csv
    = ExamUserTableCsv
      <$> csv .:?? "surname"
      <*> csv .:?? "first-name"
@ -134,29 +200,49 @@ instance FromNamedRecord ExamUserTableCsv where
      <*> csv .:?? "exercise-num-passes"
      <*> csv .:?? "exercise-points-max"
      <*> csv .:?? "exercise-num-passes-max"
+      <*> examPartResults
      <*> csv .:?? "exam-result"
      <*> csv .:?? "course-note"
-
-instance DefaultOrdered ExamUserTableCsv where
-  headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions
+    where
+      examPartResults = fmap fold . sequence . flip HashMap.mapMaybeWithKey csv $ \pNumber' _ -> do
+        pNumber <- pNumber' ^? csvExamPartHeader
+        return . fmap (singletonMap pNumber ) $ csv .:?? pNumber'

 instance CsvColumnsExplained ExamUserTableCsv where
-  csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
-    [ ('csvEUserSurname             , MsgCsvColumnExamUserSurname           )
-    , ('csvEUserFirstName           , MsgCsvColumnExamUserFirstName         )
-    , ('csvEUserName                , MsgCsvColumnExamUserName              )
-    , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation     )
-    , ('csvEUserField               , MsgCsvColumnExamUserField             )
-    , ('csvEUserDegree              , MsgCsvColumnExamUserDegree            )
-    , ('csvEUserSemester            , MsgCsvColumnExamUserSemester          )
-    , ('csvEUserOccurrence          , MsgCsvColumnExamUserOccurrence        )
-    , ('csvEUserExercisePoints      , MsgCsvColumnExamUserExercisePoints    )
-    , ('csvEUserExerciseNumPasses   , MsgCsvColumnExamUserExercisePasses    )
-    , ('csvEUserExercisePointsMax   , MsgCsvColumnExamUserExercisePointsMax )
-    , ('csvEUserExerciseNumPassesMax, MsgCsvColumnExamUserExercisePassesMax )
-    , ('csvEUserExamResult          , MsgCsvColumnExamUserResult            )
-    , ('csvEUserCourseNote          , MsgCsvColumnExamUserCourseNote        )
+  csvColumnsExplanations _ = mconcat
+    [ single "surname"                 MsgCsvColumnExamUserSurname
+    , single "first-name"              MsgCsvColumnExamUserFirstName
+    , single "name"                    MsgCsvColumnExamUserName
+    , single "matriculation"           MsgCsvColumnExamUserMatriculation
+    , single "field"                   MsgCsvColumnExamUserField
+    , single "degree"                  MsgCsvColumnExamUserDegree
+    , single "semester"                MsgCsvColumnExamUserSemester
+    , single "occurrence"              MsgCsvColumnExamUserOccurrence
+    , single "exercise-points"         MsgCsvColumnExamUserExercisePoints
+    , single "exercise-num-passes"     MsgCsvColumnExamUserExercisePasses
+    , single "exercise-points-max"     MsgCsvColumnExamUserExercisePointsMax
+    , single "exercise-num-passes-max" MsgCsvColumnExamUserExercisePassesMax
+    , single "exam-result"             MsgCsvColumnExamUserResult
+    , single "course-note"             MsgCsvColumnExamUserCourseNote
    ]
+    where
+      single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
+      single k v = singletonMap k [whamlet|_{v}|]
+
+examUserTableCsvHeader :: ( MonoFoldable mono
+                          , Element mono ~ ExamPartNumber
+                          )
+                       => mono -> Csv.Header
+examUserTableCsvHeader pNames = Csv.header $
+  [ "surname", "first-name", "name"
+  , "matriculation"
+  , "field", "degree", "semester"
+  , "course-note"
+  , "occurrence"
+  , "exercise-points", "exercise-num-passes", "exercise-points-max", "exercise-num-passes-max"
+  ] ++ map (review csvExamPartHeader) (sort $ otoList pNames) ++
+  [ "exam-result"
+  ]

 data ExamUserAction = ExamUserDeregister
                    | ExamUserAssignOccurrence
@ -175,7 +261,9 @@ data ExamUserCsvActionClass
  | ExamUserCsvRegister
  | ExamUserCsvAssignOccurrence
  | ExamUserCsvSetCourseField
+  | ExamUserCsvSetPartResult
  | ExamUserCsvSetResult
+  | ExamUserCsvOverrideResult
  | ExamUserCsvSetCourseNote
  | ExamUserCsvDeregister
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
@ -202,8 +290,14 @@ data ExamUserCsvAction
  | ExamUserCsvDeregisterData
    { examUserCsvActRegistration :: ExamRegistrationId
    }
-  | ExamUserCsvSetResultData
+  | ExamUserCsvSetPartResultData
    { examUserCsvActUser :: UserId
+    , examUserCsvActExamPart :: ExamPartNumber
+    , examUserCsvActExamPartResult :: Maybe ExamResultPoints
+    }
+  | ExamUserCsvSetResultData
+    { examUserCsvIsResultOverride :: Bool
+    , examUserCsvActUser :: UserId
    , examUserCsvActExamResult :: Maybe ExamResultPassedGrade
    }
  | ExamUserCsvSetCourseNoteData
@ -232,6 +326,7 @@ getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
  ((registrationResult, examUsersTable), Entity eId _) <- runDB $ do
    exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn
+    examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
    bonus <- examBonus exam

    let
@ -242,6 +337,8 @@ postEUsersR tid ssh csh examn = do
      resultView :: ExamResultGrade -> ExamResultPassedGrade
      resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades

+      examPartNumbers = examParts ^.. folded . _entityVal . _examPartNumber
+
    csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn)

    let
@ -263,7 +360,25 @@ postEUsersR tid ssh csh examn = do
            E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid
            return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField, examResult, courseUserNote)
          dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
-          dbtProj = return
+          dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
+            (,,,,,,,,)
+              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7
+              <*> getExamParts
+              <*> view _8
+            where
+              getExamParts :: ReaderT _ (MaybeT (YesodDB UniWorX)) (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
+              getExamParts = do
+                uid <- view $ _2 . _entityKey
+                rawResults <- lift . lift . E.select . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> do
+                  E.on $ examPartResult E.?. ExamPartResultExamPart E.==. E.just (examPart E.^. ExamPartId)
+                   E.&&. examPartResult E.?. ExamPartResultUser     E.==. E.just (E.val uid)
+                  E.where_ $ examPart E.^. ExamPartExam E.==. E.val eid
+                  return (examPart, examPartResult)
+                return $ Map.fromList
+                  [ (epId, (examPart, mbRes))
+                  | (Entity epId examPart, mbRes) <- rawResults
+                  ]
+            
          dbtColonnade = mconcat $ catMaybes
            [ pure $ dbSelect (applying _2) id $ return . view (resultExamRegistration . _entityKey)
            , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
@ -359,21 +474,30 @@ postEUsersR tid ssh csh examn = do
            }
          dbtIdent :: Text
          dbtIdent = "exam-users"
-          dbtCsvEncode = simpleCsvEncode csvName $ ExamUserTableCsv
-            <$> view (resultUser . _entityVal . _userSurname . to Just)
-            <*> view (resultUser . _entityVal . _userFirstName . 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 . _achievedPasses . _Wrapped . integral)
-            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
-            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
-            <*> preview (resultExamResult . _entityVal . _examResultResult . to resultView)
-            <*> preview (resultCourseNote . _entityVal . _courseUserNoteNote)
+          dbtCsvEncode = Just DBTCsvEncode
+            { dbtCsvExportForm   = pure ()
+            , dbtCsvDoEncode     = \() -> C.map (doEncode' . view _2)
+            , dbtCsvName         = unpack csvName
+            , dbtCsvNoExportData = Just id
+            , dbtCsvHeader       = const . return . examUserTableCsvHeader $ examParts ^.. folded . _entityVal . _examPartNumber
+            }
+            where
+              doEncode' = ExamUserTableCsv
+                <$> view (resultUser . _entityVal . _userSurname . to Just)
+                <*> view (resultUser . _entityVal . _userFirstName . 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 . _achievedPasses . _Wrapped . integral)
+                <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
+                <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
+                <*> (Map.fromList . map (over _1 examPartNumber . over (_2 . _Just) (examPartResultResult . entityVal)) <$> asks (toListOf resultExamParts))
+                <*> preview (resultExamResult . _entityVal . _examResultResult . to resultView)
+                <*> preview (resultCourseNote . _entityVal . _courseUserNoteNote)
          dbtCsvDecode = Just DBTCsvDecode
            { dbtCsvRowKey = \csv -> do
                uid <- lift $ view _2 <$> guessUser csv
@ -394,8 +518,13 @@ postEUsersR tid ssh csh examn = do
                          yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
                    | otherwise ->
                        yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupStudyFeatures dbCsvNew <*> lookupOccurrence dbCsvNew
+
+                  iforMOf_ (ifolded <. _Just) (csvEUserExamPartResults dbCsvNew) $ \epNumber epRes ->
+                    when (epNumber `elem` examPartNumbers) $
+                      yield $ ExamUserCsvSetPartResultData uid epNumber (Just epRes)
+            
                  when (is _Just $ csvEUserExamResult dbCsvNew) $
-                    yield . ExamUserCsvSetResultData uid $ csvEUserExamResult dbCsvNew
+                    yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew

                  note <- lift . getBy $ UniqueCourseUserNote uid examCourse
                  when (csvEUserCourseNote dbCsvNew /= note ^? _Just . _entityVal . _courseUserNoteNote) $
@ -410,8 +539,38 @@ postEUsersR tid ssh csh examn = do
                    Just (Entity cpId _) <- lift . getBy . flip UniqueParticipant examCourse $ dbCsvOld ^. resultUser . _entityKey
                    yield $ ExamUserCsvSetCourseFieldData cpId newFeatures

-                  when (csvEUserExamResult dbCsvNew /= dbCsvOld ^? resultExamResult . _entityVal . _examResultResult . to resultView) $
-                    yield . ExamUserCsvSetResultData (dbCsvOld ^. resultUser . _entityKey) $ csvEUserExamResult dbCsvNew
+                  let uid = dbCsvOld ^. resultUser . _entityKey
+
+                  forM_ examPartNumbers $ \epNumber ->
+                    let oldPartResult = dbCsvOld ^? resultExamParts . filtered (views (_1 . _examPartNumber) (== epNumber)) . _2 . _Just . _entityVal . _examPartResultResult
+                     in whenIsJust (csvEUserExamPartResults dbCsvNew !? epNumber) $ \epRes ->
+                          when (epRes /= oldPartResult) $
+                            yield $ ExamUserCsvSetPartResultData uid epNumber epRes
+
+                  let newResults :: Map ExamPartNumber (Maybe ExamResultPoints)
+                      newResults = csvEUserExamPartResults dbCsvNew
+                       `Map.union` toMapOf (resultExamParts .> ito (over _1 $ examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld
+
+                      newGrade :: Maybe ExamResultPassedGrade
+                      newGrade = do
+                        possible <- examBonusPossible uid bonus
+                        achieved <- examBonusAchieved uid bonus
+                        resultView <$> examGrade exam possible achieved (newResults ^.. folded . _Just)
+
+                      oldResult = dbCsvOld ^? resultExamResult . _entityVal . _examResultResult . to resultView
+                  
+                  case newGrade of
+                    _ | csvEUserExamResult dbCsvNew == oldResult
+                        -> return ()
+                    Nothing
+                      -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
+                    Just _
+                      | csvEUserExamResult dbCsvNew /= newGrade
+                        -> yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew
+                      | oldResult /= newGrade
+                        -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
+                      | otherwise
+                        -> return ()

                  when (csvEUserCourseNote dbCsvNew /= dbCsvOld ^? resultCourseNote . _entityVal . _courseUserNoteNote) $
                    yield . ExamUserCsvSetCourseNoteData (dbCsvOld ^. resultUser . _entityKey) $ csvEUserCourseNote dbCsvNew
@ -421,7 +580,10 @@ postEUsersR tid ssh csh examn = do
                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
-                ExamUserCsvSetResultData{}        -> ExamUserCsvSetResult
+                ExamUserCsvSetPartResultData{}    -> ExamUserCsvSetPartResult
+                ExamUserCsvSetResultData{..}
+                  | examUserCsvIsResultOverride   -> ExamUserCsvOverrideResult
+                  | otherwise                     -> ExamUserCsvSetResult
                ExamUserCsvSetCourseNoteData{}    -> ExamUserCsvSetCourseNote
            , dbtCsvCoarsenActionClass = \case
                ExamUserCsvCourseRegister -> DBCsvActionNew
@ -462,6 +624,21 @@ postEUsersR tid ssh csh examn = do
                    update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
                    CourseParticipant{..} <- getJust examUserCsvActCourseParticipant
                    audit $ TransactionCourseParticipantEdit examCourse courseParticipantUser
+                  ExamUserCsvSetPartResultData{..} -> do
+                    epid <- getKeyJustBy $ UniqueExamPartNumber eid examUserCsvActExamPart
+                    case examUserCsvActExamPartResult of
+                      Nothing  -> do
+                        deleteBy $ UniqueExamPartResult epid examUserCsvActUser
+                        audit $ TransactionExamPartResultDeleted epid examUserCsvActUser
+                      Just res -> do
+                        now <- liftIO getCurrentTime
+                        void $ upsertBy
+                          (UniqueExamPartResult epid examUserCsvActUser)
+                          (ExamPartResult epid examUserCsvActUser res now)
+                          [ ExamPartResultResult =. res
+                          , ExamPartResultLastChanged =. now
+                          ]
+                        audit $ TransactionExamPartResultEdit epid examUserCsvActUser
                  ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of
                    Nothing  -> do
                      deleteBy $ UniqueExamResult eid examUserCsvActUser
@ -540,6 +717,19 @@ postEUsersR tid ssh csh examn = do
                    $nothing
                      , _{MsgCourseStudyFeatureNone}
                  |]
+                ExamUserCsvSetPartResultData{..} -> do
+                  (User{..}, Entity _ ExamPart{..}) <- liftHandlerT . runDB $
+                    (,) <$> getJust examUserCsvActUser
+                        <*> getJustBy (UniqueExamPartNumber eid examUserCsvActExamPart)
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    , „#{examPartName}“
+                    $maybe newResult <- examUserCsvActExamPartResult
+                      , _{newResult}
+                    $nothing
+                      , _{MsgExamResultNone}
+                  |]
                ExamUserCsvSetResultData{..} -> do
                  User{..} <- liftHandlerT . runDB $ getJust examUserCsvActUser
                  [whamlet|
--- a/src/Handler/ExamOffice/Exam.hs
+++ b/src/Handler/ExamOffice/Exam.hs
@ -408,6 +408,7 @@ postEGradesR tid ssh csh examn = do
                  (row ^. resultExamResult . _entityVal . _examResultResult . to (fmap $ bool (Left . view passingGrade) Right examShowGrades))
            , dbtCsvName = unpack csvName
            , dbtCsvNoExportData = Nothing
+            , dbtCsvHeader = const . return $ Csv.headerOrder (error "headerOrder" :: ExamUserTableCsv)
            }
          dbtCsvDecode = Nothing

--- a/src/Handler/Utils/Csv.hs
+++ b/src/Handler/Utils/Csv.hs
@ -4,7 +4,9 @@ module Handler.Utils.Csv
  ( typeCsv, extensionCsv
  , decodeCsv
  , encodeCsv
+  , encodeDefaultOrderedCsv
  , respondCsv, respondCsvDB
+  , respondDefaultOrderedCsv, respondDefaultOrderedCsvDB
  , fileSourceCsv
  , CsvParseError(..)
  , ToNamedRecord(..), FromNamedRecord(..)
@ -12,6 +14,7 @@ module Handler.Utils.Csv
  , ToField(..), FromField(..)
  , CsvRendered(..)
  , toCsvRendered
+  , toDefaultOrderedCsvRendered
  ) where

 import Import hiding (Header, mapM_)
@ -111,30 +114,54 @@ decodeCsv = transPipe throwExceptT $ do
      

 encodeCsv :: ( ToNamedRecord csv
-             , DefaultOrdered csv
             , Monad m
             )
-          => Conduit csv m ByteString
+          => Header
+          -> Conduit csv m ByteString
 -- ^ Encode a stream of records
 --
 -- Currently not streaming
-encodeCsv = fmap encodeDefaultOrderedByName (C.foldMap pure) >>= C.sourceLazy
+encodeCsv hdr = fmap (encodeByName hdr) (C.foldMap pure) >>= C.sourceLazy
+
+encodeDefaultOrderedCsv :: forall csv m.
+                           ( ToNamedRecord csv
+                           , DefaultOrdered csv
+                           , Monad m
+                           )
+                        => Conduit csv m ByteString
+encodeDefaultOrderedCsv = encodeCsv $ headerOrder (error "headerOrder" :: csv)

  
-respondCsv :: ( ToNamedRecord csv
-              , DefaultOrdered csv
-              )
-           => Source (HandlerT site IO) csv
+respondCsv :: ToNamedRecord csv
+           => Header
+           -> Source (HandlerT site IO) csv
           -> HandlerT site IO TypedContent
-respondCsv src = respondSource typeCsv' $ src .| encodeCsv .| awaitForever sendChunk
+respondCsv hdr src = respondSource typeCsv' $ src .| encodeCsv hdr .| awaitForever sendChunk
+
+respondDefaultOrderedCsv :: forall csv site.
+                            ( ToNamedRecord csv
+                            , DefaultOrdered csv
+                            )
+                         => Source (HandlerT site IO) csv
+                         -> HandlerT site IO TypedContent
+respondDefaultOrderedCsv = respondCsv $ headerOrder (error "headerOrder" :: csv)

 respondCsvDB :: ( ToNamedRecord csv
-                , DefaultOrdered csv
                , YesodPersistRunner site
                )
-             => Source (YesodDB site) csv
+             => Header
+             -> Source (YesodDB site) csv
             -> HandlerT site IO TypedContent
-respondCsvDB src = respondSourceDB typeCsv' $ src .| encodeCsv .| awaitForever sendChunk
+respondCsvDB hdr src = respondSourceDB typeCsv' $ src .| encodeCsv hdr .| awaitForever sendChunk
+
+respondDefaultOrderedCsvDB :: forall csv site.
+                              ( ToNamedRecord csv
+                              , DefaultOrdered csv
+                              , YesodPersistRunner site
+                              )
+                           => Source (YesodDB site) csv
+                           -> HandlerT site IO TypedContent
+respondDefaultOrderedCsvDB = respondCsvDB $ headerOrder (error "headerOrder" :: csv)

 fileSourceCsv :: ( FromNamedRecord csv
                 , MonadResource m
@ -166,8 +193,16 @@ toCsvRendered :: forall mono.
                 , DefaultOrdered (Element mono)
                 , MonoFoldable mono
                 )
-              => mono -> CsvRendered
-toCsvRendered (otoList -> csvs) = CsvRendered{..}
+              => Header
+              -> mono -> CsvRendered
+toCsvRendered csvRenderedHeader (otoList -> csvs) = CsvRendered{..}
  where
-    csvRenderedHeader = headerOrder (error "not forced" :: Element mono)
    csvRenderedData   = map toNamedRecord csvs
+  
+toDefaultOrderedCsvRendered :: forall mono.
+                               ( ToNamedRecord (Element mono)
+                               , DefaultOrdered (Element mono)
+                               , MonoFoldable mono
+                               )
+                            => mono -> CsvRendered
+toDefaultOrderedCsvRendered = toCsvRendered $ headerOrder (error "headerOrder" :: Element mono)
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@ -2,6 +2,7 @@ module Handler.Utils.Exam
  ( fetchExamAux
  , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam
  , examBonus, examBonusPossible, examBonusAchieved
+  , examGrade
  ) where

 import Import.NoFoundation
@ -81,3 +82,58 @@ examBonus (Entity eId Exam{..}) = runConduit $
 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
+
+
+examGrade :: ( MonoFoldable mono
+             , Element mono ~ ExamResultPoints
+             )
+          => Entity Exam
+          -> SheetGradeSummary -- ^ `examBonusPossible`
+          -> SheetGradeSummary -- ^ `examBonusAchieved`
+          -> mono -- ^ `ExamPartResult`s
+          -> Maybe ExamResultGrade
+examGrade (Entity _ Exam{..}) bonusPossible bonusAchieved (otoList -> results)
+  | null results
+  = Nothing
+  | otherwise
+  = traverse pointsToGrade achievedPoints'
+  where
+    achievedPoints' :: ExamResultPoints
+    achievedPoints' = withBonus . getSum <$> foldMap (fmap Sum) results
+
+    withBonus :: Points -> Points
+    withBonus ps
+      | ExamBonusPoints{..} <- examBonusRule
+      = if
+          |    not bonusOnlyPassed
+            || fmap (view passingGrade) (pointsToGrade ps) == Just (_Wrapped # True)
+            -> ps + roundToPoints (toRational bonusMaxPoints * bonusProp)
+          | otherwise
+            -> ps
+      | otherwise
+      = ps
+      where
+        bonusProp :: Rational
+        bonusProp = clamp 0 1 $ toRational (getSum (achievedPoints bonusAchieved) + scalePasses (getSum $ achievedPasses bonusAchieved))
+                              / toRational (getSum (sumSheetsPoints bonusPossible) + scalePasses (getSum $ numSheetsPasses bonusPossible))
+          where
+            scalePasses :: Integer -> Points
+            -- ^ Rescale passes so count of all sheets with pass is worth as many points as sum of all sheets with points
+            scalePasses passes = fromInteger passes / (fromInteger . getSum $ numSheetsPasses bonusPossible) * (getSum $ sumSheetsPoints bonusPossible)
+
+        roundToPoints :: forall a. HasResolution a => Rational -> Fixed a
+        roundToPoints = MkFixed . round . ((*) . toRational $ resolution (Proxy @a))
+    
+    pointsToGrade :: Points -> Maybe ExamGrade
+    pointsToGrade ps
+      | ExamGradingKey{..} <- examGradingRule
+      = Just $ gradeFromKey examGradingKey
+      | otherwise
+      = Nothing
+      where
+        gradeFromKey :: [Points] -> ExamGrade
+        gradeFromKey examGradingKey' = maximum $ impureNonNull [ g | (g, b) <- lowerBounds, b <= clampMin 0 ps ]
+          where
+            lowerBounds :: [(ExamGrade, Points)]
+            lowerBounds = zip [Grade50, Grade40 ..] $ 0 : examGradingKey'
+        
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -111,6 +111,8 @@ import qualified Control.Monad.Catch as Catch

 import Data.Dynamic

+import qualified Data.Csv as Csv
+

 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@ -513,17 +515,18 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)


 data DBTCsvEncode r' k' csv = forall exportData.
-  ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+  ( ToNamedRecord csv, CsvColumnsExplained csv
  , DBTableKey k'
  , Typeable exportData
  ) => DBTCsvEncode
  { dbtCsvExportForm   :: AForm (YesodDB UniWorX) exportData
+  , dbtCsvHeader       :: Maybe exportData -> YesodDB UniWorX Csv.Header -- ^ @exportData@ is @Nothing@, if we're reporting an error
  , dbtCsvDoEncode     :: exportData -> Conduit (k', r') (YesodDB UniWorX) csv
  , dbtCsvName         :: FilePath
  , dbtCsvNoExportData :: Maybe (AnIso' exportData ())
  }
 data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
-  ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
+  ( FromNamedRecord csv, ToNamedRecord csv
  , DBTableKey k'
  , RedirectUrl UniWorX route
  , Typeable csv
@ -566,7 +569,8 @@ type DBFilterUI = Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
 noCsvEncode :: Maybe (DBTCsvEncode r' k' Void)
 noCsvEncode = Nothing

-simpleCsvEncode :: ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+simpleCsvEncode :: forall fp r' k' csv.
+                   ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
                   , DBTableKey k'
                   , Textual fp
                   )
@ -576,9 +580,11 @@ simpleCsvEncode fName f = Just DBTCsvEncode
  , dbtCsvDoEncode     = \() -> C.map (f . view _2)
  , dbtCsvName         = unpack fName
  , dbtCsvNoExportData = Just id
+  , dbtCsvHeader       = const . return $ headerOrder (error "headerOrder" :: csv)
  }

-simpleCsvEncodeM :: ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+simpleCsvEncodeM :: forall fp r' k' csv.
+                    ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
                    , DBTableKey k'
                    , Textual fp
                    )
@ -588,6 +594,7 @@ simpleCsvEncodeM fName f = Just DBTCsvEncode
  , dbtCsvDoEncode     = \() -> C.mapM (runReaderT f . view _2)
  , dbtCsvName         = unpack fName
  , dbtCsvNoExportData = Just id
+  , dbtCsvHeader       = const . return $ headerOrder (error "headerOrder" :: csv)
  }


@ -964,11 +971,13 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
    DBCsvExport{..}
      | Just DBTCsvEncode{..} <- dbtCsvEncode
      , Just exportData <- fromDynamic dbCsvExportData -> do
+        hdr <- dbtCsvHeader $ Just exportData
        let ensureExtension ext fName = bool (addExtension ext) id (ext `isExtensionOf` fName) fName
        setContentDisposition' . Just $ ensureExtension (unpack extensionCsv) dbtCsvName
-        sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList (zip currentKeys rows) .| dbtCsvDoEncode exportData >> lift E.transactionSave
+        sendResponse <=< liftHandlerT . respondCsvDB hdr $ C.sourceList (zip currentKeys rows) .| dbtCsvDoEncode exportData >> lift E.transactionSave
    DBCsvImport{..}
-      | Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass
+      | Just DBTCsvEncode{..} <- dbtCsvEncode
+      , Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass
                          , ..
                          } :: DBTCsvDecode r' k' csv) <- dbtCsvDecode -> do
        let existing = Map.fromList $ zip currentKeys rows
@ -1052,14 +1061,14 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db

                  $(widgetFile "csv-import-confirmation-wrapper")

-        let defaultHeaderOrder = headerOrder (error "not to be forced" :: csv)
+        hdr <- dbtCsvHeader Nothing
        catches importCsv
          [ Catch.Handler $ \case
              (DBCsvDuplicateKey{..} :: DBCsvException k')
                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
                     mr <- getMessageRender

-                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
+                     let offendingCsv = CsvRendered hdr [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]

                     siteLayoutMsg heading $ do
@ -1073,7 +1082,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
                     mr <- getMessageRender

-                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvExceptionRow ]
+                     let offendingCsv = CsvRendered hdr [ dbCsvExceptionRow ]
                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvException]

                     siteLayoutMsg heading $ do
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@ -141,7 +141,7 @@ import Control.Lens as Import
  hiding ( (<.>)
         , universe
         , cons, uncons, snoc, unsnoc, (<|)
-         , Index, index, (<.)
+         , Index, index, (<.), (.>)
         )
 import Control.Lens.Extras as Import (is)
 import Data.Set.Lens as Import
--- a/src/Model.hs
+++ b/src/Model.hs
@ -33,13 +33,6 @@ import Text.Blaze (ToMarkup(..))
 share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll'", mkSave "currentModel"]
    $(persistDirectoryWith lowerCaseSettings "models")

-- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only; comments helpful for searching in code
-deriving instance Eq (Unique Course)    -- instance Eq TermSchoolCourseShort; instance Eq TermSchoolCourseName
-deriving instance Eq (Unique Sheet)     -- instance Eq CourseSheet
-deriving instance Eq (Unique Material)  -- instance Eq UniqueMaterial
-deriving instance Eq (Unique Tutorial)  -- instance Eq Tutorial
-deriving instance Eq (Unique Exam)
-

 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@ -47,6 +47,9 @@ import qualified Net.IPv6 as IPv6

 import Data.Aeson (toJSON)

+import qualified Data.Char as Char
+import qualified Data.CaseInsensitive as CI
+
 -- 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)
@ -493,6 +496,33 @@ customMigrations = Map.fromListWith (>>)
          ALTER TABLE "user" ALTER COLUMN "display_email" SET NOT NULL;
        |]
    )
+  , ( AppliedMigrationKey [migrationVersion|20.0.0|] [version|21.0.0|]
+    , whenM (tableExists "exam_part") $ do
+        [executeQQ|
+          ALTER TABLE "exam_part" ADD COLUMN IF NOT EXISTS "number" citext;
+        |]
+
+        let getExamEntries = rawQuery [st|SELECT DISTINCT exam FROM exam_part ORDER BY exam;|] []
+            renameExamParts [fromPersistValue -> Right (eId :: ExamId)] = do
+              partNames' <- [sqlQQ|SELECT id, name FROM "exam_part" WHERE exam = #{eId};|]
+              let
+                partNames :: [(ExamPartId, ExamPartName)]
+                partNames = foldMap (\(Single epId, Single pName) -> singletonMap epId pName) partNames'
+
+                partsSorted = partNames
+                  & sortOn ( map (\x -> maybe (Left x) Right (readMay x :: Maybe Integer))
+                           . groupBy ((==) `on` Char.isDigit)
+                           . CI.foldedCase
+                           . snd
+                           )
+                  & map fst
+              forM_ (zip [_ExamPartNumber' # 1..] partsSorted) $ \(num :: ExamPartNumber, pId) -> 
+                [executeQQ|
+                  UPDATE "exam_part" SET "number" = #{num} WHERE "id" = #{pId};
+                |]
+            renameExamParts _ = return ()
+        runConduit $ getExamEntries .| C.mapM_ renameExamParts
+    )
  ]


--- a/src/Model/Types/Exam.hs
+++ b/src/Model/Types/Exam.hs
@ -6,7 +6,20 @@ Module: Model.Types.Exam
 Description: Types for modeling Exams
 -}
 module Model.Types.Exam
-  ( module Model.Types.Exam
+  ( ExamResult'(..)
+  , _ExamAttended, _ExamNoShow, _ExamVoided
+  , _examResult
+  , ExamBonusRule(..)
+  , ExamOccurrenceRule(..)
+  , ExamGrade(..)
+  , numberGrade
+  , ExamGradingRule(..)
+  , ExamPassed(..)
+  , passingGrade
+  , ExamResultPoints, ExamResultGrade, ExamResultPassed
+  , ExamResultPassedGrade
+  , ExamPartNumber
+  , _ExamPartNumber, _ExamPartNumber'
  ) where

 import Import.NoModel
@ -20,6 +33,15 @@ import qualified Data.Csv as Csv

 import Database.Persist.Sql

+import qualified Data.CaseInsensitive as CI
+import qualified Data.Char as Char
+
+import Text.Read
+
+import Text.Blaze (ToMarkup(..))
+
+import qualified Data.Foldable
+

 data ExamResult' res = ExamAttended { examResult :: res }
                     | ExamNoShow
@ -56,6 +78,12 @@ instance Applicative ExamResult' where
  ExamNoShow     <*> _              = ExamNoShow
  ExamVoided     <*> _              = ExamVoided

+instance Foldable ExamResult' where
+  foldMap = foldMapOf _examResult
+  
+instance Traversable ExamResult' where
+  traverse = _examResult
+
 instance Semigroup res => Semigroup (ExamResult' res) where
  ExamAttended r <> ExamAttended r' = ExamAttended $ r <> r'
  ExamVoided     <> _               = ExamVoided
@ -185,7 +213,7 @@ instance PersistFieldSql ExamGrade where
 data ExamGradingRule
  = ExamGradingManual
  | ExamGradingKey
-    { examGradingKey :: [Points] -- ^ @[n1, n2, n3, ..., n11]@ means @0 <= p < n1 -> p ~= 5@, @n1 <= p < n2 -> p ~ 4.7@, @n2 <= p < n3 -> p ~ 4.3@, ..., @n11 <= p -> p ~ 1.0@
+    { examGradingKey :: [Points] -- ^ @[n1, n2, n3, ..., n11]@ means @0 <= p < n1 -> p ~= 5@, @n1 <= p < n2 -> p ~ 4@, @n2 <= p < n3 -> p ~ 3.7@, ..., @n10 <= p -> p ~ 1.0@
    }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
 deriveJSON defaultOptions
@ -223,3 +251,55 @@ instance Csv.ToField (Either ExamPassed ExamGrade) where

 instance Csv.FromField (Either ExamPassed ExamGrade) where
  parseField x = (Left <$> Csv.parseField x) <|> (Right <$> Csv.parseField x) -- encodings are disjoint
+
+
+newtype ExamPartNumber = ExamPartNumber { examPartNumberFragments :: [Either (CI Text) Natural] }
+  deriving (Eq, Ord, Generic, Typeable)
+
+_ExamPartNumber :: Iso' ExamPartNumber (CI Text)
+_ExamPartNumber = iso pToText pFromText
+  where
+    pToText = foldMap (either id (CI.mk . tshow)) . examPartNumberFragments
+    pFromText = ExamPartNumber . map (\t -> maybe (Left $ CI.mk t) Right $ readMay t) . Text.groupBy ((==) `on` Char.isDigit) . CI.original
+
+_ExamPartNumber' :: Integral n => Prism' ExamPartNumber n
+_ExamPartNumber' = prism (ExamPartNumber . fromNum) (first ExamPartNumber . toNum . examPartNumberFragments)
+  where
+    fromNum (toInteger -> n)
+      | n < 0 = [Left "-", Right . fromInteger $ abs n]
+      | otherwise = [Right $ fromInteger n]
+    
+    toNum fs
+      | Just ns <- mapM (preview _Right) fs
+      = case ns of
+          []  -> Left []
+          [n] -> Right $ fromIntegral n
+          _   -> Right . fromInteger . read $ concatMap show ns
+      | otherwise
+      = Left fs
+
+instance Show ExamPartNumber where
+  showsPrec p = showsPrec p . CI.original . view _ExamPartNumber
+instance Read ExamPartNumber where
+  readPrec = review _ExamPartNumber . CI.mk <$> readPrec 
+
+instance PersistField ExamPartNumber where
+  toPersistValue = toPersistValue . view _ExamPartNumber
+  fromPersistValue = fmap (review _ExamPartNumber) . fromPersistValue
+instance PersistFieldSql ExamPartNumber where
+  sqlType _ = sqlType (Proxy @(CI Text))
+
+instance PathPiece ExamPartNumber where
+  toPathPiece = toPathPiece . view _ExamPartNumber
+  fromPathPiece = fmap (review _ExamPartNumber) . fromPathPiece
+
+instance ToMarkup ExamPartNumber where
+  toMarkup = toMarkup . view _ExamPartNumber
+
+pathPieceCsv ''ExamPartNumber
+pathPieceJSON ''ExamPartNumber
+pathPieceJSONKey ''ExamPartNumber
+
+instance Enum ExamPartNumber where
+  toEnum = review _ExamPartNumber' . toEnum
+  fromEnum = maybe (error "Converting non-numeric ExamPartNumber to Int") fromEnum . preview _ExamPartNumber'
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -962,3 +962,21 @@ type DictMaybe constr a = Maybe (Dict constr, a)

 pattern DictJust :: constr => a -> DictMaybe constr a
 pattern DictJust a = Just (Dict, a)
+
+-------------
+-- Ord --
+-------------
+
+clamp :: Ord a
+      => a -- ^ Minimum
+      -> a -- ^ Maximum
+      -> a -- ^ Value
+      -> a -- ^ Clamped Value
+clamp minVal maxVal = clampMin minVal . clampMax maxVal
+
+clampMin, clampMax :: Ord a
+                   => a -- ^ Boundary
+                   -> a -- ^ Value
+                   -> a -- ^ Clamped Value
+clampMin minVal = max minVal
+clampMax maxVal = min maxVal
--- a/src/Utils/DB.hs
+++ b/src/Utils/DB.hs
@ -26,6 +26,12 @@ emptyOrIn criterion testSet
 entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
 entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty

+getJustBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m, MonadThrow m, Show (Unique record))
+          => Unique record -> ReaderT backend m (Entity record)
+getJustBy u = getBy u >>= maybe
+  (throwM . PersistForeignConstraintUnmet $ tshow u)
+  return
+
 getKeyBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
         => Unique record -> ReaderT backend m (Maybe (Key record))
 getKeyBy u = fmap entityKey <$> getBy u -- TODO optimize this, so that DB does not deliver entire record!
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -167,6 +167,8 @@ makeLenses_ ''Invitation
 makeLenses_ ''ExamBonusRule
 makeLenses_ ''ExamGradingRule
 makeLenses_ ''ExamResult
+makeLenses_ ''ExamPart
+makeLenses_ ''ExamPartResult

 makeLenses_ ''UTCTime

--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@ -138,24 +138,30 @@ $if gradingShown && not (null examParts)
    <table .table .table--striped .table--hover >
      <thead>
        <tr .table__row .table__row--head>
+          <th .table__th>_{MsgExamPartNumber}
          <th .table__th>_{MsgExamPartName}
-          <th .table__th>_{MsgExamPartMaxPoints}
-          <th .table__th>_{MsgExamPartResultPoints}
+          $if showMaxPoints
+            <th .table__th>_{MsgExamPartMaxPoints}
+          $if showAchievedPoints
+            <th .table__th>_{MsgExamPartResultPoints}
      <tbody>
-        $forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- examParts
+        $forall Entity partId ExamPart{examPartNumber, examPartName, examPartWeight, examPartMaxPoints} <- examParts
          <tr .table__row>
+            <td .table__td>#{examPartNumber}
            <td .table__td>#{examPartName}
-            <td .table__td>
-              $maybe mPoints <- examPartMaxPoints
-                #{showFixed True (fromRational examPartWeight * mPoints)}
-            <td .table__td>
-              $case fmap (examPartResultResult . entityVal) (results !? partId)
-                $of Nothing
-                $of Just (ExamAttended ps)
-                  #{showFixed True ps}
-                $of Just ExamNoShow
-                  _{MsgExamNoShow}
-                $of Just ExamVoided
-                  _{MsgExamVoided}
+            $if showMaxPoints
+              <td .table__td>
+                $maybe mPoints <- examPartMaxPoints
+                  #{showFixed True (fromRational examPartWeight * mPoints)}
+            $if showAchievedPoints
+              <td .table__td>
+                $case fmap (examPartResultResult . entityVal) (results !? partId)
+                  $of Nothing
+                  $of Just (ExamAttended ps)
+                    #{showFixed True ps}
+                  $of Just ExamNoShow
+                    _{MsgExamNoShow}
+                  $of Just ExamVoided
+                    _{MsgExamVoided}

 $# TODO: Statistics
--- a/templates/widgets/massinput/examParts/form.hamlet
+++ b/templates/widgets/massinput/examParts/form.hamlet
@ -1,4 +1,5 @@
 $newline never
-<td>#{csrf}^{fvInput epfIdView}^{fvInput epfNameView}
+<td>#{csrf}^{fvInput epfIdView}^{fvInput epfNumberView}
+<td>^{fvInput epfNameView}
 <td>^{fvInput epfMaxPointsView}
 <td>^{fvInput epfWeightView}
--- a/templates/widgets/massinput/examParts/layout.hamlet
+++ b/templates/widgets/massinput/examParts/layout.hamlet
@ -1,10 +1,27 @@
 $newline never
 <table>
  <thead>
-    <th>_{MsgExamPartName}
-    <th>_{MsgExamPartMaxPoints}
-    <th>_{MsgExamPartWeight}
-    <td>
+    <tr>
+      <th>
+        _{MsgExamPartNumber} #
+        <span .form-group__required-marker>
+      <th>
+        _{MsgExamPartName} #
+        <span .form-group__required-marker>
+      <th>_{MsgExamPartMaxPoints}
+      <th>
+        _{MsgExamPartWeight} #
+        <span .form-group__required-marker>
+      <td>
+    <tr .form-group__hint>
+      <td>
+        _{MsgExamPartNumberTip}
+      <td>
+        _{MsgExamPartNameTip}
+      <td>
+      <td>
+        _{MsgExamPartWeightTip}
+      <td>
  <tbody>
    $forall coord <- review liveCoords lLength
      <tr .massinput__cell>
--- a/templates/widgets/massinput/examRooms/layout.hamlet
+++ b/templates/widgets/massinput/examRooms/layout.hamlet
@ -1,13 +1,22 @@
 $newline never
 <table>
  <thead>
-    <th>_{MsgExamRoomName}
-    <th>_{MsgExamRoom}
-    <th>_{MsgExamRoomCapacity}
-    <th>_{MsgExamRoomStart}
-    <th>_{MsgExamRoomEnd}
-    <th>_{MsgExamRoomDescription}
-    <td>
+    <tr>
+      <th>
+        _{MsgExamRoomName} #
+        <span .form-group__required-marker>
+      <th>
+        _{MsgExamRoom} #
+        <span .form-group__required-marker>
+      <th>
+        _{MsgExamRoomCapacity} #
+        <span .form-group__required-marker>
+      <th>
+        _{MsgExamRoomStart} #
+        <span .form-group__required-marker>
+      <th>_{MsgExamRoomEnd}
+      <th>_{MsgExamRoomDescription}
+      <td>
  <tbody>
    $forall coord <- review liveCoords lLength
      <tr .massinput__cell>