From 93c6853b082a5d2195bb55cbf7b792d2f4307254 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
Date: Thu, 8 Dec 2022 19:16:42 +0100
Subject: [PATCH] feat(users-add): redirect to different routes depending on
 tutorial

---
 src/Handler/Course/ParticipantInvite.hs | 30 +++++++++++++++++--------
 1 file changed, 21 insertions(+), 9 deletions(-)

diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs
index 8190b0905..9b53902cf 100644
--- a/src/Handler/Course/ParticipantInvite.hs
+++ b/src/Handler/Course/ParticipantInvite.hs
@@ -14,7 +14,7 @@ import Handler.Utils.Avs
 import Jobs.Queue
 
 --import Data.Aeson hiding (Result(..))
---import qualified Data.CaseInsensitive as CI
+import qualified Data.CaseInsensitive as CI
 --import qualified Data.HashSet as HashSet
 import Data.List (genericLength)
 import qualified Data.Map as Map
@@ -26,6 +26,12 @@ import Control.Monad.Except (MonadError(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 
+data AddUsers = AddUsers
+  { auUsers    :: Set Text
+  , auTutorial :: Maybe Text
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+
 data AddParticipantsResult = AddParticipantsResult
   { aurNotFound              :: Set Text
   , aurAlreadyRegistered
@@ -54,14 +60,20 @@ postCAddUserR tid ssh csh = do
     cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . Set.toList)
 
   ((usersToRegister, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
-    users <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
-    mTutorial <- optionalActionW
+    auUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
+    auTutorial <- optionalActionW
       ( areq textField (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just $ tshow today) ) -- TODO: use user date display setting
       ( fslI MsgCourseParticipantsRegisterTutorialOption )
       ( Just True )
-    return $ Map.fromSet . const <$> mTutorial <*> users
+    return $ AddUsers <$> auUsers <*> auTutorial
 
-  formResultModal usersToRegister (CourseR tid ssh csh CUsersR) $
+  -- let dest = CourseR tid ssh csh . maybe CUsersR (flip TutorialR TUsersR . CI.mk) . join . fmap auTutorial $ formResult' usersToRegister
+  let dest | Just AddUsers{..}    <- formResult' usersToRegister
+           , Just (CI.mk -> tutn) <- auTutorial
+             = CTutorialR tid ssh csh tutn TUsersR
+           | otherwise
+             = CourseR tid ssh csh CUsersR
+  formResultModal usersToRegister dest $
     hoist runDBJobs . registerUsers cid -- TODO: register for tutorial, if specified
 
   let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
@@ -74,10 +86,10 @@ postCAddUserR tid ssh csh = do
       }
 
 
-registerUsers :: CourseId -> Map Text (Maybe Text) -> WriterT [Message] (YesodJobDB UniWorX) ()
-registerUsers cid usersToRegister = do
-  avsUsers :: Map Text (Maybe UserId) <- flip Map.traverseWithKey usersToRegister $ \userIdent _ ->
-    liftHandler $ upsertAvsUser userIdent -- TODO: upsertAvsUser should return whole Entity
+registerUsers :: CourseId -> AddUsers -> WriterT [Message] (YesodJobDB UniWorX) ()
+registerUsers cid AddUsers{..} = do
+  avsUsers :: Map Text (Maybe UserId) <- sequenceA . flip Map.fromSet auUsers $
+    liftHandler . upsertAvsUser -- TODO: upsertAvsUser should return whole Entity
 
   if
     | null avsUsers