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

import Import

import qualified Data.Set as Set
import qualified Data.List.NonEmpty as NonEmpty (toList)

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

import Handler.Utils
import Handler.Utils.ExternalExam
import Handler.Utils.Users

import Utils.Exam.Correct


-- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
minNeedleLength :: Int
minNeedleLength = 3  -- TODO rethink

-- | Maximum number of user matches to show. Also serves as an upper limit to the number of query results from user and/or ldap lookups.
maxCountUserMatches :: Integral a => a
maxCountUserMatches = 10


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 <- encrypt eeId :: Handler CryptoUUIDExternalExam

  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 ((>= minNeedleLength) . length) $ euid ^? _Left) $
      CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExternalExamCorrectErrorNeedleTooShort)

    matches <- case euid of
      Right uid   -> lift . E.select . E.from $ \user -> E.where_ (user E.^. UserId E.==. E.val uid) >> return user
      Left  ident ->
        let pdnf = PredDNF . Set.fromList $ impureNonNull . Set.fromList . pure . PLVariable <$>
              [ GuessUserMatrikelnummer (ident :: UserMatriculation)
              , GuessUserDisplayName    (ident :: UserDisplayName)
              , GuessUserSurname        (ident :: UserSurname)
              , GuessUserFirstName      (ident :: UserFirstName)
              ]
        in  maybe [] (either NonEmpty.toList pure) <$> lift (guessUser pdnf . Just $ succ maxCountUserMatches)

    if
      | is _Nothing ciqResults, is _Nothing ciqGrade -> do
        users <- traverse userToResponse $ take maxCountUserMatches matches
        return CorrectInterfaceResponseNoOp
          { cirnUsers   = Set.fromList users
          , cirnHasMore = length matches > maxCountUserMatches
          }
      | [match@(Entity uid _)] <- matches -> do
        now <- liftIO getCurrentTime
        newExamResult <- for ciqGrade $ \ciqGrade' -> lift $ do
          unless mayEditResults $
            permissionDeniedI MsgUnauthorizedExternalExamCorrectorGrade
          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
                  let resultTime = fromMaybe now externalExamDefaultTime
                  newResult <- upsert ExternalExamResult
                    { externalExamResultExam        = eeId
                    , externalExamResultUser        = uid
                    , externalExamResultResult      = resultGrade
                    , externalExamResultTime        = resultTime
                    , externalExamResultLastChanged = now
                    }
                    [ ExternalExamResultResult      =. resultGrade
                    , ExternalExamResultTime        =. resultTime
                    , 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 MsgExternalExamCorrectErrorNoMatchingUsers
        }

      | otherwise -> do
        users <- traverse userToResponse $ take maxCountUserMatches matches
        return CorrectInterfaceResponseAmbiguous
          { ciraUsers   = Set.fromList users
          , ciraHasMore = length matches > maxCountUserMatches
          , ciraMessage = mr MsgExternalExamCorrectErrorMultipleMatchingUsers
          }

  whenM acceptsJson $
    sendResponseStatus (ciResponseStatus response) $ toJSON response

  redirect $ EExamR tid ssh coursen examn EEShowR