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 = 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 $ \mPrev -> mconcat
        [ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse)
        , prismAForm (singletonFilter "term"   ) mPrev $ aopt (lift `hoistField` selectField termOptions)   (fslI MsgTerm)
        , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
        , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField)                 (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant)             (fslI MsgRatingTime)
        , prismAForm (singletonFilter "rating-visible" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
        , prismAForm (singletonFilter "rating" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` pointsField) (fslI MsgColumnRatingPoints)
        , Map.singleton "comment" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgRatingComment) (Just <$> listToMaybe =<< (Map.lookup "comment" =<< mPrev))
        ]
      courseOptions = runDB $ do
        courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs $ map (id &&& id) $ nub $ 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) $ nub $ 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) $ nub $ 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 $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)

  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI 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")