module Handler.Submission where

import Import

import Jobs

-- import Yesod.Form.Bootstrap3

import Handler.Utils
import Handler.Utils.Delete
import Handler.Utils.Submission
import Handler.Utils.Table.Cells

import Network.Mime

-- import Control.Monad.Trans.Maybe
-- import Control.Monad.State.Class
-- import Control.Monad.Trans.State.Strict (StateT)

import Data.Monoid (Any(..))
import Data.Maybe (fromJust)
-- import qualified Data.Maybe
import qualified Data.Text.Encoding as Text

import Data.CaseInsensitive (CI)
-- import qualified Data.CaseInsensitive as CI

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlFunction)

import qualified Data.Conduit.List as Conduit
-- import Data.Conduit.ResumableSink

-- import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
-- import Data.Bifunctor

import System.FilePath

-- import Colonnade hiding (bool, fromMaybe)
-- import qualified Yesod.Colonnade as Yesod
-- import qualified Text.Blaze.Html5.Attributes as HA

-- DEPRECATED: We always show all edits!
-- numberOfSubmissionEditDates :: Int64
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.


makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identifyForm FIDsubmission $ \html -> do
    let
      fileUploadForm = case uploadMode of
        NoUpload -> pure Nothing
        (Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
    flip (renderAForm FormStandard) html $ (,)
      <$> fileUploadForm
      <*> ( (:|)
        -- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
        <$> aforced ciField (fslpI (MsgSubmissionMember 1) "user@campus.lmu.de" ) self
        <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
                                      | g <- [2..(fromIntegral groupNr)]
                                      | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
                                      ])
        )
  where
    (groupNr, editableBuddies)
      | Arbitrary{..} <- grouping = (maxParticipants, True)
      | RegisteredGroups <- grouping = (fromIntegral $ length buddies, False)
      | otherwise = (0, False)

    aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
    aforced' _ _  _ = error "Cannot happen since groupNr==0 if grouping/=Arbitrary"

getSubmissionNewR, postSubmissionNewR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionNewR = postSubmissionNewR
postSubmissionNewR tid ssh csh shn = submissionHelper tid ssh csh shn Nothing


getSubShowR, postSubShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubShowR = postSubShowR
postSubShowR tid ssh csh shn cid = submissionHelper tid ssh csh shn $ Just cid

getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionOwnR tid ssh csh shn = do
  authId <- requireAuthId
  sid <- runDB $ do
    shid <- fetchSheetId tid ssh csh shn
    submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
      E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
      E.where_ $ submissionUser E.^. SubmissionUserUser   E.==. E.val authId
           E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
      return $ submission E.^. SubmissionId
    case submissions of
      (E.Value sid : _) -> return sid
      []      -> notFound
  cID <- encrypt sid
  redirect $ CSubmissionR tid ssh csh shn cID SubShowR

submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe CryptoFileNameSubmission -> Handler Html
submissionHelper tid ssh csh shn mcid = do
  (Entity uid userData) <- requireAuth
  msmid     <- traverse decrypt mcid
  actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
  maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.

  (Entity shid Sheet{..}, buddies, lastEdits)  <- runDB $ do
    csheet@(Entity shid Sheet{..})  <- fetchSheet tid ssh csh shn
    case msmid of
      Nothing     -> do
        submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
          E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
          E.where_ $ submissionUser E.^. SubmissionUserUser   E.==. E.val uid
               E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
          return $ submission E.^. SubmissionId
        -- logDebugS "Submission.DUPLICATENEW" (tshow submissions)
        case submissions of
          []    -> do
            -- fetch buddies from previous submission in this course
            buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
              E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
              let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` subUser `E.InnerJoin` submissionEdit) -> do
                    E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
                    E.on (subUser        E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
                    E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
                    E.where_ $  subUser E.^. SubmissionUserUser E.==. E.val uid
                          E.&&. sheet   E.^.        SheetCourse E.==. E.val sheetCourse
                    E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
                    E.limit 1
                    return $ submission E.^. SubmissionId
              E.where_ $  submissionUser E.^. SubmissionUserSubmission `E.in_` oldids
                    E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
              E.orderBy  [E.asc $ user E.^. UserEmail]
              return $ user E.^. UserEmail
            return (csheet, map E.unValue buddies, [])
          (E.Value smid:_) -> do
            cID <- encrypt smid
            addMessageI Info MsgSubmissionAlreadyExists
            redirect $ CSubmissionR tid ssh csh shn cID SubShowR
      (Just smid) -> do
        void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)

        shid' <- submissionSheet <$> get404 smid
        unless (shid == shid') $
          invalidArgsI [MsgSubmissionWrongSheet]
        -- fetch buddies from current submission
        (Any isOwner, buddies) <- do
          submitters <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
            E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
            E.where_ $  submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
            E.orderBy  [E.asc $ user E.^. UserEmail]
            return (user E.^. UserId, user E.^. UserEmail)
          let breakUserFromBuddies (E.Value userID, E.Value email)
                | uid == userID  =  (Any True ,      [])
                | otherwise      =  (Any False, [email])
          return $ foldMap breakUserFromBuddies submitters

        lastEdits <- do
            raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
              E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
              E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
              E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
              -- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times
              let userName = if isOwner || maySubmit
                              then E.just $ user E.^. UserDisplayName
                              else E.nothing
              return (userName, submissionEdit E.^. SubmissionEditTime)
            forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
        return (csheet,buddies,lastEdits)
  ((res,formWidget'), formEnctype) <- runFormPost $ makeSubmissionForm msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping (userEmail userData :| buddies)
  let formWidget = wrapForm formWidget' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
        }
  mCID <- fmap join . msgSubmissionErrors . runDBJobs $ do
    res' <- case res of
      FormMissing              -> return   FormMissing
      (FormFailure failmsgs)   -> return $ FormFailure failmsgs
      -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
      (FormSuccess (mFiles,_submitter:|[])) -> return $ FormSuccess (mFiles,[]) -- Type change
      (FormSuccess (mFiles,_submitter:|gEMails@(_:_))) -- Validate AdHoc Group Members
        | Arbitrary{..} <- sheetGrouping -> do
          -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
          let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))
              prep ps = Map.filter (maybe True $ \(i,_,_) -> i /= uid) . Map.fromList $ map (, Nothing) gEMails ++ [(m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
          participants <- fmap prep . E.select . E.from $ \user -> do
            E.where_ $ (user E.^. UserEmail) `E.in_` E.valList gEMails
            let
              isParticipant = E.sub_select . E.from $ \courseParticipant -> do
                E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
                     E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val sheetCourse
                return $ E.countRows E.>. E.val (0 :: Int64)
              hasSubmitted = E.sub_select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
                E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
                     E.&&. submission E.^. SubmissionSheet E.==. E.val shid
                case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
                  Nothing   -> return ()
                  Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
                return $ E.countRows E.>. E.val (0 :: Int64)
            return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))

          $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants

          mr <- getMessageRender
          let
            failmsgs = (concat :: [[Text]] -> [Text])
              [ flip Map.foldMapWithKey participants $ \email -> \case
                  Nothing            -> pure . mr $ MsgEMailUnknown email
                  (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant email tid csh
                  (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor email
                  _other             -> mempty
              , case fromIntegral (length participants) `compare` maxParticipants of
                  LT -> mempty
                  _  -> pure $ mr MsgTooManyParticipants
              ]
          return $ if null failmsgs
            then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants)
            else FormFailure failmsgs
        | otherwise -> return $ FormFailure ["Mismatching number of group participants"]


    case res' of
      (FormSuccess (mFiles, setFromList -> adhocIds)) -> do
        smid <- do
          smid <- case (mFiles, msmid) of
            (Nothing, Just smid)   -- no new files, existing submission partners updated
              -> return smid
            (Just files, _) -> -- new files
              runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission uid (maybe (Left shid) Right msmid) False
            (Nothing, Nothing) -- new submission, no file upload requested
              -> insert Submission
                  { submissionSheet = shid
                  , submissionRatingPoints   = Nothing
                  , submissionRatingComment  = Nothing
                  , submissionRatingBy       = Nothing
                  , submissionRatingAssigned = Nothing
                  , submissionRatingTime     = Nothing
                  }
          -- Determine members of pre-registered group
          groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
            E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
            E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
            E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
                E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
            return $ submissionGroupUser' E.^. SubmissionGroupUserUser
          -- SubmissionUser for all group members (pre-registered & ad-hoc)
          let subUsers = Set.insert uid $ groupUids `Set.union` adhocIds
          -- remove obsolete old entries
          deleteWhere [SubmissionUserSubmission ==. smid, SubmissionUserUser /<-. setToList subUsers]
          -- maybe add current users
          forM_ subUsers $ \uid' -> void . insertUnique $ SubmissionUser uid' smid
          return smid
        cID <- encrypt smid
        return $ Just cID
      (FormFailure msgs) -> Nothing <$ forM_ msgs (addMessage Warning . toHtml)
      _other -> return Nothing

  case mCID of
    Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
    Nothing  -> return ()

  -- Maybe construct a table to display uploaded archive files
  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
      colonnadeFiles cid = mconcat
        [ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
              Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
              origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
              corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
              Just isFile = origIsFile <|> corrIsFile
            in if
              | Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
                                                      [whamlet|#{fileTitle'}|]
              | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
        , sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
            Nothing -> cell mempty
            Just (_, Entity _ File{..})
              | isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
                                                 [whamlet|_{MsgFileCorrected}|]
              | otherwise -> i18nCell MsgCorrected
        , sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
              origTime = fileModified . entityVal . snd <$> mOrig
              corrTime = fileModified . entityVal . snd <$> mCorr
              Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
            in dateTimeCell fileTime
        ]
      coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File))
      coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md)
      submissionFiles :: _ -> _ -> E.SqlQuery _
      submissionFiles smid ((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) = do
        E.on $ f2 E.?. FileId E.==. sf2 E.?. SubmissionFileFile
        E.on $ f1 E.?. FileTitle E.==. f2 E.?. FileTitle
         E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission
         E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId
        E.on $ f1 E.?. FileId E.==. sf1 E.?. SubmissionFileFile

        E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate))
             E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True)  E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate))
             E.&&. (sf1 E.?. SubmissionFileSubmission E.==. E.val (Just smid) E.||. sf2 E.?. SubmissionFileSubmission E.==. E.val (Just smid))

        return ((sf1, f1), (sf2, f2))
      smid2ArchiveTable (smid,cid) = DBTable
        { dbtSQLQuery = submissionFiles smid
        , dbtRowKey = \((_ `E.InnerJoin` f1) `E.FullOuterJoin` (_ `E.InnerJoin` f2)) -> (f1 E.?. FileId, f2 E.?. FileId)
        , dbtColonnade = colonnadeFiles cid
        , dbtProj = return . dbrOutput
        , dbtStyle = def
        , dbtIdent = "files" :: Text
        , dbtSorting = Map.fromList
          [ ( "path"
            , SortColumn $ \((_sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (_sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
            )
          , ( "time"
            , SortColumn $ \((_sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (_sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
            )
          ]
        , dbtFilter = mempty
        , dbtFilterUI = mempty
        , dbtParams = def
        }
  mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid

  defaultLayout $ do
    setTitleI $ MsgSubmissionEditHead tid ssh csh shn
    let urlArchive  cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))
        urlOriginal cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))
    $(widgetFile "submission")


getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = runDB $ do
  submissionID <- submissionMatchesSheet tid ssh csh shn cID

  isRating <- (== Just submissionID) <$> isRatingFile path

  when (isUpdate || isRating) $
    guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False

  case isRating of
    True
      | isUpdate -> do
          file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
          maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
      | otherwise -> notFound
    False -> do
      results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
        E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
        E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
             E.&&. f E.^. FileTitle E.==. E.val path
             E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
             E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
             -- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
        return f

      case results of
        [Entity _ File{ fileContent = Just c, fileTitle }] -> do
          whenM downloadFiles $
            addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
          return $ TypedContent (defaultMimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent c)
        [Entity _ File{ fileContent = Nothing }] -> sendResponseStatus noContent204 ()
        other -> do
          $logErrorS "SubDownloadR" $ "Multiple matching files: " <> tshow other
          error "Multiple matching files found."

getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
getSubArchiveR tid ssh csh shn cID (ZIPArchiveName sfType) = do
  when (sfType == SubmissionCorrected) $
    guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False

  let filename
        | SubmissionOriginal <- sfType = ZIPArchiveName $ toPathPiece cID <> "-" <> toPathPiece sfType
        | otherwise = ZIPArchiveName $ toPathPiece cID

  addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece filename}"|]
  respondSourceDB "application/zip" $ do
    submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
    rating <- lift $ getRating submissionID

    let
      fileSelect = case sfType of
        SubmissionOriginal -> E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> do
          E.on $ f E.^. FileId E.==. sf E.^. SubmissionFileFile
          E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
               E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
          return f
        _ -> submissionFileSource submissionID

      fileSource' = do
        fileSelect .| Conduit.map entityVal
        when (sfType == SubmissionCorrected) $
          maybe (return ()) (yieldM . ratingFile cID) rating

      zipComment = Text.encodeUtf8 $ toPathPiece cID

    fileSource' .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder

getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubDelR = postSubDelR
postSubDelR tid ssh csh shn cID = do
  subId <- runDB $ submissionMatchesSheet tid ssh csh shn cID
  deleteR $ (submissionDeleteRoute $ Set.singleton subId)
    { drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
    , drSuccess = SomeRoute $ CSheetR tid ssh csh shn SShowR
    }
