module Handler.ExternalExam.Correct
  ( getEECorrectR, postEECorrectR
  ) where

import Import

import qualified Data.Set as Set

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
import Database.Persist.Sql (transactionUndo)

import Handler.Utils
import Handler.Utils.ExternalExam

import Utils.Exam


getEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEECorrectR tid ssh coursen examn = do
  MsgRenderer mr <- getMsgRenderer

  Entity _eeId ExternalExam{..} <- runDB $ fetchExternalExam tid ssh coursen examn

  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR

  let
    heading = mr $ MsgExternalExamCorrectHeading coursen examn

    ptsInput :: ExamPartNumber -> Widget
    ptsInput = const mempty

    examParts :: [ExamPart]
    examParts = []

    examGrades :: [ExamGrade]
    examGrades = universeF

    examGradingMode = externalExamGradingMode

    examCorrectIdent :: Text
    examCorrectIdent = "TODO"  -- TODO fix below

  -- examCorrectIdent <- encrypt eeId :: Handler (CryptoID UUID ExternalExamId)

  siteLayoutMsg heading $ do
    setTitleI heading
    let
      examCorrectExplanation = $(i18nWidgetFile "external-exam-correct-explanation")
    $(widgetFile "exam-correct")


postEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Void
postEECorrectR tid ssh coursen examn = do
  MsgRenderer mr <- getMsgRenderer

  CorrectInterfaceRequest{..} <- requireCheckJsonBody

  mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR

  response <- runDB . exceptT (<$ transactionUndo) return $ do
    Entity eeId ExternalExam{..} <- lift $ fetchExternalExam tid ssh coursen examn
    euid <- traverse decrypt ciqUser

    guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $  -- TODO rethink max needle length
      CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)

    matches <- lift . E.select . E.from $ \user -> do
      let mUserIdent = euid ^? _Left
      E.where_ $ either (const E.false) (\uid -> user E.^. UserId E.==. E.val uid) euid
        E.||. (case mUserIdent of
                 Just userIdent -> 
                         user E.^. UserSurname         E.==.       E.val userIdent
                   E.||. user E.^. UserSurname        `E.hasInfix` E.val userIdent
                   E.||. user E.^. UserFirstName       E.==.       E.val userIdent
                   E.||. user E.^. UserFirstName      `E.hasInfix` E.val userIdent
                   E.||. user E.^. UserDisplayName     E.==.       E.val userIdent
                   E.||. user E.^. UserDisplayName    `E.hasInfix` E.val userIdent
                   E.||. user E.^. UserMatrikelnummer  E.==.       E.val mUserIdent
                   E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
                 Nothing -> E.false)
      return user

    let
      userToResponse (Entity uid User{..}) = do  -- TODO move to util
        uuid <- encrypt uid
        return CorrectInterfaceUser
          { ciuSurname     = userSurname
          , ciuDisplayName = userDisplayName
          , ciuMatNr       = userMatrikelnummer
          , ciuId          = uuid
          }
    
    if
      | is _Nothing ciqResults, is _Nothing ciqGrade -> do
        users <- traverse userToResponse matches
        return CorrectInterfaceResponseNoOp
          { cirnUsers = Set.fromList users
          }
      | [match@(Entity uid _)] <- matches -> do
        now <- liftIO getCurrentTime
        newExamResult <- for ciqGrade $ \ciqGrade' -> lift $ do
          unless mayEditResults $
            permissionDeniedI MsgUnauthorizedExamCorrectorGrade
          mOldResult <- getBy $ UniqueExternalExamResult eeId uid
          if
            | Just (Entity oldId _) <- mOldResult, is _Nothing ciqGrade' -> do
              delete oldId
              audit $ TransactionExternalExamResultDelete eeId uid
              return Nothing
            | Just resultGrade <- ciqGrade' -> let
                mOld = externalExamResultResult . entityVal <$> mOldResult
              in if
                | ciqGrade' /= mOld -> do
                  newResult <- upsert ExternalExamResult
                    { externalExamResultExam        = eeId
                    , externalExamResultUser        = uid
                    , externalExamResultResult      = resultGrade
                    , externalExamResultTime        = now  -- TODO add and use utcTimeField
                    , externalExamResultLastChanged = now
                    }
                    [ ExternalExamResultResult      =. resultGrade
                    , ExternalExamResultTime        =. now  -- TODO add and use utcTimeField
                    , ExternalExamResultLastChanged =. now
                    ]
                  audit $ TransactionExternalExamResultEdit eeId uid
                  return $ newResult ^? _entityVal . _externalExamResultResult
                | otherwise -> return $ mOldResult ^? _Just . _entityVal . _externalExamResultResult
            | otherwise -> return Nothing

        user <- userToResponse match
        return CorrectInterfaceResponseSuccess
          { cirsUser    = user
          , cirsResults = mempty
          , cirsGrade   = newExamResult
          , cirsTime    = now
          }

      | [] <- matches -> return CorrectInterfaceResponseFailure
        { cirfUser    = Nothing
        , cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants  -- TODO use new msg
        }

      | otherwise -> do
        users <- traverse userToResponse matches
        return CorrectInterfaceResponseAmbiguous
          { ciraUsers   = Set.fromList users
          , ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants  -- TODO use new msg
          }

  let
    responseStatus = case response of
      CorrectInterfaceResponseSuccess{} -> ok200
      CorrectInterfaceResponseNoOp{}    -> ok200
      _                                 -> badRequest400

  whenM acceptsJson $
    sendResponseStatus responseStatus $ toJSON response

  redirect $ EExamR tid ssh coursen examn EEShowR