{-# 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 Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import qualified Colonnade


type ExamsTableExpr = E.SqlExpr (Entity Exam)
        `E.InnerJoin` E.SqlExpr (Entity Course)

type ExamsTableData = DBRow ( Entity Exam
                            , Entity Course
                            , Natural, Natural
                            )

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

queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Entity Course))
queryCourse = to $(E.sqlIJproj 2 2)

querySynchronised :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Natural))
querySynchronised office = to . runReader $ do
  exam <- view queryExam
  let
    synchronised = E.sub_select . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
      E.where_ $ Exam.resultIsSynced office examResult
      return E.countRows
  return synchronised
  
queryResults :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Natural))
queryResults office = to . runReader $ do
  exam <- view queryExam
  let
    results = E.sub_select . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
      return E.countRows
  return results

queryIsSynced :: UTCTime -> E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Bool))
queryIsSynced now office = to . runReader $ do
  exam <- view queryExam
  let
    synchronised = E.not_ . E.exists . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
      E.where_ $ Exam.examOfficeExamResultAuth office examResult
      E.where_ . E.not_ $ Exam.resultIsSynced office examResult
    open = E.maybe E.true (E.>. E.val now) $ exam E.^. ExamClosed
  return $ synchronised E.||. open


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

resultCourse :: Lens' ExamsTableData (Entity Course)
resultCourse = _dbrOutput . _2

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

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

      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

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

            lift $ do
              E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId

              E.where_ $ results E.>. E.val 0

            return (exam, course, synchronised, results)
          dbtRowKey = views queryExam (E.^. ExamId)

          dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) ExamsTableData
          dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
            exam <- view $ _1 . _entityVal
            course <- view $ _2 . _entityVal

            guard =<< hasReadAccessTo (urlRoute $ examLink course exam)
    
            (,,,)
              <$> view _1 <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value)


          colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
            Entity _ Exam{examClosed} <- view resultExam

            if
              | NTop examClosed > NTop (Just now)
                -> 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
            , anchorColonnade (views ($(multifocusG 2) (resultCourse . _entityVal) (resultExam . _entityVal)) (uncurry examLink))
                $ colExamName (resultExam . _entityVal . _examName)
            , colExamTime (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd)
            , colExamFinishedOffice (resultExam . _entityVal . _examFinished)
            , colExamClosed (resultExam . _entityVal . _examClosed)
            , anchorColonnade (views (resultCourse . _entityVal) courseLink)
                $ colCourseName (resultCourse . _entityVal . _courseName)
            , colSchool (resultCourse . _entityVal . _courseSchool)
            , colTermShort (resultCourse . _entityVal . _courseTerm)
            ]
          dbtSorting = mconcat
            [ singletonMap "synced" . SortColumn $ (E./.) <$> view querySynchronised' <*> view queryResults'
            , singletonMap "is-synced" . SortColumn $ view queryIsSynced'
            , sortExamName (queryExam . to (E.^. ExamName))
            , sortExamTime (queryExam . $(multifocusG 2) (to (E.^. ExamStart)) (to (E.^. ExamEnd)))
            , sortExamFinished (queryExam . to (E.^. ExamFinished))
            , sortExamClosed (queryExam . to (E.^. ExamClosed))
            , sortCourseName (queryCourse . to (E.^. CourseName))
            , sortSchool (queryCourse . to (E.^. CourseSchool))
            , sortTerm (queryCourse . to (E.^. CourseTerm))
            ]

          dbtFilter = mconcat
            [
            ]
          dbtFilterUI = mconcat
            [
            ]

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

          dbtIdent :: Text
          dbtIdent = "exams"

          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing

      examsDBTableValidator = def & defaultSorting [SortAscBy "is-synced", SortAscBy "exam-time"]

    dbTableWidget' examsDBTableValidator examsDBTable

  siteLayoutMsg MsgMenuExamList $ do
    setTitleI MsgMenuExamList
    examsTable