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

fix(users-add): upsert tutorial only if users not empty

Browse Source
This commit is contained in:
Sarah Vaupel 2022-12-10 00:28:35 +01:00
parent 662445e8cc
commit e65d38898e
1 changed files with 45 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
src/Handler/Course/ParticipantInvite.hs
View File

@ -73,36 +73,42 @@ postCAddUserR tid ssh csh = do
| otherwise | otherwise
= CourseR tid ssh csh CUsersR = CourseR tid ssh csh CUsersR
formResultModal usersToRegister dest $ \AddUsers{..} -> hoist runDBJobs $ do formResultModal usersToRegister dest $ \AddUsers{..} -> hoist runDBJobs $ do
uids <- registerUsers cid auUsers avsUsers :: Map Text (Maybe UserId) <- sequenceA . flip Map.fromSet auUsers $ liftHandler . upsertAvsUser
for_ auTutorial $ \tutorialName -> lift $ do let retrievedUsers = catMaybes $ Map.elems avsUsers
-- TODO: move somewhere else if
now <- liftIO getCurrentTime | uids@(_:_) <- retrievedUsers -> do
Entity tutId _ <- upsert registerUsers cid avsUsers
Tutorial for_ auTutorial $ \tutorialName -> lift $ do
{ tutorialCourse = cid -- TODO: move somewhere else
, tutorialType = CI.mk mempty -- TODO: remove type? unneeded? now <- liftIO getCurrentTime
, tutorialCapacity = Nothing Entity tutId _ <- upsert
, tutorialRoom = Nothing Tutorial
, tutorialRoomHidden = False { tutorialCourse = cid
, tutorialTime = Occurrences mempty mempty , tutorialType = CI.mk mempty -- TODO: remove type? unneeded?
, tutorialRegGroup = Nothing -- TODO: remove , tutorialCapacity = Nothing
, tutorialRegisterFrom = Nothing , tutorialRoom = Nothing
, tutorialRegisterTo = Nothing , tutorialRoomHidden = False
, tutorialDeregisterUntil = Nothing , tutorialTime = Occurrences mempty mempty
, tutorialLastChanged = now , tutorialRegGroup = Nothing -- TODO: remove
, tutorialTutorControlled = False , tutorialRegisterFrom = Nothing
, .. , tutorialRegisterTo = Nothing
} , tutorialDeregisterUntil = Nothing
[ TutorialName =. tutorialName , tutorialLastChanged = now
, TutorialLastChanged =. now , tutorialTutorControlled = False
] , ..
for_ uids $ \tutorialParticipantUser -> upsert }
TutorialParticipant [ TutorialName =. tutorialName
{ tutorialParticipantTutorial = tutId , TutorialLastChanged =. now
, .. ]
} for_ uids $ \tutorialParticipantUser -> upsert
[] TutorialParticipant
-- tell . pure <=< messageI Success . MsgCourseParticipantsRegisteredTutorial $ length uids { tutorialParticipantTutorial = tutId
, ..
}
[]
-- tell . pure <=< messageI Success . MsgCourseParticipantsRegisteredTutorial $ length uids
| otherwise
-> tell . pure =<< messageI Error MsgCourseParticipantsRegisterNoneGiven
let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
@ -114,19 +120,17 @@ postCAddUserR tid ssh csh = do
} }
registerUsers :: CourseId -> Set Text -> WriterT [Message] (YesodJobDB UniWorX) [UserId] --confirmAddUser :: ()
registerUsers cid auUsers = do --confirmAddUser = do
avsUsers :: Map Text (Maybe UserId) <- sequenceA . flip Map.fromSet auUsers $ -- siteLayoutMsg MsgCourseParticipantsRegisterConfirmationHeading $ do
liftHandler . upsertAvsUser -- TODO: upsertAvsUser should return whole Entity -- setTitleI MsgCourseParticipantsRegisterConfirmationHeading
if
| null avsUsers
-> tell . pure =<< messageI Error MsgCourseParticipantsRegisterNoneGiven
| otherwise
-- register retrieved users
-> tell <=< lift . addParticipantsResultMessages <=< lift . execWriterT . mapM_ (registerUser cid) $ Map.toList avsUsers
return . catMaybes $ Map.elems avsUsers
registerUsers :: CourseId -> Map Text (Maybe UserId) -> WriterT [Message] (YesodJobDB UniWorX) ()
registerUsers cid users
| null users = tell . pure =<< messageI Error MsgCourseParticipantsRegisterNoneGiven
| otherwise = tell <=< lift . addParticipantsResultMessages <=< lift . execWriterT . mapM_ (registerUser cid) $ Map.toList users
addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX) addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)