module Handler.Submission.Grade
  ( getCorrectionsGradeR, postCorrectionsGradeR
  ) where

import Import hiding (link)

import Handler.Utils hiding (colSchool)

import qualified Data.Map.Strict as Map

import qualified Data.CaseInsensitive as CI

import Data.List (genericLength)

import Handler.Submission.List


getCorrectionsGradeR, postCorrectionsGradeR :: Handler Html
getCorrectionsGradeR = postCorrectionsGradeR
postCorrectionsGradeR = do
  uid <- requireAuthId
  let whereClause :: CorrectionTableWhere
      whereClause = ratedBy uid
      displayColumns = mconcat -- should match getSSubsR for consistent UX
        [ -- dbRow,
          colSchool
        , colTerm
        , colCourse
        , colSheet
        , colSMatrikel
        , colSubmittors
        , colSGroups
        , colPseudonyms
        , colSubmissionLink
        , colRated
        , colRatedField
        , colPointsField
        , colMaxPointsField
        , colCommentField
        ] -- Continue here
      filterUI = Just $ mconcat
        [ filterUICourse courseOptions
        , filterUITerm termOptions
        , filterUISchool schoolOptions
        , filterUISheetSearch
        , filterUIPseudonym
        , filterUIIsRated
        -- , flip (prismAForm $ singletonFilter "rating-visible" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
        , filterUIRating
        , filterUIComment
        ]
      courseOptions = runDB $ do
        courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . courseShorthand . entityVal) courses
      termOptions = runDB $ do
        courses <- selectList [] [Asc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs . map (id &&& id) . nubOrd $ map (termToText . unTermKey . courseTerm . entityVal) courses
      schoolOptions = runDB $ do
        courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
      psValidator = def
        & restrictAnonymous
        & restrictCorrector
        & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
      unFormResult = getDBFormResult $ \(view $ resultSubmission . _entityVal -> sub@Submission{..}) -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)

  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI Nothing psValidator $ def
    { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
    }

  formResult tableRes $ \resMap -> do
    now <- liftIO getCurrentTime
    subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
      s@Submission{..} <- get404 subId
      if
        | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
          -> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet
                Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
                                           , SubmissionRatingComment =. mComment
                                           , SubmissionRatingBy =. Just uid
                                           , SubmissionRatingTime =. now <$ guard rated
                                           ]
        | otherwise -> return Nothing
    subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
    let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
        content = Right $(widgetFile "messages/correctionsUploaded")
    unless (null subs') $ addMessageModal Success trigger content
    redirect CorrectionsGradeR

  siteLayoutMsg MsgCorrectionsGrade $ do
    setTitleI MsgCorrectionsGrade
    $(widgetFile "corrections-grade")