Merge branch 'feat/exam-sheets'

2021-01-18 20:44:50 +01:00 · 2021-01-18 20:44:50 +01:00 · 4061fb5c3a
commit 4061fb5c3a
parent 04f69eb48c 00825edbfe
52 changed files with 542 additions and 208 deletions
--- a/frontend/src/app.sass
+++ b/frontend/src/app.sass
@ -461,7 +461,7 @@ input[type="button"].btn-info:not(.btn-link):hover,
  overflow-y: auto
 .table--vertical
-  th
+  th, .table__th
    background-color: transparent
    color: var(--color-font)
    width: 170px
@ -469,7 +469,16 @@ input[type="button"].btn-info:not(.btn-link):hover,
    padding-right: 15px
    font-weight: 400
-  td
+    a
      color: var(--color-lin)
      &:hover
        color: var(--color-link-hover)
      &::before
        display: none
  td, .table__td
    font-weight: 600
    color: var(--color-font)
--- a/load/Load.hs
+++ b/load/Load.hs
@ -50,13 +50,6 @@ import Data.List (genericLength)
 import qualified Control.Retry as Retry
 instance (a ~ b, Monad m) => Monoid (Kleisli m a b) where
  mempty = Kleisli return
 instance (a ~ b, Monad m) => Semigroup (Kleisli m a b) where
  Kleisli f <> Kleisli g = Kleisli $ f <=< g
 data Normal k = Normal
  { dAvg :: k
  , dRelDev :: Centi
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@ -720,6 +720,8 @@ RatingTime: Korrigiert
 RatingComment: Kommentar
 SubmissionUsers: Studenten
 Rating: Korrektur
 IsRated: Korrigiert
 SheetTypeIsExam: Anrechnung „als Prüfungsaufgabe“
 RatingPoints: Punkte
 RatingDone: Bewertung abgeschlossen
 RatingDoneTip: Das Korrekturergebnis ist nur dann für die Abgebenden sichtbar und kann gegen etwaige Prüfungs-Bonuspunkte verrechnet werden, wenn die Bewertung abgeschlossen ist.
@ -1126,9 +1128,10 @@ SheetGradingPassPoints': Bestehen nach Punkten
 SheetGradingPassBinary': Bestanden/Nicht bestanden
 SheetGradingPassAlways': Automatisch bestanden, sobald korrigiert
-SheetTypeBonus grading@SheetGrading: Bonus
+SheetTypeBonus: Bonus
-SheetTypeNormal grading@SheetGrading: Normal
+SheetTypeNormal: Normal
-SheetTypeInformational grading@SheetGrading: Ohne Anrechnung
+SheetTypeInformational: Ohne Anrechnung
 SheetTypeExamPartPoints: Als Prüfungsaufgabe
 SheetTypeNotGraded: Keine Korrektur
 SheetTypeInfoNormalLecturer: Normale Blätter werden zur Berechnung eines etwaigen Prüfungsbonus herangezogen. Der Bonus kann sowohl anhand der zu bestehenden Blätter als auch der erreichbaren Maximalpunktzahl automatisch oder manuell berechnet werden.
 SheetTypeInfoNotGraded: Keine Korrektur bedeutet, dass es gar kein Feedback gibt.
@ -1138,6 +1141,11 @@ SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den errei
 SummaryTitle: Zusammenfassung über
 SheetGradingSummaryTitle intgr@Integer: #{intgr} #{pluralDE intgr "Blatt" "Blätter"}
 SubmissionGradingSummaryTitle intgr@Integer: #{intgr} #{pluralDE intgr "Abgabe" "Abgaben"}
 SheetTypeExamPartPointsWeightNegative: Gewichtung darf nicht negativ sein
 SheetTypeExamPartPointsWeight: Gewichtung
 SheetTypeExamPartPointsExamPartOption examn@ExamName examPartNumber@ExamPartNumber: #{examn} - Teil #{view _ExamPartNumber examPartNumber}
 SheetTypeInfoExamPartPoints: Bei diesem Übungsblatt erreichte Punkte werden direkt auf die Punktezahl eines Prüfungsteils angerechnet. Wenn die Anzahl von über Übungsblättern erreichbaren Punkten nicht der Maximalpunktzahl des Prüfungsteils entspricht, werden die Übungsblattpunkte anhand der angegebenen Gewichtung skaliert.
 SheetTypeExamPartPointsExamPart: Prüfungsteil
 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal
@ -1998,6 +2006,10 @@ ExamPartMaxPoints: Maximalpunktzahl
 ExamPartWeight: Gewichtung
 ExamPartWeightTip: Wird vor Anzeige oder automatischen Notenberechnung mit der erreichten Punktzahl und der Maximalpunktzahl multipliziert; Änderungen hier passen also auch bestehende Korrekturergebnisse an (derart geänderte Noten müssen erneut manuell übernommen werden)
 ExamPartResultPoints: Erreichte Punkte
 ExamPartSheets: Übungsblätter
 ExamPartsFrom: Teile anzeigen ab
 ExamPartsFromTip: Ab dem gegebenen Zeitpunkt wird die Liste von Prüfungsteilen/Aufgaben veröffentlicht, nicht jedoch die jeweilige Maximalpunktzahl. Ohne Zeitpunkt wird die Liste ab "Ergebnisse sichtbar ab" angezeigt.
 ExamNameTaken exam@ExamName: Es existiert bereits eine Prüfung mit Namen #{exam}
 ExamCreated exam@ExamName: #{exam} erfolgreich angelegt
@ -2035,6 +2047,7 @@ ExamRegistrationMustFollowSchoolSeparationFromStart dayCount@Int: Nach Regeln de
 ExamRegistrationMustFollowSchoolDuration dayCount@Int: Nach Regeln des Instituts #{pluralDE dayCount "muss" "müssen"} zwischen "Anmeldung ab" und "Anmeldung bis" mindestens #{dayCount} #{pluralDE dayCount "Tag" "Tage"} liegen.
 ExamModeRequiredForRegistration: Nach Regeln des Institus muss die "Ausgestaltung der Prüfung" vollständig angegeben sein, bevor "Anmeldung ab" festgelegt werden kann.
 ExamModeSchoolDiscouraged: Nach Regeln des Instituts wird von der angegebenen "Ausgestaltung der Prüfung" abgeraten
 ExamPartsFromMustBeBeforeFinished: "Teile anzeigen ab" muss vor "Ergebnisse sichtbar ab" liegen
 ExamOccurrenceEndMustBeAfterStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss vor seinem Ende liegen
 ExamOccurrenceStartMustBeAfterExamStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss nach Beginn der Prüfung liegen
@ -2043,6 +2056,7 @@ ExamOccurrenceDuplicate eoRoom@Text eoRange@Text: Raum #{eoRoom}, Termin #{eoRan
 ExamOccurrenceDuplicateName eoName@ExamOccurrenceName: Interne Terminbezeichnung #{eoName} kommt mehrfach vor
 ExamOccurrenceCannotBeDeletedDueToRegistrations eoName@ExamOccurrenceName: Termin #{eoName} kann nicht gelöscht werden, da noch Teilnehmer diesem Termin zugewiesen sind. Über die Liste von Prüfungsteilnehmern können Sie zunächst die entsprechenden Terminzuweisungen entfernen.
 ExamPartCannotBeDeletedDueToResults exampartnum@ExamPartNumber: Teil #{exampartnum} kann nicht gelöscht werden, da bereits Prüfungsergebnisse für diesen Teil eingetragen wurden.
 ExamPartCannotBeDeletedDueToSheetReference exampartnum@ExamPartNumber sheetName@SheetName: Teil #{exampartnum} kann nicht gelöscht werden, da Übungsblatt #{sheetName} den Bewertungsmodus „als Prüfungsaufgabe“ trägt.
 VersionHistory: Versionsgeschichte
 KnownBugs: Bekannte Bugs
@ -2056,6 +2070,7 @@ ExamUserAssignOccurrence: Termin/Raum zuweisen
 ExamUserAcceptComputedResult: Berechnetes Prüfungsergebnis übernehmen
 ExamUserResetToComputedResult: Prüfungsergebnis zurücksetzen
 ExamUserResetBonus: Auch Bonuspunkte zurücksetzen
 ExamUserResetParts: Auch Teilergebnisse zurücksetzen
 ExamUserSetPartResult: Teilergebnis setzen
 ExamUserSetBonus: Bonuspunkte setzen
 ExamUserSetResult: Prüfungsergebnis setzen
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@ -717,6 +717,8 @@ RatingTime: Marked
 RatingComment: Comment
 SubmissionUsers: Submittors
 Rating: Marking
 IsRated: Marked
 SheetTypeIsExam: Rating „as an exam part“
 RatingPoints: Points
 RatingDone: Rating finished
 RatingDoneTip: The rating is only visible to the submittors and considered for any exam bonuses if it is finished.
@ -1127,9 +1129,10 @@ SheetGradingPassPoints': Passing by points
 SheetGradingPassBinary': Pass/Fail
 SheetGradingPassAlways': Automatically passed when corrected
-SheetTypeBonus grading: Bonus
+SheetTypeBonus: Bonus
-SheetTypeNormal grading: Normal
+SheetTypeNormal: Normal
-SheetTypeInformational grading: Informational
+SheetTypeInformational: Informational
 SheetTypeExamPartPoints: As an exam part
 SheetTypeNotGraded: Not marked
 SheetTypeInfoNormalLecturer: Normal sheets are used to calculate exam bonuses. Bonuses may be calculated from the number of sheets that can be passed or the maximum number of points achievable either manually or automatically.
 SheetTypeInfoNotGraded: "Not marked" means that there will be no feedback at all.
@ -1139,6 +1142,11 @@ SheetGradingBonusIncluded: Achieved bonus points are already counted among the a
 SummaryTitle: Summary of
 SheetGradingSummaryTitle intgr: #{intgr} #{pluralEN intgr "sheet" "sheets"}
 SubmissionGradingSummaryTitle intgr: #{intgr} #{pluralEN intgr "submission" "submissions"}
 SheetTypeExamPartPointsWeightNegative: Weight may not be negative
 SheetTypeExamPartPointsWeight: Weight
 SheetTypeExamPartPointsExamPartOption examn examPartNumber: #{examn} - Part #{view _ExamPartNumber examPartNumber}
 SheetTypeInfoExamPartPoints: Points achieved in this exercise sheet will be directly applied to the result of an exam part. If the number of points achievable via exercise sheets for an exam part does not match the maximum number of points of that exam part, the points achieved via exercise sheets will be scaled according to their weight.
 SheetTypeExamPartPointsExamPart: Exam part
 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal
@ -1997,6 +2005,10 @@ ExamPartMaxPoints: Maximum points
 ExamPartWeight: Weight
 ExamPartWeightTip: Will be multiplied with the achieved number of points before they are shown to the participant or used in automatic grade computation. Thus this also affects existing exam results (changed exam achievements have to be accepted manually again)
 ExamPartResultPoints: Achieved points
 ExamPartSheets: Exercise sheets
 ExamPartsFrom: Parts visible from
 ExamPartsFromTip: At this time the list of exam parts/questions will be published, but without their respective maximum number of points. If left empty the list will be published with “Results visible from”
 ExamNameTaken exam: There already is an exam named #{exam}
 ExamCreated exam: Successfully created #{exam}
@ -2034,6 +2046,7 @@ ExamRegistrationMustFollowSchoolSeparationFromStart dayCount: As per school rule
 ExamRegistrationMustFollowSchoolDuration dayCount: As per school rules there #{pluralEN dayCount "needs" "need"} to be at least #{dayCount} #{pluralEN dayCount "day" "days"} between "Register from" and "Register to".
 ExamModeRequiredForRegistration: As per school rules "Exam design" needs to be fully specified before "Register from" may be set.
 ExamModeSchoolDiscouraged: As per school rules the specified "Exam design" is discouraged
 ExamPartsFromMustBeBeforeFinished: “Parts visible from” must be before “Results visible from”
 ExamOccurrenceEndMustBeAfterStart eoName: End of the occurrence #{eoName} must be after it's start
 ExamOccurrenceStartMustBeAfterExamStart eoName: Start of the occurrence #{eoName} must be after the exam start
@ -2042,6 +2055,7 @@ ExamOccurrenceDuplicate eoRoom eoRange: Combination of room #{eoRoom} and occurr
 ExamOccurrenceDuplicateName eoName: Internal name #{eoName} occurs multiple times
 ExamOccurrenceCannotBeDeletedDueToRegistrations eoName: Occurrence #{eoName} cannot be deleted because participants are registered for it. You can remove the offending registrations via the list of exam participants.
 ExamPartCannotBeDeletedDueToResults exampartnum: Part #{exampartnum} cannot be deleted because some exam part results were already entered for it.
 ExamPartCannotBeDeletedDueToSheetReference exampartnum sheetName: Part #{exampartnum} cannot be deleted, since exercise sheet #{sheetName} is configured “as an exam part”.
 VersionHistory: Version history
 KnownBugs: Known bugs
@ -2055,6 +2069,7 @@ ExamUserAssignOccurrence: Assign occurrence/room
 ExamUserAcceptComputedResult: Accept computed result
 ExamUserResetToComputedResult: Reset result
 ExamUserResetBonus: Also reset exam bonus
 ExamUserResetParts: Also reset exam part results
 ExamUserSetPartResult: Set exam part result
 ExamUserSetBonus: Set exam bonus
 ExamUserSetResult: Set exam result
--- a/models/exams.model
+++ b/models/exams.model
@ -19,6 +19,7 @@ Exam
  description StoredMarkup Maybe
  examMode ExamMode
  staff Text Maybe
  partsFrom UTCTime Maybe
  UniqueExam course name
 ExamPart
  exam ExamId
@ -28,6 +29,7 @@ ExamPart
  weight Rational
  UniqueExamPartNumber exam number
  UniqueExamPartName exam name !force
  deriving Read Show Eq Ord Generic Typeable
 ExamOccurrence
  exam ExamId
  name ExamOccurrenceName
--- a/models/sheets.model
+++ b/models/sheets.model
@ -2,7 +2,7 @@ Sheet   -- exercise sheet for a given course
    course          CourseId
    name            (CI Text)
    description     StoredMarkup Maybe
-    type            SheetType        -- Does it count towards overall course grade?
+    type            (SheetType SqlBackendKey) -- ExamPartId; Does it count towards overall course grade?
    grouping        SheetGroup       -- May participants submit in groups of certain sizes?
    markingText     StoredMarkup Maybe -- Instructons for correctors, included in marking templates
    visibleFrom     UTCTime Maybe    -- Invisible to enrolled participants before
--- a/src/Control/Arrow/Instances.hs
+++ b/src/Control/Arrow/Instances.hs
@ -0,0 +1,15 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Control.Arrow.Instances
  (
  ) where
 import ClassyPrelude
 import Control.Arrow
 instance (a ~ b, Monad m) => Monoid (Kleisli m a b) where
  mempty = Kleisli return
 instance (a ~ b, Monad m) => Semigroup (Kleisli m a b) where
  Kleisli f <> Kleisli g = Kleisli $ f <=< g
--- a/src/Database/Persist/Types/Instances.hs
+++ b/src/Database/Persist/Types/Instances.hs
@ -1,3 +1,4 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Database.Persist.Types.Instances
@ -22,3 +23,6 @@ deriving instance Typeable PersistValue
 instance Hashable PersistValue
 instance Binary PersistValue
 instance NFData PersistValue
 instance (NFData record, NFData (Key record)) => NFData (Entity record) where
  rnf Entity{..} = rnf entityKey `seq` rnf entityVal
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@ -8,7 +8,7 @@ module Foundation.I18n
  , MsgLanguage(..)
  , ShortSex(..)
  , ShortWeekDay(..)
-  , SheetTypeHeader(..)
+  , SheetType'(..), classifySheetType
  , SheetArchiveFileTypeDirectory(..)
  , ShortStudyDegree(..)
  , ShortStudyTerms(..)
@ -248,22 +248,27 @@ embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials"
 newtype ShortSex = ShortSex Sex
 embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)
-newtype SheetTypeHeader = SheetTypeHeader SheetType
+data SheetType'
-embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)
+  = NotGraded' | Normal' | Bonus' | Informational' | ExamPartPoints'
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving (Universe, Finite)
 classifySheetType :: SheetType a -> SheetType'
 classifySheetType = \case
  NotGraded        -> NotGraded'
  Normal{}         -> Normal'
  Bonus{}          -> Bonus'
  Informational{}  -> Informational'
  ExamPartPoints{} -> ExamPartPoints'
 nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'")
 embedRenderMessage ''UniWorX ''SheetType' $ ("SheetType" <>) . fromMaybe (error "Expected SheetType' to have '") . stripSuffix "'"
 newtype SheetArchiveFileTypeDirectory = SheetArchiveFileTypeDirectory SheetFileType
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving newtype (Enum, Bounded, Universe, Finite)
 embedRenderMessageVariant ''UniWorX ''SheetArchiveFileTypeDirectory $ ("SheetArchiveFileTypeDirectory" <>) . concat . drop 1 . splitCamel
 instance RenderMessage UniWorX SheetType where
  renderMessage foundation ls sheetType = case sheetType of
      NotGraded -> mr $ SheetTypeHeader NotGraded
      other -> mr (grading other) <> ", " <> mr (SheetTypeHeader other)
    where
      mr :: RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls
 instance RenderMessage UniWorX StudyDegree where
  renderMessage _found _ls StudyDegree{..} = fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
--- a/src/Handler/Course/Users.hs
+++ b/src/Handler/Course/Users.hs
@ -85,7 +85,7 @@ type UserTableData = DBRow ( Entity User
                           , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial)))
                           , [Entity Exam]
                           , Maybe (Entity SubmissionGroup)
-                           , Map SheetName (SheetType, Maybe Points)
+                           , Map SheetName (SheetType SqlBackendKey, Maybe Points)
                           , UserTableStudyFeatures
                           )
@ -113,7 +113,7 @@ _userExams = _dbrOutput . _5
 _userSubmissionGroup :: Traversal' UserTableData (Entity SubmissionGroup)
 _userSubmissionGroup = _dbrOutput . _6 . _Just
-_userSheets :: Lens' UserTableData (Map SheetName (SheetType, Maybe Points))
+_userSheets :: Lens' UserTableData (Map SheetName (SheetType SqlBackendKey, Maybe Points))
 _userSheets = _dbrOutput . _7
 _userStudyFeatures :: Lens' UserTableData UserTableStudyFeatures
@ -160,7 +160,7 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns
                      ]
    userSheetCol :: SheetName -> Colonnade Sortable UserTableData (DBCell m c)
-    userSheetCol shn = sortable (Just . SortingKey $ "sheet-" <> shn) (i18nCell shn) . views (_userSheets . at shn) $ \case
+    userSheetCol shn = sortable (Just . SortingKey $ "sheet-" <> shn) (i18nCell shn) $ \dat -> flip (views $ _userSheets . at shn) dat $ \case
      Just (preview _grading -> Just Points{..}, Just points) -> i18nCell $ MsgAchievedOf points maxPoints
      Just (preview _grading -> Just grading', Just points) -> i18nCell . bool MsgNotPassed MsgPassed $ Just True == gradingPassed grading' points
      _other -> mempty
@ -177,7 +177,7 @@ data UserTableCsv = UserTableCsv
  , csvUserNote :: Maybe StoredMarkup
  , csvUserTutorials :: ([TutorialName], Map (CI Text) (Maybe TutorialName))
  , csvUserExams :: [ExamName]
-  , csvUserSheets :: Map SheetName (SheetType, Maybe Points)
+  , csvUserSheets :: Map SheetName (SheetType (), Maybe Points)
  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 makeLenses_ ''UserTableCsv
@ -470,7 +470,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                  <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials)
                  -- <*> (over (_2.traverse._Just) (examName . entityVal) . over (_1.traverse) (examName . entityVal) <$> view _userExams)
                  <*> (over traverse (examName . entityVal) <$> view _userExams)
-                  <*> view _userSheets
+                  <*> views _userSheets (set (mapped . _1 . mapped) ())
            , dbtCsvName = unpack csvName
            , dbtCsvNoExportData = Nothing
            , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
--- a/src/Handler/Exam/Edit.hs
+++ b/src/Handler/Exam/Edit.hs
@ -48,6 +48,7 @@ postEEditR tid ssh csh examn = do
        , examDescription      = efDescription
        , examExamMode         = efExamMode
        , examStaff            = efStaff
        , examPartsFrom        = efPartsFrom
        }
      when (is _Nothing insertRes) $ do
--- a/src/Handler/Exam/Form.hs
+++ b/src/Handler/Exam/Form.hs
@ -26,6 +26,8 @@ import Text.Blaze.Html.Renderer.Text (renderHtml)
 import qualified Data.Text.Lazy as LT
 import qualified Data.Conduit.Combinators as C
 data ExamForm = ExamForm
  { efName :: ExamName
@ -37,6 +39,7 @@ data ExamForm = ExamForm
  , efRegisterTo :: Maybe UTCTime
  , efDeregisterUntil :: Maybe UTCTime
  , efPublishOccurrenceAssignments :: Maybe UTCTime
  , efPartsFrom :: Maybe UTCTime
  , efFinished :: Maybe UTCTime
  , efOccurrences :: Set ExamOccurrenceForm
  , efPublicStatistics :: Bool
@ -121,6 +124,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
    <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template)
    <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template)
    <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template)
    <*> aopt utcTimeField (fslpI MsgExamPartsFrom (mr MsgDate) & setTooltip MsgExamPartsFromTip) (efPartsFrom <$> template)
    <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template)
    <*  aformSection MsgExamFormOccurrences
    <*> examOccurrenceForm (efOccurrences <$> template)
@ -322,6 +326,7 @@ examFormTemplate (Entity eId Exam{..}) = do
    , efRegisterTo       = examRegisterTo
    , efDeregisterUntil  = examDeregisterUntil
    , efPublishOccurrenceAssignments = examPublishOccurrenceAssignments
    , efPartsFrom        = examPartsFrom
    , efStart            = examStart
    , efEnd              = examEnd
    , efFinished         = examFinished
@ -397,6 +402,7 @@ examTemplate cid = runMaybeT $ do
    , efRegisterTo       = dateOffset <$> examRegisterTo oldExam
    , efDeregisterUntil  = dateOffset <$> examDeregisterUntil oldExam
    , efPublishOccurrenceAssignments = dateOffset <$> examPublishOccurrenceAssignments oldExam
    , efPartsFrom        = dateOffset <$> examPartsFrom oldExam
    , efStart            = dateOffset <$> examStart oldExam
    , efEnd              = dateOffset <$> examEnd oldExam
    , efFinished         = dateOffset <$> examFinished oldExam
@ -425,9 +431,10 @@ validateExam cId oldExam = do
  guardValidation MsgExamDeregisterUntilMustBeAfterRegisterFrom            $ NTop efDeregisterUntil              >= NTop efRegisterFrom
  guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      $ Just False /= ((>=) <$> efStart <*> efPublishOccurrenceAssignments)
  guardValidation MsgExamEndMustBeAfterStart                               $ NTop efEnd                          >= NTop efStart
-  guardValidation MsgExamFinishedMustBeAfterEnd   $ Just False /= ((>=) <$> efFinished <*> efEnd)
+  guardValidation MsgExamFinishedMustBeAfterEnd                            $ Just False /= ((>=) <$> efFinished <*> efEnd)
-  guardValidation MsgExamFinishedMustBeAfterStart $ Just False /= ((>=) <$> efFinished <*> efStart)
+  guardValidation MsgExamFinishedMustBeAfterStart                          $ Just False /= ((>=) <$> efFinished <*> efStart)
-
+  guardValidation MsgExamPartsFromMustBeBeforeFinished                     $ NTop efFinished                     >= NTop efPartsFrom
                                                                          || is _Nothing efPartsFrom
  forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
    guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName)       $ NTop eofEnd >= NTop (Just eofStart)
@ -465,8 +472,11 @@ validateExam cId oldExam = do
    return ( examPart E.^. ExamPartId
           , examPart E.^. ExamPartNumber
           )
-  forM_ (join $ hoistMaybe oldPartsWithResults) $ \(E.Value epId, E.Value epNumber) ->
+  forM_ (join $ hoistMaybe oldPartsWithResults) $ \(E.Value epId, E.Value epNumber) -> do
    guardValidationM (MsgExamPartCannotBeDeletedDueToResults epNumber) . anyM (otoList efExamParts) $ \ExamPartForm{..} -> (== Just epId) <$> traverse decrypt epfId
    runConduit $ transPipe lift (selectSource [] [])
              .| C.filter (has $ _entityVal . _sheetType . _examPart . re _SqlKey . only epId)
              .| C.mapM_ (\(Entity _ Sheet{..}) -> guardValidationM (MsgExamPartCannotBeDeletedDueToSheetReference epNumber sheetName) . anyM (otoList efExamParts) $ \ExamPartForm{..} -> (== Just epId) <$> traverse decrypt epfId)
  mSchool <- liftHandler . runDB . E.selectMaybe . E.from $ \(course `E.InnerJoin` school) -> do
--- a/src/Handler/Exam/New.hs
+++ b/src/Handler/Exam/New.hs
@ -50,6 +50,7 @@ postCExamNewR tid ssh csh = do
        , examDescription                  = efDescription
        , examExamMode                     = efExamMode
        , examStaff                        = efStaff
        , examPartsFrom                    = efPartsFrom
        }
      whenIsJust insertRes $ \examid -> do
        insertMany_
--- a/src/Handler/Exam/Show.hs
+++ b/src/Handler/Exam/Show.hs
@ -26,24 +26,34 @@ getEShowR tid ssh csh examn = do
  cTime <- liftIO getCurrentTime
  mUid <- maybeAuthId
-  (Entity eId Exam{..}, School{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools) <- runDB $ do
+  (Entity eId Exam{..}, School{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools, (partsVisible, partsShown)) <- runDB $ do
    exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
    school <- getJust examCourse >>= belongsToJust courseSchool
    lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
    let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
    let gradingVisible = NTop (Just cTime) >= NTop examFinished
-    gradingShown <- or2M (return gradingVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
+        gradingShown = gradingVisible || lecturerInfoShown
    let partsVisible = gradingVisible
                    || NTop (Just cTime) >= NTop examPartsFrom
        partsShown = partsVisible || lecturerInfoShown
    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == ExamRoomFifo
-    occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
+        occurrenceAssignmentsShown = occurrenceAssignmentsVisible || lecturerInfoShown
-    examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
+    sheets <- selectList [ SheetCourse ==. examCourse ] [] 
    let examPartSheets epId = do
          let sheets' = flip filter sheets $ \(Entity _ Sheet{..}) -> has (_examPart . re _SqlKey . only epId) sheetType
          flip filterM sheets' $ \(Entity _ Sheet{..}) -> hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR
    examParts <- fmap (sortOn . view $ _1 . _entityVal . _examPartNumber) $ selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ] >>= traverse (\ep@(Entity epId _) -> (ep,,) <$> encrypt @ExamPartId @UUID epId <*> examPartSheets epId)
    resultsRaw <- for mUid $ \uid ->
      E.select . E.from $ \examPartResult -> do
        E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
-             E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey examParts)
+             E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map (views _1 entityKey) examParts)
        return examPartResult
    let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
@ -83,8 +93,6 @@ getEShowR tid ssh csh examn = do
            sortPred (Entity _ ExamOccurrence{..}, registered', _, showRoom)
              = (Down $ registered' && not mayRegister, examOccurrenceStart, guardOn @Maybe showRoom examOccurrenceRoom)
    lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
    staffInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EGradesR
    extraSchools <- E.select . E.from $ \(school' `E.InnerJoin` examOfficeSchool) -> do
@ -92,7 +100,7 @@ getEShowR tid ssh csh examn = do
      E.where_ $ examOfficeSchool E.^. ExamOfficeSchoolExam E.==. E.val eId
      return school'
-    return (exam, school, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools)
+    return (exam, school, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools, (partsVisible, partsShown))
  let occurrenceNamesShown = lecturerInfoShown
      partNumbersShown = lecturerInfoShown
@ -102,7 +110,7 @@ getEShowR tid ssh csh examn = do
      showRegisteredCount = lecturerInfoShown
      examFinishedMsg = if lecturerInfoShown then MsgExamFinished else MsgExamFinishedParticipant
-      sumMaxPoints = sum [ fromRational examPartWeight * mPoints | Entity _ ExamPart{..} <- examParts, mPoints <- examPartMaxPoints ^.. _Just ]
+      sumMaxPoints = sum [ fromRational examPartWeight * mPoints | (Entity _ ExamPart{..}, _, _) <- examParts, mPoints <- examPartMaxPoints ^.. _Just ]
      sumRegisteredCount = sumOf (folded . _3) occurrences
@ -175,8 +183,9 @@ getEShowR tid ssh csh examn = do
            |]
        | otherwise = Nothing
-      showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
+      showMaxPoints = gradingShown && any (has $ _1 . _entityVal . _examPartMaxPoints . _Just) examParts
-      showAchievedPoints = not $ null results
+      showAchievedPoints = gradingShown && not (null results)
      showPartSheets = any (has $ _3 . folded) examParts
      showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == ExamRoomFifo)
      markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
      showOccurrenceMappingColumn = examOccurrenceRuleAutomatic examOccurrenceRule && occurrenceAssignmentsShown && is _Just examExamOccurrenceMapping
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@ -135,8 +135,8 @@ resultExamParts = _dbrOutput . _6 . itraversed
 resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult))
 resultExamPartResult epId = _dbrOutput . _6 . unsafeSingular (ix epId) . _2
-resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult))
+-- resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult))
-resultExamPartResults = resultExamParts <. _2
+-- resultExamPartResults = resultExamParts <. _2
 resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote)
 resultCourseNote = _dbrOutput . _7 . _Just
@ -145,16 +145,24 @@ resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures
 resultStudyFeatures = _dbrOutput . _8
-resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points
+resultAutomaticExamBonus :: Ord epId => Exam -> Map UserId (SheetTypeSummary epId) -> Fold ExamUserTableData Points
 resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> join $ examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus'))
-resultAutomaticExamResult :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData ExamResultPassedGrade
+resultAutomaticExamResult :: Exam -> Map UserId (SheetTypeSummary ExamPartId) -> Fold ExamUserTableData ExamResultPassedGrade
 resultAutomaticExamResult exam@Exam{..} examBonus' = folding . runReader $ do
-  parts' <- asks $ sequence . toListOf (resultExamPartResults . to (^? _Just . _entityVal . _examPartResultResult))
+  parts' <- asks (itoListOf resultExamParts) >>= mapM (\(epId, (ep, mRes)) -> runMaybeT $ hoistMaybe (mRes ^? _Just . _entityVal . _examPartResultResult)
                                                                                      <|> MaybeT (preview $ resultAutomaticExamPartResult (Entity epId ep) examBonus')
                                                      )
  bonus <- preview $ resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus exam examBonus'
-  let gradeRes = examGrade exam bonus =<< parts'
+  let gradeRes = examGrade exam bonus =<< sequence parts'
  return $ fmap (bool Right (Left . view passingGrade) $ is _ExamGradingPass examGradingMode) <$> gradeRes
 resultAutomaticExamPartResult :: Entity ExamPart -> Map UserId (SheetTypeSummary ExamPartId) -> Fold ExamUserTableData ExamResultPoints
 resultAutomaticExamPartResult epEnt examBonus' = folding . runReader . runMaybeT $ do
  uid <- view $ resultUser . _entityKey
  summary <- hoistMaybe $ Map.lookup uid examBonus'
  hoistMaybe $ sheetExamResult summary epEnt
 csvExamPartHeader :: Prism' Csv.Name ExamPartNumber
 csvExamPartHeader = prism' toHeader fromHeader
@ -294,7 +302,8 @@ data ExamUserActionData = ExamUserDeregisterData
                        | ExamUserSetResultData (Maybe ExamResultPassedGrade)
                        | ExamUserAcceptComputedResultData
                        | ExamUserResetToComputedResultData
-                          { examUserResetBonus :: Bool
+                          { examUserResetBonus
                          , examUserResetParts :: Bool
                          }
@ -479,8 +488,8 @@ postEUsersR tid ssh csh examn = do
                 in propCell (getSum achievedPoints) (getSum sumSheetsPoints)
            , guardOn doBonus $ sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) . automaticCell $ resultExamBonus . _entityVal . _examBonusBonus . to Right <> resultAutomaticExamBonus' . to Left
            , pure $ mconcat
-              [ sortable (Just $ fromText [st|part-#{toPathPiece examPartNumber}|]) (i18nCell $ MsgExamPartNumbered examPartNumber) $ maybe mempty i18nCell . preview (resultExamPartResult epId . _Just . _entityVal . _examPartResultResult)
+              [ sortable (Just $ fromText [st|part-#{toPathPiece examPartNumber}|]) (i18nCell $ MsgExamPartNumbered examPartNumber) . automaticCell $ resultExamPartResult epId . _Just . _entityVal . _examPartResultResult . to Right <> resultAutomaticExamPartResult epEnt bonus . to Left
-              | Entity epId ExamPart{..} <- sortOn (examPartNumber . entityVal) examParts
+              | epEnt@(Entity epId ExamPart{..}) <- sortOn (examPartNumber . entityVal) examParts
              ]
            , pure $ sortable (Just "exam-result") (i18nCell MsgExamResult) . automaticCell $ (resultExamResult . _entityVal . _examResultResult . to Right <> resultAutomaticExamResult' . to Left)
            , pure . sortable (Just "note") (i18nCell MsgCourseUserNote) $ \((,) <$> view (resultUser . _entityKey) <*> has resultCourseNote -> (uid, hasNote))
@ -548,6 +557,7 @@ postEUsersR tid ssh csh examn = do
                    , singletonMap ExamUserResetToComputedResult $
                        ExamUserResetToComputedResultData
                          <$> bool (pure True) (apopt checkBoxField (fslI MsgExamUserResetBonus) (Just True)) (is _Just examBonusRule)
                          <*> bool (pure True) (apopt checkBoxField (fslI MsgExamUserResetParts) (Just True)) (not $ all (null . examSummary) bonus)
                    , singletonMap ExamUserSetPartResult $
                        ExamUserSetPartResultData
                          <$> areq (selectField $ optionsPairs (map ((MsgExamPartNumbered &&& id) . examPartNumber . entityVal) examParts)) (fslI MsgExamPart) Nothing
@ -601,9 +611,11 @@ postEUsersR tid ssh csh examn = do
                <*> fmap (bool (const Nothing) Just showPoints) (preview $ resultUser . _entityKey . to (examBonusPossible ?? bonus) . _sumSheetsPoints . _Wrapped)
                <*> fmap (bool (const Nothing) Just showPasses) (preview $ resultUser . _entityKey . to (examBonusPossible ?? bonus) . _numSheetsPasses . _Wrapped . integral)
                <*> fmap (bool (const Nothing) Just doBonus   ) (preview $ resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus')
-                <*> (Map.fromList . map (over _1 examPartNumber . over (_2 . _Just) (examPartResultResult . entityVal)) <$> asks (toListOf resultExamParts))
+                <*> encodePartResults
                <*> preview (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult')
                <*> preview (resultCourseNote . _entityVal . _courseUserNoteNote)
              encodePartResults = fmap Map.fromList . forM examParts $ \epEnt@(Entity epId ExamPart{..}) -> (examPartNumber, ) <$>
                preview (resultExamPartResult epId . _Just . _entityVal . _examPartResultResult <> resultAutomaticExamPartResult epEnt bonus)
          dbtCsvDecode = Just DBTCsvDecode
            { dbtCsvRowKey = \csv -> do
                uid <- lift $ view _2 <$> guessUser' csv
@ -964,6 +976,7 @@ postEUsersR tid ssh csh examn = do
        hasBonus <- asks $ has resultExamBonus
        autoResult <- preview $ resultAutomaticExamResult examVal bonus
        autoBonus <- preview $ resultAutomaticExamBonus examVal bonus
        autoParts <- asks (itoListOf resultExamParts) >>= mapM (\(epId, (ep, mRes)) -> fmap (guardOnM (isn't _Just mRes) . fmap (epId, )) . preview $ resultAutomaticExamPartResult (Entity epId ep) bonus)
        lift $ if
          | not hasResult
          , Just examResultResult <- autoResult
@ -982,6 +995,15 @@ postEUsersR tid ssh csh examn = do
                | otherwise
                -> return ()
              iforM_ (Map.fromList $ catMaybes autoParts) $ \epId autoPartResult -> do
                insert_ ExamPartResult
                  { examPartResultExamPart = epId
                  , examPartResultUser = uid
                  , examPartResultResult = autoPartResult
                  , examPartResultLastChanged = now
                  }
                audit $ TransactionExamPartResultEdit epId uid
              insert_ ExamResult
                { examResultExam = eId
                , examResultUser = uid
@ -1003,6 +1025,12 @@ postEUsersR tid ssh csh examn = do
            whenIsJust bonusId' $ \bonusId -> do
                delete bonusId
                audit $ TransactionExamBonusDeleted eId uid
          when examUserResetParts $ do
            forM_ (foldMap (Map.keysSet . unMergeMap . examSummary) $ Map.lookup uid bonus) $ \epId -> do
              partResultId' <- getKeyBy $ UniqueExamPartResult epId uid
              whenIsJust partResultId' $ \partResultId -> do
                delete partResultId
                audit $ TransactionExamPartResultDeleted epId uid
          result <- getKeyBy $ UniqueExamResult eId uid
          case result of
--- a/src/Handler/Sheet/Edit.hs
+++ b/src/Handler/Sheet/Edit.hs
@ -33,7 +33,7 @@ postSEditR tid ssh csh shn = do
  let template = Just $ SheetForm
        { sfName           = sheetName
        , sfDescription    = sheetDescription
-        , sfType           = sheetType
+        , sfType           = review _SqlKey <$> sheetType
        , sfGrouping       = sheetGrouping
        , sfVisibleFrom    = sheetVisibleFrom
        , sfActiveFrom     = sheetActiveFrom
@ -74,7 +74,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
              { sheetCourse         = cid
              , sheetName           = sfName
              , sheetDescription    = sfDescription
-              , sheetType           = sfType
+              , sheetType           = view _SqlKey <$> sfType
              , sheetGrouping       = sfGrouping
              , sheetMarkingText    = sfMarkingText
              , sheetVisibleFrom    = sfVisibleFrom
--- a/src/Handler/Sheet/Form.hs
+++ b/src/Handler/Sheet/Form.hs
@ -37,7 +37,7 @@ data SheetForm = SheetForm
      , sfSolutionFrom :: Maybe UTCTime
      , sfSubmissionMode :: SubmissionMode
      , sfGrouping     :: SheetGroup
-      , sfType         :: SheetType
+      , sfType         :: SheetType ExamPartId
      , sfAutoDistribute :: Bool
      , sfMarkingText  :: Maybe StoredMarkup
      , sfAnonymousCorrection :: Bool
@ -93,7 +93,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
      <* aformSection MsgSheetFormType
      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False))
      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        ((sfGrouping <$> template) <|> pure NoGroups)
-      <*> sheetTypeAFormReq   (fslI MsgSheetType)         (sfType        <$> template)
+      <*> sheetTypeAFormReq cId (fslI MsgSheetType) (sfType <$> template)
      <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
      <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
--- a/src/Handler/Sheet/List.hs
+++ b/src/Handler/Sheet/List.hs
@ -9,6 +9,7 @@ import Handler.Utils
 import Handler.Utils.SheetType
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 import qualified Data.Map as Map
@ -38,6 +39,9 @@ getSheetListR tid ssh csh = do
        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
    querySubmission :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionUser))) -> E.SqlExpr (Maybe (Entity Submission))
    querySubmission (_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) = submission
    sheetFilter :: SheetName -> DB Bool
    sheetFilter sheetName = hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR
@ -64,8 +68,10 @@ getSheetListR tid ssh csh = do
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveFrom
      , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveTo
-      , sortable Nothing (i18nCell MsgSheetType)
+      , sortable Nothing (i18nCell MsgSheetType) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> cell $ do
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> i18nCell sheetType
+          sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
          tr <- getTranslate
          toWidget $ sheetTypeDesc tr
      , sortable Nothing (i18nCell MsgSubmission)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub, _)} -> case mbSub of
              Nothing -> mempty
@ -86,7 +92,6 @@ getSheetListR tid ssh csh = do
                    mkRoute = liftHandler $ do
                      cid' <- encrypt sid
                      return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                    mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this
                    acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
                    tellStats = do
                      r <- mkRoute
@ -154,10 +159,17 @@ getSheetListR tid ssh csh = do
      , dbtFilter    = mconcat
        [ singletonMap "may-access" . FilterProjected $ \(Any b) DBRow{..} ->
            let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool))
-             in (==b) <$> sheetFilter sheetName :: DB Bool
+             in (== b) <$> sheetFilter sheetName :: DB Bool
        , singletonMap "rated" . FilterColumn $ \(Any b) -> (E.==. E.val b) . E.isJust . (E.?. SubmissionRatingTime) . querySubmission
        , singletonMap "is-exam" . FilterProjected $ \(Any b) DBRow{..} ->
            let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool))
             in return $ is _ExamPartPoints sheetType == b :: DB Bool
        ]
-      , dbtFilterUI  = mempty
+      , dbtFilterUI  = mconcat
-      , dbtStyle     = def
+        [ flip (prismAForm $ singletonFilter "is-exam" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSheetTypeIsExam)
        , flip (prismAForm $ singletonFilter "rated" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgIsRated)
        ]
      , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
      , dbtParams    = def
      , dbtIdent     = "sheets" :: Text
      , dbtCsvEncode = noCsvEncode
--- a/src/Handler/Sheet/New.hs
+++ b/src/Handler/Sheet/New.hs
@ -48,7 +48,7 @@ postSheetNewR tid ssh csh = do
          in Just $ SheetForm
            { sfName           = stepTextCounterCI sheetName
            , sfDescription    = sheetDescription
-            , sfType           = sheetType
+            , sfType           = review _SqlKey <$> sheetType
            , sfGrouping       = sheetGrouping
            , sfVisibleFrom    = addTime <$> sheetVisibleFrom
            , sfActiveFrom     = addTime <$> sheetActiveFrom
--- a/src/Handler/Sheet/Show.hs
+++ b/src/Handler/Sheet/Show.hs
@ -150,6 +150,8 @@ getSShowR tid ssh csh shn = do
    guardM . hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
    return $ notification NotificationBroad =<< messageI Warning MsgSheetSubmissionModeNoneWithoutNotGraded
  sTypeDesc <- runDB $ sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
  defaultLayout $ do
    setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
    let zipLink = CSheetR tid ssh csh shn SArchiveR
@ -161,4 +163,5 @@ getSShowR tid ssh csh shn = do
    solutionFrom  <- traverse (formatTime SelFormatDateTime) $  sheetSolutionFrom sheet
    markingText   <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
    submissionTip <- messageI Info MsgSheetCorrectorSubmissionsTip
    tr <- getTranslate
    $(widgetFile "sheetShow")
--- a/src/Handler/Submission/Correction.hs
+++ b/src/Handler/Submission/Correction.hs
@ -49,8 +49,11 @@ postCorrectionR tid ssh csh shn cid = do
    <*> hasWriteAccessTo (CSheetR tid ssh csh shn SSubsR)
  MsgRenderer mr <- getMsgRenderer
  ur <- getUrlRenderParams
  tr <- getTranslate
  case results of
    [(Entity cId Course{}, Entity shId Sheet{..}, Entity _ subm@Submission{..}, corrector, E.Value filesCorrected)] -> do
      sheetTypeDesc <- runDB $ sheetTypeDescription cId sheetType
      let ratingComment = submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) . Text.strip
          pointsForm = case sheetType of
            NotGraded
@ -59,10 +62,10 @@ postCorrectionR tid ssh csh shn cid = do
              -> Just <$> apopt (convertField (bool 0 1) (/= 0) checkBoxField) (fslI MsgPassed) submissionRatingPoints
            (preview _grading -> Just PassAlways)
              -> Just <$> aforced (convertField (bool 0 1) (/= 0) checkBoxField) (fslI MsgPassed) 1
-            _otherwise
+            _otherwise -> aSetTooltip (Just $ sheetTypeDesc tr ur) $
-              -> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
+              aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
-                      (fslpI MsgRatingPoints (mr MsgPointsPlaceholder) & setTooltip sheetType)
+                   (fslpI MsgRatingPoints (mr MsgPointsPlaceholder))
-                      (Just submissionRatingPoints)
+                   (Just submissionRatingPoints)
          correctorForm
            | not isLecturer = wFormToAForm $ pure . Just <$> requireAuthId
            | otherwise = wFormToAForm $ do
@ -142,6 +145,7 @@ postCorrectionR tid ssh csh shn cid = do
              $if not (submissionRatingDone subm)
                \ ^{isVisibleWidget False}
            |]
      siteLayout headingWgt $ do
        setTitleI heading
        urlArchive <- toTextUrl . CSubmissionR tid ssh csh shn cid $ SubArchiveR SubmissionCorrected
@ -154,9 +158,13 @@ getCorrectionUserR tid ssh csh shn cid = do
  results <- runDB $ correctionData tid ssh csh shn sub
  case results of
-    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _), E.Value filesCorrected)] ->
+    [(_, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _), E.Value filesCorrected)] -> do
      let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
-       in defaultLayout $ do
+      let heading = MsgCorrectionHead tid ssh csh shn cid
-            urlArchive <- toTextUrl . CSubmissionR courseTerm courseSchool courseShorthand sheetName cid $ SubArchiveR SubmissionCorrected
+      urlArchive <- toTextUrl . CSubmissionR tid ssh csh shn cid $ SubArchiveR SubmissionCorrected
-            $(widgetFile "correction-user")
+      tr <- getTranslate
      sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
      siteLayoutMsg heading $ do
        setTitleI heading
        $(widgetFile "correction-user")
    _ -> notFound
--- a/src/Handler/Submission/Helper.hs
+++ b/src/Handler/Submission/Helper.hs
@ -548,12 +548,14 @@ submissionHelper tid ssh csh shn mcid = do
    E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. E.val subId
    E.where_ $ sFile2 E.?. SubmissionFileSubmission E.==. E.just (E.val subId)
  sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
  defaultLayout $ do
    setTitleI $ MsgSubmissionEditHead tid ssh csh shn
    (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
      -> let mkUrl sft = toTextUrl . CSubmissionR tid ssh csh shn cID $ SubArchiveR sft
          in liftHandler . runDB $ (,) <$> mkUrl SubmissionCorrected <*> mkUrl SubmissionOriginal
    tr <- getTranslate
    let correctionWdgt = guardOnM (showCorrection && maybe False submissionRatingDone msubmission) ((,) <$> msubmission <*> mcid) <&> \(Submission{..}, cid) ->
          let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
           in $(widgetFile "correction-user")
--- a/src/Handler/Submission/List.hs
+++ b/src/Handler/Submission/List.hs
@ -118,7 +118,7 @@ colSubmissionLink = sortable (Just "submission") (i18nCell MsgSubmission)
              shn = sheetName $ entityVal sheet
          in anchorCellC $cacheIdentHere (CSubmissionR tid ssh csh shn cid SubShowR) (toPathPiece cid)
-colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
+colSelect :: forall act h epId. (Semigroup act, Monoid act, Headedness h, Ord epId) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary epId))
 colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid, _) } -> return cid
 colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
@ -150,7 +150,7 @@ colSGroups = sortable (Just "submittors-group") (i18nCell MsgSubmissionGroup) $
        | otherwise
          -> mempty
-colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
+colRating :: forall m a. IsDBTable m (a, SheetTypeSummary SqlBackendKey) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary SqlBackendKey))
 colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _, _) } ->
  let csh = course ^. _2
      tid = course ^. _3
@ -160,14 +160,13 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
      mkRoute = do
        cid <- encrypt subId
        return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
      mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this
  in mconcat
     [ anchorCellCM $cacheIdentHere mkRoute $(widgetFile "widgets/rating/rating")
     , writerCell $ do
         let
-           summary :: SheetTypeSummary
+           summary :: SheetTypeSummary SqlBackendKey
           summary = sheetTypeSum sheetType $ submissionRatingPoints <* guard (submissionRatingDone sub)
-         scribe (_2 :: Lens' (a, SheetTypeSummary) SheetTypeSummary) summary
+         scribe (_2 :: Lens' (a, SheetTypeSummary SqlBackendKey) (SheetTypeSummary SqlBackendKey)) summary
     ]
 colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
@ -198,7 +197,10 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for
  )
 colMaxPointsField :: _ => Colonnade Sortable CorrectionTableData (DBCell m (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
-colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _, _, _) } -> sheetType)
+colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{sheetCourse, sheetType}, _, _, _, _, _, _) } -> cell $ do
  sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
  tr <- getTranslate
  toWidget $ sheetTypeDesc tr
 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
 colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
@ -434,7 +436,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
    setTitleI MsgCourseCorrectionsTitle
    $(widgetFile "corrections")
-correctionsR' :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary)
+correctionsR' :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary SqlBackendKey)
 correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
  currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@ -54,6 +54,7 @@ import qualified Data.Char as Char
 import qualified Data.RFC5051 as RFC5051
 import Handler.Utils.I18n
 import Handler.Utils.Sheet
 fetchExamAux :: ( SqlBackendCanRead backend
@ -90,7 +91,7 @@ fetchCourseIdExam  :: MonadHandler m => TermId -> SchoolId -> CourseShorthand ->
 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 :: (MonadHandler m, MonadThrow m) => Entity Exam -> ReaderT SqlBackend m (Map UserId (SheetTypeSummary ExamPartId))
 examBonus (Entity eId Exam{..}) = runConduit $
  let
    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
@ -112,19 +113,20 @@ examBonus (Entity eId Exam{..}) = runConduit $
        ]
        ( E.else_ . E.not_ . E.isNothing $ sheet E.^. SheetVisibleFrom
        )
-      return (examRegistration E.^. ExamRegistrationUser, sheet E.^. SheetType, submission)
+      return (examRegistration E.^. ExamRegistrationUser, sheet E.^. SheetType, submission, sheet E.^. SheetCourse)
-    accum = C.fold ?? Map.empty $ \acc (E.Value uid, E.Value sheetType, fmap entityVal -> sub) ->
+    accum = C.foldM ?? Map.empty $ \acc (E.Value uid, E.Value sheetType, fmap entityVal -> sub, E.Value cId) -> do
-      flip (Map.insertWith mappend uid) acc . sheetTypeSum sheetType $ assertM submissionRatingDone sub >>= submissionRatingPoints
+      sheetType' <- fmap entityKey <$> resolveSheetType cId sheetType
      return . flip (Map.insertWith mappend uid) acc . sheetTypeSum sheetType' $ assertM submissionRatingDone sub >>= submissionRatingPoints
   in rawData .| accum
-examBonusPossible, examBonusAchieved :: UserId -> Map UserId SheetTypeSummary -> SheetGradeSummary
+examBonusPossible, examBonusAchieved :: Ord epId => UserId -> Map UserId (SheetTypeSummary epId) -> SheetGradeSummary
 examBonusPossible uid bonusMap = normalSummary $ Map.findWithDefault mempty uid bonusMap
 examBonusAchieved uid bonusMap = mappend <$> normalSummary <*> bonusSummary $ Map.findWithDefault mempty uid bonusMap
 getRelevantSheetsUpTo :: CourseId
                      -> UserId
                      -> Maybe UTCTime
-                      -> DB (Map SheetId (SheetType, Maybe Points))
+                      -> DB (Map SheetId (SheetType SqlBackendKey, Maybe Points))
 getRelevantSheetsUpTo cid uid mCutoff
  = fmap postprocess . E.select . E.from $ \(sheet `E.LeftOuterJoin` submission) -> E.distinctOnOrderBy [ E.asc $ sheet E.^. SheetId ] $ do
      E.on $ submission E.?. SubmissionSheet E.==. E.just (sheet E.^. SheetId)
@ -138,8 +140,8 @@ getRelevantSheetsUpTo cid uid mCutoff
        Nothing -> E.where_ . E.not_ . E.isNothing $ sheet E.^. SheetVisibleFrom
      return (sheet E.^. SheetId, sheet E.^. SheetType, submission)
  where
-    postprocess :: [(E.Value SheetId, E.Value SheetType, Maybe (Entity Submission))]
+    postprocess :: [(E.Value SheetId, E.Value (SheetType SqlBackendKey), Maybe (Entity Submission))]
-                -> Map SheetId (SheetType, Maybe Points)
+                -> Map SheetId (SheetType SqlBackendKey, Maybe Points)
    postprocess = Map.fromList . map postprocess'
      where postprocess' (E.Value sId, E.Value sType, fmap entityVal -> sub)
              = (sId, ) . (sType, ) $ assertM submissionRatingDone sub >>= submissionRatingPoints
@ -155,36 +157,27 @@ examResultBonus bonusRule bonusPossible bonusAchieved = case bonusRule of
  ExamBonusManual{}
    -> Nothing
  ExamBonusPoints{..}
-    -> Just . roundToPoints bonusRound $ toRational bonusMaxPoints * bonusProp
+    -> Just . roundToPoints' bonusRound $ toRational bonusMaxPoints * bonusProp bonusMaxPoints
  where
-    bonusProp :: Rational
+    bonusProp :: Points -> Rational
-    bonusProp
+    bonusProp mPoints
      | possible <= 0 = 1
      | otherwise = achieved / possible
      where
-        achieved = toRational (getSum $ achievedPoints  bonusAchieved) + scalePasses (getSum $ achievedPasses  bonusAchieved)
+        achieved = toRational (getSum $ achievedPoints  bonusAchieved - achievedPassPoints  bonusAchieved) + scalePasses (getSum $ achievedPasses  bonusAchieved)
-        possible = toRational (getSum $ sumSheetsPoints bonusPossible) + scalePasses (getSum $ numSheetsPasses bonusPossible)
+        possible = toRational (getSum $ sumSheetsPoints bonusPossible - sumSheetsPassPoints bonusPossible) + scalePasses (getSum $ numSheetsPasses bonusPossible)
        scalePasses :: Integer -> Rational
        -- ^ Rescale passes so count of all sheets with pass is worth as many points as sum of all sheets with points
        scalePasses passes
          | pointsPossible <= 0 = toRational mPoints / fromInteger passesPossible
          | passesPossible <= 0 = 0
          | otherwise = fromInteger passes / fromInteger passesPossible * toRational pointsPossible
          where
            passesPossible = getSum $ numSheetsPasses bonusPossible
-            pointsPossible = getSum $ sumSheetsPoints bonusPossible
+            pointsPossible = getSum $ sumSheetsPoints bonusPossible - sumSheetsPassPoints bonusPossible
-    roundToPoints :: forall a. HasResolution a => Fixed a -> Rational -> Fixed a
+    roundToPoints' mult = (* mult) . roundToPoints . (/ toRational mult)
    -- ^ 'round-to-nearest' whole multiple
    roundToPoints (MkFixed mult'@(fromInteger -> mult)) ((* toRational (resolution (Proxy @a))) -> raw)
      = MkFixed . (* mult') $
          let (whole, frac) = raw `divMod'` mult
           in if | abs frac < abs (mult / 2)
                   -> whole
                 | raw >= 0
                   -> succ whole
                 | otherwise
                   -> pred whole
 examGrade :: ( MonoFoldable mono
             , Element mono ~ ExamResultPoints
@ -223,9 +216,10 @@ examGrade Exam{..} mBonus (otoList -> results)
            lowerBounds = zip [Grade40, Grade37 ..] examGradingKey'
 examBonusGrade :: ( MonoFoldable sheets
-                  , Element sheets ~ (SheetType, Maybe Points)
+                  , Element sheets ~ (SheetType epId, Maybe Points)
                  , MonoFoldable results
                  , Element results ~ ExamResultPoints
                  , Ord epId
                  )
               => Exam
               -> Either Points sheets -- ^ `Points` retrieved from relevant `ExamBonus`, iff it exists
@ -241,8 +235,6 @@ examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus
        bonusAchieved = (<>) <$> fmap normalSummary sheetSummary <*> fmap bonusSummary sheetSummary
 data ExamAutoOccurrenceConfig = ExamAutoOccurrenceConfig
  { eaocMinimizeRooms :: Bool
  , eaocFinenessCost  :: Rational -- ^ Cost factor incentivising shorter common prefixes on breaks between rooms
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -1168,16 +1168,6 @@ nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'")
 embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)
 data SheetType' = Normal' | Bonus' | Informational' | NotGraded'
  deriving (Eq, Ord, Read, Show, Enum, Bounded)
 instance Universe SheetType'
 instance Finite SheetType'
 nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'")
 embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)
 data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups'
  deriving (Eq, Ord, Read, Show, Enum, Bounded)
@ -1207,30 +1197,47 @@ sheetGradingAFormReq fs template = multiActionA selOptions fs (classify' <$> tem
    passPointsReq = apreq pointsField (fslI MsgSheetGradingPassingPoints) (template >>= preview _passingPoints)
-sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType
+sheetTypeAFormReq :: CourseId -> FieldSettings UniWorX -> Maybe (SheetType ExamPartId) -> AForm Handler (SheetType ExamPartId)
-sheetTypeAFormReq fs template = explainedMultiActionA acts opts fs (classify' <$> template)
+sheetTypeAFormReq cId fs template = wFormToAForm $ do
-  where
+  examParts'' <- liftHandler . runDB . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examPart) -> do
-    acts = Map.fromList
+    E.on $ exam E.^. ExamId E.==. examPart E.^. ExamPartExam
-      [ ( Normal', Normal <$> gradingReq )
+    E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
-      , ( Bonus' , Bonus  <$> gradingReq )
+    E.where_ $ exam E.^. ExamCourse E.==. E.val cId
-      , ( Informational', Informational <$> gradingReq  )
+    return (exam, course, examPart)
-      , ( NotGraded', pure NotGraded )
+
  editableExams <- fmap Map.keysSet . flip mapFilterM (foldMap (\(Entity eId exam, Entity _ course, _) -> Map.singleton eId (exam, course)) examParts'') $ \(Exam{..}, Course{..}) ->
    hasWriteAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EEditR
  let
    examParts' = flip foldMap examParts'' $ \(eEnt@(Entity eId _), _, epEnt) -> guardOn @[] (eId `Set.member` editableExams) (eEnt, epEnt)
    examParts = flip sortOn examParts' $ \(Entity _ Exam{..}, Entity _ ExamPart{..}) -> (examName, examPartNumber)
    doExamPartPoints = fmap classifySheetType template == Just ExamPartPoints'
                    || not (null examParts)
    acts = Map.fromList $ catMaybes
      [ pure ( Normal', Normal <$> gradingReq )
      , pure ( Bonus' , Bonus  <$> gradingReq )
      , pure ( Informational', Informational <$> gradingReq )
      , pure ( NotGraded', pure NotGraded )
      , guardOn doExamPartPoints ( ExamPartPoints', ExamPartPoints <$> examPartReq <*> weightReq <*> gradingReq )
      ]
    gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading
-        & setTooltip MsgSheetGradingInfo) (template >>= preview _grading)
+        & setTooltip MsgSheetGradingInfo) $ template >>= preview _grading
    weightReq = apreq (checkBool (>= 0) MsgSheetTypeExamPartPointsWeightNegative rationalField) (fslI MsgSheetTypeExamPartPointsWeight) $ preview (_Just . _weight) template
    examPartReq = apreq examPartField (fslI MsgSheetTypeExamPartPointsExamPart) $ preview (_Just . _examPart) template >>= assertM' (\epId -> any (\(_, Entity epId' _) -> epId == epId') examParts)
    examPartField = selectField' Nothing . fmap (fmap $ \(_, Entity epId _) -> epId) $ optionsCryptoIdF examParts
      (\(_, Entity epId _) -> return epId)
      (\(Entity _ Exam{..}, Entity _ ExamPart{..}) -> return $ MsgSheetTypeExamPartPointsExamPartOption examName examPartNumber)
    opts = explainOptionList optionsFinite $ \case
      Normal' -> return $ i18n MsgSheetTypeInfoNormalLecturer
      Bonus' -> return $ i18n MsgSheetTypeInfoBonus
      Informational' -> return $ i18n MsgSheetTypeInfoInformational
      NotGraded' -> return $ i18n MsgSheetTypeInfoNotGraded
      ExamPartPoints' -> return $ i18n MsgSheetTypeInfoExamPartPoints
-    classify' :: SheetType -> SheetType'
+  aFormToWForm . explainedMultiActionA acts opts fs $ classifySheetType <$> template
    classify' = \case
      Bonus  {} -> Bonus'
      Normal {} -> Normal'
      Informational {} -> Informational'
      NotGraded -> NotGraded'
 sheetGroupAFormReq :: FieldSettings UniWorX -> Maybe SheetGroup -> AForm Handler SheetGroup
 sheetGroupAFormReq fs template = explainedMultiActionA acts opts fs (classify' <$> template)
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@ -13,6 +13,7 @@ import Import
 import Handler.Utils.Files
 import Handler.Utils.DateTime (getDateTimeFormatter)
 import Handler.Utils.Sheet (resolveSheetTypeRating)
 import qualified Data.Text as Text
@ -28,7 +29,7 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.Char as Char
-validateRating :: SheetType -> Rating' -> [RatingValidityException]
+validateRating :: SheetType a -> Rating' -> [RatingValidityException]
 validateRating ratingSheetType Rating'{ ratingPoints=Just rp }
  | rp < 0
    = [RatingNegative]
@ -59,7 +60,8 @@ getRating submissionId = runMaybeT $ do
        E.where_ $ submission E.^. SubmissionId E.==. E.val submissionId
        -- Yes, we can only pass a tuple through 'E.select'
-        return ( course E.^. CourseTerm
+        return ( course E.^. CourseId
               , course E.^. CourseTerm
               , school E.^. SchoolName
               , course E.^. CourseName
               , sheet E.^. SheetName
@ -68,14 +70,16 @@ getRating submissionId = runMaybeT $ do
               , submission
               )
-  [ ( unTermKey . E.unValue -> ratingCourseTerm
+  [ ( E.unValue -> cId
    , unTermKey . E.unValue -> ratingCourseTerm
    , E.unValue -> ratingCourseSchool
    , E.unValue -> ratingCourseName
    , E.unValue -> ratingSheetName
    , E.unValue -> ratingCorrectorName
-    , E.unValue -> ratingSheetType
+    , E.unValue -> ratingSheetType'
    , E.Entity _ sub@Submission{..}
    ) ] <- lift query
  ratingSheetType <- lift $ resolveSheetTypeRating cId ratingSheetType'
  let ratingPoints = submissionRatingPoints
      ratingComment = submissionRatingComment
--- a/src/Handler/Utils/Sheet.hs
+++ b/src/Handler/Utils/Sheet.hs
@ -5,6 +5,10 @@ import Import
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Internal as E
 import qualified Data.Map.Strict as Map
 import Text.Hamlet
 -- | Map sheet file types to their visibily dates of a given sheet, for convenience
 sheetFileTypeDates :: Sheet -> SheetFileType -> Maybe UTCTime
@ -51,3 +55,96 @@ fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Ye
 fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux (\sheet course -> (sheet E.^. SheetId, course E.^. CourseId)) tid ssh cid shn
 data ResolveSheetTypeException
  = ResolveSheetTypeExamPartUnavailable SqlBackendKey
  | ResolveSheetTypeForeignExam
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)
 resolveSheetType :: ( MonadThrow m
                    , MonadIO m
                    )
                 => CourseId
                 -> SheetType SqlBackendKey
                 -> ReaderT SqlBackend m (SheetType (Entity ExamPart))
 resolveSheetType cId = traverse $ \epId'@(review _SqlKey -> epId) -> do
  ep@(Entity _ ExamPart{..}) <- maybe (throwM $ ResolveSheetTypeExamPartUnavailable epId') return =<< getEntity epId
  Exam{..} <- getJust examPartExam
  if | examCourse /= cId -> throwM ResolveSheetTypeForeignExam
     | otherwise         -> return ep
 resolveSheetTypeRating :: ( MonadThrow m
                          , MonadIO m
                          )
                       => CourseId
                       -> SheetType SqlBackendKey
                       -> ReaderT SqlBackend m (SheetType RatingExamPartReference)
 resolveSheetTypeRating cId dbST = do
  eST <- resolveSheetType cId dbST
  case matching _ExamPartPoints eST of
    Left t -> return t
    Right (Entity _ ExamPart{..}, weight, grading) -> do
      Exam{..} <- getJust examPartExam
      return ExamPartPoints
        { examPart = RatingExamPartReference examName examPartNumber
        , ..
        }
 sheetTypeDescription :: forall m.
                        ( MonadThrow m
                        , MonadHandler m, HandlerSite m ~ UniWorX
                        )
                     => CourseId
                     -> SheetType SqlBackendKey
                     -> ReaderT SqlBackend m (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
 sheetTypeDescription cId dbST = do
  sType' <- resolveSheetType cId dbST
  sType <- for sType' $ \(Entity _epId ExamPart{..}) -> do
    Exam{..} <- getJust examPartExam
    Course{..} <- getJust examCourse
    cTime <- liftIO getCurrentTime
    lecturerInfo <- hasReadAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EEditR
    let partVisible = gradingVisible
                   || NTop (Just cTime) >= NTop examPartsFrom
                   || lecturerInfo
        gradingVisible = NTop (Just cTime) >= NTop examPartsFrom
                      || lecturerInfo
    return (examName, examPartName, examPartNumber, partVisible, gradingVisible, CExamR courseTerm courseSchool courseShorthand examName EShowR)
  return $(ihamletFile "templates/widgets/sheetType.hamlet")
 sheetExamResult :: SheetTypeSummary ExamPartId -> Entity ExamPart -> Maybe ExamResultPoints
 sheetExamResult SheetTypeSummary{ examSummary = MergeMap examSummary'' } (Entity epId ExamPart{..}) = Map.lookup epId examSummary'' <&> \examSummary' ->
  let
    sumOfWeights = getSum $ foldMap (views _1 Sum) examSummary'
    weightRescale = recip sumOfWeights
    toExamPoints :: (Rational, SheetGradeSummary) -> Maybe Rational
    toExamPoints (weight, summary)
      | sumOfWeights <= 0 = Nothing
      | otherwise = Just . (* weight) $ case examPartMaxPoints of
          Just maxPoints -> toRational maxPoints * bonusProp
          Nothing        -> bonusProp * possible
      where
        bonusProp :: Rational
        bonusProp | possible <= 0 = 1
                  | otherwise     = achieved / possible
        achieved = toRational (getSum $ achievedPoints  summary - achievedPassPoints  summary) + scalePasses (getSum $ achievedPasses  summary)
        possible = toRational (getSum $ sumSheetsPoints summary - sumSheetsPassPoints summary) + scalePasses (getSum $ numSheetsPasses summary)
        scalePasses :: Integer -> Rational
        scalePasses passes
          | pointsPossible <= 0
          , Just maxPoints <- examPartMaxPoints = fromInteger passes * toRational maxPoints / fromInteger passesPossible
          | pointsPossible <= 0 = 0
          | passesPossible <= 0 = 0
          | otherwise = fromInteger passes / (fromInteger passesPossible * passesWeights) * (toRational pointsPossible * pointsWeights)
          where
            passesPossible = getSum $ numSheetsPasses summary
            pointsPossible = getSum $ sumSheetsPoints summary - sumSheetsPassPoints summary
            pointsWeights = getSum $ foldMap (\(sWeight, gradeSummary) -> guardMonoid (sumSheetsPoints gradeSummary - sumSheetsPassPoints gradeSummary > 0) $ Sum sWeight) examSummary'
            passesWeights = getSum $ foldMap (\(sWeight, gradeSummary) -> guardMonoid (numSheetsPasses gradeSummary > 0) $ Sum sWeight) examSummary'
   in ExamAttended . roundToPoints . (* examPartWeight) . (* weightRescale) . getSum . fold $ foldMapM (fmap Sum . toExamPoints) examSummary'
--- a/src/Handler/Utils/SheetType.hs
+++ b/src/Handler/Utils/SheetType.hs
@ -5,7 +5,7 @@ module Handler.Utils.SheetType
 import Import
-addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
+addBonusToPoints :: SheetTypeSummary a -> SheetTypeSummary a
 addBonusToPoints sts =
    sts & _normalSummary . _achievedPasses %~ (min passmax . (passbonus +))
        & _normalSummary . _achievedPoints %~ (min ptsmax  . (ptsbonus  +))
@ -15,7 +15,7 @@ addBonusToPoints sts =
    ptsmax    = sts ^. _normalSummary . _sumMarkedPoints
    ptsbonus  = sts ^. _bonusSummary  . _achievedPoints
-gradeSummaryWidget ::  RenderMessage UniWorX msg => (Integer -> msg) -> SheetTypeSummary -> Widget
+gradeSummaryWidget ::  RenderMessage UniWorX msg => (Integer -> msg) -> SheetTypeSummary a -> Widget
 gradeSummaryWidget title sts =
  let SheetTypeSummary{..} = addBonusToPoints sts
      sumSummaries    = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -32,7 +32,7 @@ module Handler.Utils.Table.Pagination
  , dbTableWidget, dbTableWidget'
  , dbTableDB, dbTableDB'
  , widgetColonnade, formColonnade, dbColonnade
-  , cell, textCell, stringCell, i18nCell
+  , cell, wgtCell, textCell, stringCell, i18nCell
  , anchorCell, anchorCell', anchorCellM, anchorCellM'
  , linkEitherCell, linkEitherCellM, linkEitherCellM'
  , maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
@ -1508,6 +1508,9 @@ pagesizeField psLim = selectField $ do
 cell :: IsDBTable m a => Widget -> DBCell m a
 cell wgt = dbCell # ([], return wgt)
 wgtCell :: (IsDBTable m a, ToWidget UniWorX wgt) => wgt -> DBCell m a
 wgtCell = cell . toWidget
 textCell, stringCell :: (MonoFoldable msg, Element msg ~ Char, IsDBTable m a) => msg -> DBCell m a
 textCell = cell . toWidget . (pack :: String -> Text) . otoList
 stringCell = textCell
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@ -187,6 +187,7 @@ import Text.Shakespeare.Text.Instances as Import ()
 import Ldap.Client.Instances as Import ()
 import Network.URI.Instances as Import ()
 import Data.MultiSet.Instances as Import ()
 import Control.Arrow.Instances as Import ()
 import Crypto.Hash as Import (Digest, SHA3_256, SHA3_512)
 import Crypto.Random as Import (ChaChaDRG, Seed)
@ -213,6 +214,8 @@ import Data.Kind as Import (Type, Constraint)
 import Data.Scientific as Import (Scientific, formatScientific)
 import Data.MultiSet as Import (MultiSet)
 import Control.Monad.Trans.RWS (RWST)
--- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs
+++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
@ -12,14 +12,16 @@ import Jobs.Handler.SendNotification.Utils
 import Text.Hamlet
 import qualified Data.CaseInsensitive as CI
 dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler ()
 dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipient $ do
-  (Course{..}, Sheet{..}, Submission{..}, corrector) <- liftHandler . runDB $ do
+  (Course{..}, Sheet{..}, Submission{..}, corrector, sheetTypeDesc) <- liftHandler . runDB $ do
    submission@Submission{submissionRatingBy} <- getJust nSubmission
    sheet <- belongsToJust submissionSheet submission
    course <- belongsToJust sheetCourse sheet
    corrector <- traverse getJust submissionRatingBy
-    return (course, sheet, submission, corrector)
+    sheetTypeDesc <- sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
    return (course, sheet, submission, corrector, sheetTypeDesc)
  whenIsJust corrector $ \corrector' ->
    addMailHeader "Reply-To" . renderAddress $ userAddressFrom corrector'
@ -29,7 +31,6 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
  csid <- encrypt nSubmission
  MsgRenderer mr <- getMailMsgRenderer
  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
  let sheetTypeDesc = mr sheetType
  submissionRatingTime' <- traverse (formatTimeMail SelFormatDateTime) submissionRatingTime
  let tid = courseTerm
      ssh = courseSchool
@ -38,4 +39,4 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
  editNotifications <- mkEditNotifications jRecipient
-  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+  addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
--- a/src/Jobs/Handler/SendNotification/Utils.hs
+++ b/src/Jobs/Handler/SendNotification/Utils.hs
@ -11,7 +11,7 @@ import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HashMap
-ihamletSomeMessage :: HtmlUrlI18n UniWorXMessage (Route UniWorX) -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
+ihamletSomeMessage :: HtmlUrlI18n UniWorXMessage route -> HtmlUrlI18n (SomeMessage UniWorX) route
 ihamletSomeMessage f trans = f $ trans . SomeMessage
 mkEditNotifications :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (HtmlUrlI18n UniWorXMessage (Route UniWorX))
--- a/src/Model.hs
+++ b/src/Model.hs
@ -23,6 +23,8 @@ import Text.Blaze (ToMarkup(..))
 import Database.Persist.Sql (BackendKey(..))
 import qualified Database.Esqueleto as E
 type SqlBackendKey = BackendKey SqlBackend
@ -38,6 +40,9 @@ share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateUni
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
 sqlSubmissionRatingDone :: E.SqlExpr (Entity Submission) -> E.SqlExpr (E.Value Bool)
 sqlSubmissionRatingDone submission = E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
 deriving newtype instance ToJSONKey UserId
 deriving newtype instance FromJSONKey UserId
@ -46,6 +51,8 @@ deriving newtype instance FromJSONKey ExamOccurrenceId
 deriving instance Show (Unique ExamPart)
 deriving anyclass instance NFData ExamPart
 -- ToMarkup and ToMessage instances for displaying selected database primary keys
 instance ToMarkup (Key School) where
--- a/src/Model/Migration/Definitions.hs
+++ b/src/Model/Migration/Definitions.hs
@ -96,6 +96,7 @@ data ManualMigration
  | Migration20200916ExamMode
  | Migration20201106StoredMarkup
  | Migration20201119RoomTypes
  | Migration20210115ExamPartsFrom
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)
@ -959,6 +960,14 @@ customMigrations = mapF $ \case
          migrateCourse _ = return ()
       in runConduit $ getCourses .| C.mapM_ migrateCourse
  Migration20210115ExamPartsFrom -> do
    whenM (tableExists "exam") $ do
      [executeQQ|ALTER TABLE "exam" ADD COLUMN "parts_from" timestamp with time zone|]
      let getExam = [queryQQ|SELECT "id", "finished" FROM "exam"|]
          migrateExam [ fromPersistValue -> Right (eId :: ExamId), fromPersistValue -> Right (finished :: Maybe UTCTime) ] = [executeQQ|UPDATE "exam" SET "parts_from" = #{finished} WHERE "id" = #{eId}|]
          migrateExam _ = return ()
       in runConduit $ getExam .| C.mapM_ migrateExam
 tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
 tableExists table = do
--- a/src/Model/Migration/Types.hs
+++ b/src/Model/Migration/Types.hs
@ -28,7 +28,7 @@ data SheetType
  | NotGraded
  deriving (Show, Read, Eq)
-sheetType :: SheetType -> Current.SheetType
+sheetType :: SheetType -> Current.SheetType a
 sheetType Bonus {..}  = Current.Bonus  Current.Points {..}
 sheetType Normal {..} = Current.Normal Current.Points {..}
 sheetType Pass {..}   = Current.Normal Current.PassPoints {..}
--- a/src/Model/Rating.hs
+++ b/src/Model/Rating.hs
@ -6,6 +6,9 @@ import CryptoID
 -- import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException(..))
 import Data.Aeson.TH
 import Utils.PathPiece
 data Rating = Rating
  { ratingCourseTerm :: TermIdentifier
@ -13,11 +16,17 @@ data Rating = Rating
  , ratingCourseName :: CourseName
  , ratingSheetName :: SheetName
  , ratingCorrectorName :: Maybe Text
-  , ratingSheetType :: SheetType
+  , ratingSheetType :: SheetType RatingExamPartReference
  , ratingValues :: Rating'
  } deriving (Read, Show, Eq, Generic, Typeable)
    deriving anyclass (NFData)
 data RatingExamPartReference = RatingExamPartReference
  { ratingExamName :: ExamName
  , ratingExamPartNumber :: ExamPartNumber
  } deriving (Read, Show, Eq, Ord, Generic, Typeable)
    deriving anyclass (NFData)
 data Rating' = Rating'
  { ratingPoints :: Maybe Points
  , ratingComment :: Maybe Text
@ -26,6 +35,11 @@ data Rating' = Rating'
  } deriving (Read, Show, Eq, Generic, Typeable)
    deriving anyclass (NFData)
 deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  } ''RatingExamPartReference
 data RatingValidityException
  = RatingNegative       -- ^ Rating points must be non-negative
  | RatingExceedsMax     -- ^ Rating point must not exceed maximum points
--- a/src/Model/Types/Exam.hs
+++ b/src/Model/Types/Exam.hs
@ -387,6 +387,7 @@ hasExamGradingGrades _                 = True
 newtype ExamPartNumber = ExamPartNumber { examPartNumberFragments :: [Either (CI Text) Natural] }
  deriving (Eq, Ord, Generic, Typeable)
  deriving anyclass (NFData)
 _ExamPartNumber :: Iso' ExamPartNumber (CI Text)
 _ExamPartNumber = iso pToText pFromText
--- a/src/Model/Types/Sheet.hs
+++ b/src/Model/Types/Sheet.hs
@ -1,3 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-|
 Module: Model.Types.Sheet
 Description: Types for modeling sheets
@ -15,6 +17,7 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.MultiSet as MultiSet
 import Text.Blaze (Markup)
@ -26,6 +29,7 @@ import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 data SheetGrading
  = Points     { maxPoints :: Points }
  | PassPoints { maxPoints, passingPoints :: Points }
@ -78,7 +82,7 @@ data SheetGradeSummary = SheetGradeSummary
  , 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)
+  } deriving (Generic, Read, Show, Eq, Ord)
 instance Monoid SheetGradeSummary where
  mempty  = memptydefault
@ -113,12 +117,17 @@ sheetGradeSum gr (Just p) =
        }
-data SheetType
+data SheetType exampartid
  = NotGraded
  | Normal        { grading :: SheetGrading }
  | Bonus         { grading :: SheetGrading }
  | Informational { grading :: SheetGrading }
-  deriving (Eq, Ord, Read, Show, Generic)
+  | ExamPartPoints
    { examPart  :: exampartid
    , weight    :: Rational
    , grading   :: SheetGrading
    }
  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Generic)
  deriving anyclass (NFData)
 deriveJSON defaultOptions
@ -131,27 +140,29 @@ derivePersistFieldJSON ''SheetType
 makeLenses_ ''SheetType
 makePrisms ''SheetType
-data SheetTypeSummary = SheetTypeSummary
+data SheetTypeSummary exampartid = SheetTypeSummary
  { normalSummary
  , bonusSummary
  , informationalSummary :: SheetGradeSummary
  , examSummary :: MergeMap exampartid (MultiSet (Rational, SheetGradeSummary))
  , numNotGraded :: Count
-  } deriving (Generic, Read, Show, Eq)
+  } deriving (Generic, Show, Eq)
-instance Monoid SheetTypeSummary where
+instance Ord epid => Monoid (SheetTypeSummary epid) where
  mempty  = memptydefault
  mappend = mappenddefault
-instance Semigroup SheetTypeSummary where
+instance Ord epid => Semigroup (SheetTypeSummary epid) where
  (<>) = mappend -- TODO: remove for GHC > 8.4.x
 makeLenses_ ''SheetTypeSummary
-sheetTypeSum :: SheetType -> Maybe Points -> SheetTypeSummary
+sheetTypeSum :: forall epid. Ord epid => SheetType epid -> Maybe Points -> SheetTypeSummary epid
-sheetTypeSum Bonus{..}         mps = mempty { bonusSummary         = sheetGradeSum grading mps }
+sheetTypeSum Bonus{..}          mps = mempty { bonusSummary         = sheetGradeSum grading mps }
-sheetTypeSum Normal{..}        mps = mempty { normalSummary        = sheetGradeSum grading mps }
+sheetTypeSum Normal{..}         mps = mempty { normalSummary        = sheetGradeSum grading mps }
-sheetTypeSum Informational{..} mps = mempty { informationalSummary = sheetGradeSum grading mps }
+sheetTypeSum Informational{..}  mps = mempty { informationalSummary = sheetGradeSum grading mps }
-sheetTypeSum NotGraded _           = mempty { numNotGraded         = Sum 1 }
+sheetTypeSum NotGraded          _   = mempty { numNotGraded         = Sum 1 }
 sheetTypeSum ExamPartPoints{..} mps = (mempty @(SheetTypeSummary epid)) { examSummary = MergeMap . Map.singleton examPart $ MultiSet.singleton (weight, sheetGradeSum grading mps) }
 data SheetGroup
  = Arbitrary { maxParticipants :: Natural }
@ -360,7 +371,7 @@ showCompactCorrectorLoad Load{..} CorrectorNormal  | byProportion == 0 = tutoria
                                      Just True  -> "(T)"
                                      Just False -> "T"
-instance Csv.ToField (SheetType, Maybe Points) where
+instance Csv.ToField (SheetType epid, Maybe Points) where
  toField (_, Nothing) = mempty
  toField (sType, Just res)
    | Just passed <- flip gradingPassed res =<< preview _grading sType
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -10,6 +10,8 @@ import qualified Data.Foldable as Fold
 import Data.Foldable as Utils (foldlM, foldrM)
 import Data.Monoid (First, Sum(..))
 import Data.Proxy
 import Control.Arrow (Kleisli(..))
 import Control.Arrow.Instances ()
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@ -36,7 +38,7 @@ import Utils.NTop as Utils
 import Utils.HttpConditional as Utils
 import Utils.Persist as Utils
-import Text.Blaze (Markup, ToMarkup)
+import Text.Blaze (Markup, ToMarkup(..))
 import Data.Char (isDigit, isSpace, isAscii)
 import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
@ -132,6 +134,10 @@ import Yesod.Core.Types.Instances.Catch ()
 import Control.Monad.Trans.Resource
 import Control.Monad.Reader.Class (MonadReader(local))
 import Text.Hamlet (Translate)
 import Data.Ratio ((%))
 {-# ANN module ("HLint: ignore Use asum" :: String) #-}
@ -148,6 +154,9 @@ getMsgRenderer = do
  mr <- getMessageRender
  return $ MsgRenderer (mr . SomeMessage :: forall msg. RenderMessage site msg => msg -> Text)
 getTranslate :: forall m site msg. (MonadHandler m, HandlerSite m ~ site, RenderMessage site msg) => m (Translate msg)
 getTranslate = (toMarkup .) <$> getMessageRender
 guardAuthResult :: MonadHandler m => AuthResult -> m ()
 guardAuthResult AuthenticationRequired = notAuthenticated
@ -346,6 +355,14 @@ rationalToFixed2 = rationalToFixed
 realToFixed :: forall a n. (Real n, HasResolution a) => n -> Fixed a
 realToFixed = rationalToFixed . toRational
 roundToPoints :: forall a. HasResolution a => Rational -> Fixed a
 roundToPoints ((* toRational (resolution $ Proxy @a)) -> raw) = MkFixed $
  let (whole, frac) = properFraction raw
   in if | abs frac < abs (1 % 2)
           -> whole
         | otherwise
           -> succ whole
 ----------
 -- Bool --
 ----------
@ -427,6 +444,9 @@ guardMonoid :: Monoid m => Bool -> m -> m
 guardMonoid False _ = mempty
 guardMonoid True  x = x
 assertMonoid :: Monoid m => (m -> Bool) -> m -> m
 assertMonoid f x = guardMonoid (f x) x
 ------------
 -- Tuples --
 ------------
@ -442,7 +462,8 @@ trd3 (_,_,z) = z
 -- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
 -- snd3 = $(projNI 3 2)
-
+mTuple :: Applicative f => f a -> f b -> f (a, b)
 mTuple = liftA2 (,)
 -----------
 -- Lists --
@ -574,6 +595,9 @@ partitionKeysEither = over _2 (Map.mapKeysMonotonic . view $ singular _Right) .
 mapFromSetM :: Applicative m => (k -> m v) -> Set k -> m (Map k v)
 mapFromSetM = (sequenceA .) . Map.fromSet
 mapFilterM :: (Monad m, Ord k) => (v -> m Bool) -> Map k v -> m (Map k v)
 mapFilterM f m = ($ m) . runKleisli $ foldMap (Kleisli . Map.alterF (runMaybeT . assertMM (lift . f) . hoistMaybe)) (Map.keys m)
 ---------------
 -- Functions --
 ---------------
@ -893,6 +917,7 @@ diffTimeout timeoutLength timeoutRes act = fromMaybe timeoutRes <$> timeout time
      = let (MkFixed micro :: Micro) = realToFrac timeoutLength
         in fromInteger micro
 --------------
 -- Foldable --
 --------------
@ -1469,7 +1494,6 @@ instance (Ord k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON (MergeMap k
      parseJSONElemAtIndex :: (Value -> Aeson.Parser a) -> Int -> Vector Value -> Aeson.Parser a
      parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) Aeson.<?> Aeson.Index idx
 --------------
 -- FilePath --
 --------------
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -161,6 +161,8 @@ makeLenses_ ''SubmissionGroup
 makeLenses_ ''SheetGrading
 makeLenses_ ''Sheet
 makePrisms ''SheetGroup
 makePrisms ''AuthResult
--- a/src/Utils/Workflow/Lint.hs
+++ b/src/Utils/Workflow/Lint.hs
@ -6,7 +6,6 @@ module Utils.Workflow.Lint
 import Import.NoFoundation
 import qualified Data.Set as Set
 import Data.MultiSet (MultiSet)
 import qualified Data.MultiSet as MultiSet
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
--- a/templates/correction-user.hamlet
+++ b/templates/correction-user.hamlet
@ -17,11 +17,11 @@
        $case grading 
          $of Points{..}
            <tr .table__row>
-              <th .table__th>_{sheetType}
+              <th .table__th>^{sheetTypeDesc tr}
              <td .table__td>_{MsgAchievedOf points maxPoints}
          $of PassPoints{..}
            <tr .table__row>
-              <th .table__th>_{sheetType}
+              <th .table__th>^{sheetTypeDesc tr}
              <td .table__td>
                $if fromMaybe False (gradingPassed grading points)
                  _{MsgPassed}
@ -32,7 +32,7 @@
              <td .table__td>_{MsgPassAchievedOf points passingPoints maxPoints}
          $of PassBinary
            <tr .table__row>
-              <th .table__th>_{sheetType}
+              <th .table__th>^{sheetTypeDesc tr}
              <td .table__td>
                $if fromMaybe False (gradingPassed grading points)
                  _{MsgPassed}
--- a/templates/exam-show.hamlet
+++ b/templates/exam-show.hamlet
@ -260,11 +260,11 @@ $if not (null occurrences)
          <td>
-$if gradingShown && not (null examParts)
+$if (gradingShown || partsShown) && not (null examParts)
  <section>
    <h2>
      _{MsgExamParts}
-      $if gradingShown && not gradingVisible
+      $if (gradingShown && not gradingVisible) || (partsShown && not partsVisible)
        \ ^{isVisible False}
    <table .table .table--striped .table--hover >
      <thead>
@ -273,13 +273,15 @@ $if gradingShown && not (null examParts)
            <th .table__th>
              _{MsgExamPartNumber} ^{isVisible False}
          <th .table__th>_{MsgExamPartName}
          $if showPartSheets
            <th .table__th>_{MsgExamPartSheets}
          $if showMaxPoints
            <th .table__th>_{MsgExamPartMaxPoints}
          $if showAchievedPoints
            <th .table__th>_{MsgExamPartResultPoints}
      <tbody>
-        $forall Entity partId ExamPart{examPartNumber, examPartName, examPartWeight, examPartMaxPoints} <- examParts
+        $forall (Entity partId ExamPart{examPartNumber, examPartName, examPartWeight, examPartMaxPoints}, cID, partSheets) <- examParts
-          <tr .table__row>
+          <tr .table__row ##{toPathPiece cID}>
            $if partNumbersShown
              <td .table__td>#{examPartNumber}
            <td .table__td>
@ -287,6 +289,14 @@ $if gradingShown && not (null examParts)
                #{pName}
              $nothing
                _{MsgExamPartNumbered examPartNumber}
            $if showPartSheets
              <td .table__td>
                $if not (null partSheets)
                  <ul .list--inline .list--comma-separated>
                    $forall Entity _ Sheet{sheetName} <- partSheets
                      <li>
                        <a href=@{CSheetR tid ssh csh sheetName SShowR}>
                          #{sheetName}
            $if showMaxPoints
              <td .table__td>
                $maybe mPoints <- examPartMaxPoints
--- a/templates/i18n/changelog/exam-sheets.de-de-formal.hamlet
+++ b/templates/i18n/changelog/exam-sheets.de-de-formal.hamlet
@ -0,0 +1,2 @@
 $newline never
 Übungsblätter können nun „als Prüfungsaufgabe“ bewertet werden.
--- a/templates/i18n/changelog/exam-sheets.en-eu.hamlet
+++ b/templates/i18n/changelog/exam-sheets.en-eu.hamlet
@ -0,0 +1,2 @@
 $newline never
 Exercise sheets can now be rated “as an exam part”.
--- a/templates/mail/submissionRated.hamlet
+++ b/templates/mail/submissionRated.hamlet
@ -16,52 +16,52 @@ $newline never
      }
  <body>
    <h1>
-      _{MsgMailSubmissionRatedIntro (CI.original courseName) termDesc}
+      _{SomeMessage (MsgMailSubmissionRatedIntro (CI.original courseName) termDesc)}
    <dl>
      <dt>
-        _{MsgSubmission}
+        _{SomeMessage MsgSubmission}
      <dd>
        <a href=@{CSubmissionR tid ssh csh shn csid SubShowR}>
          #{csid}
      $maybe User{userDisplayName, userSurname, userEmail} <- corrector
        <dt>
-          _{MsgRatingBy}
+          _{SomeMessage MsgRatingBy}
        <dd>
          #{nameEmailHtml userEmail userDisplayName userSurname}
      $maybe time <- submissionRatingTime'
        <dt>
-          _{MsgRatingTime}
+          _{SomeMessage MsgRatingTime}
        <dd>
          #{time}
-      <dt> #{sheetTypeDesc}
+      <dt> ^{sheetTypeDesc}
      $maybe points <- submissionRatingPoints
        $maybe grading <- preview _grading sheetType
          $case grading 
            $of Points{..}
              <dd>
-                _{MsgAchievedOf points maxPoints}          
+                _{SomeMessage (MsgAchievedOf points maxPoints)}
            $of PassPoints{..}
              <dd>
                $if fromMaybe False (gradingPassed grading points)
-                  _{MsgPassed}
+                  _{SomeMessage MsgPassed}
                $else
-                  _{MsgNotPassed}
+                  _{SomeMessage MsgNotPassed}
              <dt>
-                _{MsgAchievedPassPoints}
+                _{SomeMessage MsgAchievedPassPoints}
              <dd>
-                _{MsgPassAchievedOf points passingPoints maxPoints}
+                _{SomeMessage (MsgPassAchievedOf points passingPoints maxPoints)}
            $of PassBinary
              <dd>
                $if fromMaybe False (gradingPassed grading points)
-                  _{MsgPassed}
+                  _{SomeMessage MsgPassed}
                $else
-                  _{MsgNotPassed}
+                  _{SomeMessage MsgNotPassed}
            $of PassAlways
              <dd>
      $maybe comment <- submissionRatingComment
        <dt>
-          _{MsgRatingComment}
+          _{SomeMessage MsgRatingComment}
        <dd .comment>
          #{comment}
-    ^{editNotifications}
+    ^{ihamletSomeMessage editNotifications}
--- a/templates/sheetShow.hamlet
+++ b/templates/sheetShow.hamlet
@ -66,8 +66,10 @@ $maybe descr <- sheetDescription sheet
          $nothing
            ^{generateForm}
      $of _
-    <dt .deflist__dt>_{MsgSheetType}
+    <dt .deflist__dt>
-    <dd .deflist__dd>_{sheetType sheet}
+      _{MsgSheetType}
    <dd .deflist__dd>
      ^{sTypeDesc tr}
 $maybe marktxt <- markingText
  <section>
--- a/templates/widgets/rating/rating.hamlet
+++ b/templates/widgets/rating/rating.hamlet
@ -8,20 +8,17 @@ $if submissionRatingDone sub
    $case grading
      $of Points{..}
        _{MsgAchievedOf points maxPoints}
        , #
      $of PassPoints{maxPoints}
        $if fromMaybe False (gradingPassed grading points)
          _{MsgPassed}, _{MsgAchievedOf points maxPoints}
        $else
          _{MsgNotPassed}, _{MsgAchievedOf points maxPoints}
        , #
      $of PassBinary
        $if fromMaybe False (gradingPassed grading points)
          _{MsgPassed}
        $else
          _{MsgNotPassed}
        , #
      $of PassAlways
-    _{SheetTypeHeader sheetType}
+        #{hasTickmark True}
  $nothing
    #{hasTickmark True}
--- a/templates/widgets/sheetType.hamlet
+++ b/templates/widgets/sheetType.hamlet
@ -0,0 +1,13 @@
 $newline never
 $maybe g <- preview _grading sType
  _{SomeMessage g}, #
 _{SomeMessage (classifySheetType sType)}
 $maybe ((eName, epName, epNumber, partVisible, gradingVisible, eRoute), weight, _) <- preview _ExamPartPoints sType
  \ (
  <a href=@{eRoute}>
    #{eName}
  $if partVisible
    \ - _{fromMaybe (SomeMessage (MsgExamPartNumbered epNumber)) (fmap SomeMessage epName)}
    $if gradingVisible
      , _{SomeMessage MsgSheetTypeExamPartPointsWeight} _{SomeMessage (rationalToFixed3 weight)}
  )
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@ -3,7 +3,7 @@ module Database.Fill
  ) where
 import "uniworx" Import hiding (Option(..), currentYear)
-import Handler.Utils.Form (SheetGrading'(..), SheetType'(..), SheetGroup'(..))
+import Handler.Utils.Form (SheetGrading'(..), SheetGroup'(..))
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as Text
@ -708,6 +708,7 @@ fillDb = do
    , examStart = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 10 0 0)
    , examEnd = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 12 0 0)
    , examFinished = Just $ termTime True Summer 3 True Wednesday (toTimeOfDay 22 0 0)
    , examPartsFrom = Just $ termTime True Summer (-4) True Monday toMidnight
    , examClosed = Nothing
    , examPublicStatistics = True
    , examGradingMode = ExamGradingGrades
@ -888,11 +889,7 @@ fillDb = do
          | otherwise
          = mr sheetType'
          where
-            sheetType' = case sheetType of
+            sheetType' = classifySheetType sheetType
              NotGraded -> NotGraded'
              Normal{} -> Normal'
              Bonus{} -> Bonus'
              Informational{} -> Informational'
        prog = 14 * (shNr % genericLength sheetCombinations)
--- a/test/Model/RatingSpec.hs
+++ b/test/Model/RatingSpec.hs
@ -4,6 +4,10 @@ import TestImport
 import ModelSpec ()
 import Model.Rating
 instance Arbitrary RatingExamPartReference where
  arbitrary = genericArbitrary
  shrink = genericShrink
 instance Arbitrary Rating' where
  arbitrary = genericArbitrary
  shrink = genericShrink
--- a/test/Model/TypesSpec.hs
+++ b/test/Model/TypesSpec.hs
@ -91,7 +91,7 @@ instance Arbitrary SheetGrading where
    ]
  shrink = genericShrink
-instance Arbitrary SheetType where
+instance Arbitrary epId => Arbitrary (SheetType epId) where
  arbitrary = genericArbitrary
  shrink = genericShrink
@ -103,9 +103,8 @@ instance Arbitrary SheetGroup where
  arbitrary = genericArbitrary
  shrink = genericShrink
-instance Arbitrary SheetTypeSummary where
+instance (Arbitrary epId, Ord epId) => Arbitrary (SheetTypeSummary epId) where
-  arbitrary = genericArbitrary
+  arbitrary = foldMap (uncurry sheetTypeSum) <$> listOf arbitrary
  shrink = genericShrink
 instance Arbitrary SheetFileType where
  arbitrary = genericArbitrary
@ -342,10 +341,10 @@ spec = do
      [ eqLaws, showReadLaws, jsonLaws, persistFieldLaws ]
    lawsCheckHspec (Proxy @SheetGradeSummary)
      [ eqLaws, showReadLaws, commutativeMonoidLaws, commutativeSemigroupLaws ]
-    lawsCheckHspec (Proxy @SheetType)
+    lawsCheckHspec (Proxy @(SheetType SqlBackendKey))
      [ eqLaws, showReadLaws, jsonLaws, persistFieldLaws ]
-    lawsCheckHspec (Proxy @SheetTypeSummary)
+    lawsCheckHspec (Proxy @(SheetTypeSummary SqlBackendKey))
-      [ eqLaws, showReadLaws, commutativeMonoidLaws ]
+      [ eqLaws, showLaws, commutativeMonoidLaws ]
    lawsCheckHspec (Proxy @SheetGroup)
      [ eqLaws, showReadLaws, jsonLaws, persistFieldLaws ]
    lawsCheckHspec (Proxy @SheetFileType)
		`@ -0,0 +1,2 @@`
							`$newline never`
							`Übungsblätter können nun „als Prüfungsaufgabe“ bewertet werden.`
		`@ -0,0 +1,2 @@`
							`$newline never`
							`Exercise sheets can now be rated “as an exam part”.`