chore(lms): distinct qualifications filter by notExists alternative implemented

This commit is contained in:
Steffen Jost 2022-10-27 17:23:28 +02:00
parent ad49a5095b
commit af0bed5bd4
2 changed files with 17 additions and 9 deletions

View File

@ -323,17 +323,24 @@ lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Enti
, E.SqlExpr (E.Value (Maybe UTCTime))
)
lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do
-- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting
-- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting;
-- instead we use notExits in printJob join condition; experiments with separate sub-query showed that we would need two subsqueries to learn wether the request was indeed the latest
E.on $ lmsUser E.?. LmsUserIdent E.=?. printJob E.?. PrintJobLmsUser
E.&&. -- is the latest created printJob for this LmsUser; note that notExists has in general a pretty good performance in postgresql
E.notExists (E.from $ \otherpj ->
E.where_ $ E.isJust (otherpj E.^. PrintJobLmsUser)
E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (otherpj E.^. PrintJobLmsUser))
E.&&. ((printJob E.?. PrintJobCreated) E.<. E.just (otherpj E.^. PrintJobCreated))
)
E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser
E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
E.where_ $ E.isJust (pj E.^. PrintJobLmsUser)
E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (pj E.^. PrintJobLmsUser))
pure $ E.max_ $ pj E.^. PrintJobAcknowledged
return (qualUser, user, lmsUser, printJob, E.joinV printAcknowledged)
pure $ E.joinV $ E.max_ $ pj E.^. PrintJobAcknowledged
return (qualUser, user, lmsUser, printJob, printAcknowledged)
mkLmsTable :: forall h p cols act act'.
@ -515,7 +522,7 @@ postLmsR sid qsh = do
in if notNotified
then mempty
else cIcon <> spacerCell <> cDate
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> foldMap dateTimeCell d
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> foldMap dateTimeCell d
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
]
where

View File

@ -530,9 +530,9 @@ fillDb = do
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5))
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) now (Just now) (Just $ n_day' 0) Nothing
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) now (Just now) (Just $ n_day' (-1)) Nothing
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) now (Just now) (Just $ n_day' (-4)) Nothing
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) now (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) Nothing Nothing
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing
void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
@ -543,7 +543,8 @@ fillDb = do
void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing
void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-4)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob8" "job8" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
void . insert $ PrintJob "TestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
let