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

chore(tutorial): aborted invite preserves identified users as form prefill

Browse Source
This commit is contained in:
Steffen Jost 2024-01-26 10:00:38 +01:00
parent 28837c41ab
commit a06f345391
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -194,9 +194,13 @@ handleAddUserR tid ssh csh tdesc ttyp = do
(_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm (_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm
-- $logDebugS "***AbortProblem***" $ tshow registerConfirmResult -- $logDebugS "***AbortProblem***" $ tshow registerConfirmResult
case registerConfirmResult of prefillUsers <- case registerConfirmResult of
Nothing -> return () Nothing -> return mempty
(Just BtnCourseRegisterAbort) -> addMessageI Warning MsgAborted (Just BtnCourseRegisterAbort) -> do
addMessageI Warning MsgAborted
-- prefill confirmed users for convenience. Note that Browser-Back may also return to the filled form, but history.back() does not in Chrome
confirmedActs :: [CourseRegisterActionData] <- exceptT (const $ return mempty) return . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction -- ignore any exception, since it is only used to prefill a form field for convenience
return $ Just $ Set.fromList $ fmap crActIdent confirmedActs
(Just BtnCourseRegisterConfirm) -> do (Just BtnCourseRegisterConfirm) -> do
confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction
-- $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs -- $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
@ -213,11 +217,12 @@ handleAddUserR tid ssh csh tdesc ttyp = do
-- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point
redirect $ CTutorialR tid ssh csh tName TUsersR redirect $ CTutorialR tid ssh csh tName TUsersR
redirect $ CourseR tid ssh csh CUsersR redirect $ CourseR tid ssh csh CUsersR
return mempty
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . identifyForm FIDCourseRegister . renderWForm FormStandard $ do ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . identifyForm FIDCourseRegister . renderWForm FormStandard $ do
let tutTypesMsg = [(SomeMessage tt,tt) | tt <- tutTypes] let tutTypesMsg = [(SomeMessage tt,tt) | tt <- tutTypes]
tutDefType = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing) tutDefType = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing)
auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) prefillUsers
auReqTutorial <- optionalActionW auReqTutorial <- optionalActionW
( (,,) ( (,,)
<$> aopt (textField & cfStrip & cfCI & addDatalist tutNameSuggestions) <$> aopt (textField & cfStrip & cfCI & addDatalist tutNameSuggestions)