{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE IncoherentInstances #-} -- why is this needed? Instance for "display deadline" ought to be clear
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Handler.Home where

import Import
import Handler.Utils

import qualified Data.Map as Map

import Data.Time hiding (formatTime)
-- import qualified Data.Text as T
-- import Yesod.Form.Bootstrap3

-- import Web.PathPieces (showToPathPiece, readFromPathPiece)

import Control.Lens
import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import qualified Database.Esqueleto as E

import Text.Shakespeare.Text

-- import qualified Data.UUID.Cryptographic as UUID


-- Some constants:
-- nrSheetDeadlines :: Int64
-- nrSheetDeadlines   = 10
offSheetDeadlines :: NominalDiffTime
offSheetDeadlines   = 15
--nrExamDeadlines    = 10
--offExamDeadlines    = 15
-- nrCourseDeadlines :: Int64
-- nrCourseDeadlines  = 12
--offCourseDeadlines  = 15



getHomeR :: Handler Html
getHomeR = do
  muid <- maybeAuthId
  case muid of
    Nothing   -> homeAnonymous
    Just uid  -> homeUser uid


homeAnonymous :: Handler Html
homeAnonymous = do
  cTime <- liftIO getCurrentTime
  let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
  let tableData :: E.SqlExpr (Entity Course)
                  -> E.SqlQuery (E.SqlExpr (Entity Course))
      tableData course = do
            E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom)
                E.&&.  (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
                E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
                        E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
--             E.limit nrCourseDeadlines
            return course

      colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (WidgetT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
            let tid = courseTerm course
                csh = courseShorthand course
            cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
        , sortable (Just "term")  (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
            textCell $ display $ courseTerm course
        , sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
            cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
        ]
  courseTable <- dbTable def $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = colonnade
    , dbtSorting   = Map.fromList
                      [ ( "term"
                        , SortColumn $ \(course) -> course E.^. CourseTerm
                        )
                      , ( "course"
                        , SortColumn $ \(course) -> course E.^. CourseShorthand
                        )
                      , ( "deadline"
                        , SortColumn $ \(course) -> course E.^. CourseRegisterTo
                        )
                      ]
    , dbtFilter    =  mempty {- [ ( "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)
                        )
                        ] -}
    , dbtStyle     = def
    , dbtIdent     = "upcomingdeadlines" :: Text
    }
  let features = $(widgetFile "featureList")
  defaultLayout $ do
    $(widgetFile "dsgvDisclaimer")
    $(widgetFile "home")

homeUser :: Key User -> Handler Html
homeUser uid = do
  cTime <- liftIO getCurrentTime
  let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime

      tableData :: -- E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant))
                   --                         (E.SqlExpr (Entity Course           )))
                   --                         (E.SqlExpr (Entity Sheet            ))
                _ -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
                                , E.SqlExpr (E.Value Text)
                                , E.SqlExpr (E.Value Text)
                                , E.SqlExpr (E.Value UTCTime)
                                , E.SqlExpr (E.Value (Maybe SubmissionId)))
      tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` (submission `E.InnerJoin` subuser)) = do
        E.on $ submission E.?. SubmissionId    E.==. subuser      E.?. SubmissionUserSubmission
            E.&&.       (E.just $ E.val uid)   E.==. subuser      E.?. SubmissionUserUser
        E.on $ submission E.?. SubmissionSheet E.==. E.just(sheet E.^. SheetId)
        E.on $ course     E.^. CourseId        E.==. sheet        E.^. SheetCourse
        E.on $ course     E.^. CourseId        E.==. participant  E.^. CourseParticipantCourse
        E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
            E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
            E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime
        -- E.limit nrSheetDeadlines
        return
          ( course  E.^. CourseTerm
          , course  E.^. CourseShorthand
          , sheet   E.^. SheetName
          , sheet   E.^. SheetActiveTo
          , submission E.?. SubmissionId
          )

      colonnade :: Colonnade Sortable (DBRow ( E.Value (Key Term)
                                             , E.Value Text
                                             , E.Value Text
                                             , E.Value UTCTime
                                             , E.Value (Maybe SubmissionId)
                                             ))
                                      (DBCell (WidgetT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } ->
            cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
        , sortable (Just "term")   (textCell MsgTerm)   $ \DBRow{ dbrOutput=(E.Value tid, _,_,_,_) } ->
            textCell $ display tid
        , sortable (Just "sheet")  (textCell MsgSheet)  $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, _) } ->
            cell [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
        , sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } ->
            cell $ formatTime SelFormatDateTime deadline >>= toWidget
        , sortable (Just "done")   (textCell MsgDone)   $ \(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
            case mbsid of
              Nothing    -> mempty
              (Just sid) -> anchorCellM (CSubmissionR tid csh shn <$> encrypt sid <*> pure SubShowR)
                                        tickmark
        ]
  let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
  sheetTable <- dbTable validator $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = colonnade
    , dbtSorting   = Map.fromList
                      [ ( "term"
                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
                        )
                      , ( "course"
                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
                        )
                      , ( "sheet"
                        , SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
                        )
                      , ( "deadline"
                        , SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
                        )
                      , ( "done"
                        , SortColumn $ \(_ `E.InnerJoin` _ `E.InnerJoin` _ `E.LeftOuterJoin` (subm `E.InnerJoin` _)) -> E.isNothing $ subm E.?. SubmissionId
                        )
                      ]
    , dbtFilter    =  mempty {- [ ( "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)
                        )
                        ] -}
    , dbtStyle     = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines }
    , dbtIdent     = "upcomingdeadlines" :: Text
    }
  defaultLayout $ do
    -- setTitle "Willkommen zum Uni2work Test!"
    $(widgetFile "homeUser")
    $(widgetFile "dsgvDisclaimer")


getVersionR :: Handler Html
getVersionR = do
  let features = $(widgetFile "featureList")
  changeLog <- withUrlRenderer $(textFile "ChangeLog.md")
  defaultLayout $ do
    $(widgetFile "versionHistory")