{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE MultiWayIf #-}

module Handler.Submission where

import Import hiding (joinPath)

-- import Yesod.Form.Bootstrap3  

import Handler.Utils

import Network.Mime

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

import Data.Maybe (fromJust)
import qualified Data.Maybe
import qualified Data.Text as Text
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

import Text.Shakespeare.Text (st)


numberOfSubmissionEditDates :: Int64
numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.


makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [Text] -> Form (Maybe (Source Handler File), [Text])
makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
    flip (renderAForm FormStandard) html $ (,)
      <$> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
      <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies textField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
                                    | g <- [1..(max groupNr $ length buddies)]             -- groupNr might have decreased meanwhile
                                    | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
                                    ])
      <*  submitButton
  where
    (groupNr, editableBuddies)
      | Arbitrary{..} <- grouping = (pred maxParticipants, True) -- pred to account for the person submitting
      | 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 -> Text -> Text -> Handler Html
getSubmissionNewR = postSubmissionNewR
postSubmissionNewR tid csh shn = submissionHelper tid csh shn NewSubmission


getSubShowR, postSubShowR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> Handler Html
getSubShowR = postSubShowR
postSubShowR tid csh shn cid = submissionHelper tid csh shn $ ExistingSubmission cid

getSubmissionOwnR :: TermId -> Text -> Text -> Handler Html
getSubmissionOwnR tid csh shn = do
  authId <- requireAuthId
  sid <- runDB $ do
    shid <- fetchSheetId tid 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 csh shn cID SubShowR

submissionHelper :: TermId -> Text -> Text -> SubmissionMode -> Handler Html
submissionHelper tid csh shn (SubmissionMode mcid) = do
  uid   <- requireAuthId
  msmid <- traverse decrypt mcid
  (Entity shid Sheet{..}, buddies, lastEdits)  <- runDB $ do
    sheet@(Entity shid Sheet{..})  <- fetchSheet tid 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` submissionUser `E.InnerJoin` submissionEdit) -> do
                    E.on (submissionEdit E.^. SubmissionEditSubmission   E.==. submission E.^. SubmissionId)
                    E.on (submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
                    E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet)
                    E.where_ $  submissionUser 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 (sheet,buddies,[])
          (E.Value smid:_) -> do
            cID <- encrypt smid
            addMessageI "info" $ MsgSubmissionAlreadyExists
            redirect $ CSubmissionR tid csh shn cID SubShowR
      (Just smid) -> do
        submissionMatchesSheet tid csh shn (fromJust mcid)
        
        shid' <- submissionSheet <$> get404 smid
        -- fetch buddies from current submission
        buddies <- 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.&&. submissionUser E.^. SubmissionUserUser       E.!=. E.val uid
          E.orderBy  [E.asc $ user E.^. UserEmail]
          return $ user E.^. UserEmail
        -- mLastEdit <- selectFirst [SubmissionEditSubmission ==. smid] [Desc SubmissionEditTime]
        lastEditValues <- 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
            return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
        let lastEdits = map (bimap E.unValue E.unValue) lastEditValues
        return (sheet,buddies,lastEdits)
  let unpackZips = True -- undefined -- TODO
  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
  mCID <- runDB $ do
    res' <- case res of
      (FormMissing )           -> return $ FormMissing
      (FormFailure failmsgs)   -> return $ FormFailure failmsgs
      (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
      (FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members
        | (Arbitrary {..}) <- sheetGrouping -> do
          -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
          let gemails = map CI.foldedCase gEMails
              prep :: [(E.Value Text, (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 ++ [(CI.mk 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_ $ (E.lower_ $ 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 $ CI.original email
                  (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant (CI.original email) tid csh
                  (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor (CI.original email)
                  _other             -> mempty
              , case 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
        now <- liftIO $ getCurrentTime
        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 files .| extractRatings .| sinkSubmission uid (maybe (Left shid) Right msmid) False
            _ -> error "Impossible, because of definition of `makeSubmissionForm`"
          -- 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 csh shn cID SubShowR
    Nothing  -> return ()

  actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
  -- Maybe construct a table to display uploaded archive files
  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
      colonnadeFiles cid = mconcat
        [ sortable (Just "path") (textCell 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 csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
                                                      ([whamlet|#{fileTitle'}|])
              | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
        , sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
            Nothing -> cell mempty
            Just (_, Entity _ File{..})
              | isJust fileContent -> anchorCell (CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
                                                 ([whamlet|_{MsgFileCorrected}|])
              | otherwise -> textCell MsgFileCorrected
        , sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
              origTime = fileModified . entityVal . snd <$> mOrig
              corrTime = fileModified . entityVal . snd <$> mCorr
              Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
            in textCell $ display 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
        , dbtColonnade = colonnadeFiles cid
        , dbtStyle = def
        , dbtIdent = "files" :: Text
        , dbtSorting =  [ ( "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 = []
        }
  mFileTable <- traverse (dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid

  defaultLayout $ do
    setTitleI $ MsgSubmissionEditHead tid csh shn
    $(widgetFile "submission")


getSubDownloadR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
  submissionID <- decrypt cID

  runDB $ do
    submissionMatchesSheet tid csh shn cID

    isRating <- maybe False (== submissionID) <$> isRatingFile path
    case isRating of
      True  -> do
        file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
        maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
      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_ (E.isNothing $ f E.^. FileContent)
               E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
               E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
          return f

        let fileName = Text.pack $ takeFileName path
        case results of
          [Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName <> "; charset=utf-8") (toContent c)
          _ -> notFound

getSubArchiveR :: TermId -> Text -> Text -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
getSubArchiveR tid csh shn cID@CryptoID{..} (ZIPArchiveName sfType) = do
  submissionID <- decrypt cID

  addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece cID}-#{toPathPiece sfType}.zip"|]

  respondSourceDB "application/zip" $ do
    lift $ submissionMatchesSheet tid csh shn cID

    rating <- lift $ getRating submissionID

    let
      fileSource = 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
        fileSource .| Conduit.map entityVal
        maybe (return ()) (yieldM . ratingFile cID) rating

      zipComment = Text.encodeUtf8 . pack $ CI.foldedCase ciphertext

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