Allow upload of single files
This commit is contained in:
parent
d01404047f
commit
cb27038c6b
@ -103,7 +103,7 @@ postSubmissionR cID = do
|
|||||||
|
|
||||||
((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,)
|
((uploadResult, uploadWidget), uploadEnctype) <- runFormPost . renderBootstrap3 BootstrapBasicForm $ (,)
|
||||||
<$> areq checkBoxField (bfs ("Dies ist eine Korrektur" :: Text)) (Just False)
|
<$> 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)
|
<* bootstrapSubmit ("Upload" :: BootstrapSubmit Text)
|
||||||
|
|
||||||
(submission, files) <- runDB $ do
|
(submission, files) <- runDB $ do
|
||||||
@ -114,7 +114,16 @@ postSubmissionR cID = do
|
|||||||
FormFailure _ -> submission <$ setMessage "Bitte Eingabe korrigieren."
|
FormFailure _ -> submission <$ setMessage "Bitte Eingabe korrigieren."
|
||||||
FormSuccess (isUpdate, fInfo) -> do
|
FormSuccess (isUpdate, fInfo) -> do
|
||||||
userId <- lift requireAuthId
|
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'
|
get404 submissionId'
|
||||||
|
|
||||||
files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
|
files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
|
||||||
|
|||||||
@ -239,6 +239,14 @@ sinkSubmission :: SheetId
|
|||||||
-> UserId
|
-> UserId
|
||||||
-> Maybe (SubmissionId, Bool {-^ Is this a correction -})
|
-> Maybe (SubmissionId, Bool {-^ Is this a correction -})
|
||||||
-> Sink SubmissionContent (YesodDB UniWorX) SubmissionId
|
-> 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
|
sinkSubmission sheetId userId mExists = do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let
|
let
|
||||||
|
|||||||
@ -25,20 +25,20 @@
|
|||||||
<div .col-md-6>
|
<div .col-md-6>
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>
|
<div .panel-heading>
|
||||||
Download
|
Abgabe herunterladen
|
||||||
<div .panel-body .text-center>
|
<div .panel-body .text-center>
|
||||||
<a href=@{SubmissionDownloadArchiveR archiveName} download .btn .btn-lg .btn-default>
|
<a href=@{SubmissionDownloadArchiveR archiveName} download .btn .btn-lg .btn-default>
|
||||||
<span .glyphicon .glyphicon-cloud-download aria-hidden="true"> ZIP-Archive
|
<span .glyphicon .glyphicon-cloud-download aria-hidden="true"> ZIP-Archive
|
||||||
<div .col-md-6>
|
<div .col-md-6>
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>
|
<div .panel-heading>
|
||||||
Replace
|
Abgabe ersetzen
|
||||||
<form role=form method=post action=@{SubmissionR cID} enctype=#{uploadEnctype} .panel-body>
|
<form role=form method=post action=@{SubmissionR cID} enctype=#{uploadEnctype} .panel-body>
|
||||||
^{uploadWidget}
|
^{uploadWidget}
|
||||||
|
|
||||||
<div .panel .panel-default>
|
<div .panel .panel-default>
|
||||||
<div .panel-heading>
|
<div .panel-heading>
|
||||||
Files & Directories
|
Abgegebene Dateien
|
||||||
<div .list-group .panel-body>
|
<div .list-group .panel-body>
|
||||||
$forall (Entity _ file, Entity _ sFile) <- files
|
$forall (Entity _ file, Entity _ sFile) <- files
|
||||||
$if submissionFileIsDeletion sFile
|
$if submissionFileIsDeletion sFile
|
||||||
|
|||||||
Reference in New Issue
Block a user