From f00a1925e561e0368d9f9ae5231a67eb406f8d49 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 4 May 2018 10:02:54 +0200 Subject: [PATCH] Allow changing buddies without re-uploading submission --- src/Handler/Submission.hs | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 1f1a15e15..d369216e1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -52,10 +52,10 @@ import qualified Text.Blaze.Html5.Attributes as HA -makeSubmissionForm :: Bool -> SheetGroup -> [Text] -> Form (Source Handler File, [Text]) -makeSubmissionForm unpackZips grouping buddies = identForm FIDsubmission $ \html -> do +makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [Text] -> Form (Maybe (Source Handler File), [Text]) +makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $ \html -> do 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 | g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile | 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 return (sheet,buddies,oldfiles,lastEdits) 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 res' <- case res of (FormMissing ) -> return $ FormMissing (FormFailure failmsgs) -> return $ FormFailure failmsgs - (FormSuccess (files,[])) -> return $ FormSuccess (files,[]) -- Type change - (FormSuccess (files, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members + (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change + (FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members | (Arbitrary {..}) <- sheetGrouping , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for let gemails = map CI.foldedCase gEMails @@ -163,17 +163,22 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do (Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)] _other -> mempty return $ if null failmsgs - then FormSuccess (files, foldMap (\(Just (i,_,_)) -> [i]) participants) + then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants) else FormFailure failmsgs | otherwise -> return $ FormFailure ["Mismatching number of group participants"] case res' of - (FormSuccess (files,(setFromList -> adhocIds))) -> do + (FormSuccess (mFiles,(setFromList -> adhocIds))) -> do now <- liftIO $ getCurrentTime 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 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