{-# 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

import qualified Data.Conduit.Combinators as C


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)


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

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

            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_ $ (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)
          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

            let
              getExamResults = for_ exam $ \(Entity examId _) -> E.selectSource . E.from $ \examResult -> do
                E.where_ $ examResult E.^. ExamResultExam E.==. E.val examId
                E.where_ $ Exam.examOfficeExamResultAuth (E.val uid) examResult
                return $ Exam.resultIsSynced (E.val uid) examResult
              getExternalExamResults = for_ externalExam $ \(Entity externalExamId _) -> E.selectSource . E.from $ \externalExamResult -> do
                E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val externalExamId
                E.where_ $ ExternalExam.examOfficeExternalExamResultAuth (E.val uid) externalExamResult
                return $ ExternalExam.resultIsSynced (E.val uid) externalExamResult
              getResults = getExamResults >> getExternalExamResults
              foldResult (E.Value isSynced) = (Sum 1, guardMonoid isSynced $ Sum 1)
            (Sum resultCount, Sum syncedCount) <- lift . runConduit $ getResults .| C.foldMap foldResult

            case (exam, course, school, externalExam) of
              (Just exam', Just course', Just school', Nothing) -> return
                (Right (exam', course', school'), syncedCount, resultCount)
              (Nothing, Nothing, Nothing, Just externalExam') -> return
                (Left externalExam', syncedCount, resultCount)
              _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" $
                SortProjected . comparing $ ((/) `on` toRational) <$> view resultSynchronised <*> view resultResults
            , singletonMap "is-synced" $
                SortProjected . comparing $ (>=) <$> view resultSynchronised <*> view resultResults
            , 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"
            , singletonMap "has-results" . FilterProjected $ \(Any b) r -> (return $ b == (r ^. resultResults > 0) :: DB Bool)
            , singletonMap "is-synced" . FilterProjected $ \(Any b) r -> (return $ b == (r ^. resultSynchronised >= r ^. resultResults) :: DB Bool)
            ]
          dbtFilterUI = mconcat
            [ flip (prismAForm $ singletonFilter "is-synced" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamSynchronised)
            ]

          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)
        & forceFilter "has-results" (Any True)

    dbTableWidget' examsDBTableValidator examsDBTable

  siteLayoutMsg MsgMenuExamList $ do
    setTitleI MsgMenuExamList
    examsTable
