module Handler.Home where

import Import
import Handler.Utils

import qualified Data.Map as Map
import qualified Database.Esqueleto as E


getHomeR :: Handler Html
getHomeR = do
  muid <- maybeAuthId
  defaultLayout $ do
    setTitleI MsgHomeHeading
    maybe mempty homeUpcomingSheets muid
    homeOpenCourses


homeOpenCourses :: Widget
homeOpenCourses = do
  cTime <- liftIO getCurrentTime
  let tableData :: E.SqlExpr (Entity Course)
                  -> E.SqlQuery (E.SqlExpr (Entity Course))
      tableData course = do
            E.where_ $ E.not_ (E.isNothing $ course E.^. CourseRegisterFrom) --   DO: do this with isAuthorized in dbtProj
                E.&&.  (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
                E.&&. (       E.isNothing (course E.^. CourseRegisterTo)
                        E.||. course E.^. CourseRegisterTo E.>=. E.val (Just cTime)
                      )
            return course

      colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          sortable (Just "term")   (i18nCell MsgTerm) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
            textCell $ display $ courseTerm course
        , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
            textCell $ display $ courseSchool course
        , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=Entity{entityVal = course} } -> do
            let tid = courseTerm      course
                ssh = courseSchool    course
                csh = courseShorthand course
            anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
        , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
            cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
        ]
  courseTable <- liftHandlerT . runDB $ dbTableWidget' def DBTable
    { dbtSQLQuery  = tableData
    , dbtRowKey    = (E.^. CourseId)
    , dbtColonnade = colonnade
    , dbtProj      = return
    , dbtSorting   = Map.fromList
                      [ ( "term"
                        , SortColumn $ \course -> course E.^. CourseTerm
                        )
                      , ( "school"
                        , SortColumn $ \course -> course E.^. CourseSchool
                        )
                      , ( "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)
                        )
                        ] -}
    , dbtFilterUI  = mempty
    , dbtStyle     = def
    , dbtParams    = def
    , dbtIdent     = "open-courses" :: Text
    }
  $(widgetFile "home/openCourses")

homeUpcomingSheets :: UserId -> Widget
homeUpcomingSheets uid = do
  cTime <- liftIO getCurrentTime
  let tableData :: E.LeftOuterJoin
                        (E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet)))
                        (E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser))))
                  -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
                                , E.SqlExpr (E.Value SchoolId)
                                , E.SqlExpr (E.Value CourseShorthand)
                                , E.SqlExpr (E.Value SheetName)
                                , 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
        return
          ( course  E.^. CourseTerm
          , course  E.^. CourseSchool
          , course  E.^. CourseShorthand
          , sheet   E.^. SheetName
          , sheet   E.^. SheetActiveTo
          , submission E.?. SubmissionId
          )

      colonnade :: Colonnade Sortable (DBRow ( E.Value (Key Term)
                                             , E.Value SchoolId
                                             , E.Value CourseShorthand
                                             , E.Value SheetName
                                             , E.Value UTCTime
                                             , E.Value (Maybe SubmissionId)
                                             ))
                                      (DBCell (HandlerT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          -- TOOD: sortable (Just "term")   (textCell MsgTerm)   $ \DBRow{ dbrOutput=(view _1 -> E.Value tid) } ->
          sortable (Just "term")   (i18nCell MsgTerm)   $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
            textCell $ display tid
        , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
            textCell $ display ssh
        , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
            anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
        , sortable (Just "sheet")  (i18nCell MsgSheet)  $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
            anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
        , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
            cell $ formatTime SelFormatDateTime deadline >>= toWidget
        , sortable (Just "done")   (i18nCell MsgDone)   $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
            case mbsid of
              Nothing    -> mempty
              (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
                                        (toWidget $ hasTickmark True)
        ]
  let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
  sheetTable <- liftHandlerT . runDB $ dbTableWidget' validator DBTable
    { dbtSQLQuery  = tableData
    , dbtRowKey    = \((_ `E.InnerJoin` _ `E.InnerJoin` sheet) `E.LeftOuterJoin` _) -> sheet E.^. SheetId
    , dbtColonnade = colonnade
    , dbtProj      = \row@DBRow{ dbrOutput = (E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) }
                        -> row <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SShowR) False)
    , dbtSorting   = Map.fromList
                      [ ( "term"
                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
                        )
                      , ( "school"
                        , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseSchool
                        )
                      , ( "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)
                        )
                        ] -}
    , dbtFilterUI  = mempty
    , dbtStyle     = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines }
    , dbtParams    = def
    , dbtIdent     = "upcoming-sheets" :: Text
    }
  $(widgetFile "home/upcomingSheets")