-- SPDX-FileCopyrightText: 2022-2024 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,David Mosbach <david.mosbach@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Course.User
  ( getCUserR, postCUserR
  ) where

import Import

import Utils.Form
import Utils.Mail (pickValidUserEmail)
import Handler.Utils
import Handler.Utils.SheetType
import Handler.Utils.StudyFeatures
import Handler.Submission.List
import Handler.Course.Register

import Jobs.Queue

import Database.Persist.Sql (deleteWhereCount)
import Database.Esqueleto.Utils.TH
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import Text.Blaze.Html.Renderer.Text (renderHtml)

import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Lazy as LT


data ExamAction = ExamDeregister
                | ExamSetResult
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''ExamAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ExamAction $ Text.replace "Exam" "ExamUser"

data ExamActionData = ExamDeregisterData
                    | ExamSetResultData (Maybe ExamResultPassedGrade)

data TutorialAction = TutorialDeregister
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''TutorialAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''TutorialAction $ Text.replace "Tutorial" "TutorialUser"

data TutorialActionData = TutorialDeregisterData


getCUserR, postCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html
getCUserR = postCUserR
postCUserR tid ssh csh uCId = do
  showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth

  (course, user@(Entity _ User{..}), registered) <- runDB $ do
    uid <- decrypt uCId
    course@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
    user <- get404 uid
    registered <- exists [ CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive ]

    return (course, Entity uid user, registered)

  sections <- mapM (runMaybeT . ($ user) . ($ course))
    [ courseUserProfileSection
    , courseUserNoteSection
    , courseUserExamsSection
    , courseUserTutorialsSection
    , courseUserSubmissionsSection
    ]

  -- generate output
  let headingLong
        | registered
        , Just sex <- guardOn showSex =<< userSex
        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseMemberOf} #{csh} #{tid}|]
        | registered
        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseMemberOf} #{csh} #{tid}|]
        | Just sex <- guardOn showSex =<< userSex
        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseAssociatedWith} #{csh} #{tid}|]
        | otherwise
        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseAssociatedWith} #{csh} #{tid}|]
      headingShort = prependCourseTitle tid ssh csh $ SomeMessage userDisplayName
  siteLayout headingLong $ do
    setTitleI headingShort

    mapM_ maybeVoid sections

courseUserProfileSection :: Entity Course -> Entity User -> MaybeT Handler Widget
courseUserProfileSection course@(Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do
  showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth
  currentRoute <- MaybeT getCurrentRoute

  (mRegistration, studies) <- lift . runDB $ do
    registration <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
    studies <- E.select $ E.from $ \(course' `E.InnerJoin` studyfeat `E.InnerJoin` studydegree `E.InnerJoin` studyterms) -> do
      E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
      E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
      E.on $ isCourseStudyFeature course' studyfeat
      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
      E.where_ $ course' E.^. CourseId E.==. E.val cid
      return  (studyfeat, studydegree, studyterms)
    return (registration, studies)

  mayRegister <- lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CAddUserR
  let regButton
        | is _Just mRegistration = BtnCourseDeregister
        | otherwise = BtnCourseRegister
  ((regButtonRes, regButtonView), regButtonEnctype) <- lift . runFormPost . identifyForm FIDcRegButton $ \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)

  let registrationButtonFrag :: Text
      registrationButtonFrag = "registration-button"
      regButtonWidget = wrapForm' regButton regButtonView FormSettings
        { formMethod = POST
        , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
        , formEncoding = regButtonEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formCustomBtn = Nothing :: Maybe ButtonSubmit
        , formAnchor = Just registrationButtonFrag
        }
  formResult regButtonRes $ \case
    _
      | not mayRegister
        -> permissionDenied "User may not be registered"
    (BtnCourseDeregister, mbReason)
      | Just (Entity _pId CourseParticipant{..}) <- mRegistration
        -> do
          lift . runDB $ do
            unless (courseParticipantCourse == cid) $ error "courseParticipantCourse does not match cid"
            deregisterParticipant courseParticipantUser course

            whenIsJust mbReason $ \(_reason, noShow) -> do
              updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
          addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
          redirect $ CourseR courseTerm courseSchool courseShorthand CUsersR
      | otherwise
        -> invalidArgs ["User not registered"]
    (BtnCourseRegister, _) -> do
      now <- liftIO getCurrentTime
      lift . runDBJobs $ do
        void $ upsert
          (CourseParticipant cid uid now CourseParticipantActive)
          [ CourseParticipantRegistration =. now
          , CourseParticipantState =. CourseParticipantActive
          ]
        queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
        audit $ TransactionCourseParticipantEdit cid uid
      addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
      redirect currentRoute

  mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime

  return $(widgetFile "course/user/profile")


courseUserNoteSection :: Entity Course -> Entity User -> MaybeT Handler Widget
courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CUsersR

  currentRoute <- MaybeT getCurrentRoute

  (thisUniqueNote, noteText, noteEdits) <- lift . runDB $ do
    let thisUniqueNote = UniqueCourseUserNote uid cid
    mbNoteEnt <- getBy thisUniqueNote
    (noteText,noteEdits) <- case mbNoteEnt of
      Nothing -> return (Nothing,[])
      (Just (Entity noteKey CourseUserNote{courseUserNoteNote})) -> do
        noteEdits <- E.select $ E.from $ \(edit `E.InnerJoin` usr) -> do
          E.on     $ edit E.^. CourseUserNoteEditUser E.==. usr E.^. UserId
          E.where_ $ edit E.^. CourseUserNoteEditNote E.==. E.val noteKey
          E.orderBy [E.desc $ edit E.^. CourseUserNoteEditTime]
          E.limit 1 -- more will be shown, if changed here
          return (edit E.^. CourseUserNoteEditTime, usr E.^. UserEmail, usr E.^. UserDisplayName, usr E.^. UserSurname)
        return (Just courseUserNoteNote, $(unValueN 4) <$> noteEdits)
    return (thisUniqueNote, noteText, noteEdits)
  let editByWgt = [whamlet|
          $newline never
          <ul .list--iconless>
            $forall (etime,_eemail,ename,_esurname) <- noteEdits
              <li>
                _{MsgCourseLastEdit} ^{editedByW SelFormatDateTime etime ename}
        |] -- _{MsgLastEdit} ^{formatTimeW SelFormatDateTime etime} ^{nameWidget ename esurname}

  ((noteRes, noteView), noteEnctype) <- runFormPost . identifyForm FIDcUserNote . renderAForm FormStandard $
      aopt (annotateField editByWgt htmlField) (fslpI MsgCourseUserNote "HTML" & setTooltip MsgCourseUserNoteTooltip) (Just noteText)
  let noteFrag :: Text
      noteFrag = "notes"
      noteWidget = wrapForm noteView FormSettings
        { formMethod = POST
        , formAction = Just . SomeRoute $ currentRoute :#: noteFrag
        , formEncoding = noteEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formCustomBtn = Nothing :: Maybe ButtonSubmit
        , formAnchor = Just noteFrag
        }
  formResult noteRes $ \mbNote -> do
    now <- liftIO getCurrentTime
    lift . runDB $ case mbNote of
      Nothing -> do
        -- must delete all edits due to foreign key constraints, which does not make sense -> refactor!
        maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote)
        deleteBy thisUniqueNote
        addMessageI Info MsgCourseUserNoteDeleted
      _ | ((==) `on` fmap (LT.strip . renderHtml . markupOutput)) mbNote noteText -> return () -- no changes
      (Just note) -> do
        dozentId <- requireAuthId
        (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note]
        void . insert $ CourseUserNoteEdit dozentId now noteKey
        addMessageI Success MsgCourseUserNoteSaved
    redirect $ currentRoute :#: noteFrag -- reload page after post

  return $(widgetFile "course/user/note")


courseUserSubmissionsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid User{..}) = do
  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR

  let whereClause :: CorrectionTableWhere
      whereClause = (E.&&.) <$> courseIs cid <*> userIs uid
      colonnade = mconcat -- should match getSSubsR for consistent UX
        [ colSelect
        , colSheet
        , colSMatrikel
        , colSubmittors
        , colSubmissionLink
        , colLastEdit
        , colRating
        , colRated
        , colCorrector
        , colAssigned
        ] -- Continue here
      filterUI = Just $ mconcat
        [ filterUIUserNameEmail
        , filterUIUserMatrikelnummer
        , filterUIPseudonym
        , filterUISheetSearch
        , filterUICorrectorNameEmail
        , filterUIIsAssigned
        , filterUIIsRated
        , filterUISubmission
        ]
      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
      csvSettings = Just CorrectionTableCsvSettings
        { cTableCsvQualification = CorrectionTableCsvQualifySheet
        , cTableCsvName = MsgCorrectionTableCsvNameCourseUserCorrections courseTerm courseSchool courseShorthand userDisplayName
        , cTableCsvSheetName = MsgCorrectionTableCsvSheetNameCourseUserCorrections courseTerm courseSchool courseShorthand userDisplayName
        , cTableShowCorrector = True
        }
  (cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI csvSettings psValidator $ Map.fromList
    [ downloadAction
    , assignAction (Left cid)
    , deleteAction
    ]

  guard $ statistics /= mempty

  return $(widgetFile "course/user/corrections")


courseUserExamsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
  guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CExamNewR

  uCID <- encrypt uid

  let
    examDBTable = DBTable{..}
      where
        dbtSQLQuery exam = do
          E.where_ $ exam E.^. ExamCourse E.==. E.val cid
          E.where_ $ E.or
            [ E.exists . E.from $ \examRegistration ->
                E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
                     E.&&. examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
            , E.exists . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do
                E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart
                E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
                     E.&&. examPart E.^. ExamPartExam E.==. exam E.^. ExamId
            , E.exists . E.from $ \examBonus ->
                E.where_ $ examBonus E.^. ExamBonusUser E.==. E.val uid
                     E.&&. examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
            , E.exists . E.from $ \examResult ->
                E.where_ $ examResult E.^. ExamResultUser E.==. E.val uid
                     E.&&. examResult E.^. ExamResultExam E.==. exam E.^. ExamId
            ]
          return exam
        dbtRowKey = (E.^. ExamId)
        dbtProj = dbtProjSimple $ \exam@(Entity eId _) -> do
          registration <- getBy $ UniqueExamRegistration eId uid
          occurrence <- runMaybeT $ do
            Entity _ ExamRegistration{..} <- hoistMaybe registration
            occId <- hoistMaybe examRegistrationOccurrence
            MaybeT $ getEntity occId
          bonus <- getBy $ UniqueExamBonus eId uid
          result <- getBy $ UniqueExamResult eId uid

          return ( exam
                 , occurrence
                 , bonus
                 , result
                 , registration
                 )
        dbtColonnade = mconcat
          [ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _1 . _entityKey)
          , sortable (Just "name") (i18nCell MsgTableExamName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> CExamR courseTerm courseSchool courseShorthand examName EShowR) (view $ _dbrOutput . _1 . _entityVal . _examName)
          , sortable (Just "occurrence") (i18nCell MsgTableExamOccurrence) $ maybe mempty (cell . toWidget) . preview (_dbrOutput . _2 . _Just . _entityVal . _examOccurrenceName)
          , sortable (Just "registration-time") (i18nCell MsgCourseExamRegistrationTime) $ maybe mempty (cell . formatTimeW SelFormatDateTime) . preview (_dbrOutput . _5 . _Just . _entityVal . _examRegistrationTime)
          , sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) $ maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _examBonusBonus)
          , sortable (Just "result") (i18nCell MsgTableExamResult) $ maybe mempty i18nCell . preview (_dbrOutput . _4 . _Just . _entityVal . _examResultResult)
          ]
        dbtSorting = mconcat
          [ singletonMap "name" . SortColumn $ \exam -> exam E.^. ExamName
          , singletonMap "occurrence" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \(examOccurrence `E.InnerJoin` examRegistration) -> do
              E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
                   E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
              return . E.just $ examOccurrence E.^. ExamOccurrenceName
          , singletonMap "registration-time" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examRegistration -> do
              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
                   E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
              return . E.just $ examRegistration E.^. ExamRegistrationTime
          , singletonMap "bonus" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examBonus -> do
              E.where_ $ examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
                   E.&&. examBonus E.^. ExamBonusUser E.==. E.val uid
              return . E.just $ examBonus E.^. ExamBonusBonus
          , singletonMap "result" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examResult -> do
              E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
                   E.&&. examResult E.^. ExamResultUser E.==. E.val uid
              return . E.just $ examResult E.^. ExamResultResult
          ]
        dbtFilter = mempty
        dbtFilterUI _mPrev = mempty
        dbtStyle = def
        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          , dbParamsFormAdditional = \csrf -> do
              let
                actionMap :: Map ExamAction (AForm Handler ExamActionData)
                actionMap = mconcat
                  [ singletonMap ExamDeregister $
                      pure ExamDeregisterData
                  , singletonMap ExamSetResult $
                      ExamSetResultData <$> aopt (examResultModeField (Just $ SomeMessage MsgExamResultNone) ExamGradingMixed) (fslI MsgTableExamResult) Nothing
                  ]

              (res, formWgt) <- multiActionM actionMap (fslI MsgTableAction) Nothing csrf
              let formRes = (, mempty) . First . Just <$> res
              return (formRes, formWgt)
          , dbParamsFormEvaluate = liftHandler . runFormPost
          , dbParamsFormResult = _2
          , dbParamsFormIdent = def
          }
        dbtIdent :: Text
        dbtIdent = "course-user-exams"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []
    examDBTableValidator = def & defaultSorting [SortAscBy "registration-time"]
    postprocess :: FormResult (First ExamActionData, DBFormResult ExamId (Bool, _) _) -> FormResult (ExamActionData, Map ExamId _)
    postprocess inp = do
      (First (Just act), regMap) <- inp
      let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
      return (act, regMap')
  ((Any hasExams, actRes), examTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable examDBTableValidator examDBTable

  lift . formResult actRes $ \case
    (ExamDeregisterData, Map.keys -> selectedExams) -> do
      nrDel <- runDB $ deleteWhereCount
        [ ExamRegistrationUser ==. uid
        , ExamRegistrationExam <-. selectedExams
        ]
      if | nrDel > 0 -> addMessageI Success $ MsgCourseUserExamsDeregistered nrDel
         | otherwise -> addMessageI Info MsgCourseUserNoExamsDeregistered
      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
    (ExamSetResultData mRes, selectedExams) -> do
      now <- liftIO getCurrentTime
      Sum nrUpdated <- runDB . flip ifoldMapM selectedExams $ \eId (view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> if
        | hasExamGradingGrades examGradingMode || isn't (_Just . _ExamAttended . _Right) mRes
        , hasExamGradingPass   examGradingMode || isn't (_Just . _ExamAttended . _Left ) mRes
          -> do
            oldResult <- getBy $ UniqueExamResult eId uid
            case mRes of
              Just res
                | maybe True ((/= res) . examResultResult . entityVal) oldResult -> do
                    void $ upsert
                      ExamResult
                        { examResultExam = eId
                        , examResultUser = uid
                        , 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
        | otherwise -> mempty <$ addMessageI Error (MsgCourseUserExamResultDoesNotMatchMode examName)
      when (nrUpdated > 0) . addMessageI Success $ MsgCourseUserExamsResultSet nrUpdated
      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID

  guard hasExams

  return $(widgetFile "course/user/exams")


courseUserTutorialsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
  uCID <- encrypt uid

  let
    tutorialDBTable = DBTable{..}
      where
        dbtSQLQuery (tutorial `E.InnerJoin` tutorialParticipant) = do
          E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
          E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
               E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
          return (tutorial, tutorialParticipant)
        dbtRowKey (_ `E.InnerJoin` tutorialParticipant) = tutorialParticipant E.^. TutorialParticipantId
        dbtProj = dbtProjSimple $ \(tutorial, tutorialParticipant) -> do
          tutors <- E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
            E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
            E.where_ $ tutor E.^. TutorTutorial E.==. E.val (tutorial ^. _entityKey)
            return user
          return (tutorial, tutorialParticipant, tutors)
        dbtColonnade = mconcat
          [ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _2 . _entityKey)
          , sortable (Just "type") (i18nCell MsgTableTutorialType) $ textCell . CI.original . view (_dbrOutput . _1 . _entityVal . _tutorialType)
          , sortable (Just "name") (i18nCell MsgTableTutorialName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal . _tutorialName -> tutn) -> CTutorialR courseTerm courseSchool courseShorthand tutn TUsersR) (view $ _dbrOutput . _1 . _entityVal . _tutorialName)
          , sortable (Just "tutors") (i18nCell MsgTableTutorialTutors) $ \(view $ _dbrOutput . _3 -> tutors) -> cell
              [whamlet|
                $newline never
                <ul .list--iconless .list--inline .list--comma-separated>
                  $forall (Entity _ usr) <- tutors
                    <li>
                      ^{userEmailWidget usr}
              |]
          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
          , sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
          ]
        dbtSorting = mconcat
          [ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType
          , singletonMap "name" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialName
          , singletonMap "room" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialRoom
          , singletonMap "tutors" . SortColumn $ \(tutorial `E.InnerJoin` _) -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
              E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
              E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
              return . E.min_ $ user E.^. UserSurname
          ]
        dbtFilter = mempty
        dbtFilterUI _mPrev = mempty
        dbtStyle = def
        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          , dbParamsFormAdditional = \csrf -> do
              let
                actionMap :: Map TutorialAction (AForm Handler TutorialActionData)
                actionMap = mconcat
                  [ singletonMap TutorialDeregister $
                      pure TutorialDeregisterData
                  ]

              (res, formWgt) <- multiActionM actionMap (fslI MsgTableAction) Nothing csrf
              let formRes = (, mempty) . First . Just <$> res
              return (formRes, formWgt)
          , dbParamsFormEvaluate = liftHandler . runFormPost
          , dbParamsFormResult = _2
          , dbParamsFormIdent = def
          }
        dbtIdent :: Text
        dbtIdent = "tutorials"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []
    tutorialDBTableValidator = def & defaultSorting [SortAscBy "type", SortAscBy "name"]
    postprocess :: FormResult (First TutorialActionData, DBFormResult TutorialParticipantId (Bool, _) _) -> FormResult (TutorialActionData, Map TutorialParticipantId _)
    postprocess inp = do
      (First (Just act), regMap) <- inp
      let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
      return (act, regMap')
  ((Any hasTutorials, actRes), tutorialTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable tutorialDBTableValidator tutorialDBTable

  lift . formResult actRes $ \case
    (TutorialDeregisterData, Map.keys -> selectedTutParts) -> do
      nrDel <- runDB $ deleteWhereCount [ TutorialParticipantId <-. selectedTutParts ]
      if | nrDel > 0 -> addMessageI Success $ MsgCourseUserTutorialsDeregistered nrDel
         | otherwise -> addMessageI Info MsgCourseUserNoTutorialsDeregistered
      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID

  guard hasTutorials

  return $(widgetFile "course/user/tutorials")