module Handler.Exam.Show
  ( getEShowR
  ) where

import Import
import Handler.Exam.Register

import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget)

import Handler.ExamOffice.Exam (examCloseWidget)

import Data.Map ((!?))
import qualified Data.Map as Map

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

import qualified Data.CaseInsensitive as CI

import Handler.Utils
import Handler.Utils.Exam


getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getEShowR tid ssh csh examn = do
  cTime <- liftIO getCurrentTime
  mUid <- maybeAuthId

  (Entity eId Exam{..}, School{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools, (partsVisible, partsShown)) <- runDB $ do
    exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
    school <- getJust examCourse >>= belongsToJust courseSchool

    lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR

    let examVisible = NTop (Just cTime) >= NTop examVisibleFrom

    let gradingVisible = NTop (Just cTime) >= NTop examFinished
        gradingShown = gradingVisible || lecturerInfoShown

    let partsVisible = gradingVisible
                    || NTop (Just cTime) >= NTop examPartsFrom
        partsShown = partsVisible || lecturerInfoShown

    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == ExamRoomFifo
        occurrenceAssignmentsShown = occurrenceAssignmentsVisible || lecturerInfoShown

    sheets <- selectList [ SheetCourse ==. examCourse ] [] 
    let examPartSheets epId = do
          let sheets' = flip filter sheets $ \(Entity _ Sheet{..}) -> has (_examPart . re _SqlKey . only epId) sheetType
          flip filterM sheets' $ \(Entity _ Sheet{..}) -> hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR
    examParts <- fmap (sortOn . view $ _1 . _entityVal . _examPartNumber) $ selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ] >>= traverse (\ep@(Entity epId _) -> (ep,,) <$> encrypt @ExamPartId @UUID epId <*> examPartSheets epId)

    resultsRaw <- for mUid $ \uid ->
      E.select . E.from $ \examPartResult -> do
        E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
             E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map (views _1 entityKey) examParts)
        return examPartResult
    let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw

    result <- fmap join . for mUid $ getBy . UniqueExamResult eId
    bonus <- fmap join . for mUid $ getBy . UniqueExamBonus eId

    occurrencesRaw <- E.select . E.from $ \examOccurrence -> do
      E.where_ $ examOccurrence E.^. ExamOccurrenceExam E.==. E.val eId
      let
        registered
          | Just uid <- mUid
          = E.exists . E.from $ \examRegistration ->
              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
                   E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
                   E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
          | otherwise = E.false
        registeredCount :: E.SqlExpr (E.Value Int64)
        registeredCount
          = E.subSelectCount . E.from $ \examRegistration ->
              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
                   E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
        showRoom = maybe E.false (flip showExamOccurrenceRoom examOccurrence . E.val) mUid
             E.||. E.not_ (examOccurrence E.^. ExamOccurrenceRoomHidden)
      E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
      return (examOccurrence, registered, registeredCount, showRoom)

    registeredCount <- fromIntegral <$> count [ ExamRegistrationExam ==. eId ]

    registered <- for mUid $ getBy . UniqueExamRegistration eId
    mayRegister <- if
      | examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _, _, _) ->
          hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
      | otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR

    let occurrences = sortOn sortPred $ map (over _4 E.unValue . over _3 E.unValue . over _2 E.unValue) occurrencesRaw
          where
            sortPred (Entity _ ExamOccurrence{..}, registered', _, showRoom)
              = (Down $ registered' && not mayRegister, examOccurrenceStart, guardOn @Maybe showRoom examOccurrenceRoom)

    staffInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EGradesR

    extraSchools <- E.select . E.from $ \(school' `E.InnerJoin` examOfficeSchool) -> do
      E.on $ school' E.^. SchoolId E.==. examOfficeSchool E.^. ExamOfficeSchoolSchool
      E.where_ $ examOfficeSchool E.^. ExamOfficeSchoolExam E.==. E.val eId
      return school'

    return (exam, school, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools, (partsVisible, partsShown))

  let occurrenceNamesShown = lecturerInfoShown
      partNumbersShown = lecturerInfoShown
      examClosedShown = lecturerInfoShown && isn't _ExamCloseOnFinished' schoolExamCloseMode
      showCloseWidget = lecturerInfoShown
      showAutoOccurrenceCalculateWidget = lecturerInfoShown
      showRegisteredCount = lecturerInfoShown
      examFinishedMsg = if lecturerInfoShown then MsgExamFinished else MsgExamFinishedParticipant

      sumMaxPoints = sum [ fromRational examPartWeight * mPoints | (Entity _ ExamPart{..}, _, _) <- examParts, mPoints <- examPartMaxPoints ^.. _Just ]

      sumRegisteredCount = sumOf (folded . _3) occurrences

      noBonus = (Just True ==) $ do
        guardM $ bonusOnlyPassed <$> examBonusRule
        return $ Just False /= result ^? _Just . _entityVal . _examResultResult . _examResult . to (either id $ view passingGrade) . _Wrapped . to not

      sumPoints = fmap getSum . mconcat $ catMaybes
        [ Just $ foldMap (fmap Sum . examPartResultResult . entityVal) results
        , guard (not noBonus) *> fmap (pure . Sum . examBonusBonus . entityVal) bonus
        ]

      hasRegistration = orOf (folded . _2) occurrences

  mayRegister' <- fmap ((Map.!) . Map.fromList) . for (Nothing : map Just occurrences) $ \case
    Nothing ->
      fmap (Nothing, ) . hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
    Just (Entity occId ExamOccurrence{..}, _, _, _) ->
      fmap (Just occId, ) . hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName

  let examTimes = all (\(Entity _ ExamOccurrence{..}, _, _, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
      examRoom = do
        (Entity _ primeOcc, _, _, _) <- occurrences ^? _head
        guard $ all (\(Entity _ occ, _, _, _) -> examOccurrenceRoom occ == examOccurrenceRoom primeOcc) occurrences
        guard $ andOf (folded . _4) occurrences
        examOccurrenceRoom primeOcc
      registerWidget mOcc
        | isRegistered <- is _Just $ join registered
        , examOccurrenceRule /= ExamRoomFifo || (isRegistered && not (orOf (folded . _2) occurrences))
        , mayRegister' (entityKey <$> mOcc) = Just $ do
            (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
            [whamlet|
              $newline never
              <p>
                $if isRegistered
                  _{MsgExamRegistered}
                $else
                  _{MsgExamNotRegistered}
            |]
            wrapForm examRegisterForm def
              { formAction = Just . SomeRoute $ CExamR tid ssh csh examName ERegisterR
              , formEncoding = examRegisterEnctype
              , formSubmit = FormNoSubmit
            }
        | examOccurrenceRule == ExamRoomFifo
        , Just (Entity occId ExamOccurrence{..}) <- mOcc
        , isRegistered <- (== Just occId) $ examRegistrationOccurrence . entityVal =<< join registered
        , mayRegister' (Just occId) = Just $ do
            (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [bool BtnExamRegisterOccurrence BtnExamSwitchOccurrence . is _Just $ join registered] [BtnExamDeregister] isRegistered
            wrapForm examRegisterForm def
              { formAction = Just . SomeRoute . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
              , formEncoding = examRegisterEnctype
              , formSubmit = FormNoSubmit
            }
        | is _Nothing mOcc
        , is _Nothing registered
        = Just $ i18n MsgExamLoginToRegister
        | is _Nothing mOcc
        , isRegistered <- is _Just $ join registered
        = Just
            [whamlet|
              $newline never
              <p>
                $if isRegistered
                  _{MsgExamRegistered}
                $else
                  _{MsgExamNotRegistered}
                $if mayRegister
                  ^{messageTooltip =<< messageI Info MsgExamRegisterForOccurrence}
            |]
        | otherwise = Nothing

      showMaxPoints = gradingShown && any (has $ _1 . _entityVal . _examPartMaxPoints . _Just) examParts
      showAchievedPoints = gradingShown && not (null results)
      showPartSheets = any (has $ _3 . folded) examParts
      showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == ExamRoomFifo)
      markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
      showOccurrenceMappingColumn = examOccurrenceRuleAutomatic examOccurrenceRule && occurrenceAssignmentsShown && is _Just examExamOccurrenceMapping

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

  let heading = prependCourseTitle tid ssh csh $ CI.original examName

  notificationDiscouragedExamMode <- runMaybeT $ do
    guard $ evalExamModeDNF schoolExamDiscouragedModes examExamMode
    guardM . lift . hasWriteAccessTo $ CExamR tid ssh csh examn EEditR
    return $ notification NotificationBroad =<< messageI Warning MsgExamModeSchoolDiscouraged
      
  siteLayoutMsg heading $ do
    setTitleI heading
    let
      gradingKeyW :: [Points] -> Widget
      gradingKeyW bounds
        = let boundWidgets :: [Widget]
              boundWidgets = toWidget . (pack :: String -> Text) . showFixed True <$> 0 : bounds
              grades :: [ExamGrade]
              grades = universeF
           in $(widgetFile "widgets/gradingKey")

      examBonusW :: ExamBonusRule -> Widget
      examBonusW bonusRule = $(widgetFile "widgets/bonusRule")

      occurrenceMapping :: ExamOccurrenceName -> Maybe Widget
      occurrenceMapping occName = examOccurrenceMappingDescriptionWidget <$> fmap examOccurrenceMappingRule examExamOccurrenceMapping <*> (examExamOccurrenceMapping >>= Map.lookup occName . examOccurrenceMappingMapping)

      notificationPersonalIdentification = notification NotificationBroad =<< messageIconI Info IconPersonalIdentification MsgExamShowIdentificationRequired
    $(widgetFile "exam-show")
