{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}

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 qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.CaseInsensitive as CI

import qualified Database.Esqueleto as E

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

import Data.Map (Map)
import qualified Data.Map as Map

import System.FilePath

import Colonnade
import Yesod.Colonnade
import qualified Text.Blaze.Html5.Attributes as HA

submissionTable :: MForm Handler (FormResult [SubmissionId], Widget)
submissionTable = do
  subs <- lift . runDB $ E.select . E.from $ \(sub `E.InnerJoin` sheet `E.InnerJoin` course) -> do
    E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourseId
    E.on $ sheet E.^. SheetId E.==. sub E.^. SubmissionSheetId

    return (sub, sheet, course)

  cryptedSubs <- forM subs $ \s@(Entity submissionId _, _, _) ->
    (,,) <$> encrypt submissionId <*> encrypt submissionId <*> pure s

  let
    anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseShowR (unTermKey courseTermId) courseShorthand
    courseText (_, _, (_, _, Entity _ Course{..})) = toWidget courseName
    anchorSubmission (_, cUUID, _) = SubmissionR cUUID
    submissionText (cID, _, _) = toWidget . toPathPiece . CI.foldedCase $ ciphertext cID
    colonnade = mconcat
      [ headed "Abgabe-ID" $ anchorCell anchorSubmission submissionText
      , headed "Kurs" $ anchorCell anchorCourse courseText
      , headed "Blatt" $ \(_, _, (_, Entity _ Sheet{..}, _)) -> textCell $ sheetName
      ]
    toExternal :: (CryptoFileNameSubmission, CryptoUUIDSubmission, a) -> Handler CryptoUUIDSubmission
    toExternal (_, cID, _) = return cID
    fromExternal :: CryptoUUIDSubmission -> Handler SubmissionId
    fromExternal = decrypt
  headedRowSelector toExternal fromExternal (HA.class_ "table table-striped table-hover") colonnade cryptedSubs


getSubmissionListR, postSubmissionListR :: Handler Html
getSubmissionListR = postSubmissionListR
postSubmissionListR = do
  ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,)
    <$> areq checkBoxField (bfs ("Dies sind Korrekturen" :: Text)) (Just False)
    <*> fileAFormReq (bfs ("Archiv" :: Text))
    <*  bootstrapSubmit ("Mehrere Hochladen" :: BootstrapSubmit Text)

  runDB $ do
    case uploadResult of
      FormMissing -> return ()
      FormFailure _ -> addMessage "warning" "Bitte Eingabe korrigieren."
      FormSuccess (isUpdate, fInfo) -> do
        userId <- lift requireAuthId
        let feed :: SubmissionId -> SubmissionContent -> StateT (Map SubmissionId (ResumableSink SubmissionContent (YesodDB UniWorX) SubmissionId)) (YesodDB UniWorX) ()
            feed sId val = do
              mSink <- gets $ Map.lookup sId
              sink <- case mSink of
                Just sink -> return sink
                Nothing -> do
                  Submission{..} <- lift $ get404 sId
                  return . newResumableSink $ sinkSubmission submissionSheetId userId (Just (sId, isUpdate))
              sink' <- lift $ yield val ++$$ sink
              case sink' of
                Left _ -> error "sinkSubmission returned prematurely"
                Right nSink -> modify $ Map.insert sId nSink
            sinkSubmissions :: Sink SubmissionContent (YesodDB UniWorX) ()
            sinkSubmissions = do
              sinks <- execStateC Map.empty . awaitForever $ \case
                v@(Right (sId, _)) -> lift $ feed sId v
                (Left f@File{..})  -> case splitDirectories fileTitle of
                  (cID:rest) 
                    | not (null rest) -> do
                        sId <- decrypt (CryptoID $ CI.mk cID :: CryptoFileNameSubmission)
                        lift . feed sId $ Left f{ fileTitle = joinPath rest }
                    | otherwise -> return ()
                  [] -> invalidArgs ["Encountered file/directory with empty name"]
              lift $ mapM_ (void . closeResumableSink) sinks
                  
        runConduit $ fileSource fInfo =$= void consumeZip =$= extractRatings =$= void sinkSubmissions
 
  (subTable, selectEncoding) <- generateFormPost . identifyForm "selection" . withFragment $ submissionTable

  defaultLayout $(widgetFile "submission-list")

getSubmissionDownloadSingleR :: CryptoUUIDSubmission -> FilePath -> Handler TypedContent
getSubmissionDownloadSingleR cID path = do
  submissionID <- decrypt cID
  cID' <- encrypt submissionID

  runDB $ do
    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) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
          E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
          E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID)
          E.where_ (f E.^. FileTitle E.==. E.val path)
          E.where_ . E.not_ . E.isNothing $ f E.^. FileContent
          E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
          E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
          return f

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

submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
submissionFileSource submissionID = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
  E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
  E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID
  E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
  E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
  return f

postSubmissionDownloadMultiArchiveR :: Handler TypedContent
postSubmissionDownloadMultiArchiveR = do
  ((selectResult, _), _) <- runFormPost . withFragment $ submissionTable

  case selectResult of
    FormMissing -> invalidArgs ["Missing submission numbers"]
    FormFailure errs -> invalidArgs errs
    FormSuccess ids -> do
      (dbrunner, cleanup) <- getDBRunner

      ratedSubmissions <- runDBRunner dbrunner $ do
        submissions <- selectList [ SubmissionId <-. ids ] []
        forM submissions $ \s@(Entity submissionId _) -> maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s)) =<< getRating submissionId
  
      (<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
        let
          fileEntitySource' :: (Rating, Entity Submission) -> Source (YesodDB UniWorX) File
          fileEntitySource' (rating, Entity submissionID Submission{..}) = do
            cID <- encrypt submissionID

            let
              directoryName = CI.foldedCase $ ciphertext (cID :: CryptoFileNameSubmission)
              
              fileEntitySource = do
                submissionFileSource submissionID =$= Conduit.map entityVal
                yieldM (ratingFile cID rating)

              withinDirectory f@File{..} = f { fileTitle = directoryName </> fileTitle }

            yield $ File
              { fileModified = submissionChanged
              , fileTitle = directoryName
              , fileContent = Nothing
              }

            fileEntitySource =$= mapC withinDirectory
          
        mapM_ fileEntitySource' ratedSubmissions =$= produceZip def =$= Conduit.map toFlushBuilder


getSubmissionDownloadArchiveR :: FilePath -> Handler TypedContent
getSubmissionDownloadArchiveR path = do
  let (baseName, ext) = splitExtension path
      cID :: CryptoFileNameSubmission
      cID = CryptoID $ CI.mk baseName
  unless (ext == ".zip") notFound
  submissionID <- decrypt cID
  cUUID <- encrypt submissionID
  respondSourceDB "application/zip" $ do
    rating <- lift $ getRating submissionID
    case rating of
      Nothing -> lift notFound
      Just rating' -> do
        let fileEntitySource' :: Source (YesodDB UniWorX) File
            fileEntitySource' = submissionFileSource submissionID =$= Conduit.map entityVal >> yieldM (ratingFile cID rating')
            info = ZipInfo { zipComment = Text.encodeUtf8 . tshow $ ciphertext (cUUID :: CryptoUUIDSubmission) }
        fileEntitySource' =$= produceZip info =$= Conduit.map toFlushBuilder

getSubmissionR, postSubmissionR :: CryptoUUIDSubmission -> Handler Html
getSubmissionR = postSubmissionR
postSubmissionR cID = do
  submissionId <- decrypt cID
  
  ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,)
    <$> areq checkBoxField (bfs ("Dies ist eine Korrektur" :: Text)) (Just False)
    <*> fileAFormReq (bfs ("Datei" :: Text))
    <*  bootstrapSubmit ("Upload" :: BootstrapSubmit Text)

  (submission, files) <- runDB $ do
    submission <- do
      submission@Submission{..} <- get404 submissionId
      case uploadResult of
        FormMissing -> return submission
        FormFailure _ -> submission <$ addMessage "warning" "Bitte Eingabe korrigieren."
        FormSuccess (isUpdate, fInfo) -> do
          userId <- lift requireAuthId
          let mimeType = defaultMimeLookup (fileName fInfo) 
              source
                | mimeType == "application/zip" = fileSource fInfo =$= void consumeZip
                | otherwise = do
                  let fileTitle = Text.unpack $ fileName fInfo
                  fileModified <- liftIO getCurrentTime
                  yieldM $ do
                    fileContent <- Just <$> runConduit (fileSource fInfo =$= foldC)
                    return File{..}
          submissionId' <- runConduit $ source =$= extractRatings =$= sinkSubmission submissionSheetId userId (Just (submissionId, isUpdate))
          get404 submissionId'
  
    files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
      E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
      E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId)
      E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
      return (f, sf)
    return (submission, files)

  let
    Rating'{..} = Rating'
      { ratingPoints = submissionRatingPoints submission
      , ratingComment = submissionRatingComment submission
      , ratingTime = submissionRatingTime submission
      }

  cID' <- encrypt submissionId
  let
    archiveBaseName = CI.foldedCase $ ciphertext (cID' :: CryptoFileNameSubmission)
    archiveName = archiveBaseName <.> "zip"

  defaultLayout $(widgetFile "submission")