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

ExcerciseBuddies working

Browse Source
This commit is contained in:
SJost 2018-04-19 10:45:05 +02:00
parent 8725f935d0
commit efcbb82d25
2 changed files with 37 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/Handler/Submission.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@ -50,24 +51,28 @@ import qualified Text.Blaze.Html5.Attributes as HA
makeSubmissionForm :: Bool -> SheetGroup -> Form (Source Handler File, [Text])
makeSubmissionForm unpackZips grouping = identForm FIDsubmission $ \html -> do
makeSubmissionForm :: Bool -> SheetGroup -> [Text] -> Form (Source Handler File, [Text])
makeSubmissionForm unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
flip (renderAForm FormStandard) html $ (,)
<$> areq (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
<*> (catMaybes <$> sequenceA [aopt textField (fsm $ MsgSubmissionMember g) Nothing | g <- [1..groupNr] ]) -- TODO: Convenience: preselect last buddies
<*> (catMaybes <$> sequenceA [aopt 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
])
<* submitButton
where
groupNr
| Arbitrary{..} <- grouping = pred maxParticipants -- pred to account for the person submitting
| otherwise = 0
getSubmissionR, postSubmissionR :: TermId -> Text -> Text -> SubmissionMode -> Handler Html
getSubmissionR = postSubmissionR
postSubmissionR tid csh shn (SubmissionMode mcid) = do
uid <- requireAuthId
msmid <- traverse decrypt mcid
(Entity shid Sheet{..}) <- runDB $ do
sheet@(Entity shid _) <- fetchSheet tid csh shn
(Entity shid Sheet{..}, buddies) <- runDB $ do
sheet@(Entity shid Sheet{..}) <- fetchSheet tid csh shn
case msmid of
Nothing -> do
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
@ -77,18 +82,41 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
return $ submission E.^. SubmissionId
$logDebugS "Submission.DUPLICATENEW" (tshow submissions)
case submissions of
[] -> return shid
[] -> do
-- fetch buddies from previous submission in this course
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId)
let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser `E.InnerJoin` submissionEdit) -> do
E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId)
E.on (submissionUser E.^. SubmissionUserSubmissionId E.==. submission E.^. SubmissionId)
E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheetId)
E.where_ $ submissionUser E.^. SubmissionUserUserId E.==. E.val uid
E.&&. sheet E.^. SheetCourseId E.==. E.val sheetCourseId
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.limit 1
return $ submission E.^. SubmissionId
E.where_ $ submissionUser E.^. SubmissionUserSubmissionId `E.in_` oldids
E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserEmail
return (sheet,buddies)
(E.Value smid:_) -> do
cID <- encrypt smid
addMessageI "info" $ MsgSubmissionAlreadyExists
redirect $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID
return sheet
(Just smid) -> do
shid' <- submissionSheetId <$> get404 smid
when (shid /= shid') $ invalidArgsI [MsgSubmissionWrongSheet]
return sheet
-- fetch buddies from current submission
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId)
E.where_ $ submissionUser E.^. SubmissionUserSubmissionId E.==. E.val smid
E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserEmail
return (sheet,buddies)
let unpackZips = True -- undefined -- TODO
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies
mCID <- runDB $ do
res' <- case res of
(FormMissing ) -> return $ FormMissing

1
src/Handler/Utils/Form.hs
View File

@ -232,7 +232,6 @@ posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.")
minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intField
--termField: see Utils.Term
schoolField :: Field Handler SchoolId