refactor(exam-office): try to make list performance more predictable
This commit is contained in:
Gregor Kleen
parent
f4f95e1494
commit
500b0bba6f
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user