From 490b89e174f521ac3e54499e5f375c7ae1c60bbd Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 4 Feb 2025 15:05:30 +0100 Subject: [PATCH] refactor(lms): use runDBRead and caching for FilterColumnHandler used in LMS Orphans --- src/Handler/LMS/Learners.hs | 42 ++++++++++--------- .../i18n/lms-orphans/de-de-formal.hamlet | 10 ++--- templates/i18n/lms-orphans/en-eu.hamlet | 10 ++--- 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/Handler/LMS/Learners.hs b/src/Handler/LMS/Learners.hs index 6422fb964..bb2069720 100644 --- a/src/Handler/LMS/Learners.hs +++ b/src/Handler/LMS/Learners.hs @@ -186,22 +186,24 @@ getLmsLearnersR sid qsh = do lmsTable -selectOrphans :: QualificationId -> UTCTime -> DB [(LmsOrphanId, LmsIdent)] +-- selectOrphans :: QualificationId -> UTCTime -> DB [(LmsOrphanId, LmsIdent)] +selectOrphans :: (MonadHandler m, HasAppSettings (HandlerSite m), BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend) + => Key Qualification -> UTCTime -> ReaderT backend m [(LmsOrphanId, LmsIdent)] selectOrphans qid now = do lmsConf <- getsYesod $ view _appLmsConf let cutoff_seen_first = addLocalDays (negate $ lmsConf ^. _lmsOrphanDeletionDays) now cutoff_deleted_last = addHours (negate $ lmsConf ^. _lmsOrphanRepeatHours) now cutoff_seen_last = cutoff_deleted_last orphan_max_batch = lmsConf ^. _lmsOrphanDeletionBatch - $(E.unValueN 2) <<$>> ( Ex.select $ do + $(E.unValueN 2) <<$>> (Ex.select $ do orv <- Ex.from $ Ex.table @LmsOrphan - Ex.where_ $ Ex.val qid Ex.==. orv Ex.^. LmsOrphanQualification - Ex.&&. Ex.val cutoff_seen_first Ex.>=. orv Ex.^. LmsOrphanSeenFirst -- has been seen for while - Ex.&&. Ex.val cutoff_seen_last Ex.<=. orv Ex.^. LmsOrphanSeenLast -- was still seen recently - Ex.&&. Ex.val cutoff_deleted_last E.>~. orv Ex.^. LmsOrphanDeletedLast -- not already recently deleted + Ex.where_ $ Ex.val qid E.==. orv Ex.^. LmsOrphanQualification + Ex.&&. Ex.val cutoff_seen_first E.>=. orv Ex.^. LmsOrphanSeenFirst -- has been seen for while + Ex.&&. Ex.val cutoff_seen_last E.<=. orv Ex.^. LmsOrphanSeenLast -- was still seen recently + Ex.&&. Ex.val cutoff_deleted_last E.>~. orv Ex.^. LmsOrphanDeletedLast -- not already recently deleted Ex.&&. Ex.notExists (do -- not currently used anywhere (LmsIdent share the namespace) lusr <- Ex.from $ Ex.table @LmsUser - Ex.where_ $ lusr Ex.^. LmsUserIdent Ex.==. orv Ex.^.LmsOrphanIdent + Ex.where_ $ lusr Ex.^. LmsUserIdent E.==. orv Ex.^.LmsOrphanIdent ) Ex.orderBy [Ex.desc $ orv Ex.^. LmsOrphanDeletedLast, Ex.asc $ orv Ex.^. LmsOrphanSeenLast] -- Note for PostgreSQL: DESC == DESC NULLS FIRST Ex.limit orphan_max_batch @@ -291,27 +293,29 @@ getLmsOrphansR sid qsh = do , ("deleted-last" , SortColumn (E.^. LmsOrphanDeletedLast)) , ("reason" , SortColumn (E.^. LmsOrphanReason)) ] + cachedNextOrphans = $(memcachedByHere) (Just $ Right $ 1 * diffMinute) ("cache-next-orphans" <> tshow qid) $ do + now <- liftIO getCurrentTime + next_orphans <- runDBRead $ selectOrphans qid now -- only query next orphans when really needed; not sure how to formulate a proper sub-query here + -- addMessageI Info $ MsgLmsOrphanNr $ length next_orphans -- debug + return $ map fst next_orphans dbtFilter = Map.fromList - [ ("preview" , FilterColumnHandler $ \case + [ ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent)) + , ("preview" , FilterColumnHandler $ \case (x:_) | x == tshow True -> do - now <- liftIO getCurrentTime - next_orphans <- runDB $ selectOrphans qid now -- only query next orphans when really needed; not sure how to formulate a proper sub-query here - -- addMessageI Info $ MsgLmsOrphanNr $ length next_orphans -- debug - return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.in_` E.valList (map fst next_orphans) + next_orphans <- cachedNextOrphans + return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.in_` E.valList next_orphans | x == tshow False -> do - now <- liftIO getCurrentTime - next_orphans <- runDB $ selectOrphans qid now - return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.notIn` E.valList (map fst next_orphans) + next_orphans <- cachedNextOrphans + return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.notIn` E.valList next_orphans _ -> return (const E.true) ) - , ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent)) ] -- checkBoxTextField = convertField show (\case { t | t == show True -> True; _ -> False }) checkBoxField -- UNNECESSARY hack to use FilterColumnHandler, which only works on [Text] criteria dbtFilterUI mPrev = mconcat - [ prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt textField (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus) - -- , prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr) -- NOTE: anticipated checkBoxTextField-hack not needed here - , prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgLmsOrphanPreviewFltr) + [ -- prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr) -- NOTE: anticipated checkBoxTextField-hack not needed here + prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgLmsOrphanPreviewFltr) + , prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt textField (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def diff --git a/templates/i18n/lms-orphans/de-de-formal.hamlet b/templates/i18n/lms-orphans/de-de-formal.hamlet index 1dc0c1979..e1702108c 100644 --- a/templates/i18n/lms-orphans/de-de-formal.hamlet +++ b/templates/i18n/lms-orphans/de-de-formal.hamlet @@ -6,7 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

- Gezeigt werden E‑Learning Logins, welche für diese Qualifikation an FRADrive zurückgemeldet wurden # + Gezeigt werden E‑Learning Logins, welche für Qualifikation #{qsh} an FRADrive zurückgemeldet wurden # und von FRADrive nicht mehr zugeordnet werden können. # Normalerweise löscht das LMS beendete E‑Learning Logins selbstständig. # @@ -18,11 +18,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later Verwaiste Logins werden beim nächsten Abruf der E‑Learning Logins von FRADrive zur Löschung durch das LMS gemeldet. # Die Auswahl, ob ein E‑Learning Login zur Löschung gemeldet wird, hängt von folgenden Kriterien ab: #