module Handler.Home where

import Import
import Handler.Utils

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

import Jobs
import Development.GitRev


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 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 <- 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     = "upcomingdeadlines" :: Text
    }
  -- let features = $(widgetFile "featureList")
  -- addMessage Warning "Vorabversion! Die Implementierung von  Uni2work ist noch nicht abgeschlossen!"
  defaultLayout
    -- (widgetFile "dsgvDisclaimer")
    $(widgetFile "home")

homeUser :: Key User -> Handler Html
homeUser 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)
                                        tickmark
        ]
  let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
  sheetTable <- 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     = "upcomingdeadlines" :: Text
    }
  -- addMessage Warning "Vorabversion! Die Implementierung von  Uni2work ist noch nicht abgeschlossen."
  defaultLayout $
    -- setTitle "Willkommen zum Uni2work Test!"
    $(widgetFile "homeUser")
    -- (widgetFile "dsgvDisclaimer")


getVersionR :: Handler TypedContent
getVersionR = selectRep $ do
    provideRep . defaultLayout $ do
      let features = $(widgetFile "featureList")
          gitInfo :: Text
          gitInfo  = $gitDescribe <> " (" <> $gitCommitDate <> ")"
      changeLog <- withUrlRenderer $(textFile "ChangeLog.md")
      $(widgetFile "versionHistory")
    provideRep $
      return ($gitDescribe :: Text)




data HelpIdentOptions = HIUser | HIEmail | HIAnonymous
  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance Universe HelpIdentOptions
instance Finite HelpIdentOptions

nullaryPathPiece ''HelpIdentOptions (camelToPathPiece' 1)
embedRenderMessage ''UniWorX ''HelpIdentOptions (("Help" <>) . dropPrefix "HI")

data HelpForm = HelpForm
  { hfReferer:: Maybe (Route UniWorX)
  , hfUserId :: Either (Maybe Address) UserId
  , hfRequest:: Text
  }

helpForm :: Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm
helpForm mReferer mUid = HelpForm
    <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
    <*> multiActionA (fslI MsgHelpAnswer) identActions (HIUser <$ mUid)
    <*> (unTextarea <$> areq textareaField (fslI MsgHelpRequest) Nothing)
    <*  submitButton
  where
    identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
    identActions = Map.fromList $ case mUid of
      (Just uid) -> (HIUser, pure $ Right uid):defaultActions
      Nothing    -> defaultActions

    defaultActions =
      [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslI MsgName) Nothing <*> apreq emailField (fslI MsgEMail) Nothing))
      , (HIAnonymous, pure $ Left Nothing)
      ]

getHelpR, postHelpR :: Handler Html
getHelpR = postHelpR
postHelpR = do
  mUid <- maybeAuthId
  mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer)

  ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid

  formResultModal res HelpR $ \HelpForm{..} -> do
    now <- liftIO getCurrentTime
    hfReferer' <- traverse toTextUrl hfReferer
    queueJob' JobHelpRequest
      { jSender      = hfUserId
      , jHelpRequest = hfRequest
      , jRequestTime = now
      , jReferer     = hfReferer'
      }
    tell . pure =<< messageI Success MsgHelpSent

  defaultLayout $ do
    setTitle "Hilfe" -- TODO: International
    isModal <- hasCustomHeader HeaderIsModal
    $(widgetFile "help")


getAuthPredsR, postAuthPredsR :: Handler Html
getAuthPredsR = postAuthPredsR
postAuthPredsR = do
  (AuthTagActive authTagCurrentActive) <- fromMaybe def <$> lookupSessionJson SessionActiveAuthTags

  let
    blacklist = Set.fromList [ AuthFree, AuthDevelopment, AuthDeprecated ]
    taForm authTag
      | authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag)
      | otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag)

  ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard
    $ AuthTagActive
      <$> (submitButton -- for convenience, avoids frequent scrolling
      *>  funcForm taForm (fslI MsgActiveAuthTags) True)
      <*  submitButton

  mReferer <- runMaybeT $ do
    param <- MaybeT (lookupGetParam $ toPathPiece GetReferer) <|> MaybeT (lookupPostParam $ toPathPiece GetReferer)
    MaybeT . return $ fromPathPiece param
  formResult authActiveRes $ \authTagActive -> do
    setSessionJson SessionActiveAuthTags authTagActive
    modifySessionJson SessionInactiveAuthTags . fmap $ Set.filter (not . authTagIsActive authTagActive)
    addMessageI Success MsgAuthPredsActiveChanged
    redirect $ fromMaybe AuthPredsR mReferer

  defaultLayout $ do
    setTitleI MsgAuthPredsActive
    $(widgetFile "authpreds")
