chore(lms): clean direct result upload
This commit is contained in:
Steffen Jost
parent
51aa76ebdb
commit
cbfa88a059
@ -18,4 +18,5 @@ LmsUserlistUpdate: LMS User aktualisierung
|
||||
LmsResultInsert: Neues LMS Ergebnis
|
||||
LmsResultUpdate: LMS Ergebnis aktualisierung
|
||||
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
|
||||
@ -18,4 +18,5 @@ LmsUserlistUpdate: Update of LMS User
|
||||
LmsResultInsert: New LMS result
|
||||
LmsResultUpdate: Update of LMS result
|
||||
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
|
||||
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
|
||||
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
|
||||
LmsDirectUpload: Direct upload for automated Systems
|
||||
@ -126,4 +126,5 @@ MenuLanguage: Sprache
|
||||
MenuLms: Schnittstelle E-Lernen
|
||||
MenuLmsUsers: Empfang E-Lernen Benutzer
|
||||
MenuLmsUserlist: Melden E-Lernen Benutzer
|
||||
MenuLmsResult: Melden Ergebnisse E-Lernen
|
||||
MenuLmsResult: Melden Ergebnisse E-Lernen
|
||||
MenuLmsUpload: Direkter Upload
|
||||
@ -127,4 +127,5 @@ MenuLanguage: Language
|
||||
MenuLms: Interface E-Learning
|
||||
MenuLmsUsers: Download E-Learning Users
|
||||
MenuLmsUserlist: Upload E-Learning Users
|
||||
MenuLmsResult: Upload E-Learning Results
|
||||
MenuLmsResult: Upload E-Learning Results
|
||||
MenuLmsUpload: Direct Upload
|
||||
3
routes
3
routes
@ -259,5 +259,4 @@
|
||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/result LmsResultR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST
|
||||
/lms/test LmsTestR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST
|
||||
@ -133,12 +133,12 @@ breadcrumb HealthR = i18nCrumb MsgMenuHealth Nothing
|
||||
breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing
|
||||
breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed
|
||||
|
||||
breadcrumb (LmsR _sid _qsh) = i18nCrumb MsgMenuLms Nothing
|
||||
breadcrumb (LmsUsersR sid qsh) = i18nCrumb MsgMenuLmsUsers $ 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 (LmsResultUploadR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsResultR sid qsh
|
||||
breadcrumb LmsTestR = i18nCrumb MsgMenuLmsResult Nothing
|
||||
breadcrumb (LmsR _sid _qsh) = i18nCrumb MsgMenuLms Nothing
|
||||
breadcrumb (LmsUsersR sid qsh) = i18nCrumb MsgMenuLmsUsers $ 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 (LmsResultUploadR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsResultR sid qsh
|
||||
|
||||
|
||||
breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing
|
||||
breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR
|
||||
|
||||
@ -2,8 +2,7 @@
|
||||
|
||||
module Handler.LMS.Result
|
||||
( getLmsResultR, postLmsResultR
|
||||
, getLmsResultUploadR, postLmsResultUploadR
|
||||
, getLmsTestR
|
||||
, getLmsResultUploadR, postLmsResultUploadR
|
||||
)
|
||||
where
|
||||
|
||||
@ -195,6 +194,7 @@ mkResultTable sid qsh qid = do
|
||||
getLmsResultR, postLmsResultR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsResultR = postLmsResultR
|
||||
postLmsResultR sid qsh = do
|
||||
let directUploadLink = LmsResultUploadR sid qsh
|
||||
lmsTable <- runDB $ do
|
||||
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
|
||||
view _2 <$> mkResultTable sid qsh qid
|
||||
@ -204,32 +204,11 @@ postLmsResultR sid qsh = do
|
||||
|
||||
|
||||
-- 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) =>
|
||||
-- Key Qualification -> LmsResultTableCsv -> ReaderT backend m ()
|
||||
saveResultCsv :: QualificationId -> LmsResultTableCsv -> DB ()
|
||||
saveResultCsv qid LmsResultTableCsv{..} = do
|
||||
saveResultCsv :: QualificationId -> Int -> LmsResultTableCsv -> DB Int
|
||||
saveResultCsv qid i LmsResultTableCsv{..} = do
|
||||
now <- liftIO getCurrentTime
|
||||
void $ upsert
|
||||
LmsResult
|
||||
@ -241,33 +220,36 @@ saveResultCsv qid LmsResultTableCsv{..} = do
|
||||
[ LmsResultSuccess =. (csvLRTsuccess & lms2day)
|
||||
, 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
|
||||
((result,widget), enctype) <- runFormPost makeResultUploadForm
|
||||
case result of
|
||||
FormSuccess file -> do
|
||||
-- content <- fileSourceByteString file
|
||||
-- return $ Just (fileName file, content)
|
||||
void $ runDB $ do
|
||||
nr <- runDB $ do
|
||||
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
|
||||
runConduit $ fileSource file
|
||||
.| decodeCsv
|
||||
.| mapM_C (saveResultCsv qid)
|
||||
addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file
|
||||
.| foldMC (saveResultCsv qid) 0
|
||||
addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
|
||||
redirect $ LmsResultR sid qsh
|
||||
FormFailure errs -> do
|
||||
forM_ errs $ addMessage Error . toHtml
|
||||
redirect $ LmsResultUploadR sid qsh
|
||||
FormMissing ->
|
||||
siteLayoutMsg MsgMenuLmsResult $ do
|
||||
setTitleI MsgMenuLmsResult
|
||||
[whamlet|$newline never
|
||||
setTitleI MsgMenuLmsUpload
|
||||
[whamlet|$newline never
|
||||
<form method=post enctype=#{enctype}>
|
||||
^{widget}
|
||||
<p>
|
||||
<input type=submit>
|
||||
|]
|
||||
|
||||
makeResultUploadForm :: Form FileInfo
|
||||
makeResultUploadForm = renderAForm FormStandard $ fileAFormReq "ResultCSV"
|
||||
|
||||
@ -1,2 +1,5 @@
|
||||
LMS Result
|
||||
^{lmsTable}
|
||||
<p>
|
||||
<a href=@{directUploadLink}>
|
||||
_{MsgLmsDirectUpload}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user