module Handler.Submission.Correction
  ( getCorrectionR, postCorrectionR
  , getCorrectionUserR
  ) where

import Import hiding (link)
-- import System.FilePath (takeFileName)

import Jobs
import Handler.Utils hiding (colSchool)
import Handler.Utils.Submission

import qualified Data.Text as Text

import qualified Control.Monad.State.Class as State

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


correctionData :: TermId -> SchoolId -> CourseShorthand -> SheetName -> _ -- CryptoFileNameSubmission -> _
correctionData tid ssh csh shn sub = E.select . E.from $ \((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> do
  E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
  E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
  E.where_ $ course E.^. CourseTerm       E.==. E.val tid
       E.&&. course E.^. CourseSchool     E.==. E.val ssh
       E.&&. course E.^. CourseShorthand  E.==. E.val csh
       E.&&. sheet  E.^. SheetName        E.==. E.val shn
       E.&&. submission E.^. SubmissionId E.==. E.val sub
  let filesCorrected = E.exists . E.from $ \(sFile1 `E.LeftOuterJoin` sFile2) -> do
        E.on $ E.just (sFile1 E.^. SubmissionFileTitle) E.==. sFile2 E.?. SubmissionFileTitle
         E.&&. E.just (sFile1 E.^. SubmissionFileSubmission) E.==. sFile2 E.?. SubmissionFileSubmission
         E.&&. sFile1 E.^. SubmissionFileContent E.!=. E.joinV (sFile2 E.?. SubmissionFileContent)
         E.&&. sFile1 E.^. SubmissionFileIsUpdate E.&&. E.maybe E.false E.not_ (sFile2 E.?. SubmissionFileIsUpdate)
        E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. submission E.^. SubmissionId
             E.&&. sFile2 E.?. SubmissionFileSubmission E.==. E.just (submission E.^. SubmissionId)
  return (course, sheet, submission, corrector, filesCorrected)

getCorrectionR, getCorrectionUserR, postCorrectionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getCorrectionR tid ssh csh shn cid = do
  mayPost <- isAuthorized (CSubmissionR tid ssh csh shn cid CorrectionR) True
  bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid ssh csh shn cid
postCorrectionR tid ssh csh shn cid = do
  sub <- decrypt cid

  (results, isLecturer) <- runDB $ (,)
    <$> correctionData tid ssh csh shn sub
    <*> hasWriteAccessTo (CSheetR tid ssh csh shn SSubsR)

  MsgRenderer mr <- getMsgRenderer
  ur <- getUrlRenderParams
  tr <- getTranslate
  case results of
    [(Entity cId Course{}, Entity shId Sheet{..}, subEnt@(Entity _ subm@Submission{..}), corrector, E.Value filesCorrected)] -> do
      (sheetTypeDesc, invisibleWidget) <- runDB $ do
        sheetTypeDesc <- sheetTypeDescription cId sheetType
        invisibleWidget <- correctionInvisibleWidget tid ssh csh shn cid subEnt
        return (sheetTypeDesc, invisibleWidget)
      let ratingComment = submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) . Text.strip
          pointsForm = case sheetType of
            NotGraded
              -> pure Nothing
            (preview _grading -> Just PassBinary)
              -> Just <$> apopt (convertField (bool 0 1) (/= 0) checkBoxField) (fslI MsgSubmissionPassed) submissionRatingPoints
            (preview _grading -> Just PassAlways)
              -> Just <$> aforced (convertField (bool 0 1) (/= 0) checkBoxField) (fslI MsgSubmissionPassed) 1
            _otherwise -> aSetTooltip (Just $ sheetTypeDesc tr ur) $
              aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
                   (fslpI MsgRatingPoints (mr MsgPointsPlaceholder))
                   (Just submissionRatingPoints)
          correctorForm
            | not isLecturer = wFormToAForm $ pure . Just <$> requireAuthId
            | otherwise = wFormToAForm $ do
                let correctors = E.from $ \user -> do
                      let isCorrector = E.exists . E.from $ \sheetCorrector ->
                            E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
                                 E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. E.val shId
                          isLecturer'  = E.exists . E.from $ \lecturer ->
                            E.where_ $ lecturer E.^. LecturerUser E.==. user E.^. UserId
                                 E.&&. lecturer E.^. LecturerCourse E.==. E.val cId
                      E.where_ $ isCorrector E.||. isLecturer'
                      return user
                wopt (selectField' (Just $ SomeMessage MsgSubmissionNoCorrector) $ userOptionsE correctors) (fslI MsgSubmissionCorrector & setTooltip MsgSubmissionCorrectorTip) (Just submissionRatingBy)
          validateCorr = do
            (now, ratingBy', rated, ratingPoints', ratingComment') <- State.get
            mapM_ tellValidationError $ validateRating sheetType Rating'
              { ratingPoints  = ratingPoints'
              , ratingComment = ratingComment'
              , ratingTime    = guardOn rated now
              , ratingDone    = rated
              }
            guardValidation MsgSubmissionCannotBeRatedWithoutCorrector $ isn't _Nothing ratingBy' || not rated

      ((corrResult, corrForm'), corrEncoding) <- runFormPost . validateForm validateCorr . identifyForm FIDcorrection . renderAForm FormStandard $ (,,,,)
        <$> wFormToAForm (pure <$> liftIO getCurrentTime)
        <*> correctorForm
        <*> apopt checkBoxField (fslI MsgRatingDone & setTooltip MsgRatingDoneTip) (Just $ submissionRatingDone Submission{..})
        <*> pointsForm
        <*> aopt (textareaField & isoField _Wrapped & cfStrip) (fslI MsgRatingComment) (Just submissionRatingComment)
      let corrForm = wrapForm' BtnSave corrForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = corrEncoding
            }

      ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
            apopt (zipFileField True Nothing True) (fslI MsgRatingFiles & setTooltip MsgRatingFilesTip) Nothing
      let uploadForm = wrapForm uploadForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = uploadEncoding
            }

      formResult corrResult $ \(now, ratingBy', rated, ratingPoints', ratingComment') -> do
        runDBJobs $ do
          update sub  [ SubmissionRatingBy      =. ratingBy'
                      , SubmissionRatingTime    =. (now <$ guard rated)
                      , SubmissionRatingPoints  =. ratingPoints'
                      , SubmissionRatingComment =. ratingComment'
                      ]

        addMessageI Success $ if
          | rated -> MsgRatingUpdated
          | is _Nothing ratingComment'
          , is _Nothing ratingPoints'
          , is _Nothing ratingBy' -> MsgRatingDeleted
          | is _Nothing ratingComment'
          , is _Nothing ratingPoints' -> MsgCorrectorUpdated
          | otherwise -> MsgRatingDraftUpdated
        redirect $ CSubmissionR tid ssh csh shn cid CorrectionR

      formResult uploadResult $ \fileUploads -> do
        uid <- maybeAuthId

        res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True

        when (is _Just res) $ do
          addMessageI Success MsgRatingFilesUpdated
          redirect $ CSubmissionR tid ssh csh shn cid CorrectionR

      let heading = MsgSubmissionCorrectionHead tid ssh csh shn cid
          headingWgt = [whamlet|
              $newline never
              _{heading}
              $if is _Just invisibleWidget || not (submissionRatingDone subm)
                \ ^{isVisibleWidget False}
            |]
            
      siteLayout headingWgt $ do
        setTitleI heading
        urlArchive <- toTextUrl . CSubmissionR tid ssh csh shn cid $ SubArchiveR SubmissionCorrected
        let userCorrection = $(widgetFile "correction-user")
        maybeVoid invisibleWidget
        $(widgetFile "correction")
    _ -> notFound
getCorrectionUserR tid ssh csh shn cid = do
  sub <- decrypt cid

  results <- runDB $ correctionData tid ssh csh shn sub

  case results of
    [(_, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _), E.Value filesCorrected)] -> do
      let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
      let heading = MsgSubmissionCorrectionHead tid ssh csh shn cid
      urlArchive <- toTextUrl . CSubmissionR tid ssh csh shn cid $ SubArchiveR SubmissionCorrected
      tr <- getTranslate
      sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
      siteLayoutMsg heading $ do
        setTitleI heading
        $(widgetFile "correction-user")
    _ -> notFound