-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Submission.Upload
  ( getCorrectionsUploadR, postCorrectionsUploadR
  ) where

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

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

import qualified Data.Set as Set

import Data.List (genericLength)

import qualified Data.Conduit.List as C


data SubmissionDoneMode
  = SubmissionDoneNever
  | SubmissionDoneByFile
  | SubmissionDoneAlways
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''SubmissionDoneMode $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''SubmissionDoneMode id


explainSubmissionDoneMode :: SubmissionDoneMode -> MaybeT Handler Widget
explainSubmissionDoneMode SubmissionDoneNever  = return $(i18nWidgetFile "submission-done-tip/never")
explainSubmissionDoneMode SubmissionDoneAlways = return $(i18nWidgetFile "submission-done-tip/always")
explainSubmissionDoneMode SubmissionDoneByFile = return $(i18nWidgetFile "submission-done-tip/by-file")


getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
getCorrectionsUploadR = postCorrectionsUploadR
postCorrectionsUploadR = do
  ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $ (,)
    <$> areq (zipFileField True Nothing True) (fslI MsgCorrUploadField) Nothing
    <*> apopt (explainedSelectionField Nothing $ explainOptionList optionsFinite explainSubmissionDoneMode) (fslI MsgCorrUploadSubmissionDoneMode & setTooltip MsgCorrUploadSubmissionDoneModeTip) (Just SubmissionDoneByFile)

  formResult uploadRes $ \(files, doneMode) -> do
    let
      setDone (Right (subId, rating))
        = Right ( subId
                , rating & _ratingDone %~ setDone'
                )
        where setDone' = case doneMode of
                SubmissionDoneNever  -> const False
                SubmissionDoneByFile -> id
                SubmissionDoneAlways -> const True
      setDone other = other

    uid <- requireAuthId
    mbSubs <- msgSubmissionErrors . runDBJobs . runConduit $
         transPipe (lift . lift) files
      .| extractRatingsMsg
      .| C.map setDone
      .| sinkMultiSubmission uid True

    forM_ mbSubs $ \subs -> if
      | null subs -> addMessageI Warning MsgNoCorrectionsUploaded
      | otherwise -> do
          subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) $ Set.toList subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
          let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
              content = Right $(widgetFile "messages/correctionsUploaded")
          addMessageModal Success trigger content
          redirect CorrectionsR

  let uploadForm = wrapForm upload def
        { formAction = Just $ SomeRoute CorrectionsUploadR
        , formEncoding = uploadEncoding
        }

  maxUploadMB <- appMaximumContentLength <$> getsYesod appSettings'

  defaultLayout $ do
    let uploadInstruction = $(i18nWidgetFile "corrections-upload-instructions")
    $(widgetFile "corrections-upload")