diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index bbf743671..642e9cdee 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -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 \ No newline at end of file +LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel +LmsDirectUpload: Direkter Upload für automatisierte Systeme \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index c618d7307..cf100eece 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -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 \ No newline at end of file +LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key +LmsDirectUpload: Direct upload for automated Systems \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 51d4765fc..44bf1006f 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -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 \ No newline at end of file +MenuLmsResult: Melden Ergebnisse E-Lernen +MenuLmsUpload: Direkter Upload \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 255a07c22..8c46e72da 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -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 \ No newline at end of file +MenuLmsResult: Upload E-Learning Results +MenuLmsUpload: Direct Upload \ No newline at end of file diff --git a/routes b/routes index 63263989e..36e4215a2 100644 --- a/routes +++ b/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 \ No newline at end of file +/lms/#SchoolId/#QualificationShorthand/result/upload LmsResultUploadR GET POST \ No newline at end of file diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 5d1b5c677..9527f7ad8 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -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 diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index 9f04c35bf..6d337a290 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -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 -
- ^{widget} -

- - |] - --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 ^{widget}

|] -makeResultUploadForm :: Form FileInfo -makeResultUploadForm = renderAForm FormStandard $ fileAFormReq "ResultCSV" diff --git a/templates/lms-result.hamlet b/templates/lms-result.hamlet index 389ec613d..44ca90389 100644 --- a/templates/lms-result.hamlet +++ b/templates/lms-result.hamlet @@ -1,2 +1,5 @@ LMS Result ^{lmsTable} +

+ + _{MsgLmsDirectUpload}