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

module Handler.Corrections where

import Import
-- import System.FilePath (takeFileName)

import Handler.Utils
import Handler.Utils.Submission
-- import Handler.Utils.Zip

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

-- 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.Lens
-- import Control.Monad.Writer (MonadWriter(..), execWriterT)

-- import Network.Mime

import Web.PathPieces



type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
            (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
            -> expr (E.Value Bool)

ratedBy :: Key User -> CorrectionsWhere
ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)

courseIs :: Key Course -> CorrectionsWhere
courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid


type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))

colTerm :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colTerm = sortable (Just "term") (i18nCell MsgTerm)
        $ \DBRow{ dbrOutput=(_, _, course) } ->
          -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
          textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel

colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse)
        $ \DBRow{ dbrOutput=(_, _, course) } -> cell $
          let tid = E.unValue $ course ^. _3
              csh = E.unValue $ course ^. _2
          in [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]

colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
        $ \DBRow{ dbrOutput=(_, sheet, course) } -> cell $
          let tid = E.unValue $ course ^. _3
              csh = E.unValue $ course ^. _2
              shn = sheetName $ entityVal sheet
          in [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
          -- textCell $ sheetName $ entityVal sheet

colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector)
        $ \DBRow{ dbrOutput=(submission, _, _) } ->
          textCell $ display $ submissionRatingBy $ entityVal submission

colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
        $ \DBRow{ dbrOutput=(submission, sheet, course) } -> cell $ do
          let tid = E.unValue $ course ^. _3
              csh = E.unValue $ course ^. _2
              shn = sheetName $ entityVal sheet
          cid <- encrypt (entityKey submission :: SubmissionId)
          [whamlet|<a href=@{CSheetR tid csh shn (SubmissionR cid)}>#{display cid}|]

colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool)))
colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _) } -> encrypt subId
            
makeCorrectionsTable :: ( IsDBTable m x, DBOutput CorrectionTableData r', ToSortable h, Functor h )
                     => _ -> Colonnade h r' (DBCell m x) -> Handler (DBResult m x)
makeCorrectionsTable whereClause colChoices = do
  let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course))
                                            (E.SqlExpr (Entity Sheet )))
                               (E.SqlExpr (Entity Submission))
                    -> E.SqlQuery _
      tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do
        E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
        E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
        E.where_ $ whereClause (course,sheet,submission)
        let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value Text)
                    , course E.^. CourseShorthand
                    , course E.^. CourseTerm
                    , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
                    )
        return (submission, sheet, crse)
  dbTable def $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = colChoices
    , dbtSorting   =  [ ( "term"
                        , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm
                        )
                      , ( "course"
                        , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseShorthand
                        )
                        -- TODO
                      ]
    , dbtFilter    =  [] {- [ ( "term"
                        , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
                            | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
                            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
                        )
                        ] -}
    , dbtAttrs     = tableDefault
    , dbtIdent     = "corrections" :: Text
    }

data ActionCorrections = CorrDownload
                       | CorrSetCorrector
  deriving (Eq, Ord, Read, Show, Enum, Bounded)
instance PathPiece ActionCorrections where
  fromPathPiece = readFromPathPiece
  toPathPiece = showToPathPiece

instance RenderMessage UniWorX ActionCorrections where
  renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
  renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector

data ActionCorrectionsData = CorrDownloadData
                           | CorrSetCorrectorData UserId

correctionsR :: _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) actions = do
  tableForm <- makeCorrectionsTable whereClause displayColumns
  ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
    ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
    (actionRes, action) <- multiAction actions
    return ((,) <$> actionRes <*> selectionRes, table <> action)

  Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
  case actionRes of
    FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs
    FormMissing      -> return ()
    FormSuccess (CorrDownloadData, subs) -> do
      (Set.fromList -> ids) <- forM (Set.toList subs) decrypt
      addHeader "Content-Disposition" "attachment; filename=\"corrections.zip\""
      sendResponse =<< submissionMultiArchive ids
    FormSuccess (CorrSetCorrectorData uid, subs) -> do
      addMessage "danger" $ "Setting correctors not implemented yet" -- TODO
      redirect currentRoute

  fmap toTypedContent . defaultLayout $ do
    setTitleI MsgCourseCorrectionsTitle
    $(widgetFile "corrections")


type ActionCorrections' = (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
  
downloadAction :: ActionCorrections'
downloadAction = ( CorrDownload
                 , return (pure CorrDownloadData, mempty)
                 )

assignAction :: ActionCorrections'
assignAction = ( CorrSetCorrector
               , return (pure undefined, mempty) -- TODO
               )

getCorrectionsR, postCorrectionsR :: Handler TypedContent
getCorrectionsR = postCorrectionsR
postCorrectionsR = do
  uid <- requireAuthId
  let whereClause = ratedBy uid
      colonnade = mconcat
        [ colSelect
        , dbRow
        , colTerm
        , colCourse
        , colSheet
        , colSubmissionLink
        ] -- Continue here
  correctionsR whereClause colonnade $ Map.fromList
    [ downloadAction
    ]

getCourseCorrectionsR, postCourseCorrectionsR ::  TermId -> Text -> Handler TypedContent
getCourseCorrectionsR = postCourseCorrectionsR
postCourseCorrectionsR tid csh = do
  cid <- runDB $ getBy404 $ CourseTermShort tid csh
  let whereClause = courseIs $ entityKey cid
      colonnade = mconcat
        [ colSelect
        , dbRow
        , colSheet
        , colCorrector
        , colSubmissionLink
        ] -- Continue here
  correctionsR whereClause colonnade $ Map.fromList
    [ downloadAction
    , assignAction
    ]