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

import Import

import Utils.Form
import Handler.Utils
import Handler.Utils.SheetType
import Database.Esqueleto.Utils.TH

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

import Database.Persist.Sql (deleteWhereCount)

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

import Handler.Course.Register

import Jobs.Queue

import Handler.Submission.List

import Handler.Utils.StudyFeatures

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

import qualified Data.Conduit.Combinators as C
import qualified Data.Text.Lazy as LT


data ExamAction = ExamDeregister
                | ExamSetResult
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
  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, Typeable)
  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 $
    if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
         -> renderWForm FormStandard $ fmap (regButton, )
              <$  (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
              <*> optionalActionW ((,)
                                     <$> areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
                                     <*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
                                  ) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
       | otherwise
         -> \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
        , 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 ]

              now <- liftIO getCurrentTime
              insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
              let recordNoShow eId = do
                    didRecord <- is _Just <$> insertUnique ExamResult
                      { examResultExam = eId
                      , examResultUser = uid
                      , examResultResult = ExamNoShow
                      , examResultLastChanged = now
                      }
                    when didRecord $
                      audit $ TransactionExamResultEdit eId uid
              when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
          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 Nothing CourseParticipantActive)
          [ CourseParticipantRegistration =. now
          , CourseParticipantAllocated =. Nothing
          , CourseParticipantState =. CourseParticipantActive
          ]
        queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
        audit $ TransactionCourseParticipantEdit cid uid
      addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
      redirect currentRoute
    _other -> error "Invalid @regButton@"

  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
        , 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 _ User{userEmail, userDisplayName, userSurname}) <- tutors
                    <li>
                      ^{nameEmailWidget userEmail userDisplayName userSurname}
              |]
          , 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")
