From 500b0bba6f1bcf1856145192222228c46c072c28 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 3 Feb 2021 18:26:55 +0100 Subject: [PATCH] refactor(exam-office): try to make list performance more predictable --- src/Handler/ExamOffice/Exams.hs | 91 +++++++++------------------------ 1 file changed, 25 insertions(+), 66 deletions(-) diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index f4f957c4c..e9249d6d9 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -15,6 +15,8 @@ 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)) @@ -38,54 +40,6 @@ 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 @@ -128,10 +82,6 @@ getEOExamsR = do 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 @@ -140,19 +90,15 @@ getEOExamsR = do 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) + return (exam, course, school, externalExam) dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId)) dbtProj :: DBRow _ -> DB ExamsTableData @@ -162,15 +108,28 @@ getEOExamsR = do 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) -> - (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) + (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 + colSynced = Colonnade.singleton (fromSortable . Sortable Nothing $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do mExam <- preview resultExam mSchool <- preview resultSchool @@ -216,9 +175,7 @@ getEOExamsR = do , 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)]) + [ 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))) @@ -236,6 +193,7 @@ getEOExamsR = do -> 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) ] dbtFilterUI = mconcat [ @@ -253,8 +211,9 @@ getEOExamsR = do dbtExtraReps = [] examsDBTableValidator = def - & defaultSorting [SortAscBy "is-synced", SortAscBy "exam-time"] + & defaultSorting [SortAscBy "exam-time"] -- TODO: sort by is-synced & forceFilter "may-access" (Any True) + & forceFilter "has-results" (Any True) dbTableWidget' examsDBTableValidator examsDBTable