fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(lms): switch result day format to LmsDay

Browse Source
This commit is contained in:
Steffen Jost 2022-03-11 11:47:19 +01:00
parent f9fb236025
commit 4a1fc5ebb2
3 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
models/lms.model
View File

@ -99,7 +99,7 @@ LmsUser
started UTCTime default=now() started UTCTime default=now()
received UTCTime Maybe -- last acknowledgement by LMS received UTCTime Maybe -- last acknowledgement by LMS
ended UTCTime Maybe -- ident was deleted from LMS ended UTCTime Maybe -- ident was deleted from LMS
UniqueLmsUser qualification ident UniqueLmsUser ident -- idents must be unique accross all qualifications, since idents are global within LMS!
deriving Generic deriving Generic
-- LmsUserlist stores LMS upload for later processing only -- LmsUserlist stores LMS upload for later processing only
@ -117,7 +117,7 @@ LmsResult
ident LmsIdent ident LmsIdent
success Day success Day
timestamp UTCTime default=now() timestamp UTCTime default=now()
UniqueLmsResult qualification ident success -- required by DBTable UniqueLmsResult qualification ident -- required by DBTable
deriving Generic deriving Generic
-- Logs all processed rows from LmsUserlist and LmsResult -- Logs all processed rows from LmsUserlist and LmsResult

2
src/Handler/LMS.hs
View File

@ -285,7 +285,7 @@ mkLmsTable sid qsh qid = do
dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later
{ dbtCsvRowKey = \LmsResultTableCsv{..} -> { dbtCsvRowKey = \LmsResultTableCsv{..} ->
fmap E.Value . MaybeT . getKeyBy $ UniqueLmsResult qid csvLRTident csvLRTsuccess fmap E.Value . MaybeT . getKeyBy $ UniqueLmsResult qid csvLRTident
, dbtCsvComputeActions = \case -- purpose is to show a diff to the user first , dbtCsvComputeActions = \case -- purpose is to show a diff to the user first
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
yield $ LmsResultInsertData yield $ LmsResultInsertData

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

@ -20,7 +20,7 @@ import qualified Database.Esqueleto.Utils as E
data LmsResultTableCsv = LmsResultTableCsv data LmsResultTableCsv = LmsResultTableCsv
{ csvLRTident :: LmsIdent { csvLRTident :: LmsIdent
, csvLRTsuccess :: Day , csvLRTsuccess :: LmsDay
} }
deriving Generic deriving Generic
makeLenses_ ''LmsResultTableCsv makeLenses_ ''LmsResultTableCsv
@ -65,7 +65,7 @@ data LmsResultCsvAction = LmsResultInsertData { lmsResultInsertIdent :: LmsIdent
deriveJSON defaultOptions deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece'' 2 1 -- LmsResultInsertData -> insert { constructorTagModifier = camelToPathPiece'' 2 1 -- LmsResultInsertData -> insert
, fieldLabelModifier = camelToPathPiece' 2 -- lmsResultInsertIdent -> insert-ident | lmsResultInsertSuccess -> insert-success , fieldLabelModifier = camelToPathPiece' 2 -- lmsResultInsertIdent -> insert-ident | lmsResultInsertSuccess -> insert-success
, sumEncoding = TaggedObject "action" "data" , sumEncoding = TaggedObject "action" "data"
} ''LmsResultCsvAction } ''LmsResultCsvAction
@ -120,28 +120,28 @@ mkResultTable sid qsh qid = do
, dbtCsvNoExportData = Just id , dbtCsvNoExportData = Just id
, dbtCsvHeader = const $ return lmsResultTableCsvHeader , dbtCsvHeader = const $ return lmsResultTableCsvHeader
, dbtCsvExampleData = Just , dbtCsvExampleData = Just
[ LmsResultTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = addDays (-dos) now_day } [ LmsResultTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day }
| (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..] | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..]
] ]
} }
where where
doEncode' = LmsResultTableCsv doEncode' = LmsResultTableCsv
<$> view (_dbrOutput . _entityVal . _lmsResultIdent) <$> view (_dbrOutput . _entityVal . _lmsResultIdent)
<*> view (_dbrOutput . _entityVal . _lmsResultSuccess) <*> view (_dbrOutput . _entityVal . _lmsResultSuccess . _lmsDay)
dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later
{ dbtCsvRowKey = \LmsResultTableCsv{..} -> { dbtCsvRowKey = \LmsResultTableCsv{..} ->
fmap E.Value . MaybeT . getKeyBy $ UniqueLmsResult qid csvLRTident csvLRTsuccess fmap E.Value . MaybeT . getKeyBy $ UniqueLmsResult qid csvLRTident
, dbtCsvComputeActions = \case -- purpose is to show a diff to the user first , dbtCsvComputeActions = \case -- purpose is to show a diff to the user first
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
yield $ LmsResultInsertData yield $ LmsResultInsertData
{ lmsResultInsertIdent = csvLRTident dbCsvNew { lmsResultInsertIdent = csvLRTident dbCsvNew
, lmsResultInsertSuccess = csvLRTsuccess dbCsvNew , 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 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 DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}} -> do
yield $ LmsResultUpdateData yield $ LmsResultUpdateData
{ lmsResultInsertIdent = csvLRTident { lmsResultInsertIdent = csvLRTident
, lmsResultInsertSuccess = csvLRTsuccess , lmsResultInsertSuccess = csvLRTsuccess & lms2day
} }
DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffMissing{} -> return () -- no deletion
, dbtCsvClassifyAction = \case , dbtCsvClassifyAction = \case