fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 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()
received UTCTime Maybe -- last acknowledgement by 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
-- LmsUserlist stores LMS upload for later processing only
@ -117,7 +117,7 @@ LmsResult
ident LmsIdent
success Day
timestamp UTCTime default=now()
UniqueLmsResult qualification ident success -- required by DBTable
UniqueLmsResult qualification ident -- required by DBTable
deriving Generic
-- 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
{ 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
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
yield $ LmsResultInsertData

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

@ -20,7 +20,7 @@ import qualified Database.Esqueleto.Utils as E
data LmsResultTableCsv = LmsResultTableCsv
{ csvLRTident :: LmsIdent
, csvLRTsuccess :: Day
, csvLRTsuccess :: LmsDay
}
deriving Generic
makeLenses_ ''LmsResultTableCsv
@ -65,7 +65,7 @@ data LmsResultCsvAction = LmsResultInsertData { lmsResultInsertIdent :: LmsIdent
deriveJSON defaultOptions
{ 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"
} ''LmsResultCsvAction
@ -120,28 +120,28 @@ mkResultTable sid qsh qid = do
, dbtCsvNoExportData = Just id
, dbtCsvHeader = const $ return lmsResultTableCsvHeader
, 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..]
]
}
where
doEncode' = LmsResultTableCsv
<$> 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
{ 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
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
yield $ LmsResultInsertData
{ 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
DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}} -> do
yield $ LmsResultUpdateData
{ lmsResultInsertIdent = csvLRTident
, lmsResultInsertSuccess = csvLRTsuccess
, lmsResultInsertSuccess = csvLRTsuccess & lms2day
}
DBCsvDiffMissing{} -> return () -- no deletion
, dbtCsvClassifyAction = \case