chore(lms): add note to orphans and create working filter
This commit is contained in:
parent
b78bd7971a
commit
572ad4afa1
@ -162,4 +162,6 @@ LmsOrphans: Verwaiste Logins
|
||||
LmsOrphanNr n@Int: #{n} verwaiste E‑Learning Logins für diese Qualifikation erkannt.
|
||||
LmsOrphanSeenFirst: Zuerst erkannt
|
||||
LmsOrphanSeenLast: Zuletzt erhalten
|
||||
LmsOrphanDeletedLast: Zuletzt Löschung beantragt
|
||||
LmsOrphanDeletedLast: Zuletzt Löschung beantragt
|
||||
LmsOrphanReason: Bemerkung
|
||||
LmsOrphanPreviewFltr: Vorschau Löschungen bei nächstem Abruf
|
||||
@ -162,4 +162,6 @@ LmsOrphans: Orphaned logins
|
||||
LmsOrphanNr n@Int: #{n} orphaned e‑learning login detected for this qualification.
|
||||
LmsOrphanSeenFirst: First seen
|
||||
LmsOrphanSeenLast: Last seen
|
||||
LmsOrphanDeletedLast: Deletion requested
|
||||
LmsOrphanDeletedLast: Deletion requested
|
||||
LmsOrphanReason: Note
|
||||
LmsOrphanPreviewFltr: Preview deletions next synch
|
||||
|
||||
@ -172,5 +172,6 @@ LmsOrphan
|
||||
seenFirst UTCTime default=now() -- first time reported by LMS
|
||||
seenLast UTCTime default=now() -- last acknowledgement by LMS, deletion uses QualificationAuditDuration
|
||||
deletedLast UTCTime Maybe -- last deletion request sent to LMS
|
||||
reason Text Maybe -- to mark explicit e-learning deletions, etc
|
||||
UniqueLmsOrphan qualification ident -- unlike other tables, LMS Idents must only be unique within qualification, allowing orphans to be handled independently
|
||||
deriving Generic Show
|
||||
@ -185,15 +185,36 @@ getLmsLearnersR sid qsh = do
|
||||
setTitleI MsgMenuLmsLearners
|
||||
lmsTable
|
||||
|
||||
getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
|
||||
getLmsLearnersDirectR sid qsh = do
|
||||
-- $logInfoS "LMS" $ "Direct Download Users for " <> tshow qsh <> " at " <> tshow sid
|
||||
|
||||
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 qid now = do
|
||||
lmsConf <- getsYesod $ view _appLmsConf
|
||||
now <- liftIO getCurrentTime
|
||||
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{..})
|
||||
|
||||
|
||||
getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
|
||||
getLmsLearnersDirectR sid qsh = do
|
||||
-- $logInfoS "LMS" $ "Direct Download Users for " <> tshow qsh <> " at " <> tshow sid
|
||||
(lms_users, orphans, cutoff, qshs) <- runDB $ do
|
||||
(qid, cutoff) <- getQidCutoff sid qsh
|
||||
qidsReuse <- selectList [QualificationLmsReuses ==. Just qid] []
|
||||
@ -216,19 +237,8 @@ getLmsLearnersDirectR sid qsh = do
|
||||
, csvLUTstaff = LmsBool False
|
||||
}
|
||||
-}
|
||||
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
|
||||
now <- liftIO getCurrentTime
|
||||
orphans <- fst <$> selectOrphans qid now
|
||||
updateWhere [LmsOrphanId <-. fmap entityKey orphans] [LmsOrphanDeletedLast =. Just now]
|
||||
return (lms_users, orphans, cutoff, qshs)
|
||||
|
||||
@ -260,29 +270,25 @@ getLmsLearnersDirectR sid qsh = do
|
||||
|
||||
getLmsOrphansR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsOrphansR sid qsh = do
|
||||
lmsConf <- getsYesod $ view _appLmsConf
|
||||
now <- liftIO getCurrentTime
|
||||
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
|
||||
|
||||
orvTable <- fmap snd $ runDB $ do
|
||||
(orvTable,OrphanParams{..}) <-runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
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
|
||||
-- resultOrphan = _dbrOutput . _entityVal
|
||||
-- resultOrphan = _dbrOutput . _entityVal -- would need explicit type to work
|
||||
dbtSQLQuery orv = do
|
||||
E.where_ $ orv E.^. LmsOrphanQualification E.==. E.val qid
|
||||
return orv
|
||||
dbtRowKey = (E.^. LmsOrphanId)
|
||||
dbtProj = dbtProjId
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanIdent . _getLmsIdent -> lid) -> textCell lid
|
||||
[ sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsOrphanIdent . _getLmsIdent -> lid) -> textCell lid
|
||||
, 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
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("ident" , SortColumn (E.^. LmsOrphanIdent))
|
||||
@ -291,10 +297,15 @@ getLmsOrphansR sid qsh = do
|
||||
, ("deleted-last" , SortColumn (E.^. LmsOrphanDeletedLast))
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent))
|
||||
[ ("preview" , FilterColumn $ \row (getLast -> criterion) -> case criterion of
|
||||
Just True -> (row E.^. LmsOrphanId) `E.in_` E.valList next_orphans
|
||||
_ -> 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 "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus)
|
||||
, prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtParams = def
|
||||
@ -304,7 +315,8 @@ getLmsOrphansR sid qsh = do
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
orvDBTableValidator = def & defaultSorting [SortAscBy "seen-first", SortDescBy "deleted-last"]
|
||||
dbTable orvDBTableValidator orvDBTable :: DB (Any, Widget)
|
||||
tbl <- snd <$> (dbTable orvDBTableValidator orvDBTable :: DB (Any, Widget))
|
||||
return (tbl,ops)
|
||||
|
||||
siteLayoutMsg MsgLmsOrphans $ do
|
||||
setTitleI MsgLmsOrphans
|
||||
|
||||
@ -407,6 +407,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
|
||||
E.<&> E.val now
|
||||
E.<&> E.val now
|
||||
E.<&> E.nothing
|
||||
E.<&> E.nothing
|
||||
)
|
||||
(\_old _new ->
|
||||
[ LmsOrphanSeenLast E.=. E.val now
|
||||
|
||||
Loading…
Reference in New Issue
Block a user