chore(lms): add note to orphans and create working filter

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -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

messages/uniworx/categories/qualification/en-eu.msg

@@ -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

models/lms.model

@@ -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

src/Handler/LMS/Learners.hs

@@ -185,15 +185,36 @@ getLmsLearnersR sid qsh = do
     setTitleI MsgMenuLmsLearners
     lmsTable
 
-getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
+
-getLmsLearnersDirectR sid qsh = do
+data OrphanParams = OrphanParams { cutoff_seen_first, cutoff_deleted_last, cutoff_seen_last :: UTCTime, orphan_max_batch :: Int64 }
-  -- $logInfoS "LMS" $ "Direct Download Users for " <> tshow qsh <> " at " <> tshow sid
+  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
+    now <- liftIO getCurrentTime
-        orv <- Ex.from $ Ex.table @LmsOrphan
+    orphans <- fst <$> selectOrphans qid now
-        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
     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
+  (orvTable,OrphanParams{..}) <-runDB $ do
-  now <- liftIO getCurrentTime
+    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
     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

src/Jobs/Handler/LMS.hs

@@ -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