module Handler.Utils.Rating
  ( Rating(..), Rating'(..)
  , validateRating
  , getRating
  , ratingFile
  , isRatingFile
  , SubmissionContent
  , extractRatings
  , module Handler.Utils.Rating.Format
  ) where

import Import

import Handler.Utils.DateTime (getDateTimeFormatter)

import qualified Data.Text as Text

import qualified Data.ByteString.Lazy as Lazy.ByteString

import qualified Database.Esqueleto as E

import qualified Data.Conduit.List as Conduit

import Handler.Utils.Rating.Format

import qualified Data.Set as Set
import qualified Data.CaseInsensitive as CI


validateRating :: SheetType -> Rating' -> [RatingValidityException]
validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. }
  | rp < 0
    = [RatingNegative]
  | NotGraded <- ratingSheetType
    = [RatingNotExpected]
  | (Just maxPoints ) <- ratingSheetType ^?  _grading . _maxPoints
  , rp > maxPoints
    = [RatingExceedsMax]
  | (Just PassBinary) <- ratingSheetType ^? _grading
  , not (rp == 0 || rp == 1)
    = [RatingBinaryExpected]
validateRating ratingSheetType Rating'{ .. }
  | has _grading ratingSheetType
  , is _Nothing ratingPoints
  , ratingDone
  , hasn't (_grading . _PassAlways) ratingSheetType
  = [RatingPointsRequired]
validateRating _ _ = []

getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating)
getRating submissionId = runMaybeT $ do
  let query = E.select . E.from $ \(corrector `E.RightOuterJoin` (submission `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` school)) -> do
        E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
        E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
        E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
        E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy

        E.where_ $ submission E.^. SubmissionId E.==. E.val submissionId

        -- Yes, we can only pass a tuple through 'E.select'
        return ( course E.^. CourseTerm
               , school E.^. SchoolName
               , course E.^. CourseName
               , sheet E.^. SheetName
               , corrector E.?. UserDisplayName
               , sheet E.^. SheetType
               , submission
               )

  [ ( unTermKey . E.unValue -> ratingCourseTerm
    , E.unValue -> ratingCourseSchool
    , E.unValue -> ratingCourseName
    , E.unValue -> ratingSheetName
    , E.unValue -> ratingCorrectorName
    , E.unValue -> ratingSheetType
    , E.Entity _ sub@Submission{..}
    ) ] <- lift query

  let ratingPoints = submissionRatingPoints
      ratingComment = submissionRatingComment
      ratingTime = submissionRatingTime
      ratingDone = submissionRatingDone sub

  return Rating{ ratingValues = Rating'{..}, .. }

extensionRating :: String
extensionRating = "txt"

ratingFile :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              )
           => CryptoFileNameSubmission -> Rating -> m File
ratingFile cID rating@Rating{ ratingValues = Rating'{..}, .. } = do
  mr'@(MsgRenderer mr) <- getMsgRenderer
  dtFmt <- getDateTimeFormatter
  fileModified <- maybe (liftIO getCurrentTime) return ratingTime
  let
    fileTitle = ensureExtension extensionRating . unpack . mr $ MsgRatingFileTitle cID
    fileContent = Just . Lazy.ByteString.toStrict $ formatRating mr' dtFmt cID rating
  return File{..}
  where ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName

type SubmissionContent = Either File (SubmissionId, Rating')

extractRatings :: ( MonadHandler m
                  , HandlerSite m ~ UniWorX
                  ) => ConduitT File SubmissionContent m ()
extractRatings = Conduit.mapM $ \f@File{..} -> liftHandler $ do
  msId <- isRatingFile fileTitle
  case () of
    _ | Just sId <- msId
      , isJust fileContent -> do
          (rating, cID) <- handle (throwM . RatingFileException fileTitle) $ parseRating f
          sId' <- traverse decrypt cID
          unless (maybe (const True) (==) sId' sId) $
            throwM $ RatingFileException fileTitle RatingSubmissionIDIncorrect
          return $ Right (sId, rating)
      | otherwise -> return $ Left f

isRatingFile :: forall m.
                ( MonadHandler m
                , HandlerSite m ~ UniWorX
                ) => FilePath -> m (Maybe SubmissionId)
isRatingFile fName = liftHandler $
  fmap getFirst . flip foldMapM segments' $ fmap First . tryDecrypt
  where
    tryDecrypt :: Text -> Handler (Maybe SubmissionId)
    tryDecrypt ciphertext
      | Just cID <- fromPathPiece ciphertext
      = (Just <$> decrypt (cID :: CryptoFileNameSubmission)) `catch` decryptErrors
      | otherwise
      = return Nothing

    decryptErrors (CiphertextConversionFailed _) = return Nothing
    decryptErrors InvalidNamespaceDetected       = return Nothing
    decryptErrors DeserializationError           = return Nothing
    decryptErrors err                            = throwM err

    segments' = filter (not . Text.null) . Text.split (flip Set.notMember cryptoIdChars . CI.mk) . Text.pack $ takeFileName fName

    cryptoIdChars :: Set (CI Char)
    cryptoIdChars = Set.fromList . map CI.mk $ "uwa" ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"