{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

module Handler.Sheet where

import Import
import System.FilePath (takeFileName)

import Handler.Utils
import Handler.Utils.Zip

-- import Data.Time
import qualified Data.Text as T
-- import Data.Function ((&))
--
import Colonnade hiding (fromMaybe, singleton)
import Yesod.Colonnade
--
import qualified Data.UUID.Cryptographic as UUID
import qualified Data.Conduit.List as C

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E

import Control.Monad.Writer (MonadWriter(..), execWriterT)

import Network.Mime

import qualified Data.Set as Set
import qualified Data.Map as Map


instance Eq (Unique Sheet) where
  (CourseSheet cid1 name1) == (CourseSheet cid2 name2) =
    cid1 == cid2 && name1 == name2

{-
  * Implement Handlers
  * Implement Breadcrumbs in Foundation
  * Implement Access in Foundation
-}

data SheetForm = SheetForm
      { sfName         :: Text
      , sfDescription  :: Maybe Html
      , sfType         :: SheetType
      , sfGrouping     :: SheetGroup
      , sfMarkingText  :: Maybe Html
      , sfVisibleFrom  :: Maybe UTCTime
      , sfActiveFrom   :: UTCTime
      , sfActiveTo     :: UTCTime
      , sfSheetF       :: Maybe (Source Handler (Either FileId File))
      , sfHintFrom     :: Maybe UTCTime
      , sfHintF        :: Maybe FileInfo
      , sfSolutionFrom :: Maybe UTCTime
      , sfSolutionF    :: Maybe FileInfo
      -- Keine SheetId im Formular!
      , sfCorrectors   :: [(UserId,Load)]
      }


makeSheetForm :: Maybe SheetId -> Maybe SheetForm -> Form SheetForm
makeSheetForm msId template = identForm FIDsheet $ \html -> do
    let oldFileIds fType
          | Just sId <- msId = fmap setFromList . fmap (map E.unValue) . runDB . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
              E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
              E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sId
                   E.&&. sheetFile E.^. SheetFileType    E.==. E.val fType
              return (file E.^. FileId)
          | otherwise = return Set.empty

    (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
      <$> areq textField      (fsb "Name")                     (sfName <$> template)
      <*> aopt htmlField      (fsb "Hinweise für Teilnehmer")  (sfDescription <$> template)
      <*> sheetTypeAFormReq   (fsb "Bewertung")                (sfType <$> template)
      <*> sheetGroupAFormReq  (fsb "Abgabegruppengröße") (sfGrouping <$> template)
      <*> aopt htmlField      (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
      <*> aopt utcTimeField   (fsb "Sichtbar ab") (sfVisibleFrom  <$> template)
      <*> areq utcTimeField   (fsb "Abgabe ab")   (sfActiveFrom   <$> template)
      <*> areq utcTimeField   (fsb "Abgabefrist") (sfActiveTo     <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
      <*> aopt utcTimeField   (fsb "Hinweis ab")  (sfHintFrom     <$> template)
      <*> fileAFormOpt        (fsb "Hinweis")
      <*> aopt utcTimeField   (fsb "Lösung ab")   (sfSolutionFrom <$> template)
      <*> fileAFormOpt        (fsb "Lösung")
      <*> formToAForm (correctorForm msId (maybe [] sfCorrectors template))
      <*  submitButton
    return $ case result of
      FormSuccess sheetResult
        | errorMsgs <- validateSheet sheetResult
        , not $ null errorMsgs ->
            (FormFailure errorMsgs,
                  [whamlet|
                    <div class="alert alert-danger">
                      <div class="alert__content">
                        <h4> Fehler:
                        <ul>
                          $forall errmsg <- errorMsgs
                            <li> #{errmsg}
                    ^{widget}
                  |]
                )
      _ -> (result, widget)
  where
    validateSheet :: SheetForm -> [Text]
    validateSheet (SheetForm{..}) =
      [ msg | (False, msg) <-
        [ ( maybe True (sfActiveFrom >=) sfVisibleFrom
          , "Sichtbarkeit muss vor Beginn der Abgabefrist liegen."
          )
        , ( sfActiveTo >= sfActiveFrom
          , "Ende der Abgabefrist muss nach deren Beginn liegen."
          )
        -- TODO: continue validation here!!!
      ] ]

correctorForm :: Maybe SheetId -> [(UserId,Load)] -> MForm Handler (FormResult [(UserId,Load)], [FieldView UniWorX])
correctorForm _msid templates = return mempty -- TODO deprecated
  -- Datenbank UserId -> UserName
  -- Eingabelist für Colonnade
     -- enthält die benötigten Felder
  -- FormResult konstruieren
  -- Eingabebox für Korrektor hinzufügen
  -- Eingabe für Korrekt ausgefüllt: FormMissing zurückschicken um dann Feld hinzuzufügen


-- List Sheets
getSheetListCID :: CourseId -> Handler Html
getSheetListCID cid = getSheetList =<<
  (Entity cid) <$> (runDB $ get404 cid)

getSheetListR :: TermId -> Text -> Handler Html
getSheetListR tid csh = getSheetList =<<
  (runDB $ getBy404 $ CourseTermShort tid csh)

getSheetList :: Entity Course -> Handler Html
getSheetList courseEnt = do
  -- mbAid <- maybeAuthId
  let cid    = entityKey courseEnt
  let course = entityVal courseEnt
  let csh    = courseShorthand course
  let tid    = courseTerm course
  sheets <- runDB $ do
    rawSheets <- selectList [SheetCourse ==. cid] [Desc SheetActiveFrom]
    forM rawSheets $ \(Entity sid sheet) -> do
        let sheetsub = [SubmissionSheet ==. sid]
        submissions <- count sheetsub
        rated       <- count $ (SubmissionRatingTime !=. Nothing):sheetsub
        return (sid, sheet, (submissions, rated))
  let colBase = mconcat
        [ headed "Blatt"       $ \(sid,sheet,_) -> simpleLink (toWgt $ sheetName sheet) $ CSheetR tid csh (sheetName sheet) SShowR
        , headed "Abgabe ab"   $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
        , headed "Abgabe bis"  $ toWgt . formatTimeGerWD . sheetActiveTo   . snd3
        , headed "Bewertung"   $ toWgt . display . sheetType . snd3
        ]
  let colAdmin = mconcat -- only show edit button for allowed course assistants
        [ headed "Korrigiert"  $ toWgt . snd . trd3
        , headed "Eingereicht" $ toWgt . fst . trd3
        , headed ""            $ \s -> simpleLink "Edit"   $ CSheetR tid csh (sheetName $ snd3 s) SEditR
        , headed ""            $ \s -> simpleLink "Delete" $ CSheetR tid csh (sheetName $ snd3 s) SDelR
        ]
  showAdmin <- case sheets of
    ((_,firstSheet,_):_) -> do
      setUltDestCurrent
      (Authorized ==) <$> isAuthorized (CSheetR tid csh (sheetName firstSheet) SEditR) False
    _otherwise   -> return False
  let colSheets = if showAdmin
        then colBase `mappend` colAdmin
        else colBase
  defaultLayout $ do
    setTitle $ toHtml $ T.append "Übungsblätter " csh
    if null sheets
      then [whamlet|Es wurden noch keine Übungsblätter angelegt.|]
      else encodeWidgetTable tableDefault colSheets sheets


-- Show single sheet
getSShowR :: TermId -> Text -> Text -> Handler Html
getSShowR tid csh shn = do
  entSheet <- runDB $ fetchSheet tid csh shn
  let sheet = entityVal entSheet
      sid   = entityKey entSheet
  -- without Colonnade
--   fileNameTypes <- runDB $ E.select $ E.from $
--     \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
--       -- Restrict to consistent rows that correspond to each other
--       E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
--       E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
--       -- filter to requested file
--       E.where_ (sheet     E.^. SheetId      E.==. E.val sid )
--       -- return desired columns
--       return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
--   let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid csh (SheetFileR shn fType fName),modified)) fileNameTypes
  -- with Colonnade

  let fileData (sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) = do
        -- Restrict to consistent rows that correspond to each other
        E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
        E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
        -- filter to requested file
        E.where_ $  sheet     E.^. SheetId      E.==. E.val sid
              E.&&. E.not_ (E.isNothing $ file E.^. FileContent)
        -- return desired columns
        return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
  let colonnadeFiles = mconcat
        [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> cell $ [whamlet| _{ftype}|]
        , sortable (Just "path") "Dateiname" $ anchorCell (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh shn (SFileR fType fName))
                                                          (\(E.Value fName,_,_) -> str2widget fName)
        , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT (modified :: UTCTime)
        ]
  fileTable <- dbTable def $ DBTable
    { dbtSQLQuery = fileData
    , dbtColonnade = colonnadeFiles
    , dbtAttrs = tableDefault
    , dbtFilter = Map.empty
    , dbtIdent = "files" :: Text
    -- TODO: Add column for and visibility date
    , dbtSorting = [ ( "type"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType
                     )
                   , ( "path"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
                     )
                   , ( "time"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified
                     )
                   ]
    }
  defaultLayout $ do
    setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
    $(widgetFile "sheetShow")
    [whamlet| Under Construction !!! |] -- TODO

getSFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent
getSFileR tid csh shn typ title = do
  content <- runDB $ E.select $ E.from $
    \(course `E.InnerJoin` sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
      -- Restrict to consistent rows that correspond to each other
      E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
      E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
      E.on (sheet     E.^. SheetCourse    E.==. course    E.^. CourseId)
      -- filter to requested file
      E.where_ ((file      E.^. FileTitle       E.==. E.val title)
        E.&&.   (sheetFile E.^. SheetFileType   E.==. E.val typ  )
        E.&&.   (sheet     E.^. SheetName       E.==. E.val shn  )
        E.&&.   (course    E.^. CourseShorthand E.==. E.val csh  )
        E.&&.   (course    E.^. CourseTerm    E.==. E.val tid  )
        )
      -- return desired columns
      return $ file E.^. FileContent
  let mimeType = defaultMimeLookup $ pack title
  case content of
    [E.Value (Just nochmalContent)] -> do
      addHeader "Content-Disposition" "attachment"
      respond mimeType nochmalContent
    []     -> notFound
    _other -> error "Multiple matching files found."


getSheetNewR :: TermId -> Text -> Handler Html
getSheetNewR tid csh = do
  let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
  let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
        insertUnique $ newSheet
  handleSheetEdit tid csh Nothing template action

postSheetNewR :: TermId -> Text -> Handler Html
postSheetNewR = getSheetNewR


getSEditR :: TermId -> Text -> Text -> Handler Html
getSEditR tid csh shn = do
  (sheetEnt, sheetFileIds) <- runDB $ do
    ent <- fetchSheet tid csh shn
    fIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
      E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
      E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent)
           E.&&. sheetFile E.^. SheetFileType    E.==. E.val SheetExercise
      return (file E.^. FileId)
    return (ent, fIds)
  let sid = entityKey sheetEnt
  let oldSheet@(Sheet {..}) = entityVal sheetEnt
  let template = Just $ SheetForm
        { sfName         = sheetName
        , sfDescription  = sheetDescription
        , sfType         = sheetType
        , sfGrouping     = sheetGrouping
        , sfMarkingText  = sheetMarkingText
        , sfVisibleFrom  = sheetVisibleFrom
        , sfActiveFrom   = sheetActiveFrom
        , sfActiveTo     = sheetActiveTo
        , sfSheetF       = Just . yieldMany . map Left $ Set.toList sheetFileIds
        , sfHintFrom     = sheetHintFrom
        , sfHintF        = Nothing -- TODO
        , sfSolutionFrom = sheetSolutionFrom
        , sfSolutionF    = Nothing -- TODO
        , sfCorrectors   = [] -- TODO read correctors from list
        }
  let action newSheet = do
        replaceRes <- myReplaceUnique sid $ newSheet
        case replaceRes of
          Nothing     -> return $ Just sid
          (Just _err) -> return $ Nothing -- More specific error message for edit old sheet could go here
  handleSheetEdit tid csh (Just sid) template action

postSEditR :: TermId -> Text -> Text -> Handler Html
postSEditR = getSEditR

handleSheetEdit :: TermId -> Text -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
handleSheetEdit tid csh msId template dbAction = do
  let tident = unTermKey tid
  let mbshn  = sfName <$> template
  aid  <- requireAuthId
  ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template
  case res of
    (FormSuccess SheetForm{..}) -> do
      saveOkay <- runDB $ do
        actTime <- liftIO getCurrentTime
        cid <- getKeyBy404 $ CourseTermShort tid csh
        let newSheet = Sheet
              { sheetCourse     = cid
              , sheetName         = sfName
              , sheetDescription  = sfDescription
              , sheetType         = sfType
              , sheetGrouping     = sfGrouping
              , sheetMarkingText  = sfMarkingText
              , sheetVisibleFrom  = sfVisibleFrom
              , sheetActiveFrom   = sfActiveFrom
              , sheetActiveTo     = sfActiveTo
              , sheetHintFrom     = sfHintFrom
              , sheetSolutionFrom = sfSolutionFrom
              }
        mbsid <- dbAction newSheet
        case mbsid of
          Nothing    -> False <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName)
          (Just sid) ->  do -- save files in DB:
            whenIsJust sfSheetF    $ insertSheetFile' sid SheetExercise
            whenIsJust sfHintF     $ insertSheetFile sid SheetHint
            whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
            insert_ $ SheetEdit aid actTime sid
            addMessageI "info" $ MsgSheetEditOk tident csh sfName
            return True
      when saveOkay $ redirect $ CSheetR tid csh sfName SShowR -- redirect must happen outside of runDB
    (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
    _ -> return ()
  let pageTitle = maybe (MsgSheetTitleNew tident csh)
                        (MsgSheetTitle    tident csh) mbshn
  let formTitle = pageTitle
  let formText  = Nothing :: Maybe UniWorXMessage
  actionUrl <- fromMaybe (CourseR tid csh SheetNewR) <$> getCurrentRoute
  defaultLayout $ do
    setTitleI pageTitle
    $(widgetFile "formPageI18n")



getSDelR :: TermId -> Text -> Text -> Handler Html
getSDelR tid csh shn = do
  let tident = unTermKey tid
  ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete)
  case result of
    (FormSuccess BtnAbort)  -> redirectUltDest $ CSheetR tid csh shn SShowR
    (FormSuccess BtnDelete) -> do
      runDB $ fetchSheetId tid csh shn >>= deleteCascade
      -- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!!
      addMessageI "info" $ MsgSheetDelOk tident csh shn
      redirect $ CourseR tid csh SheetListR
    _other -> do
      submissionno <- runDB $ do
          sid <- fetchSheetId tid csh shn
          count [SubmissionSheet ==. sid]
      let formTitle = MsgSheetDelTitle tident csh shn
      let formText  = Just $ MsgSheetDelText submissionno
      let actionUrl = CSheetR tid csh shn SDelR
      defaultLayout $ do
        setTitleI $ MsgSheetTitle tident csh shn
        $(widgetFile "formPageI18n")

postSDelR :: TermId -> Text -> Text -> Handler Html
postSDelR = getSDelR



insertSheetFile :: SheetId -> SheetFileType -> FileInfo -> YesodDB UniWorX ()
insertSheetFile sid ftype finfo = do
    runConduit $ (sourceFiles finfo) =$= C.mapM_ finsert
  where
    finsert file = do
      fid <- insert file
      void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step

insertSheetFile' :: SheetId -> SheetFileType -> Source Handler (Either FileId File) -> YesodDB UniWorX ()
insertSheetFile' sid ftype fs = do
    oldFileIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
      E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
      E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid
           E.&&. sheetFile E.^. SheetFileType    E.==. E.val ftype
      return (file E.^. FileId)
    keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert
    mapM_ deleteCascade $ (oldFileIds \\ keep :: Set FileId)
  where
    finsert (Left fileId) = tell $ singleton fileId
    finsert (Right file) = lift $ do
      fid <- insert file
      void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step