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

chore(lms): clean direct result upload

Browse Source
This commit is contained in:
Steffen Jost 2022-03-16 18:33:40 +01:00
parent 51aa76ebdb
commit cbfa88a059
8 changed files with 33 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -18,4 +18,5 @@ LmsUserlistUpdate: LMS User aktualisierung
LmsResultInsert: Neues LMS Ergebnis LmsResultInsert: Neues LMS Ergebnis
LmsResultUpdate: LMS Ergebnis aktualisierung LmsResultUpdate: LMS Ergebnis aktualisierung
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme

3
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -18,4 +18,5 @@ LmsUserlistUpdate: Update of LMS User
LmsResultInsert: New LMS result LmsResultInsert: New LMS result
LmsResultUpdate: Update of LMS result LmsResultUpdate: Update of LMS result
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsDirectUpload: Direct upload for automated Systems

3
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -126,4 +126,5 @@ MenuLanguage: Sprache
MenuLms: Schnittstelle E-Lernen MenuLms: Schnittstelle E-Lernen
MenuLmsUsers: Empfang E-Lernen Benutzer MenuLmsUsers: Empfang E-Lernen Benutzer
MenuLmsUserlist: Melden E-Lernen Benutzer MenuLmsUserlist: Melden E-Lernen Benutzer
MenuLmsResult: Melden Ergebnisse E-Lernen MenuLmsResult: Melden Ergebnisse E-Lernen
MenuLmsUpload: Direkter Upload

3
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -127,4 +127,5 @@ MenuLanguage: Language
MenuLms: Interface E-Learning MenuLms: Interface E-Learning
MenuLmsUsers: Download E-Learning Users MenuLmsUsers: Download E-Learning Users
MenuLmsUserlist: Upload E-Learning Users MenuLmsUserlist: Upload E-Learning Users
MenuLmsResult: Upload E-Learning Results MenuLmsResult: Upload E-Learning Results
MenuLmsUpload: Direct Upload

3
routes
View File

@ -259,5 +259,4 @@
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET POST /lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET POST
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST /lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
/lms/#SchoolId/#QualificationShorthand/result LmsResultR GET POST /lms/#SchoolId/#QualificationShorthand/result LmsResultR GET POST
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST /lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST
/lms/test LmsTestR GET

12
src/Foundation/Navigation.hs
View File

@ -133,12 +133,12 @@ breadcrumb HealthR = i18nCrumb MsgMenuHealth Nothing
breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing
breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed
breadcrumb (LmsR _sid _qsh) = i18nCrumb MsgMenuLms Nothing breadcrumb (LmsR _sid _qsh) = i18nCrumb MsgMenuLms Nothing
breadcrumb (LmsUsersR sid qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsR sid qsh breadcrumb (LmsUsersR sid qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsR sid qsh
breadcrumb (LmsUserlistR sid qsh) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR sid qsh breadcrumb (LmsUserlistR sid qsh) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR sid qsh
breadcrumb (LmsResultR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR sid qsh breadcrumb (LmsResultR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR sid qsh
breadcrumb (LmsResultUploadR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsResultR sid qsh breadcrumb (LmsResultUploadR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsResultR sid qsh
breadcrumb LmsTestR = i18nCrumb MsgMenuLmsResult Nothing
breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing
breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR

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

@ -2,8 +2,7 @@
module Handler.LMS.Result module Handler.LMS.Result
( getLmsResultR, postLmsResultR ( getLmsResultR, postLmsResultR
, getLmsResultUploadR, postLmsResultUploadR , getLmsResultUploadR, postLmsResultUploadR
, getLmsTestR
) )
where where
@ -195,6 +194,7 @@ mkResultTable sid qsh qid = do
getLmsResultR, postLmsResultR :: SchoolId -> QualificationShorthand -> Handler Html getLmsResultR, postLmsResultR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsResultR = postLmsResultR getLmsResultR = postLmsResultR
postLmsResultR sid qsh = do postLmsResultR sid qsh = do
let directUploadLink = LmsResultUploadR sid qsh
lmsTable <- runDB $ do lmsTable <- runDB $ do
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
view _2 <$> mkResultTable sid qsh qid view _2 <$> mkResultTable sid qsh qid
@ -204,32 +204,11 @@ postLmsResultR sid qsh = do
-- Direct File Upload/Download -- Direct File Upload/Download
getLmsTestR :: Handler Html
getLmsTestR = siteLayoutMsg MsgMenuLmsResult $ do
setTitleI MsgMenuLmsResult
[whamlet|$newline never
Hello!
|]
getLmsResultUploadR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsResultUploadR _sid _qsh = do
-- _qid <- runDB $ getKeyBy404 $ UniqueSchoolShort sid qsh
((_,widget), enctype) <- runFormPost makeResultUploadForm
siteLayoutMsg MsgMenuLmsResult $ do
setTitleI MsgMenuLmsResult
[whamlet|$newline never
<form method=post enctype=#{enctype}>
^{widget}
<p>
<input type=submit>
|]
--saveResultCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend) => --saveResultCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend) =>
-- Key Qualification -> LmsResultTableCsv -> ReaderT backend m () -- Key Qualification -> LmsResultTableCsv -> ReaderT backend m ()
saveResultCsv :: QualificationId -> LmsResultTableCsv -> DB () saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> DB Int
saveResultCsv qid LmsResultTableCsv{..} = do saveResultCsv qid i LmsResultTableCsv{..} = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
void $ upsert void $ upsert
LmsResult LmsResult
@ -241,33 +220,36 @@ saveResultCsv qid LmsResultTableCsv{..} = do
[ LmsResultSuccess =. (csvLRTsuccess & lms2day) [ LmsResultSuccess =. (csvLRTsuccess & lms2day)
, LmsResultTimestamp =. now , LmsResultTimestamp =. now
] ]
return $ succ i
postLmsResultUploadR :: SchoolId -> QualificationShorthand -> Handler Html makeResultUploadForm :: Form FileInfo
makeResultUploadForm = renderAForm FormStandard $ fileAFormReq "Result CSV"
getLmsResultUploadR, postLmsResultUploadR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsResultUploadR = postLmsResultUploadR
postLmsResultUploadR sid qsh = do postLmsResultUploadR sid qsh = do
((result,widget), enctype) <- runFormPost makeResultUploadForm ((result,widget), enctype) <- runFormPost makeResultUploadForm
case result of case result of
FormSuccess file -> do FormSuccess file -> do
-- content <- fileSourceByteString file -- content <- fileSourceByteString file
-- return $ Just (fileName file, content) -- return $ Just (fileName file, content)
void $ runDB $ do nr <- runDB $ do
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
runConduit $ fileSource file runConduit $ fileSource file
.| decodeCsv .| decodeCsv
.| mapM_C (saveResultCsv qid) .| foldMC (saveResultCsv qid) 0
addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
redirect $ LmsResultR sid qsh redirect $ LmsResultR sid qsh
FormFailure errs -> do FormFailure errs -> do
forM_ errs $ addMessage Error . toHtml forM_ errs $ addMessage Error . toHtml
redirect $ LmsResultUploadR sid qsh redirect $ LmsResultUploadR sid qsh
FormMissing -> FormMissing ->
siteLayoutMsg MsgMenuLmsResult $ do siteLayoutMsg MsgMenuLmsResult $ do
setTitleI MsgMenuLmsResult setTitleI MsgMenuLmsUpload
[whamlet|$newline never [whamlet|$newline never
<form method=post enctype=#{enctype}> <form method=post enctype=#{enctype}>
^{widget} ^{widget}
<p> <p>
<input type=submit> <input type=submit>
|] |]
makeResultUploadForm :: Form FileInfo
makeResultUploadForm = renderAForm FormStandard $ fileAFormReq "ResultCSV"

3
templates/lms-result.hamlet
View File

@ -1,2 +1,5 @@
LMS Result LMS Result
^{lmsTable} ^{lmsTable}
<p>
<a href=@{directUploadLink}>
_{MsgLmsDirectUpload}