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

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

import Import

import Utils.Lens
import Handler.Utils
import Handler.Utils.Exam
import Handler.Utils.Table.Columns
import Handler.Utils.Table.Cells
import Handler.Utils.Csv

import qualified Database.Esqueleto 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.Text 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 Control.Arrow (Kleisli(..))

import Database.Persist.Sql (deleteWhereCount, updateWhereCount)


type ExamUserTableExpr = (E.SqlExpr (Entity ExamRegistration) `E.InnerJoin` E.SqlExpr (Entity User)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence)) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity CourseParticipant)) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)))) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult))
type ExamUserTableData = DBRow (Entity ExamRegistration, Entity User, Maybe (Entity ExamOccurrence), Maybe (Entity StudyFeatures), Maybe (Entity StudyDegree), Maybe (Entity StudyTerms), Maybe (Entity ExamResult))

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 4 1)

queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 4 3)

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

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

queryStudyDegree :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 4 3)

queryStudyField :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 4 3)

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

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

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

resultStudyFeatures :: Traversal' ExamUserTableData (Entity StudyFeatures)
resultStudyFeatures = _dbrOutput . _4 . _Just

resultStudyDegree :: Traversal' ExamUserTableData (Entity StudyDegree)
resultStudyDegree = _dbrOutput . _5 . _Just

resultStudyField :: Traversal' ExamUserTableData (Entity StudyTerms)
resultStudyField = _dbrOutput . _6 . _Just

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

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

data ExamUserTableCsv = ExamUserTableCsv
  { csvEUserSurname :: Maybe Text
  , csvEUserName :: Maybe Text
  , csvEUserMatriculation :: Maybe Text
  , csvEUserField :: Maybe Text
  , csvEUserDegree :: Maybe Text
  , csvEUserSemester :: Maybe Int
  , csvEUserOccurrence :: Maybe (CI Text)
  , csvEUserExercisePoints :: Maybe Points
  , csvEUserExerciseNumPasses :: Maybe Int
  , csvEUserExercisePointsMax :: Maybe Points
  , csvEUserExerciseNumPassesMax :: Maybe Int
  , csvEUserExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
  }
  deriving (Generic)
makeLenses_ ''ExamUserTableCsv

examUserTableCsvOptions :: Csv.Options
examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }

instance ToNamedRecord ExamUserTableCsv where
  toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions

instance FromNamedRecord ExamUserTableCsv where
  parseNamedRecord = Csv.genericParseNamedRecord examUserTableCsvOptions

instance DefaultOrdered ExamUserTableCsv where
  headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions

instance CsvColumnsExplained ExamUserTableCsv where
  csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
    [ ('csvEUserSurname             , MsgCsvColumnExamUserSurname           )
    , ('csvEUserName                , MsgCsvColumnExamUserName              )
    , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation     )
    , ('csvEUserField               , MsgCsvColumnExamUserField             )
    , ('csvEUserDegree              , MsgCsvColumnExamUserDegree            )
    , ('csvEUserSemester            , MsgCsvColumnExamUserSemester          )
    , ('csvEUserOccurrence          , MsgCsvColumnExamUserOccurrence        )
    , ('csvEUserExercisePoints      , MsgCsvColumnExamUserExercisePoints    )
    , ('csvEUserExerciseNumPasses   , MsgCsvColumnExamUserExercisePasses    )
    , ('csvEUserExercisePointsMax   , MsgCsvColumnExamUserExercisePointsMax )
    , ('csvEUserExerciseNumPassesMax, MsgCsvColumnExamUserExercisePassesMax )
    , ('csvEUserExamResult          , MsgCsvColumnExamResult                )
    ]

data ExamUserAction = ExamUserDeregister
                    | ExamUserAssignOccurrence
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

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

data ExamUserActionData = ExamUserDeregisterData
                        | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)

data ExamUserCsvActionClass
  = ExamUserCsvCourseRegister
  | ExamUserCsvRegister
  | ExamUserCsvAssignOccurrence
  | ExamUserCsvSetCourseField
  | ExamUserCsvDeregister
  | ExamUserCsvSetResult
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id

data ExamUserCsvAction
  = ExamUserCsvCourseRegisterData
    { examUserCsvActUser :: UserId
    , examUserCsvActCourseField :: Maybe StudyFeaturesId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvRegisterData
    { examUserCsvActUser :: UserId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvAssignOccurrenceData
    { examUserCsvActRegistration :: ExamRegistrationId
    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
    }
  | ExamUserCsvSetCourseFieldData
    { examUserCsvActCourseParticipant :: CourseParticipantId
    , examUserCsvActCourseField :: Maybe StudyFeaturesId
    }
  | ExamUserCsvDeregisterData
    { examUserCsvActRegistration :: ExamRegistrationId
    }
  | ExamUserCsvSetResultData
    { examUserCsvActUser :: UserId
    , examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
    }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions
  { constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel
  , fieldLabelModifier = camelToPathPiece' 3
  , sumEncoding = TaggedObject "action" "data"
  } ''ExamUserCsvAction

data ExamUserCsvException
  = ExamUserCsvExceptionNoMatchingUser
  | ExamUserCsvExceptionNoMatchingStudyFeatures
  | ExamUserCsvExceptionNoMatchingOccurrence
  deriving (Show, Generic, Typeable)

instance Exception ExamUserCsvException

embedRenderMessage ''UniWorX ''ExamUserCsvException id

getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getEUsersR = postEUsersR
postEUsersR tid ssh csh examn = do
  (registrationResult, examUsersTable) <- runDB $ do
    exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn
    bonus <- examBonus exam

    let
      allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus
      showPasses     = numSheetsPasses allBoni /= 0
      showPoints     = getSum (numSheetsPoints allBoni) /= 0

      resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade
      resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades

    let
      examUsersDBTable = DBTable{..}
        where
          dbtSQLQuery ((examRegistration `E.InnerJoin` user) `E.LeftOuterJoin` occurrence `E.LeftOuterJoin` (courseParticipant `E.LeftOuterJoin` (studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyField)) `E.LeftOuterJoin` examResult) = do
            E.on $ examResult E.?. ExamResultUser E.==. E.just (user E.^. UserId)
             E.&&. examResult E.?. ExamResultExam E.==. E.just (E.val eid)
            E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
            E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
            E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
            E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
             E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
            E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
             E.&&. occurrence E.?. ExamOccurrenceId   E.==. examRegistration E.^. ExamRegistrationOccurrence
            E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
            E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid
            return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField, examResult)
          dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
          dbtProj = return
          dbtColonnade = mconcat $ catMaybes
            [ pure $ dbSelect (applying _2) id $ return . view (resultExamRegistration . _entityKey)
            , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
            , pure   colUserMatriclenr
            , pure $ colField            resultStudyField
            , pure $ colDegreeShort      resultStudyDegree
            , pure $ colFeaturesSemester resultStudyFeatures
            , pure $ sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
            , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
                SheetGradeSummary{achievedPasses} <- examBonusAchieved uid bonus
                SheetGradeSummary{numSheetsPasses} <- examBonusPossible uid bonus
                return $ propCell (getSum achievedPasses) (getSum numSheetsPasses)
            , guardOn showPoints $ sortable Nothing (i18nCell MsgAchievedPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
                SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus
                SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus
                return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints)
            , guardOn examShowGrades $ sortable (Just "result") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (resultExamResult . _entityVal . _examResultResult)
            , guardOn (not examShowGrades) $ sortable (Just "result-bool") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (resultExamResult . _entityVal . _examResultResult . to (over _examResult $ view passingGrade))
            ]
          dbtSorting = Map.fromList
            [ sortUserNameLink     queryUser
            , sortUserSurname      queryUser
            , sortUserDisplayName  queryUser
            , sortUserMatriclenr   queryUser
            , sortField            queryStudyField
            , sortDegreeShort      queryStudyDegree
            , sortFeaturesSemester queryStudyFeatures
            , ("occurrence", SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
            , ("result", SortColumn $ queryExamResult >>> (E.?. ExamResultResult))
            , ("result-bool", SortColumn $ queryExamResult >>> (E.?. ExamResultResult) >>> E.orderByList [Just ExamVoided, Just ExamNoShow, Just $ ExamAttended Grade50])
            ]
          dbtFilter = Map.fromList
            [ fltrUserNameEmail    queryUser
            , fltrUserMatriclenr   queryUser
            , fltrField            queryStudyField
            , fltrDegree           queryStudyDegree
            , fltrFeaturesSemester queryStudyFeatures
            , ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
            , ("result", FilterColumn . E.mkExactFilterWith Just $ queryExamResult >>> (E.?. ExamResultResult))
            , ( "result-bool"
              , FilterColumn $ \row criteria -> if
                  | Set.null criteria -> E.true
                  | otherwise -> let passed :: [ExamResultGrade]
                                     passed = filter (\res -> preview (_examResult . passingGrade) res == Just (ExamPassed True)) universeF
                                     criteria' = Set.map (fmap $ review passingGrade) criteria
                                     criteria''
                                       | ExamAttended (ExamPassed True) `Set.member` criteria
                                       = criteria' `Set.union` Set.fromList passed
                                       | otherwise  
                                       = criteria'
                                  in queryExamResult row E.?. ExamResultResult `E.in_` E.valList (Just <$> Set.toList criteria'')
              )
            ]
          dbtFilterUI mPrev = mconcat $ catMaybes
            [ Just $ fltrUserNameEmailUI    mPrev
            , Just $ fltrUserMatriclenrUI   mPrev
            , Just $ fltrFieldUI            mPrev
            , Just $ fltrDegreeUI           mPrev
            , Just $ fltrFeaturesSemesterUI mPrev
            , Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt textField (fslI MsgExamOccurrence)
            , guardOn examShowGrades $ prismAForm (singletonFilter "result" . maybePrism _PathPiece) mPrev $ aopt (examResultField examGradeField) (fslI MsgExamResult)
            , guardOn (not examShowGrades) $ prismAForm (singletonFilter "result" . maybePrism _PathPiece) mPrev $ aopt (examResultField examPassedField) (fslI MsgExamResult)
            ]
          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 = Map.fromList
                    [ ( ExamUserDeregister
                      , pure ExamUserDeregisterData
                      )
                    , ( ExamUserAssignOccurrence
                      , ExamUserAssignOccurrenceData
                        <$> aopt (examOccurrenceField eid) (fslI MsgExamOccurrence) (Just Nothing)
                      )
                    ]
                (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
                let formRes = (, mempty) . First . Just <$> res
                return (formRes, formWgt)
            , dbParamsFormEvaluate = liftHandlerT . runFormPost
            , dbParamsFormResult   = id
            , dbParamsFormIdent    = def
            }
          dbtIdent :: Text
          dbtIdent = "exam-users"
          dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
          dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
            <$> view (resultUser . _entityVal . _userSurname . to Just)
            <*> view (resultUser . _entityVal . _userDisplayName . to Just)
            <*> view (resultUser . _entityVal . _userMatrikelnummer)
            <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
            <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
            <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
            <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped)
            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
            <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
            <*> preview (resultExamResult . _entityVal . _examResultResult . to resultView)
          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 _}
                  -> fail "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
                DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
                  (isPart, uid) <- lift $ guessUser dbCsvNew
                  if
                    | isPart -> do
                        yieldM $ ExamUserCsvRegisterData <$> pure uid <*> lookupOccurrence dbCsvNew
                        newFeatures <- lift $ lookupStudyFeatures dbCsvNew
                        Just (Entity cpId CourseParticipant{ courseParticipantField = oldFeatures }) <- lift . getBy $ UniqueParticipant uid examCourse
                        when (newFeatures /= oldFeatures) $
                          yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
                    | otherwise ->
                        yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupStudyFeatures dbCsvNew <*> lookupOccurrence dbCsvNew
                  when (is _Just $ csvEUserExamResult dbCsvNew) $
                    yield . ExamUserCsvSetResultData uid $ csvEUserExamResult dbCsvNew
                DBCsvDiffExisting{..} -> do
                  newOccurrence <- lift $ lookupOccurrence dbCsvNew
                  when (newOccurrence /= dbCsvOld ^? resultExamOccurrence . _entityKey) $
                    yield $ ExamUserCsvAssignOccurrenceData (E.unValue dbCsvOldKey) newOccurrence

                  newFeatures <- lift $ lookupStudyFeatures dbCsvNew
                  when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $ do
                    Just (Entity cpId _) <- lift . getBy . flip UniqueParticipant examCourse $ dbCsvOld ^. resultUser . _entityKey
                    yield $ ExamUserCsvSetCourseFieldData cpId newFeatures

                  when (csvEUserExamResult dbCsvNew /= dbCsvOld ^? resultExamResult . _entityVal . _examResultResult . to resultView) $
                    yield . ExamUserCsvSetResultData (dbCsvOld ^. resultUser . _entityKey) $ csvEUserExamResult dbCsvNew
            , dbtCsvClassifyAction = \case
                ExamUserCsvCourseRegisterData{}   -> ExamUserCsvCourseRegister
                ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
                ExamUserCsvSetResultData{}        -> ExamUserCsvSetResult
            , dbtCsvCoarsenActionClass = \case
                ExamUserCsvCourseRegister -> DBCsvActionNew
                ExamUserCsvRegister       -> DBCsvActionNew
                ExamUserCsvDeregister     -> DBCsvActionMissing
                _other                    -> DBCsvActionExisting 
            , dbtCsvExecuteActions = do
                C.mapM_ $ \case
                  ExamUserCsvCourseRegisterData{..} -> do
                    now <- liftIO getCurrentTime
                    insert_ CourseParticipant
                      { courseParticipantCourse = examCourse
                      , courseParticipantUser = examUserCsvActUser
                      , courseParticipantRegistration = now
                      , courseParticipantField = examUserCsvActCourseField
                      }
                    User{userIdent} <- getJust examUserCsvActUser
                    audit' $ TransactionExamRegister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
                    insert_ ExamRegistration
                      { examRegistrationExam = eid
                      , examRegistrationUser = examUserCsvActUser
                      , examRegistrationOccurrence = examUserCsvActOccurrence
                      , examRegistrationTime = now
                      }
                  ExamUserCsvRegisterData{..} -> do
                    examRegistrationTime <- liftIO getCurrentTime
                    insert_ ExamRegistration
                      { examRegistrationExam = eid
                      , examRegistrationUser = examUserCsvActUser
                      , examRegistrationOccurrence = examUserCsvActOccurrence
                      , ..
                      }
                  ExamUserCsvAssignOccurrenceData{..} ->
                    update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
                  ExamUserCsvSetCourseFieldData{..} ->
                    update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
                  ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of
                    Nothing  -> deleteBy $ UniqueExamResult eid examUserCsvActUser
                    Just res -> let res' = either (over _examResult $ review passingGrade) id res
                                 in void $ upsert
                                      (ExamResult eid examUserCsvActUser res')
                                      [ ExamResultResult =. res'
                                      ]
                  ExamUserCsvDeregisterData{..} -> do
                    ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration
                    User{userIdent} <- getJust examRegistrationUser
                    audit' $ TransactionExamDeregister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent
                    delete examUserCsvActRegistration
                return $ CExamR tid ssh csh examn EUsersR
            , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
                ExamUserCsvCourseRegisterData{..} -> do
                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe features <- examUserCsvActCourseField
                      , ^{studyFeaturesWidget features}
                    $nothing
                      , _{MsgCourseStudyFeatureNone}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvRegisterData{..} -> do
                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvAssignOccurrenceData{..} -> do
                  occ <- for examUserCsvActOccurrence $ liftHandlerT . runDB . getJust
                  [whamlet|
                    $newline never
                    ^{registeredUserName' examUserCsvActRegistration}
                    $maybe ExamOccurrence{examOccurrenceName} <- occ
                      \ (#{examOccurrenceName})
                    $nothing
                      \ (_{MsgExamNoOccurrence})
                  |]
                ExamUserCsvSetCourseFieldData{..} -> do
                  User{..} <- liftHandlerT . runDB $ getJust . courseParticipantUser =<< getJust examUserCsvActCourseParticipant
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe features <- examUserCsvActCourseField
                      , ^{studyFeaturesWidget features}
                    $nothing
                      , _{MsgCourseStudyFeatureNone}
                  |]
                ExamUserCsvSetResultData{..} -> do
                  User{..} <- liftHandlerT . runDB $ getJust examUserCsvActUser
                  [whamlet|
                    $newline never
                    ^{nameWidget userDisplayName userSurname}
                    $maybe newResult <- examUserCsvActExamResult
                      $case newResult
                        $of Left pResult
                          , _{pResult}
                        $of Right gResult
                          , _{gResult}
                    $nothing
                      , _{MsgExamResultNone}
                  |]
 
                ExamUserCsvDeregisterData{..}
                  -> registeredUserName' examUserCsvActRegistration
            , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
            , dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
            }
            where
              studyFeaturesWidget :: StudyFeaturesId -> Widget
              studyFeaturesWidget featId = do
                (StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandlerT . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
                [whamlet|
                  $newline never
                  _{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester}
                |]
               
              registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
              registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
                where
                  Entity _ User{..} = view resultUser $ existing ! registration
              
              guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
              guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
                users <- E.select . E.from $ \user -> do
                  E.where_ . E.and $ catMaybes
                    [ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
                    , (user E.^. UserDisplayName E.==.) . E.val <$> csvEUserName
                    , (user E.^. UserSurname E.==.) . E.val <$> csvEUserSurname
                    ]
                  let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
                        E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
                             E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
                  E.limit 2
                  return $ (isCourseParticipant, user E.^. UserId)
                case users of
                  (filter . view $ _1 . _Value -> [(E.Value isPart, E.Value uid)])
                    -> return (isPart, uid)
                  [(E.Value isPart, E.Value uid)]
                    -> return (isPart, uid)
                  _other
                    -> throwM ExamUserCsvExceptionNoMatchingUser

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

              lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
              lookupStudyFeatures csv@ExamUserTableCsv{..} = do
                uid <- view _2 <$> guessUser csv
                studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do
                  E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
                  E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
                  E.where_ . E.and $ catMaybes 
                    [ do
                        field <- csvEUserField
                        return . E.or $ catMaybes
                          [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
                          , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
                          , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
                          ]
                    , do
                        degree <- csvEUserDegree
                        return . E.or $ catMaybes
                          [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
                          , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
                          , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
                          ]
                    , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
                    ]
                  E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
                       E.&&. studyFeatures E.^. StudyFeaturesType E.==. E.val FieldPrimary
                       E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
                  E.limit 2
                  return $ studyFeatures E.^. StudyFeaturesId
                case studyFeatures of
                  [E.Value fid] -> return $ Just fid
                  _other
                    | is _Nothing csvEUserField
                    , is _Nothing csvEUserDegree
                    , is _Nothing csvEUserSemester
                    -> return Nothing
                  _other        -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures

      examUsersDBTableValidator = def

      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserActionData, Set ExamRegistrationId)
      postprocess inp = do
        (First (Just act), regMap) <- inp
        let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
        return (act, regSet)
    over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable

  formResult registrationResult $ \case
    (ExamUserDeregisterData, selectedRegistrations) -> do
      nrDel <- runDB $ deleteWhereCount
        [ ExamRegistrationId <-. Set.toList selectedRegistrations
        ]
      addMessageI Success $ MsgExamUsersDeregistered nrDel
      redirect $ CExamR tid ssh csh examn EUsersR
    (ExamUserAssignOccurrenceData occId, selectedRegistrations) -> do
      nrUpdated <- runDB $ updateWhereCount
        [ ExamRegistrationId <-. Set.toList selectedRegistrations
        ]
        [ ExamRegistrationOccurrence =. occId
        ]
      addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated
      redirect $ CExamR tid ssh csh examn EUsersR

  siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
    setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading
    $(widgetFile "exam-users")
