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

chore(lms): make the stub for csv import of LmsResult compile again

Browse Source
This commit is contained in:
Steffen Jost 2022-02-21 12:53:38 +01:00
parent fea453a87e
commit f5cab6e58b
1 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -126,8 +126,8 @@ embedRenderMessage ''UniWorX ''LmsResultCsvException id
mkResultTable :: QualificationId -> DB (Any, Widget) mkResultTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
mkResultTable qid = do mkResultTable sid qsh qid = do
--now <- liftIO getCurrentTime --now <- liftIO getCurrentTime
let let
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
@ -181,14 +181,30 @@ mkResultTable qid = do
, lmsResultInsertSuccess = csvLRTsuccess dbCsvNew , lmsResultInsertSuccess = csvLRTsuccess dbCsvNew
, lmsResultInsertTimestamp = now , lmsResultInsertTimestamp = now
} }
DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew} -> error "UniqueLmsResult was found, but Key no longer exists." DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _ } -> error "UniqueLmsResult was found, but Key no longer exists."
DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffMissing{} -> return () -- no deletion
DBCsvDiffExisting{} -> return () -- no merge DBCsvDiffExisting{} -> return () -- no merge
, dbtCsvClassifyAction = \case , dbtCsvClassifyAction = \case
LmsResultInsertData{} -> LmsResultInsert LmsResultInsertData{} -> LmsResultInsert
, dbtCsvCoarsenActionClass = const DBCsvActionNew -- there is only one action: insert into table , dbtCsvCoarsenActionClass = const DBCsvActionNew -- there is only one action: insert into table
, dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error , dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error
, dbtCsvExecuteActions = error "TODO" , dbtCsvExecuteActions = do
C.mapM_ $ \case
LmsResultInsertData{..} -> do
now <- liftIO getCurrentTime
void $ upsert
LmsResult
{ lmsResultQualification = qid
, lmsResultIdent = lmsResultInsertIdent
, lmsResultSuccess = lmsResultInsertSuccess
, lmsResultTimestamp = now -- lmsResultInsertTimestamp -- does it matter which one to choose?
}
[ LmsResultSuccess =. lmsResultInsertSuccess
, LmsResultTimestamp =. now
]
-- queueDBJob
-- audit
return $ LmsResultR sid qsh
, dbtCsvRenderKey = error "TODO" -- what is the purpose? , dbtCsvRenderKey = error "TODO" -- what is the purpose?
, dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
, dbtCsvRenderException = ap getMessageRender . pure :: LmsResultCsvException -> DB Text , dbtCsvRenderException = ap getMessageRender . pure :: LmsResultCsvException -> DB Text
@ -203,7 +219,7 @@ getLmsResultR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsResultR sid qsh = do getLmsResultR sid qsh = do
lmsTable <- runDB $ do lmsTable <- runDB $ do
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
view _2 <$> mkResultTable qid view _2 <$> mkResultTable sid qsh qid
siteLayoutMsg MsgMenuLmsResult $ do siteLayoutMsg MsgMenuLmsResult $ do
setTitleI MsgMenuLmsResult setTitleI MsgMenuLmsResult
$(widgetFile "lms-result") $(widgetFile "lms-result")