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

module Handler.Sheet where

import Import 
import Handler.Utils
import Handler.Utils.Zip


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

import qualified Database.Esqueleto as E

import Network.Mime

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

data SheetForm = SheetForm
      { sfName         :: Text
      , sfComment      :: Maybe Html
      , sfType         :: SheetType
      , sfMarkingText  :: Maybe Html
      , sfActiveFrom   :: UTCTime
      , sfActiveTo     :: UTCTime
      , sfSheetF       :: Maybe FileInfo
      , sfHintFrom     :: Maybe UTCTime
      , sfHintF        :: Maybe FileInfo
      , sfSolutionFrom :: Maybe UTCTime
      , sfSolutionF    :: Maybe FileInfo
      }


makeSheetForm :: CourseId -> Maybe SheetForm -> Form SheetForm
makeSheetForm cid template = identForm FIDsheet $ \html -> do
    -- TODO: Yesod.Form.MassInput.inputList arbeitet Server-seitig :(
    -- Erstmal nur mit ZIP arbeiten
    (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
      <$> areq textField    (fsb "Name")        (sfName <$> template)
      <*> aopt htmlField    (fsb "Hinweise für Teilnehmer")  (sfMarkingText <$> template)
      <*> sheetTypeAFormReq (fsb "Bewertung")   (sfType <$> template)
      --TODO: SICHTBARKEIT hinzunehmen
      <*> aopt htmlField    (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
      <*> areq utcTimeField (fsb "Abgabe ab")   (sfActiveFrom   <$> template)
      <*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo     <$> template)
      <*> fileAFormOpt      (fsb "Aufgaben")
      <*> aopt utcTimeField (fsb "Hinweis ab")  (sfHintFrom     <$> template)
      <*> fileAFormOpt      (fsb "Hinweis")
      <*> aopt utcTimeField (fsb "Lösung ab")   (sfSolutionFrom <$> template)
      <*> fileAFormOpt      (fsb "Lösung")
    return $ case result of
      FormSuccess sheetResult
        | errorMsgs <- validateSheet sheetResult
        , not $ null errorMsgs ->
            (FormFailure errorMsgs,
                  [whamlet|
                    <div class="alert alert-danger">
                      <h4> Fehler:
                      <ul>
                        $forall errmsg <- errorMsgs
                          <li> #{errmsg}
                    ^{widget}
                  |]
                )
      _ -> (result, widget)
  where
    validateSheet _ = [] -- TODO


fetchSheet :: TermId -> Text -> Text -> YesodDB UniWorX (Entity Sheet)
fetchSheet tid csh shn = do
    -- TODO: More efficient with Esquleto?
    (Entity cid _course) <- getBy404 $ CourseTermShort tid csh
    getBy404 $ CourseSheet cid shn

-- 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    = courseTermId course
  sheets <- runDB $ do
    rawSheets <- selectList [SheetCourseId ==. cid] [Desc SheetActiveFrom]
    forM rawSheets $ \(Entity sid sheet) -> do
        let sheetsub = [SubmissionSheetId ==. sid]
        submissions <- count sheetsub
        rated       <- count $ (SubmissionRatingTime !=. Nothing):sheetsub
        return (sid, sheet, (submissions, rated))
  let colSheets = mconcat
       [ headed "Blatt"       $ toWgt . sheetName . snd3
       , headed "Abgabe ab"   $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
       , headed "Abgabe bis"  $ toWgt . formatTimeGerWD . sheetActiveTo   . snd3
       , headed "Bewertung"   $ toWgt . show . sheetType . snd3
       , headed "Korrigiert"  $ toWgt . snd . trd3
       , headed "Eingereicht" $ toWgt . fst . trd3
       -- TODO: only show edit button for allowed course assistants
       , headed ""            $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ fst3 s
       ]
  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
getSheetShowR :: TermId -> Text -> Text -> Handler Html
getSheetShowR tid csh shn = getSheetShow =<<
  (runDB $ fetchSheet tid csh shn)

{- Nur per UUID
getSheetIdShowR :: SheetId -> Handler Html
getSheetIdShowR sheetId = getSheetShow =<<
  (Entity sheetId) <$> (runDB $ get404 sheetId)\
-}{-
getSheetUUIDShowR :: CryptoUUIDSheet -> Handler Html
getSheetUUIDShowR sUUID = do
  cIDKey <- getsYesod appCryptoIDKey
  sheetId <- UUID.decrypt cIDKey sUUID
  sheetEnt <- runDB $ get404 sheetId
  getSheetShow $ Entity sheetId sheetEnt
-}

getSheetShow :: (Entity Sheet) -> Handler Html
getSheetShow entSheet = do
  let sheet = entityVal entSheet
  defaultLayout $ do
    setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
    [whamlet| Under Construction !!! |] -- TODO
    $(widgetFile "sheetAdmin")

getSheetFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent
getSheetFileR 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.^. SheetFileFileId)
      E.on (sheetFile E.^. SheetFileSheetId E.==. sheet     E.^. SheetId)
      E.on (sheet     E.^. SheetCourseId    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.^. CourseTermId    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
  (Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh
  let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
  ((res,wdgt), enc) <- runFormPost $ makeSheetForm cid template

  case res of
    (FormSuccess SheetForm{..}) -> do


      let sid   = undefined -- TODO after first insert
      let sname = undefined -- TODO after first insert

      -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye
      whenIsJust sfSheetF $ \sinfo -> do
        let sheetInsert file = do
              fid <- insert file
              void . insert $ SheetFile sid fid SheetExercise
        runDB . runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert



      addMessage "info" "Blatt angelegt"
      redirect $ SheetShowR tid csh sname
    (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
    _ -> return ()
  defaultLayout $ do
    $(widgetFile "newSheet")

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

getSheetEditR :: TermId -> Text -> SheetId -> Handler Html
getSheetEditR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO

postSheetEditR :: TermId -> Text -> SheetId -> Handler Html
postSheetEditR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO


getSheetDelR :: TermId -> Text -> SheetId -> Handler Html
getSheetDelR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO
  -- Sicherheitsabfrage

postSheetDelR :: TermId -> Text -> SheetId -> Handler Html
postSheetDelR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO
  -- Tatsächlich löschen


{-
getCourseShowR :: TermId -> Text -> Handler Html
getCourseShowR tid csh = do
  mbAid <- maybeAuthId
  (courseEnt,(schoolMB,participants,mbRegistered)) <- runDB $ do
      courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort (TermKey tid) csh
      dependent <- (,,) 
          <$> get (courseSchoolId course)               -- join
          <*> count [CourseParticipantCourseId ==. cid] -- join 
          <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
                Nothing -> return False
                (Just aid) -> do
                                regL <- getBy (UniqueCourseParticipant cid aid)
                                return $ isJust regL)
      return $ (courseEnt,dependent)
  let course = entityVal courseEnt  
  (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerButton $ mbRegistered      
  defaultLayout $ do
    setTitle $ [shamlet| #{termToText tid} - #{csh}|]
    $(widgetFile "course")
-}