diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index ca86ac978..9cded6284 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -103,7 +103,7 @@ postSubmissionR cID = do ((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,) <$> areq checkBoxField (bfs ("Dies ist eine Korrektur" :: Text)) (Just False) - <*> areq fileField (bfs ("ZIP-Archive" :: Text)) Nothing + <*> fileAFormReq (bfs ("Datei" :: Text)) <* bootstrapSubmit ("Upload" :: BootstrapSubmit Text) (submission, files) <- runDB $ do @@ -114,7 +114,16 @@ postSubmissionR cID = do FormFailure _ -> submission <$ setMessage "Bitte Eingabe korrigieren." FormSuccess (isUpdate, fInfo) -> do userId <- lift requireAuthId - submissionId' <- runConduit $ fileSource fInfo =$= void consumeZip =$= extractRatings =$= sinkSubmission submissionSheetId userId (Just (submissionId, isUpdate)) + let mimeType = defaultMimeLookup (fileName fInfo) + source + | mimeType == "application/zip" = fileSource fInfo =$= void consumeZip + | otherwise = do + let fileTitle = Text.unpack $ fileName fInfo + fileModified <- liftIO getCurrentTime + yieldM $ do + fileContent <- Just <$> runConduit (fileSource fInfo =$= foldC) + return File{..} + submissionId' <- runConduit $ source =$= extractRatings =$= sinkSubmission submissionSheetId userId (Just (submissionId, isUpdate)) get404 submissionId' files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do diff --git a/src/Handler/Utils/Zip/Rating.hs b/src/Handler/Utils/Zip/Rating.hs index ba20bfd8e..968ce1504 100644 --- a/src/Handler/Utils/Zip/Rating.hs +++ b/src/Handler/Utils/Zip/Rating.hs @@ -239,6 +239,14 @@ sinkSubmission :: SheetId -> UserId -> Maybe (SubmissionId, Bool {-^ Is this a correction -}) -> Sink SubmissionContent (YesodDB UniWorX) SubmissionId +-- ^ Replace the currently saved files for the given submission (either +-- corrected files or original ones, depending on arguments) with the supplied +-- 'SubmissionContent'. +-- +-- Files that don't occur in the 'SubmissionContent' but are in the database +-- are deleted (or marked as deleted in the case of this being a correction). +-- +-- A 'Submission' is created if no 'SubmissionId' is supplied sinkSubmission sheetId userId mExists = do now <- liftIO getCurrentTime let diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 389b651d8..5c678476a 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -25,20 +25,20 @@
- Download + Abgabe herunterladen