From a06f34539121d19a3f9c4bfb2c862fa1fb10a988 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 26 Jan 2024 10:00:38 +0100 Subject: [PATCH] chore(tutorial): aborted invite preserves identified users as form prefill --- src/Handler/Course/ParticipantInvite.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 0ce1e516b..30daf6f19 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -194,9 +194,13 @@ handleAddUserR tid ssh csh tdesc ttyp = do (_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm -- $logDebugS "***AbortProblem***" $ tshow registerConfirmResult - case registerConfirmResult of - Nothing -> return () - (Just BtnCourseRegisterAbort) -> addMessageI Warning MsgAborted + prefillUsers <- case registerConfirmResult of + Nothing -> return mempty + (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 confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction -- $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 redirect $ CTutorialR tid ssh csh tName TUsersR redirect $ CourseR tid ssh csh CUsersR + return mempty ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . identifyForm FIDCourseRegister . renderWForm FormStandard $ do let tutTypesMsg = [(SomeMessage tt,tt) | tt <- tutTypes] 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 ( (,,) <$> aopt (textField & cfStrip & cfCI & addDatalist tutNameSuggestions)