-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Exam.Users
  ( getEUsersR, postEUsersR
  ) where

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

import Handler.Utils
import Handler.Utils.Exam
import Handler.Utils.Users
import Handler.Utils.Csv
import Handler.Utils.StudyFeatures

import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget)

import Handler.ExamOffice.Exam (examCloseWidget, examFinishWidget)

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH

import qualified Data.Csv as Csv

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

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

import qualified Data.Conduit.List as C

import qualified Data.CaseInsensitive as CI

import Numeric.Lens (integral)

import Database.Persist.Sql (updateWhereCount)

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

import Jobs.Queue

import qualified Control.Monad.State.Class as State


type ExamUserTableExpr = (              E.SqlExpr (Entity ExamRegistration)
                          `E.InnerJoin` E.SqlExpr (Entity User)
                         )
       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence))
       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseParticipant))
       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamBonus))
       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult))
       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
type ExamUserTableData = DBRow ( Entity ExamRegistration
                               , Entity User
                               , Maybe (Entity ExamOccurrence)
                               , Maybe (Entity ExamBonus)
                               , Maybe (Entity ExamResult)
                               , Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult))
                               , Maybe (Entity CourseUserNote)
                               , UserTableStudyFeatures
                               )

instance HasEntity ExamUserTableData User where
  hasEntity = _dbrOutput . _2

instance HasUser ExamUserTableData where
  hasUser = _dbrOutput . _2 . _entityVal

_userTableOccurrence :: Lens' ExamUserTableData (Maybe (Entity ExamOccurrence))
_userTableOccurrence = _dbrOutput . _3

queryUser :: ExamUserTableExpr -> E.SqlExpr (Entity User)
queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 6 1)

queryExamRegistration :: ExamUserTableExpr -> E.SqlExpr (Entity ExamRegistration)
queryExamRegistration = $(sqlIJproj 2 1) . $(sqlLOJproj 6 1)

queryExamOccurrence :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamOccurrence))
queryExamOccurrence = $(sqlLOJproj 6 2)

queryCourseParticipant :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseParticipant))
queryCourseParticipant = $(sqlLOJproj 6 3)

queryExamBonus :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamBonus))
queryExamBonus = $(sqlLOJproj 6 4)

queryExamResult :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamResult))
queryExamResult = $(sqlLOJproj 6 5)

queryCourseNote :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
queryCourseNote = $(sqlLOJproj 6 6)

queryExamPart :: forall a.
                 PersistField a
              => ExamPartId
              -> (E.SqlExpr (Entity ExamPart) -> E.SqlExpr (Maybe (Entity ExamPartResult)) -> E.SqlQuery (E.SqlExpr (E.Value a)))
              -> ExamUserTableExpr
              -> E.SqlExpr (E.Value a)
queryExamPart epId cont inp = E.subSelectUnsafe . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> flip runReaderT inp $ do
  examRegistration <- asks queryExamRegistration

  lift $ do
    E.on $ E.just (examPart E.^. ExamPartId) E.==. examPartResult E.?. ExamPartResultExamPart
     E.&&. examPartResult E.?. ExamPartResultUser E.==. E.just (examRegistration E.^. ExamRegistrationUser)
    E.where_ $ examPart E.^. ExamPartExam E.==. examRegistration E.^. ExamRegistrationExam
         E.&&. examPart E.^. ExamPartId E.==. E.val epId

    cont examPart examPartResult

resultExamRegistration :: Lens' ExamUserTableData (Entity ExamRegistration)
resultExamRegistration = _dbrOutput . _1

resultUser :: Lens' ExamUserTableData (Entity User)
resultUser = _dbrOutput . _2

resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
resultExamOccurrence = _dbrOutput . _3 . _Just

resultExamBonus :: Traversal' ExamUserTableData (Entity ExamBonus)
resultExamBonus = _dbrOutput . _4 . _Just

resultExamResult :: Traversal' ExamUserTableData (Entity ExamResult)
resultExamResult = _dbrOutput . _5 . _Just

resultExamParts :: IndexedTraversal' ExamPartId ExamUserTableData (ExamPart, Maybe (Entity ExamPartResult))
resultExamParts = _dbrOutput . _6 . itraversed

-- resultExamParts' :: Traversal' ExamUserTableData (Entity ExamPart)
-- resultExamParts' = (resultExamParts <. _1) . withIndex . from _Entity

resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult))
resultExamPartResult epId = _dbrOutput . _6 . unsafeSingular (ix epId) . _2

-- resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult))
-- resultExamPartResults = resultExamParts <. _2

resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote)
resultCourseNote = _dbrOutput . _7 . _Just

resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures
resultStudyFeatures = _dbrOutput . _8


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 ExamPartId)
                          -> Map UserId (SheetTypeSummary ExamPartId)
                          -> Fold ExamUserTableData ExamResultPassedGrade
resultAutomaticExamResult exam@Exam{..} examBonus' resultSheets = folding . runReader $ do
  parts' <- asks (itoListOf resultExamParts) >>= mapM (\(epId, (ep, mRes)) -> runMaybeT $ hoistMaybe (mRes ^? _Just . _entityVal . _examPartResultResult)
                                                                                      <|> MaybeT (preview $ resultAutomaticExamPartResult (Entity epId ep) resultSheets)
                                                      )
  bonus <- preview $ resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus exam examBonus'
  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 resultSheets = folding . runReader . runMaybeT $ do
  uid <- view $ resultUser . _entityKey
  summary <- hoistMaybe $ Map.lookup uid resultSheets
  hoistMaybe $ sheetExamResult summary epEnt


csvExamPartHeader :: Prism' Csv.Name ExamPartNumber
csvExamPartHeader = prism' toHeader fromHeader
  where
    toHeader pName = encodeUtf8 $ partPrefix <> CI.foldedCase (pName ^. _ExamPartNumber)
    fromHeader hdr = do
      tHdr <- either (const Nothing) Just $ Text.decodeUtf8' hdr
      review _ExamPartNumber . CI.mk <$> stripPrefix partPrefix tHdr

    partPrefix = "part-"


data ExamUserTableCsv = ExamUserTableCsv
  { csvEUserSurname :: Maybe Text
  , csvEUserFirstName :: Maybe Text
  , csvEUserName :: Maybe Text
  , csvEUserMatriculation :: Maybe Text
  , csvEUserEPPN :: Maybe UserEduPersonPrincipalName
  , csvEUserStudyFeatures :: UserTableStudyFeatures
  , csvEUserOccurrence :: Maybe (CI Text)
  , csvEUserExercisePoints :: Maybe (Maybe Points)
  , csvEUserExerciseNumPasses :: Maybe (Maybe Int)
  , csvEUserExercisePointsMax :: Maybe (Maybe Points)
  , csvEUserExerciseNumPassesMax :: Maybe (Maybe Int)
  , csvEUserBonus :: Maybe (Maybe Points)
  , csvEUserExamPartResults :: Map ExamPartNumber (Maybe ExamResultPoints)
  , csvEUserExamResult :: Maybe ExamResultPassedGrade
  , csvEUserCourseNote :: Maybe StoredMarkup
  }
  deriving (Generic)
makeLenses_ ''ExamUserTableCsv

instance ToNamedRecord ExamUserTableCsv where
  toNamedRecord ExamUserTableCsv{..} = Csv.namedRecord $
    [ "surname" Csv..= csvEUserSurname
    , "first-name" Csv..= csvEUserFirstName
    , "name" Csv..= csvEUserName
    , "matriculation" Csv..= csvEUserMatriculation
    , "eduPersonPrincipalName" Csv..= csvEUserEPPN
    , "study-features" Csv..= csvEUserStudyFeatures
    , "occurrence" Csv..= csvEUserOccurrence
    ] ++ catMaybes
           [ fmap ("exercise-points" Csv..=) csvEUserExercisePoints
           , fmap ("exercise-num-passes" Csv..=) csvEUserExerciseNumPasses
           , fmap ("exercise-points-max" Csv..=) csvEUserExercisePointsMax
           , fmap ("exercise-num-passes-max" Csv..=) csvEUserExerciseNumPassesMax
           , fmap ("bonus" Csv..=) csvEUserBonus
           ]
      ++ examPartResults ++
    [ "exam-result" Csv..= csvEUserExamResult
    , "course-note" Csv..= csvEUserCourseNote
    ]
    where
      examPartResults
        = flip ifoldMap csvEUserExamPartResults $
            \pNumber pResult -> pure $ (csvExamPartHeader # pNumber) Csv..= pResult

instance FromNamedRecord ExamUserTableCsv where
  parseNamedRecord (lsfHeaderTranslate -> csv)
    = ExamUserTableCsv
      <$> csv .:?? "surname"
      <*> csv .:?? "first-name"
      <*> csv .:?? "name"
      <*> csv .:?? "matriculation"
      <*> csv .:?? "eduPersonPrincipalName"
      <*> pure mempty
      <*> csv .:?? "occurrence"
      <*> fmap Just (csv .:?? "exercise-points")
      <*> fmap Just (csv .:?? "exercise-num-passes")
      <*> fmap Just (csv .:?? "exercise-points-max")
      <*> fmap Just (csv .:?? "exercise-num-passes-max")
      <*> fmap Just (csv .:?? "bonus")
      <*> examPartResults
      <*> csv .:?? "exam-result"
      <*> csv .:?? "course-note"
    where
      examPartResults = fmap fold . sequence . flip HashMap.mapMaybeWithKey csv $ \pNumber' _ -> do
        pNumber <- pNumber' ^? csvExamPartHeader
        return . fmap (singletonMap pNumber ) $ csv .:?? pNumber'

instance CsvColumnsExplained ExamUserTableCsv where
  csvColumnsExplanations _ = mconcat
    [ single "surname"                 MsgCsvColumnExamUserSurname
    , single "first-name"              MsgCsvColumnExamUserFirstName
    , single "name"                    MsgCsvColumnExamUserName
    , single "matriculation"           MsgCsvColumnExamUserMatriculation
    , single "study-features"          MsgCsvColumnUserStudyFeatures
    , single "occurrence"              MsgCsvColumnExamUserOccurrence
    , single "exercise-points"         MsgCsvColumnExamUserExercisePoints
    , single "exercise-num-passes"     MsgCsvColumnExamUserExercisePasses
    , single "exercise-points-max"     MsgCsvColumnExamUserExercisePointsMax
    , single "exercise-num-passes-max" MsgCsvColumnExamUserExercisePassesMax
    , single "bonus"                   MsgCsvColumnExamUserBonus
    , single "part-*"                  MsgCsvColumnExamUserParts
    , single "exam-result"             MsgCsvColumnExamUserResult
    , single "course-note"             MsgCsvColumnExamUserCourseNote
    ]
    where
      single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
      single k v = singletonMap k [whamlet|_{v}|]

examUserTableCsvHeader :: ( MonoFoldable mono
                          , Element mono ~ ExamPartNumber
                          )
                       => SheetGradeSummary -> Bool -> mono -> Csv.Header
examUserTableCsvHeader allBoni doBonus pNames = Csv.header $
  [ "surname", "first-name", "name"
  , "matriculation", "eduPersonPrincipalName"
  , "study-features"
  , "course-note"
  , "occurrence"
  ] ++ bool mempty ["exercise-points", "exercise-points-max"] (doBonus && showPoints)
    ++ bool mempty ["exercise-num-passes", "exercise-num-passes-max"] (doBonus && showPasses)
    ++ bool mempty ["bonus"] doBonus
    ++ map (review csvExamPartHeader) (sort $ otoList pNames) ++
  [ "exam-result"
  ]
  where
    showPasses = numSheetsPasses allBoni /= 0
    showPoints = getSum (numSheetsPoints allBoni) /= 0

data ExamUserAction = ExamUserDeregister
                    | ExamUserAssignOccurrence
                    | ExamUserSetPartResult
                    | ExamUserSetBonus
                    | ExamUserSetResult
                    | ExamUserAcceptComputedResult
                    | ExamUserResetToComputedResult
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

instance Universe ExamUserAction
instance Finite ExamUserAction
nullaryPathPiece ''ExamUserAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''ExamUserAction id

data ExamUserActionData = ExamUserDeregisterData
                        | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
                        | ExamUserSetPartResultData ExamPartNumber (Maybe ExamResultPoints)
                        | ExamUserSetBonusData (Maybe Points)
                        | ExamUserSetResultData (Maybe ExamResultPassedGrade)
                        | ExamUserAcceptComputedResultData
                        | ExamUserResetToComputedResultData
                          { examUserResetBonus
                          , examUserResetParts :: Bool
                          }


data ExamUserCsvActionClass
  = ExamUserCsvCourseRegister
  | ExamUserCsvRegister
  | ExamUserCsvAssignOccurrence
  | ExamUserCsvSetPartResult
  | ExamUserCsvSetBonus
  | ExamUserCsvOverrideBonus
  | ExamUserCsvSetResult
  | ExamUserCsvOverrideResult
  | ExamUserCsvSetCourseNote
  | ExamUserCsvDeregister
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id

data ExamUserCsvAction
  = ExamUserCsvCourseRegisterData
    { examUserCsvActUser :: UserId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvRegisterData
    { examUserCsvActUser :: UserId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvAssignOccurrenceData
    { examUserCsvActRegistration :: ExamRegistrationId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvDeregisterData
    { examUserCsvActRegistration :: ExamRegistrationId
    }
  | ExamUserCsvSetPartResultData
    { examUserCsvActUser :: UserId
    , examUserCsvActExamPart :: ExamPartNumber
    , examUserCsvActExamPartResult :: Maybe ExamResultPoints
    }
  | ExamUserCsvSetBonusData
    { examUserCsvIsBonusOverride :: Bool
    , examUserCsvActUser :: UserId
    , examUserCsvActExamBonus :: Maybe Points
    }
  | ExamUserCsvSetResultData
    { examUserCsvIsResultOverride :: Bool
    , examUserCsvActUser :: UserId
    , examUserCsvActExamResult :: Maybe ExamResultPassedGrade
    }
  | ExamUserCsvSetCourseNoteData
    { examUserCsvActUser :: UserId
    , examUserCsvActCourseNote :: Maybe StoredMarkup
    }
  deriving (Eq, Ord, Read, Show, Generic)
deriveJSON defaultOptions
  { constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel
  , fieldLabelModifier = camelToPathPiece' 4
  , sumEncoding = TaggedObject "action" "data"
  } ''ExamUserCsvAction

data ExamUserCsvException
  = ExamUserCsvExceptionNoMatchingUser
  | ExamUserCsvExceptionMultipleMatchingUsers
  | ExamUserCsvExceptionNoMatchingStudyFeatures
  | ExamUserCsvExceptionNoMatchingOccurrence
  | ExamUserCsvExceptionMismatchedGradingMode ExamGradingMode ExamGradingMode
  deriving (Show, Generic)

instance Exception ExamUserCsvException

embedRenderMessage ''UniWorX ''ExamUserCsvException id

getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getEUsersR = postEUsersR
postEUsersR tid ssh csh examn = do
  (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, (bonus, resultSheets)) <- runDB $ do
    exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn
    Course{..} <- getJust examCourse
    occurrences <- selectList [ExamOccurrenceExam ==. eid] [Asc ExamOccurrenceName]
    examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
    bonus <- examRelevantSheets exam True
    resultSheets <- examRelevantSheets exam False

    let
      allBoni :: SheetGradeSummary
      allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus

      doBonus = is _Just examBonusRule
      showPasses = doBonus && numSheetsPasses allBoni /= 0
      showPoints = doBonus && getSum (numSheetsPoints allBoni) /= 0

      examPartNumbers = examParts ^.. folded . _entityVal . _examPartNumber

      resultAutomaticExamBonus' :: Fold ExamUserTableData Points
      resultAutomaticExamBonus' = resultAutomaticExamBonus examVal bonus
      resultAutomaticExamResult' :: Fold ExamUserTableData ExamResultPassedGrade
      resultAutomaticExamResult' = resultAutomaticExamResult examVal bonus resultSheets

      automaticCell :: forall msg m a b r.
                       ( RenderMessage UniWorX msg
                       , IsDBTable m a
                       , Eq msg
                       , Monoid b
                       , a ~ (Any, b)
                       )
                    => Getting (Endo [Either msg msg]) r (Either msg msg)
                    -> r
                    -> DBCell m a
      automaticCell l r = case toListOf l r of
        [] -> mempty
        (Left auto : _)
          -> i18nCell auto & cellAttrs <>~ [("class", "table__td--automatic")] & tellCell (Any True, mempty)
        (Right man : others)
          | all ((== man) . either id id) others
            -> i18nCell man
          | otherwise
            -> i18nCell man & cellAttrs <>~ [("class", "table__td--overriden")] & tellCell (Any True, mempty)

    let
      examUsersDBTable = DBTable{..}
        where
          dbtSQLQuery = runReaderT $ do
            examRegistration  <- asks queryExamRegistration
            user              <- asks queryUser
            occurrence        <- asks queryExamOccurrence
            courseParticipant <- asks queryCourseParticipant
            examBonus'        <- asks queryExamBonus
            examResult        <- asks queryExamResult
            courseUserNote    <- asks queryCourseNote

            lift $ do
              E.on $ courseUserNote E.?. CourseUserNoteUser E.==. E.just (user E.^. UserId)
               E.&&. courseUserNote E.?. CourseUserNoteCourse E.==. E.just (E.val examCourse)
              E.on $ examResult E.?. ExamResultUser E.==. E.just (user E.^. UserId)
               E.&&. examResult E.?. ExamResultExam E.==. E.just (E.val eid)
              E.on $ examBonus' E.?. ExamBonusUser E.==. E.just (user E.^. UserId)
               E.&&. examBonus' E.?. ExamBonusExam E.==. E.just (E.val eid)
              E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
               E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
               E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
              E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
               E.&&. occurrence E.?. ExamOccurrenceId   E.==. examRegistration E.^. ExamRegistrationOccurrence
              E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId

              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid

            return (examRegistration, user, occurrence, examBonus', examResult, courseUserNote)
          dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
          dbtProj = dbtProjSimple . runReaderT $
            (,,,,,,,)
              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5
              <*> getExamParts
              <*> view _6
              <*> (lift . courseUserStudyFeatures examCourse =<< view (_2 . _entityKey))
            where
              getExamParts :: ReaderT _ DB (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
              getExamParts = do
                uid <- view $ _2 . _entityKey
                rawResults <- lift . E.select . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> do
                  E.on $ examPartResult E.?. ExamPartResultExamPart E.==. E.just (examPart E.^. ExamPartId)
                   E.&&. examPartResult E.?. ExamPartResultUser     E.==. E.just (E.val uid)
                  E.where_ $ examPart E.^. ExamPartExam E.==. E.val eid
                  return (examPart, examPartResult)
                return $ Map.fromList
                  [ (epId, (examPart, mbRes))
                  | (Entity epId examPart, mbRes) <- rawResults
                  ]

          dbtColonnade = mconcat $ catMaybes
            [ pure $ dbSelect (_2 . applying _2) _1 $ return . view (resultExamRegistration . _entityKey)
            , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
            , pure $ colUserMatriclenr False
            , pure $ colStudyFeatures resultStudyFeatures
            , pure $ sortable (Just "occurrence") (i18nCell MsgTableExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
            , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) ->
                let SheetGradeSummary{achievedPasses} = examBonusAchieved uid bonus
                    SheetGradeSummary{numSheetsPasses} = examBonusPossible uid bonus
                 in propCell (getSum achievedPasses) (getSum numSheetsPasses)
            , guardOn showPoints $ sortable Nothing (i18nCell MsgAchievedPoints) $ \(view $ resultUser . _entityKey -> uid) ->
                let SheetGradeSummary{achievedPoints} = examBonusAchieved uid bonus
                    SheetGradeSummary{sumSheetsPoints} = examBonusPossible uid bonus
                 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) . automaticCell $ resultExamPartResult epId . _Just . _entityVal . _examPartResultResult . to Right <> resultAutomaticExamPartResult epEnt resultSheets . to Left
              | epEnt@(Entity epId ExamPart{..}) <- sortOn (examPartNumber . entityVal) examParts
              ]
            , pure $ sortable (Just "exam-result") (i18nCell MsgTableExamResult) . automaticCell $ (resultExamResult . _entityVal . _examResultResult . to Right <> resultAutomaticExamResult' . to Left)
            , pure . sortable (Just "note") (i18nCell MsgExamCourseUserNote) $ \((,) <$> view (resultUser . _entityKey) <*> has resultCourseNote -> (uid, hasNote))
                -> bool mempty (anchorCellM (CourseR tid ssh csh . CUserR <$> encrypt uid) $ hasComment True) hasNote
            ]
          dbtSorting = mconcat
            [ uncurry singletonMap $ sortUserNameLink     queryUser
            , uncurry singletonMap $ sortUserMatriclenr   queryUser
            , mconcat
              [ singletonMap (fromText [st|part-#{toPathPiece examPartNumber}|]) . SortColumn . queryExamPart epId $ \_ examPartResult -> return $ examPartResult E.?. ExamPartResultResult
              | Entity epId ExamPart{..} <- examParts
              ]
            , singletonMap "occurrence" . SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName)
            , singletonMap "bonus" . SortColumn $ queryExamBonus >>> (E.?. ExamBonusBonus)
            , sortExamResult (to $ queryExamResult >>> (E.?. ExamResultResult))
            , singletonMap "note" . SortColumn $ queryCourseNote >>> \note -> -- sort by last edit date
                E.subSelectMaybe . E.from $ \edit -> do
                  E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
                  return . E.max_ $ edit E.^. CourseUserNoteEditTime
            ]
          dbtFilter = mconcat
            [ uncurry singletonMap $ fltrUserNameEmail    queryUser
            , uncurry singletonMap $ fltrUserMatriclenr   queryUser
            , uncurry singletonMap   ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
            , fltrExamResultPoints (to $ queryExamResult >>> (E.?. ExamResultResult))
            , fltrRelevantStudyFeaturesTerms (to $
                \t -> ( E.val courseTerm
                      , queryUser t E.^. UserId
                      ))
            , fltrRelevantStudyFeaturesDegree (to $
                \t -> ( E.val courseTerm
                      , queryUser t E.^. UserId
                      ))
            , fltrRelevantStudyFeaturesSemester (to $
                \t -> ( E.val courseTerm
                      , queryUser t E.^. UserId
                      ))
            ]
          dbtFilterUI mPrev = mconcat $ catMaybes
            [ Just $ fltrUserNameEmailUI    mPrev
            , Just $ fltrUserMatriclenrUI   mPrev
            , Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgExamNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgTableExamOccurrence)
            , Just $ fltrExamResultPointsUI mPrev
            , Just $ fltrRelevantStudyFeaturesTermsUI mPrev
            , Just $ fltrRelevantStudyFeaturesDegreeUI mPrev
            , Just $ fltrRelevantStudyFeaturesSemesterUI mPrev
            ]
          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
          dbtParams = DBParamsForm
            { dbParamsFormMethod = POST
            , dbParamsFormAction = Just . SomeRoute $ CExamR tid ssh csh examn EUsersR
            , dbParamsFormAttrs  = []
            , dbParamsFormSubmit = FormSubmit
            , dbParamsFormAdditional = \csrf -> do
                let
                  actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData)
                  actionMap = mconcat
                    [ singletonMap ExamUserDeregister $
                        pure ExamUserDeregisterData
                    , singletonMap ExamUserAssignOccurrence $
                        ExamUserAssignOccurrenceData
                          <$> aopt (examOccurrenceField eid) (fslI MsgTableExamOccurrence) (Just Nothing)
                    , singletonMap ExamUserAcceptComputedResult $
                        pure ExamUserAcceptComputedResultData
                    , 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
                          <*> (fmap ExamAttended <$> aopt pointsField (fslI MsgExamPoints) Nothing)
                    , singletonMap ExamUserSetBonus $
                        ExamUserSetBonusData
                          <$> aopt pointsField (fslI MsgExamPoints) Nothing
                    , singletonMap ExamUserSetResult $
                        ExamUserSetResultData
                          <$> aopt (examResultModeField (Just $ SomeMessage MsgExamResultNone) examGradingMode) (fslI MsgTableExamResult) Nothing
                    ]

                  actionOpts :: Handler (OptionList ExamUserAction)
                  actionOpts = execWriterT $ do
                    tell =<< optionsF [ ExamUserDeregister, ExamUserAssignOccurrence ]
                    when (is _Just examGradingRule) $
                      tell =<< optionsF [ ExamUserAcceptComputedResult, ExamUserResetToComputedResult ]
                    unless (null examParts) $
                      tell =<< optionsF [ ExamUserSetPartResult ]
                    when doBonus $
                      tell =<< optionsF [ ExamUserSetBonus ]
                    tell =<< optionsF [ ExamUserSetResult ]

                (res, formWgt) <- multiActionMOpts actionMap actionOpts (fslI MsgExamAction) Nothing csrf
                let formRes = (, mempty) . First . Just <$> res
                return (formRes, formWgt)
            , dbParamsFormEvaluate = liftHandler . runFormPost
            , dbParamsFormResult   = _2
            , dbParamsFormIdent    = def
            }
          dbtIdent :: Text
          dbtIdent = "exam-users"
          dbtCsvName = MsgExamUserCsvName tid ssh csh examn
          dbtCsvSheetName = MsgExamUserCsvSheetName tid ssh csh examn
          dbtCsvEncode = Just DBTCsvEncode
            { dbtCsvExportForm   = pure ()
            , dbtCsvDoEncode     = \() -> C.map (doEncode' . view _2)
            , dbtCsvName, dbtCsvSheetName
            , dbtCsvNoExportData = Just id
            , dbtCsvHeader       = const . return . examUserTableCsvHeader allBoni doBonus $ examParts ^.. folded . _entityVal . _examPartNumber
            , dbtCsvExampleData  = Nothing
            }
            where
              doEncode' = ExamUserTableCsv
                <$> view (resultUser . _entityVal . _userSurname . to Just)
                <*> view (resultUser . _entityVal . _userFirstName . to Just)
                <*> view (resultUser . _entityVal . _userDisplayName . to Just)
                <*> view (resultUser . _entityVal . _userMatrikelnummer)
                <*> view (resultUser . _entityVal . _userLdapPrimaryKey)
                <*> view resultStudyFeatures
                <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
                <*> fmap (bool (const Nothing) Just showPoints) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPoints . _Wrapped)
                <*> fmap (bool (const Nothing) Just showPasses) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPasses . _Wrapped . integral)
                <*> 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')
                <*> 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 resultSheets)
          dbtCsvDecode = Just DBTCsvDecode
            { dbtCsvRowKey = \csv -> do
                uid <- lift $ view _2 <$> guessUser' csv
                fmap E.Value . MaybeT . getKeyBy $ UniqueExamRegistration eid uid
            , dbtCsvComputeActions = \case
                DBCsvDiffMissing{dbCsvOldKey}
                  -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
                DBCsvDiffNew{dbCsvNewKey = Just _}
                  -> error "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
                DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
                  (isPart, uid) <- lift $ guessUser' dbCsvNew
                  yieldM $ bool ExamUserCsvCourseRegisterData ExamUserCsvRegisterData isPart uid <$> lookupOccurrence dbCsvNew

                  iforMOf_ (ifolded <. _Just) (csvEUserExamPartResults dbCsvNew) $ \epNumber epRes ->
                    when (epNumber `elem` examPartNumbers) $
                      yield $ ExamUserCsvSetPartResultData uid epNumber (Just epRes)

                  when (doBonus && is _Just (join $ csvEUserBonus dbCsvNew)) $
                    yield . ExamUserCsvSetBonusData False uid . join $ csvEUserBonus dbCsvNew

                  whenIsJust (csvEUserExamResult dbCsvNew) $ \res -> do
                    yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
                    guardResultKind res

                  note <- lift . getBy $ UniqueCourseUserNote uid examCourse
                  when (csvEUserCourseNote dbCsvNew /= note ^? _Just . _entityVal . _courseUserNoteNote) $
                    yield . ExamUserCsvSetCourseNoteData uid $ csvEUserCourseNote dbCsvNew
                DBCsvDiffExisting{..} -> do
                  newOccurrence <- lift $ lookupOccurrence dbCsvNew
                  when (newOccurrence /= dbCsvOld ^? resultExamOccurrence . _entityKey) $
                    yield $ ExamUserCsvAssignOccurrenceData (E.unValue dbCsvOldKey) newOccurrence

                  let uid = dbCsvOld ^. resultUser . _entityKey

                  forM_ examPartNumbers $ \epNumber ->
                    let oldPartResult = dbCsvOld ^? resultExamParts . filtered (views (_1 . _examPartNumber) (== epNumber)) . _2 . _Just . _entityVal . _examPartResultResult
                     in whenIsJust (csvEUserExamPartResults dbCsvNew !? epNumber) $ \epRes ->
                          when (epRes /= oldPartResult) $
                            yield $ ExamUserCsvSetPartResultData uid epNumber epRes

                  let newResults :: Maybe (Map ExamPartNumber ExamResultPoints)
                      newResults = sequence (csvEUserExamPartResults dbCsvNew)
                               <|> sequence (toMapOf (resultExamParts .> ito (over _1 examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld)

                      newBonus, oldBonus :: Maybe Points
                      newBonus = join (csvEUserBonus dbCsvNew)
                      oldBonus = dbCsvOld ^? (resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus')

                      newResult, oldResult :: Maybe ExamResultPassedGrade
                      newResult = fmap (fmap $ bool Right (Left . view passingGrade) $ is _ExamGradingGrades examGradingMode) . examGrade examVal (newBonus <|> oldBonus) =<< newResults
                      oldResult = dbCsvOld ^? (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult')

                  when doBonus $
                    case newBonus of
                      _ | newBonus == oldBonus
                          -> return ()
                      _ | is _Nothing newBonus
                          -> return ()
                      _ | Just ExamBonusManual{} <- examBonusRule
                          -> yield $ ExamUserCsvSetBonusData False uid newBonus
                      Nothing
                        -> yield $ ExamUserCsvSetBonusData False uid newBonus
                      Just _
                        -> yield $ ExamUserCsvSetBonusData True uid newBonus

                  case newResult of
                    _ | csvEUserExamResult dbCsvNew == oldResult
                        -> return ()
                    _ | is _Nothing $ csvEUserExamResult dbCsvNew
                        -> return ()
                    Nothing -> do
                      yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
                      whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind
                    Just _
                      | csvEUserExamResult dbCsvNew /= newResult -> do
                        yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew
                        whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind
                      | oldResult /= newResult -> do
                        yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
                        whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind
                      | otherwise
                        -> return ()

                  when (csvEUserCourseNote dbCsvNew /= dbCsvOld ^? resultCourseNote . _entityVal . _courseUserNoteNote) $
                    yield . ExamUserCsvSetCourseNoteData (dbCsvOld ^. resultUser . _entityKey) $ csvEUserCourseNote dbCsvNew
            , dbtCsvClassifyAction = \case
                ExamUserCsvCourseRegisterData{}   -> ExamUserCsvCourseRegister
                ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
                ExamUserCsvSetPartResultData{}    -> ExamUserCsvSetPartResult
                ExamUserCsvSetBonusData{..}
                  | examUserCsvIsBonusOverride    -> ExamUserCsvOverrideBonus
                  | otherwise                     -> ExamUserCsvSetBonus
                ExamUserCsvSetResultData{..}
                  | examUserCsvIsResultOverride   -> ExamUserCsvOverrideResult
                  | otherwise                     -> ExamUserCsvSetResult
                ExamUserCsvSetCourseNoteData{}    -> ExamUserCsvSetCourseNote
            , dbtCsvCoarsenActionClass = \case
                ExamUserCsvCourseRegister -> DBCsvActionNew
                ExamUserCsvRegister       -> DBCsvActionNew
                ExamUserCsvDeregister     -> DBCsvActionMissing
                _other                    -> DBCsvActionExisting
            , dbtCsvValidateActions = do
                selectedActions <- State.get
                availableActions <- ask
                let missingExamDataUsers = flip filter examDataUsers $ \uid -> any (isRegisterAction uid) availableActions && none (isRegisterAction uid) selectedActions
                      where
                        examDataUsers = flip mapMaybe selectedActions $ \case
                          ExamUserCsvSetResultData{..}        -> Just examUserCsvActUser
                          ExamUserCsvSetBonusData{..}         -> Just examUserCsvActUser
                          ExamUserCsvSetPartResultData{..}    -> Just examUserCsvActUser
                          _other -> Nothing
                        isRegisterAction uid = \case
                          ExamUserCsvCourseRegisterData{..} -> uid == examUserCsvActUser
                          ExamUserCsvRegisterData{..}       -> uid == examUserCsvActUser
                          _other -> False
                unless (null missingExamDataUsers) $
                  tellMPoint $ messageI Error MsgExamUsersExamDataRequiresRegistration
            , dbtCsvExecuteActions = do
                C.mapM_ $ \case
                  ExamUserCsvCourseRegisterData{..} -> do
                    now <- liftIO getCurrentTime
                    void $ upsert
                      CourseParticipant
                        { courseParticipantCourse = examCourse
                        , courseParticipantUser = examUserCsvActUser
                        , courseParticipantRegistration = now
                        , courseParticipantState = CourseParticipantActive
                        }
                      [ CourseParticipantRegistration =. now
                      , CourseParticipantState =. CourseParticipantActive
                      ]
                    queueDBJob . JobQueueNotification $ NotificationCourseRegistered examUserCsvActUser examCourse
                    audit $ TransactionCourseParticipantEdit examCourse examUserCsvActUser
                    insert_ ExamRegistration
                      { examRegistrationExam = eid
                      , examRegistrationUser = examUserCsvActUser
                      , examRegistrationOccurrence = examUserCsvActOccurrence
                      , examRegistrationTime = now
                      }
                    audit $ TransactionExamRegister eid examUserCsvActUser
                  ExamUserCsvRegisterData{..} -> do
                    examRegistrationTime <- liftIO getCurrentTime
                    insert_ ExamRegistration
                      { examRegistrationExam = eid
                      , examRegistrationUser = examUserCsvActUser
                      , examRegistrationOccurrence = examUserCsvActOccurrence
                      , ..
                      }
                    audit $ TransactionExamRegister eid examUserCsvActUser
                  ExamUserCsvAssignOccurrenceData{..} ->
                    update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
                  ExamUserCsvSetPartResultData{..} -> do
                    epid <- getKeyJustBy $ UniqueExamPartNumber eid examUserCsvActExamPart
                    case examUserCsvActExamPartResult of
                      Nothing  -> do
                        deleteBy $ UniqueExamPartResult epid examUserCsvActUser
                        audit $ TransactionExamPartResultDeleted epid examUserCsvActUser
                      Just res -> do
                        now <- liftIO getCurrentTime
                        void $ upsertBy
                          (UniqueExamPartResult epid examUserCsvActUser)
                          (ExamPartResult epid examUserCsvActUser res now)
                          [ ExamPartResultResult =. res
                          , ExamPartResultLastChanged =. now
                          ]
                        audit $ TransactionExamPartResultEdit epid examUserCsvActUser
                  ExamUserCsvSetBonusData{..} -> case examUserCsvActExamBonus of
                    Nothing  -> do
                      deleteBy $ UniqueExamBonus eid examUserCsvActUser
                      audit $ TransactionExamBonusDeleted eid examUserCsvActUser
                    Just res -> do
                      now <- liftIO getCurrentTime
                      void $ upsertBy
                        (UniqueExamBonus eid examUserCsvActUser)
                        (ExamBonus eid examUserCsvActUser res now)
                        [ ExamBonusBonus =. res
                        , ExamBonusLastChanged =. now
                        ]
                      audit $ TransactionExamBonusEdit eid examUserCsvActUser
                  ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of
                    Nothing  -> do
                      deleteBy $ UniqueExamResult eid examUserCsvActUser
                      audit $ TransactionExamResultDeleted eid examUserCsvActUser
                    Just res -> do
                      now <- liftIO getCurrentTime
                      void $ upsertBy
                        (UniqueExamResult eid examUserCsvActUser)
                        (ExamResult eid examUserCsvActUser res now)
                        [ ExamResultResult =. res
                        , ExamResultLastChanged =. now
                        ]
                      audit $ TransactionExamResultEdit eid examUserCsvActUser
                  ExamUserCsvDeregisterData{..} -> do
                    ExamRegistration{..} <- getJust examUserCsvActRegistration
                    deregisterExamUsers examRegistrationExam $ pure examRegistrationUser
                  ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do
                    noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse
                    whenIsJust noteId $ \nid -> do
                      deleteWhere [CourseUserNoteEditNote ==. nid]
                      delete nid
                  ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Just note, .. } -> do
                    now <- liftIO getCurrentTime
                    uid <- liftHandler requireAuthId
                    Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ]
                    insert_ $ CourseUserNoteEdit uid now nid
                return $ CExamR tid ssh csh examn EUsersR
            , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
                ExamUserCsvCourseRegisterData{..} -> do
                  (User{..}, occ) <- liftHandler . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvRegisterData{..} -> do
                  (User{..}, occ) <- liftHandler . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvAssignOccurrenceData{..} -> do
                  occ <- for examUserCsvActOccurrence $ liftHandler . runDB . getJust
                  [whamlet|
                    $newline never
                    ^{registeredUserName' examUserCsvActRegistration}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvSetPartResultData{..} -> do
                  (User{..}, Entity _ ExamPart{..}) <- liftHandler . runDB $
                    (,) <$> getJust examUserCsvActUser
                        <*> getJustBy (UniqueExamPartNumber eid examUserCsvActExamPart)
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe pName <- examPartName
                      , „#{pName}“
                    $nothing
                      , _{MsgExamPartNumbered examPartNumber}
                    $maybe newResult <- examUserCsvActExamPartResult
                      , _{newResult}
                    $nothing
                      , _{MsgExamResultNone}
                  |]
                ExamUserCsvSetBonusData{..} -> do
                  User{..} <- liftHandler . runDB $ getJust examUserCsvActUser
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe newBonus <- examUserCsvActExamBonus
                      , _{newBonus}
                    $nothing
                      , _{MsgExamBonusNone}
                  |]
                ExamUserCsvSetResultData{..} -> do
                  User{..} <- liftHandler . runDB $ getJust examUserCsvActUser
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe newResult <- examUserCsvActExamResult
                      , _{newResult}
                    $nothing
                      , _{MsgExamResultNone}
                  |]
                ExamUserCsvSetCourseNoteData{..} -> do
                  User{..} <- liftHandler . runDB $ getJust examUserCsvActUser
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $if isn't _Just examUserCsvActCourseNote
                      \ (_{MsgExamUserCsvCourseNoteDeleted})
                  |]
                ExamUserCsvDeregisterData{..}
                  -> registeredUserName' examUserCsvActRegistration
            , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
            , dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
            }
            where
              guardResultKind :: MonadThrow m => ExamResultPassedGrade -> m ()
              guardResultKind res
                | (   is _ExamGradingPass examGradingMode
                   && is (_ExamAttended . _Right) res
                  ) ||
                  (   is _ExamGradingGrades examGradingMode
                   && is (_ExamAttended . _Left) res
                  )
                = throwM . ExamUserCsvExceptionMismatchedGradingMode examGradingMode $ if
                    | is (_ExamAttended . _Left) res -> ExamGradingPass
                    | otherwise -> ExamGradingGrades
                | otherwise = return ()

              registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
              registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
                where
                  Entity _ User{..} = view resultUser $ existing ! registration

              guessUser' :: ExamUserTableCsv -> DB (Bool, UserId)
              guessUser' ExamUserTableCsv{..} = do
                let criteria = PredDNF . maybe Set.empty Set.singleton . fromNullable . Set.fromList . fmap PLVariable $ catMaybes
                      [ GuessUserMatrikelnummer <$> csvEUserMatriculation
                      , GuessUserEduPersonPrincipalName <$> csvEUserEPPN
                      , GuessUserDisplayName <$> csvEUserName
                      , GuessUserSurname <$> csvEUserSurname
                      , GuessUserFirstName <$> csvEUserFirstName
                      ]
                guess <- maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria (Just 2)  -- we're only interested in at most one match, but want to throw an error on multiple matches
                pid <- either (const $ throwM ExamUserCsvExceptionMultipleMatchingUsers) (return . entityKey) guess
                (,) <$> exists [CourseParticipantCourse ==. examCourse, CourseParticipantUser ==. pid, CourseParticipantState ==. CourseParticipantActive] <*> pure pid

              lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)
              lookupOccurrence ExamUserTableCsv{..} = $cachedHereBinary (CI.foldedCase <$> csvEUserOccurrence) . for csvEUserOccurrence $ \occName -> do
                occIds <- selectKeysList [ ExamOccurrenceName ==. occName, ExamOccurrenceExam ==. eid ] []
                case occIds of
                  [occId] -> return occId
                  _other  -> throwM ExamUserCsvExceptionNoMatchingOccurrence

      dbtExtraReps = []

      examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]
                                      & defaultPagesize PagesizeAll

      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId (Bool, ExamUserTableData) ExamUserTableData) -> FormResult (ExamUserActionData, Map ExamRegistrationId ExamUserTableData)
      postprocess inp = do
        (First (Just act), regMap) <- inp
        let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
        return (act, regMap')
    (, exam, (bonus, resultSheets)) . over (_1 . _2) postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable

  formResult registrationResult $ \case
    (ExamUserDeregisterData, Map.elems -> selectedRegistrations) -> do
      nrDel <- runDB . setSerializable . deregisterExamUsersCount eId $ map (view $ resultUser . _entityKey) selectedRegistrations

      addMessageI Success $ MsgExamUsersDeregistered nrDel
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserAssignOccurrenceData occId, Map.keysSet -> selectedRegistrations) -> do
      nrUpdated <- runDB $ updateWhereCount
        [ ExamRegistrationId <-. Set.toList selectedRegistrations
        ]
        [ ExamRegistrationOccurrence =. occId
        ]
      addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserAcceptComputedResultData, Map.elems -> rows) -> do
      nrAccepted <- fmap (getSum . fold) . runDB . forM rows . runReaderT $ do
        now <- liftIO getCurrentTime
        uid <- view $ resultUser . _entityKey
        hasResult <- asks $ has resultExamResult
        hasBonus <- asks $ has resultExamBonus
        autoResult <- preview $ resultAutomaticExamResult examVal bonus resultSheets
        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) resultSheets)
        lift $ if
          | not hasResult
          , Just examResultResult <- autoResult
            -> do
              if
                | Just examBonusBonus <- autoBonus
                , not hasBonus
                -> do
                  insert_ ExamBonus
                    { examBonusExam = eId
                    , examBonusUser = uid
                    , examBonusLastChanged = now
                    , ..
                    }
                  audit $ TransactionExamBonusEdit eId uid
                | 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
                , examResultLastChanged = now
                , ..
                }
              audit $ TransactionExamResultEdit eId uid
              return $ Sum 1
          | otherwise
            -> return mempty
      addMessageI Success $ MsgExamUsersResultsAccepted nrAccepted
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserResetToComputedResultData{..}, Map.elems -> rows) -> do
      nrReset <- fmap (getSum . fold) . runDB . forM rows . runReaderT $ do
        uid <- view $ resultUser . _entityKey
        lift $ do
          when examUserResetBonus $ do
            bonusId' <- getKeyBy $ UniqueExamBonus eId uid
            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
            Just resId -> do
              delete resId
              audit $ TransactionExamResultDeleted eId uid
              return $ Sum 1
            Nothing -> return mempty
      addMessageI Success $ MsgExamUsersResultsReset nrReset
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserSetPartResultData part mPts, Map.elems -> rows) -> do
      now <- liftIO getCurrentTime
      updated <- fmap getSum . runDB $ do
        partId <- getKeyBy $ UniqueExamPartNumber eId part
        flip foldMapM partId $ \epId -> flip foldMapM rows $ \row -> do
          let uid = row ^. resultUser . _entityKey
          oldPartResult <- getBy $ UniqueExamPartResult epId uid
          case mPts of
            Just pts
              | maybe True ((/= pts) . examPartResultResult . entityVal) oldPartResult -> do
                void $ upsert
                  ExamPartResult
                    { examPartResultExamPart = epId
                    , examPartResultUser = row ^. resultUser . _entityKey
                    , examPartResultResult = pts
                    , examPartResultLastChanged = now
                    }
                  [ ExamPartResultResult =. pts, ExamPartResultLastChanged =. now ]
                audit $ TransactionExamPartResultEdit epId uid
                return $ Sum 1
            Nothing
              | is _Just oldPartResult -> do
                deleteBy $ UniqueExamPartResult epId uid
                audit $ TransactionExamPartResultDeleted epId uid
                return $ Sum 1
            _other -> return mempty
      addMessageI Success $ MsgExamUsersPartResultsSet updated
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserSetBonusData mPts, Map.elems -> rows) -> do
      now <- liftIO getCurrentTime
      updated <- fmap getSum . runDB $ do
        flip foldMapM rows $ \row -> do
          let uid = row ^. resultUser . _entityKey
          oldBonus <- getBy $ UniqueExamBonus eId uid
          case mPts of
            Just pts
              | maybe True ((/= pts) . examBonusBonus . entityVal) oldBonus -> do
                void $ upsert
                  ExamBonus
                    { examBonusExam = eId
                    , examBonusUser = row ^. resultUser . _entityKey
                    , examBonusBonus = pts
                    , examBonusLastChanged = now
                    }
                  [ ExamBonusBonus =. pts, ExamBonusLastChanged =. now ]
                audit $ TransactionExamBonusEdit eId uid
                return $ Sum 1
            Nothing
              | is _Just oldBonus -> do
                deleteBy $ UniqueExamBonus eId uid
                audit $ TransactionExamBonusDeleted eId uid
                return $ Sum 1
            _other -> return mempty
      addMessageI Success $ MsgExamUsersBonusSet updated
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserSetResultData mRes, Map.elems -> rows) -> do
      now <- liftIO getCurrentTime
      updated <- fmap getSum . runDB $ do
        flip foldMapM rows $ \row -> do
          let uid = row ^. resultUser . _entityKey
          oldResult <- getBy $ UniqueExamResult eId uid
          case mRes of
            Just res
              | maybe True ((/= res) . examResultResult . entityVal) oldResult -> do
                void $ upsert
                  ExamResult
                    { examResultExam = eId
                    , examResultUser = row ^. resultUser . _entityKey
                    , examResultResult = res
                    , examResultLastChanged = now
                    }
                  [ ExamResultResult =. res, ExamResultLastChanged =. now ]
                audit $ TransactionExamResultEdit eId uid
                return $ Sum 1
            Nothing
              | is _Just oldResult -> do
                deleteBy $ UniqueExamResult eId uid
                audit $ TransactionExamResultDeleted eId uid
                return $ Sum 1
            _other -> return mempty
      addMessageI Success $ MsgExamUsersResultSet updated
      redirect $ CExamR tid ssh csh examn EUsersR

  closeWgt <- examCloseWidget (SomeRoute $ CExamR tid ssh csh examn EUsersR) eId
  finishWgt <- examFinishWidget (SomeRoute $ CExamR tid ssh csh examn EUsersR) eId

  siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
    setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading
    let computedValuesTip = notificationWidget NotificationBroad Warning
          $(i18nWidgetFile "exam-users/computed-values-tip")
    $(widgetFile "exam-users")
