diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index ed44037e4..2d93bf47c 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -164,4 +164,4 @@ LmsOrphanSeenFirst: Zuerst erkannt LmsOrphanSeenLast: Zuletzt erhalten LmsOrphanDeletedLast: Zuletzt Löschung beantragt LmsOrphanReason: Bemerkung -LmsOrphanPreviewFltr: Vorschau Löschungen bei nächstem Abruf \ No newline at end of file +LmsOrphanPreviewFltr: Löschungen bei nächstem Abruf anfordern? \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index b030131b5..7c6435860 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -164,4 +164,4 @@ LmsOrphanSeenFirst: First seen LmsOrphanSeenLast: Last seen LmsOrphanDeletedLast: Deletion requested LmsOrphanReason: Note -LmsOrphanPreviewFltr: Preview deletions next synch +LmsOrphanPreviewFltr: Deletion request next synch? diff --git a/src/Handler/LMS/Learners.hs b/src/Handler/LMS/Learners.hs index 8f871ac5a..6422fb964 100644 --- a/src/Handler/LMS/Learners.hs +++ b/src/Handler/LMS/Learners.hs @@ -38,7 +38,7 @@ makeLenses_ ''LmsUserTableCsv lmsUserDelete2csv :: LmsIdent -> LmsUserTableCsv lmsUserDelete2csv lid = LmsUserTableCsv { csvLUTident = lid - , csvLUTpin = "12345678" + , csvLUTpin = "00000000" , csvLUTresetPin = LmsBool False , csvLUTdelete = LmsBool True , csvLUTstaff = LmsBool False @@ -186,31 +186,27 @@ getLmsLearnersR sid qsh = do lmsTable -data OrphanParams = OrphanParams { cutoff_seen_first, cutoff_deleted_last, cutoff_seen_last :: UTCTime, orphan_max_batch :: Int64 } - deriving (Show, Generic, Binary) - -selectOrphans :: QualificationId -> UTCTime -> DB ([Entity LmsOrphan], OrphanParams) +selectOrphans :: QualificationId -> UTCTime -> DB [(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 - orphans <- 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.&&. 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.orderBy [Ex.desc $ orv Ex.^. LmsOrphanDeletedLast, Ex.asc $ orv Ex.^. LmsOrphanSeenLast] -- Note for PostgreSQL: DESC == DESC NULLS FIRST - Ex.limit orphan_max_batch - return orv - return (orphans, OrphanParams{..}) - + 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 + 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.&&. 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.orderBy [Ex.desc $ orv Ex.^. LmsOrphanDeletedLast, Ex.asc $ orv Ex.^. LmsOrphanSeenLast] -- Note for PostgreSQL: DESC == DESC NULLS FIRST + Ex.limit orphan_max_batch + return (orv E.^. LmsOrphanId, orv E.^. LmsOrphanIdent) + ) getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent getLmsLearnersDirectR sid qsh = do @@ -238,15 +234,15 @@ getLmsLearnersDirectR sid qsh = do } -} now <- liftIO getCurrentTime - orphans <- fst <$> selectOrphans qid now - updateWhere [LmsOrphanId <-. fmap entityKey orphans] [LmsOrphanDeletedLast =. Just now] + orphans <- selectOrphans qid now + updateWhere [LmsOrphanId <-. map fst orphans] [LmsOrphanDeletedLast =. Just now] return (lms_users, orphans, cutoff, qshs) LmsConf{..} <- getsYesod $ view _appLmsConf let --csvRenderedData = toNamedRecord . lmsUser2csv . entityVal <$> lms_users --csvRenderedHeader = lmsUserTableCsvHeader --cvsRendered = CsvRendered {..} - csvRendered = toCsvRendered lmsUserTableCsvHeader $ (lmsUser2csv cutoff . entityVal <$> lms_users) <> (lmsUserDelete2csv . lmsOrphanIdent . entityVal <$> orphans) + csvRendered = toCsvRendered lmsUserTableCsvHeader $ (lmsUser2csv cutoff . entityVal <$> lms_users) <> (lmsUserDelete2csv . snd <$> orphans) fmtOpts = (review csvPreset CsvPresetRFC) { csvIncludeHeader = lmsDownloadHeader , csvDelimiter = lmsDownloadDelimiter @@ -266,17 +262,15 @@ getLmsLearnersDirectR sid qsh = do -- direct Download see: -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod --- TODO: show info about orphan handling; getLmsOrphansR :: SchoolId -> QualificationShorthand -> Handler Html getLmsOrphansR sid qsh = do - (orvTable,OrphanParams{..}) <-runDB $ do - now <- liftIO getCurrentTime + orvTable <- runDB $ do qid <- getKeyBy404 $ SchoolQualificationShort sid qsh - (next_orphans, ops) <- $(memcachedByHere) (Just . Right $ 1 * diffMinute) [st|next-orphan-preview-#{tshow qid}|] (over _1 (map entityKey) <$> selectOrphans qid now) let orvDBTable = DBTable{..} where + queryOrphan = id -- resultOrphan = _dbrOutput . _entityVal -- would need explicit type to work dbtSQLQuery orv = do E.where_ $ orv E.^. LmsOrphanQualification E.==. E.val qid @@ -288,24 +282,36 @@ getLmsOrphansR sid qsh = do , sortable (Just "seen-first") (i18nCell MsgLmsOrphanSeenFirst) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanSeenFirst -> d) -> dateTimeCell d , sortable (Just "seen-last") (i18nCell MsgLmsOrphanSeenLast) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanSeenLast -> d) -> dateTimeCell d , sortable (Just "deleted-last") (i18nCell MsgLmsOrphanDeletedLast) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanDeletedLast -> d) -> foldMap dateTimeCell d - , sortable (Just "note") (i18nCell MsgLmsOrphanReason) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanReason -> t) -> foldMap textCell t + , sortable (Just "reason") (i18nCell MsgLmsOrphanReason) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanReason -> t) -> foldMap textCell t ] dbtSorting = Map.fromList [ ("ident" , SortColumn (E.^. LmsOrphanIdent)) , ("seen-first" , SortColumn (E.^. LmsOrphanSeenFirst)) , ("seen-last" , SortColumn (E.^. LmsOrphanSeenLast)) , ("deleted-last" , SortColumn (E.^. LmsOrphanDeletedLast)) + , ("reason" , SortColumn (E.^. LmsOrphanReason)) ] dbtFilter = Map.fromList - [ ("preview" , FilterColumn $ \row (getLast -> criterion) -> case criterion of - Just True -> (row E.^. LmsOrphanId) `E.in_` E.valList next_orphans - _ -> E.true + [ ("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) + | 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) + _ -> return (const E.true) ) , ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent)) ] - dbtFilterUI = \mPrev -> mconcat - [ prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus) - , prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr) + -- 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) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def @@ -315,9 +321,9 @@ getLmsOrphansR sid qsh = do dbtCsvDecode = Nothing dbtExtraReps = [] orvDBTableValidator = def & defaultSorting [SortAscBy "seen-first", SortDescBy "deleted-last"] - tbl <- snd <$> (dbTable orvDBTableValidator orvDBTable :: DB (Any, Widget)) - return (tbl,ops) + snd <$> (dbTable orvDBTableValidator orvDBTable :: DB (Any, Widget)) + LmsConf{..} <- getsYesod $ view _appLmsConf siteLayoutMsg MsgLmsOrphans $ do setTitleI MsgLmsOrphans $(i18nWidgetFile "lms-orphans") diff --git a/templates/i18n/lms-orphans/de-de-formal.hamlet b/templates/i18n/lms-orphans/de-de-formal.hamlet index 129c24e60..1dc0c1979 100644 --- a/templates/i18n/lms-orphans/de-de-formal.hamlet +++ b/templates/i18n/lms-orphans/de-de-formal.hamlet @@ -5,12 +5,29 @@ $# $# SPDX-License-Identifier: AGPL-3.0-or-later
- TODO Info about LMS Oprhan handling -