From 497e3e38e1f8eb9987ae0ff3847050f01017c066 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 11 Mar 2022 17:50:40 +0100 Subject: [PATCH] chore(lms): remove example data to allow sorting again; ignore identical imports for lms tables --- src/Handler/LMS/Result.hs | 19 +++++++++++-------- src/Handler/LMS/Userlist.hs | 12 +++++++----- src/Handler/LMS/Users.hs | 8 +++++--- src/Handler/Utils/LMS.hs | 10 ++++++++-- 4 files changed, 31 insertions(+), 18 deletions(-) diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index d459d89a4..e54f3da1e 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -78,13 +78,12 @@ embedRenderMessage ''UniWorX ''LmsResultCsvException id mkResultTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget) mkResultTable sid qsh qid = do - now_day <- utctDay <$> liftIO getCurrentTime + _now_day <- utctDay <$> liftIO getCurrentTime dbtCsvName <- csvFilenameLmsResult qsh let dbtCsvSheetName = dbtCsvName let resultDBTable = DBTable{..} where - dbtSQLQuery lmsresult = do E.where_ $ lmsresult E.^. LmsResultQualification E.==. E.val qid return lmsresult @@ -119,10 +118,12 @@ mkResultTable sid qsh qid = do , dbtCsvSheetName , dbtCsvNoExportData = Just id , dbtCsvHeader = const $ return lmsResultTableCsvHeader - , dbtCsvExampleData = Just + , dbtCsvExampleData = Nothing + {-, dbtCsvExampleData = Just [ LmsResultTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day } | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..] ] + -} } where doEncode' = LmsResultTableCsv @@ -138,11 +139,13 @@ mkResultTable sid qsh qid = do , lmsResultInsertSuccess = csvLRTsuccess dbCsvNew & lms2day } DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code - DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}} -> do - yield $ LmsResultUpdateData - { lmsResultInsertIdent = csvLRTident - , lmsResultInsertSuccess = csvLRTsuccess & lms2day - } + DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}, dbCsvOld} -> do + let successDay = lms2day csvLRTsuccess + when (successDay /= dbCsvOld ^. _dbrOutput . _entityVal . _lmsResultSuccess) $ + yield $ LmsResultUpdateData + { lmsResultInsertIdent = csvLRTident + , lmsResultInsertSuccess = successDay + } DBCsvDiffMissing{} -> return () -- no deletion , dbtCsvClassifyAction = \case LmsResultInsertData{} -> LmsResultInsert diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index 849b33e26..ff261b983 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/src/Handler/LMS/Userlist.hs @@ -130,11 +130,13 @@ mkUserlistTable sid qsh qid = do { lmsUserlistInsertIdent = csvLULident dbCsvNew , lmsUserlistInsertFailed = lms2bool $ csvLULfailed dbCsvNew } - DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do - yield $ LmsUserlistUpdateData - { lmsUserlistInsertIdent = csvLULident - , lmsUserlistInsertFailed = csvLULfailed & lms2bool - } + DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}, dbCsvOld} -> do + let failedBool = lms2bool csvLULfailed + when (failedBool /= dbCsvOld ^. _dbrOutput . _entityVal . _lmsUserlistFailed) $ + yield $ LmsUserlistUpdateData + { lmsUserlistInsertIdent = csvLULident + , lmsUserlistInsertFailed = csvLULfailed & lms2bool + } DBCsvDiffMissing{} -> return () -- no deletion dbtCsvClassifyAction = \case LmsUserlistInsertData{} -> LmsUserlistInsert diff --git a/src/Handler/LMS/Users.hs b/src/Handler/LMS/Users.hs index eb4be3cde..7f7d3f9ed 100644 --- a/src/Handler/LMS/Users.hs +++ b/src/Handler/LMS/Users.hs @@ -84,11 +84,13 @@ mkUserTable _sid qsh qid = do , sortable (Just csvLmsPin) (i18nCell MsgTableLmsPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin -> pin ) -> textCell pin , sortable (Just csvLmsResetPin) (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin -> reset) -> ifIconCell reset IconReset , sortable (Just csvLmsDelete) (i18nCell MsgTableLmsDelete) $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete -> del ) -> ifIconCell del IconRemoveUser - , sortable (Just csvLmsStaff) (i18nCell MsgTableLmsStaff) $ const mempty + , sortable Nothing (i18nCell MsgTableLmsStaff) $ const mempty ] dbtSorting = Map.fromList - [ (csvLmsIdent , SortColumn $ \lmslist -> lmslist E.^. LmsUserIdent) - , (csvLmsResetPin , SortColumn $ \lmslist -> lmslist E.^. LmsUserResetPin) + [ (csvLmsIdent , SortColumn (E.^. LmsUserIdent)) + , (csvLmsPin , SortColumn (E.^. LmsUserPin)) + , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin)) + , (csvLmsDelete , SortColumn lmsUserToDeleteExpr) ] dbtFilter = Map.fromList [ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent )) diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 1c9775888..43b849e24 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -13,12 +13,14 @@ module Handler.Utils.LMS , csvFilenameLmsUserlist , csvFilenameLmsResult , lmsUserToDelete, _lmsUserToDelete + , lmsUserToDeleteExpr ) where -- general utils for LMS Interface Handlers import Import import Handler.Utils +import qualified Database.Esqueleto.Legacy as E -- generic Column names csvLmsIdent :: IsString a => a @@ -27,7 +29,7 @@ csvLmsIdent = fromString "user" -- "Benutzerkennung" csvLmsTimestamp :: IsString a => a csvLmsTimestamp = fromString "timestamp" -- "Zeitstempel" --- for User Table +-- for Users Table csvLmsPin :: IsString a => a csvLmsPin = fromString "pin" -- "PIN" @@ -72,8 +74,12 @@ getYMTH :: MonadHandler m => m Text getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime -- | Deceide whether LMS platform should delete an identifier +lmsUserToDeleteExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool) +lmsUserToDeleteExpr lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserSuccess) + lmsUserToDelete :: LmsUser -> Bool lmsUserToDelete LmsUser{lmsUserEnded, lmsUserSuccess} = isNothing lmsUserEnded && isJust lmsUserSuccess _lmsUserToDelete :: Getter LmsUser Bool -_lmsUserToDelete = to lmsUserToDelete \ No newline at end of file +_lmsUserToDelete = to lmsUserToDelete +