fix(course): fix #147 abort addd participant aborts now

Check that runButtonForm will always work with the correct field ids!

messages/uniworx/categories/courses/courses/de-de-formal.msg

@@ -95,7 +95,7 @@ CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} pe
 CourseParticipantsAlreadyRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits zur Kursart angemeldet
 CourseParticipantsAlreadyTutorialMember n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits in dieser Kurs angemeldet
 CourseParticipantsRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kursart angemeldet
-CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kurs angemeldet
+CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zum Kurs angemeldet
 CourseParticipantsRegisterConfirmationHeading: Teilnehmer:innen hinzufügen
 CourseParticipantsRegisterUnnecessary: Alle angeforderten Anmeldungen sind bereits vorhanden. Es wurden keine Änderungen vorgenommen.
 CourseParticipantsRegisterConfirmInvalid: Ungültiges Bestätigungsformular!

src/Handler/Course/ParticipantInvite.hs

@@ -192,23 +192,29 @@ handleAddUserR tid ssh csh tdesc ttyp = do
 
   currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute
 
-  confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction
+  (_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm    
-  --   $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
+  $logDebugS "***AbortProblem***" $ tshow registerConfirmResult
-  unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs
+  case registerConfirmResult of 
-    let
+    Nothing -> return ()
-      users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs
+    (Just BtnCourseRegisterAbort)   -> addMessageI Warning MsgAborted
-      tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs
+    (Just BtnCourseRegisterConfirm) -> do
-      actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member!      
+      confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction  
-    registeredUsers <- registerUsers cid users
+      --   $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs
-    whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do
+      unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs
-      whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do
+        let
-        tutId <- upsertNewTutorial cid tName tutType tutDay
+          users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs
-        registerTutorialMembers tutId registeredUsers
+          tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs
-        -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point
+          actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member!      
-        redirect $ CTutorialR tid ssh csh tName TUsersR
+        registeredUsers <- registerUsers cid users
-    redirect $ CourseR tid ssh csh CUsersR
+        whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do
+          whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do
+            tutId <- upsertNewTutorial cid tName tutType tutDay
+            registerTutorialMembers tutId registeredUsers
+            -- 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
   
-  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
+  ((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

src/Utils/Form.hs

@@ -367,6 +367,8 @@ identifyForm = identifyForm' id
 -- Buttons (new version ) --
 ----------------------------
 
+-- Bemerke: Back Button Widget implementierbar durch <button onclick="history.back()">_{MsgGenericBack}
+
 data family ButtonClass site :: Type
 
 class (PathPiece a, PathPiece (ButtonClass site), RenderMessage site ButtonMessage) => Button site a where
@@ -376,7 +378,7 @@ class (PathPiece a, PathPiece (ButtonClass site), RenderMessage site ButtonMessa
   btnLabel = toWidget <=< ap getMessageRender . return
 
   btnValidate :: forall p. p site -> a -> Bool
-  btnValidate _ _ = True
+  btnValidate _ _ = True                          -- False will attach html attribute "formnovalidate", so that browsers do not validate the form data
 
   btnClasses :: a -> [ButtonClass site]
   btnClasses _ = []