{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.ExamOffice.Exams
  ( getEOExamsR
  ) where

import Import

import Handler.Utils
import qualified Handler.Utils.ExamOffice.Exam as Exam
import qualified Handler.Utils.ExamOffice.ExternalExam as ExternalExam

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import qualified Colonnade


type ExamsTableExpr = (               E.SqlExpr (Maybe (Entity Exam))
                        `E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
                        `E.InnerJoin` E.SqlExpr (Maybe (Entity School))
                      )
    `E.FullOuterJoin` E.SqlExpr (Maybe (Entity ExternalExam))

type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course, Entity School)
                            , Natural, Natural
                            )

queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam)))
queryExam = to $ $(E.sqlIJproj 3 1) . $(E.sqlFOJproj 2 1)

queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
queryCourse = to $ $(E.sqlIJproj 3 2) . $(E.sqlFOJproj 2 1)
  
querySchool :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity School)))
querySchool = to $ $(E.sqlIJproj 3 3) . $(E.sqlFOJproj 2 1)

queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
queryExternalExam = to $(E.sqlFOJproj 2 2)

querySynchronised :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Word64))
querySynchronised office = to . runReader $ do
  exam' <- view queryExam
  externalExam' <- view queryExternalExam
  let
    examSynchronised examId = E.subSelectCount . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. examId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
      E.where_ $ Exam.resultIsSynced office examResult
    externalExamSynchronised externalExamId = E.subSelectCount . E.from $ \externalExamResult -> do
      E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
      E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
      E.where_ $ ExternalExam.resultIsSynced office externalExamResult
  return $ E.maybe (E.val 0) examSynchronised (exam' E.?. ExamId) E.+. E.maybe (E.val 0) externalExamSynchronised (externalExam' E.?. ExternalExamId)

queryResults :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Word64))
queryResults office = to . runReader $ do
  exam' <- view queryExam
  externalExam' <- view queryExternalExam
  let
    results examId = E.subSelectCount . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. examId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
    externalResults externalExamId = E.subSelectCount . E.from $ \externalExamResult -> do
      E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
      E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
  return $ E.maybe (E.val 0) results (exam' E.?. ExamId) E.+. E.maybe (E.val 0) externalResults (externalExam' E.?. ExternalExamId)

queryIsSynced :: UTCTime -> E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Bool))
queryIsSynced now office = to . runReader $ do
  exam' <- view queryExam
  externalExam' <- view queryExternalExam
  school' <- view querySchool
  let
    examSynchronised examId = E.not_ . E.exists . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. examId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
      E.where_ . E.not_ $ Exam.resultIsSynced office examResult
    externalExamSynchronised externalExamId = E.not_ . E.exists . E.from $ \externalExamResult -> do
      E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
      E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
      E.where_ . E.not_ $ ExternalExam.resultIsSynced office externalExamResult
    open examClosed' examFinished'
      = E.bool (E.maybe E.true (E.>. E.val now) $ E.min examClosed' examFinished')
               (E.maybe E.true (E.>. E.val now) examClosed')
               (E.maybe E.false (E.==. E.val ExamCloseSeparate) (school' E.?. SchoolExamCloseMode))
  return $ E.maybe E.false examSynchronised (exam' E.?. ExamId) E.||. E.maybe2 E.false open (exam' E.?. ExamClosed) (exam' E.?. ExamFinished) E.||. E.maybe E.false externalExamSynchronised (externalExam' E.?. ExternalExamId)


resultExam :: Traversal' ExamsTableData (Entity Exam)
resultExam = _dbrOutput . _1 . _Right . _1

resultCourse :: Traversal' ExamsTableData (Entity Course)
resultCourse = _dbrOutput . _1 . _Right . _2

resultSchool :: Traversal' ExamsTableData (Entity School)
resultSchool = _dbrOutput . _1 . _Right . _3

resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
resultExternalExam = _dbrOutput . _1 . _Left

resultSynchronised, resultResults :: Lens' ExamsTableData Natural
resultSynchronised = _dbrOutput . _2
resultResults = _dbrOutput . _3

resultIsSynced :: Getter ExamsTableData Bool
resultIsSynced = to $ (>=) <$> view resultSynchronised <*> view resultResults


-- | List of all exams where the current user may (in her function as
--   exam-office) access users grades
getEOExamsR :: Handler Html
getEOExamsR = do
  uid <- requireAuthId
  now <- liftIO getCurrentTime

  examsTable <- runDB $ do
    let
      examLink :: Course -> Exam -> SomeRoute UniWorX
      examLink Course{..} Exam{..}
        = SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName EGradesR

      courseLink :: Course -> SomeRoute UniWorX
      courseLink Course{..}
        = SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR

      externalExamLink :: ExternalExam -> SomeRoute UniWorX
      externalExamLink ExternalExam{..}
        = SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEGradesR

      querySynchronised' = querySynchronised $ E.val uid
      queryResults' = queryResults $ E.val uid
      queryIsSynced' = queryIsSynced now $ E.val uid

      examsDBTable = DBTable{..}
        where
          dbtSQLQuery = runReaderT $ do
            exam <- view queryExam
            course <- view queryCourse
            school <- view querySchool
            externalExam <- view queryExternalExam

            synchronised <- view querySynchronised'
            results <- view queryResults'

            lift $ do
              E.on   E.false
              E.on $ school E.?. SchoolId E.==. course E.?. CourseSchool
              E.on $ exam E.?. ExamCourse E.==. course E.?. CourseId

              E.where_ $ results E.>. E.val 0
              E.where_ $ (E.not_ (E.isNothing $ exam E.?. ExamId) E.&&. E.not_ (E.isNothing $ course E.?. CourseId) E.&&.         E.isNothing  (externalExam E.?. ExternalExamId))
                   E.||. (        E.isNothing  (exam E.?. ExamId) E.&&.         E.isNothing  (course E.?. CourseId) E.&&. E.not_ (E.isNothing $ externalExam E.?. ExternalExamId))

            return (exam, course, school, externalExam, synchronised, results)
          dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))

          dbtProj :: DBRow _ -> DB ExamsTableData
          dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
            exam <- view _1
            course <- view _2
            school <- view _3
            externalExam <- view _4

            case (exam, course, school, externalExam) of
              (Just exam', Just course', Just school', Nothing) ->
                (Right (exam', course', school'),,) <$> view (_5 . _Value . _Integral) <*> view (_6 . _Value . _Integral)
              (Nothing, Nothing, Nothing, Just externalExam') ->
                (Left externalExam',,) <$> view (_5 . _Value . _Integral) <*> view (_6 . _Value . _Integral)
              _other -> return $ error "Got exam & externalExam in same result"


          colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
            mExam <- preview resultExam
            mSchool <- preview resultSchool

            if
              | Just (Entity _ Exam{examClosed, examFinished}) <- mExam
              , Just (Entity _ School{schoolExamCloseMode}) <- mSchool
              , bool ((min `on` NTop) examClosed examFinished > NTop (Just now))
                     (NTop examClosed > NTop (Just now))
                   $ is _ExamCloseSeparate schoolExamCloseMode
                -> return . cell $ toWidget iconNew
              | otherwise
                -> do
                  synced <- view resultSynchronised
                  results <- view resultResults
                  isSynced <- view resultIsSynced

                  return $ cell
                     [whamlet|
                       $newline never
                       $if isSynced
                         #{iconOK}
                       $else
                         #{synced}/#{results}
                     |]
                     & cellAttrs <>~ [ ("class", "heated")
                                     , ("style", [st|--hotness: #{tshow (heat results synced)}|])
                                     ]


          dbtColonnade :: Colonnade Sortable _ _
          dbtColonnade = mconcat
            [ colSynced
            , maybeAnchorColonnade ( runMaybeT $     mpreview ($(multifocusG 2) (pre $ resultCourse . _entityVal) (pre $ resultExam . _entityVal) . to (uncurry $ liftA2 examLink) . _Just)
                                                 <|> mpreviews (resultExternalExam . _entityVal) externalExamLink
                                   )
                $ emptyOpticColonnade (resultExam . _entityVal . _examName <> resultExternalExam . _entityVal . _externalExamExamName) colExamName
            , emptyOpticColonnade (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd) colExamTime
            , emptyOpticColonnade (resultExam . _entityVal . _examFinished) colExamFinishedOffice
            , emptyOpticColonnade (resultExam . _entityVal . _examClosed) colExamClosed
            , maybeAnchorColonnade (previews (resultCourse . _entityVal) courseLink)
                $ emptyOpticColonnade (resultCourse . _entityVal . _courseName <> resultExternalExam . _entityVal . _externalExamCourseName) colCourseName
            , emptyOpticColonnade (resultCourse . _entityVal . _courseSchool <> resultExternalExam . _entityVal . _externalExamSchool) colSchool
            , emptyOpticColonnade (resultCourse . _entityVal . _courseTerm <> resultExternalExam . _entityVal . _externalExamTerm) colTermShort
            ]
          dbtSorting = mconcat
            [ singletonMap "synced" . SortColumn $ (E./.) <$> view querySynchronised' <*> view queryResults'
            , singletonMap "is-synced" . SortColumn $ view queryIsSynced'
            , sortExamName (to $ E.unsafeCoalesce . sequence [views queryExam (E.?. ExamName), views queryExternalExam (E.?. ExternalExamExamName)])
            , sortExamTime (queryExam . $(multifocusG 2) (to $ E.joinV . (E.?. ExamStart)) (to $ E.joinV . (E.?. ExamEnd)))
            , sortExamFinished (queryExam . to (E.joinV . (E.?. ExamFinished)))
            , sortExamClosed (queryExam . to (E.joinV . (E.?. ExamClosed)))
            , sortCourseName (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseName), views queryExternalExam (E.?. ExternalExamCourseName)])
            , sortSchool (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseSchool), views queryExternalExam (E.?. ExternalExamSchool)])
            , sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
            ]

          dbtFilter = mconcat
            [ singletonMap "may-access" . FilterProjected $ \(Any b) r -> (== b) <$> if
                | Just exam <- r ^? resultExam . _entityVal
                , Just course <- r ^? resultCourse . _entityVal
                -> hasReadAccessTo . urlRoute $ examLink course exam
                | Just eexam <- r ^? resultExternalExam . _entityVal
                -> hasReadAccessTo . urlRoute $ externalExamLink eexam :: DB Bool
                | otherwise
                -> return $ error "Got neither exam nor externalExam in result"
            ]
          dbtFilterUI = mconcat
            [
            ]

          dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout }
          dbtParams = def

          dbtIdent :: Text
          dbtIdent = "exams"

          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
                     
          dbtExtraReps = []

      examsDBTableValidator = def
        & defaultSorting [SortAscBy "is-synced", SortAscBy "exam-time"]
        & forceFilter "may-access" (Any True)

    dbTableWidget' examsDBTableValidator examsDBTable

  siteLayoutMsg MsgMenuExamList $ do
    setTitleI MsgMenuExamList
    examsTable