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

Submission form shows submitter now

Browse Source
This commit is contained in:
SJost 2018-11-09 10:28:53 +01:00
parent ec06be2dfd
commit b235541500
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Handler/Submission.hs
View File

@ -47,22 +47,27 @@ import System.FilePath
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production. -- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail]) makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identForm FIDsubmission $ \html -> do
let let
fileUploadForm = case uploadMode of fileUploadForm = case uploadMode of
NoUpload -> pure Nothing NoUpload -> pure Nothing
(Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing (Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
flip (renderAForm FormStandard) html $ (,) flip (renderAForm FormStandard) html $ (,)
<$> fileUploadForm <$> fileUploadForm
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy <*> ( (:|)
| g <- [1..(min (fromIntegral groupNr) $ length buddies)] -- groupNr might have decreased meanwhile -- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies <$> aforced ciField (fslpI (MsgSubmissionMember 1) "user@campus.lmu.de" ) self
]) <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
| g <- [2..(fromIntegral groupNr)]
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
])
)
<* submitButton <* submitButton
where where
(groupNr, editableBuddies) (groupNr, editableBuddies)
| Arbitrary{..} <- grouping = (pred maxParticipants, True) -- pred to account for the person submitting | Arbitrary{..} <- grouping = (maxParticipants, True)
| RegisteredGroups <- grouping = (fromIntegral $ length buddies, False)
| otherwise = (0, False) | otherwise = (0, False)
aforced' f fs (Just (Just v)) = Just <$> aforced f fs v aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
@ -95,7 +100,7 @@ getSubmissionOwnR tid ssh csh shn = do
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
uid <- requireAuthId (Entity uid userData) <- requireAuth
msmid <- traverse decrypt mcid msmid <- traverse decrypt mcid
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc. maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
@ -141,7 +146,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
invalidArgsI [MsgSubmissionWrongSheet] invalidArgsI [MsgSubmissionWrongSheet]
-- fetch buddies from current submission -- fetch buddies from current submission
(Any isOwner, buddies) <- do (Any isOwner, buddies) <- do
submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do submitters <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
E.orderBy [E.asc $ user E.^. UserEmail] E.orderBy [E.asc $ user E.^. UserEmail]
@ -149,7 +154,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
let breakUserFromBuddies (E.Value userID, E.Value email) let breakUserFromBuddies (E.Value userID, E.Value email)
| uid == userID = (Any True , []) | uid == userID = (Any True , [])
| otherwise = (Any False, [email]) | otherwise = (Any False, [email])
return $ foldMap breakUserFromBuddies submittors return $ foldMap breakUserFromBuddies submitters
lastEdits <- do lastEdits <- do
raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
@ -163,13 +168,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
return (userName, submissionEdit E.^. SubmissionEditTime) return (userName, submissionEdit E.^. SubmissionEditTime)
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
return (csheet,buddies,lastEdits) return (csheet,buddies,lastEdits)
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping buddies ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
mCID <- runDBJobs $ do mCID <- runDBJobs $ 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 (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
(FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members (FormSuccess (mFiles,_submitter:|[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles,_submitter:|gEMails@(_:_))) -- Validate AdHoc Group Members
| Arbitrary{..} <- sheetGrouping -> do | Arbitrary{..} <- sheetGrouping -> do
-- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool)) let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))