fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(lms): remove example data to allow sorting again; ignore identical imports for lms tables

Browse Source
This commit is contained in:
Steffen Jost 2022-03-11 17:50:40 +01:00
parent 4f2834a77a
commit 497e3e38e1
4 changed files with 31 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Handler/LMS/Result.hs
View File

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

12
src/Handler/LMS/Userlist.hs
View File

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

8
src/Handler/LMS/Users.hs
View File

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

10
src/Handler/Utils/LMS.hs
View File

@ -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
_lmsUserToDelete = to lmsUserToDelete