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

Allow changing buddies without re-uploading submission

Browse Source
This commit is contained in:
Gregor Kleen 2018-05-04 10:02:54 +02:00
parent fcc2f68cea
commit f00a1925e5
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Handler/Submission.hs
View File

@ -52,10 +52,10 @@ import qualified Text.Blaze.Html5.Attributes as HA
makeSubmissionForm :: Bool -> SheetGroup -> [Text] -> Form (Source Handler File, [Text]) makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [Text] -> Form (Maybe (Source Handler File), [Text])
makeSubmissionForm unpackZips grouping buddies = identForm FIDsubmission $ \html -> do makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
flip (renderAForm FormStandard) html $ (,) flip (renderAForm FormStandard) html $ (,)
<$> areq (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing <$> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies textField (fsm $ MsgSubmissionMember g) buddy <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies textField (fsm $ MsgSubmissionMember g) buddy
| g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile | g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
@ -129,13 +129,13 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
let lastEdits = map (bimap E.unValue E.unValue) lastEditValues let lastEdits = map (bimap E.unValue E.unValue) lastEditValues
return (sheet,buddies,oldfiles,lastEdits) return (sheet,buddies,oldfiles,lastEdits)
let unpackZips = True -- undefined -- TODO let unpackZips = True -- undefined -- TODO
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
mCID <- runDB $ do mCID <- runDB $ do
res' <- case res of res' <- case res of
(FormMissing ) -> return $ FormMissing (FormMissing ) -> return $ FormMissing
(FormFailure failmsgs) -> return $ FormFailure failmsgs (FormFailure failmsgs) -> return $ FormFailure failmsgs
(FormSuccess (files,[])) -> return $ FormSuccess (files,[]) -- Type change (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (files, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members (FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members
| (Arbitrary {..}) <- sheetGrouping | (Arbitrary {..}) <- sheetGrouping
, length gEMails < maxParticipants -> do -- < since submitting user is already accounted for , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
let gemails = map CI.foldedCase gEMails let gemails = map CI.foldedCase gEMails
@ -163,17 +163,22 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
(Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)] (Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)]
_other -> mempty _other -> mempty
return $ if null failmsgs return $ if null failmsgs
then FormSuccess (files, foldMap (\(Just (i,_,_)) -> [i]) participants) then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants)
else FormFailure failmsgs else FormFailure failmsgs
| otherwise -> return $ FormFailure ["Mismatching number of group participants"] | otherwise -> return $ FormFailure ["Mismatching number of group participants"]
case res' of case res' of
(FormSuccess (files,(setFromList -> adhocIds))) -> do (FormSuccess (mFiles,(setFromList -> adhocIds))) -> do
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
smid <- do smid <- do
smid <- runConduit $ transPipe lift files .| Conduit.map Left .| sinkSubmission shid uid ((,False) <$> msmid) smid <- case (mFiles, msmid) of
(Nothing, Just smid)
-> return smid
(Just files, Nothing)
-> runConduit $ transPipe lift files .| Conduit.map Left .| sinkSubmission shid uid Nothing
_ -> error "Impossible, because of definition of `makeSubmissionForm`"
-- Determine members of pre-registered group -- Determine members of pre-registered group
groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup