feat(users-add): upsert tutorial participants

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

@@ -120,6 +120,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 angemeldet
 CourseParticipantsAlreadyTutorialMember n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits in dieser Übungsgruppe angemeldet
 CourseParticipantsRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich angemeldet
+CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Übungsgruppe angemeldet
 CourseApplicationText: Text-Bewerbung
 CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung!
 CourseRegistrationText: Text zur Anmeldung
@@ -299,5 +300,3 @@ CourseAdministrator: Kursadministrator:in
 CourseAvsRegisterTitle: Teilnehmer:innen anmelden
 CourseAvsRegisterParticipants: Teilnehmer:innen
 CourseAvsRegisterParticipantsTip: Mehrere Teilnehmer:innen mit Komma separieren
-CourseAvsRegisterCreateTutorial: Teilnehmer:innen in Tagesgruppe eintragen
-CourseAvsRegisterTutorialDay: Tag

messages/uniworx/categories/courses/courses/en-eu.msg

@@ -120,6 +120,7 @@ CourseParticipantsInvited n: #{n} #{pluralEN n "invitation" "invitations"} sent
 CourseParticipantsAlreadyRegistered n: #{n} #{pluralEN n "participant is" "participants are"} already enrolled
 CourseParticipantsAlreadyTutorialMember n: #{n} #{pluralEN n "participant is" "participants are"} already registered for this tutorial
 CourseParticipantsRegistered n: Successfully registered #{n} #{pluralEN n "participant" "participants"}
+CourseParticipantsRegisteredTutorial n: Successfully registered #{n} #{pluralEN n "participant" "participants"} for tutorial
 CourseApplicationText: Application text
 CourseApplicationFollowInstructions: Please follow the instructions for applications!
 CourseRegistrationText: Registration text
@@ -298,5 +299,3 @@ CourseAdministrator: Course administrator
 CourseAvsRegisterTitle: Register participants
 CourseAvsRegisterParticipants: Participants
 CourseAvsRegisterParticipantsTip: Separate multiple participants with comma
-CourseAvsRegisterCreateTutorial: Add participants to day group
-CourseAvsRegisterTutorialDay: Day

src/Handler/Course/ParticipantInvite.hs

@@ -28,7 +28,7 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 data AddUsers = AddUsers
   { auUsers    :: Set Text
-  , auTutorial :: Maybe Text
+  , auTutorial :: Maybe (CI Text)
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -62,19 +62,47 @@ postCAddUserR tid ssh csh = do
   ((usersToRegister, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
     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
+      ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting
       ( fslI MsgCourseParticipantsRegisterTutorialOption )
       ( Just True )
     return $ AddUsers <$> auUsers <*> auTutorial
 
   -- 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
+  let dest | Just AddUsers{auTutorial=Just tutn} <- formResult' usersToRegister
              = 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
+  formResultModal usersToRegister dest $ \AddUsers{..} -> hoist runDBJobs $ do
+    uids <- registerUsers cid auUsers
+    for_ auTutorial $ \tutorialName -> lift $ do
+      -- TODO: move somewhere else
+      now <- liftIO getCurrentTime
+      Entity tutId _ <- upsert
+        Tutorial
+          { tutorialCourse = cid
+          , tutorialType = CI.mk mempty -- TODO: remove type? unneeded?
+          , tutorialCapacity = Nothing
+          , tutorialRoom = Nothing
+          , tutorialRoomHidden = False
+          , tutorialTime = Occurrences mempty mempty
+          , tutorialRegGroup = Nothing -- TODO: remove
+          , tutorialRegisterFrom = Nothing
+          , tutorialRegisterTo = Nothing
+          , tutorialDeregisterUntil = Nothing
+          , tutorialLastChanged = now
+          , tutorialTutorControlled = False
+          , ..
+          }
+        [ TutorialName        =. tutorialName
+        , TutorialLastChanged =. now
+        ]
+      for_ uids $ \tutorialParticipantUser -> upsert
+        TutorialParticipant
+          { tutorialParticipantTutorial = tutId
+          , ..
+          }
+        []
+      -- tell . pure <=< messageI Success . MsgCourseParticipantsRegisteredTutorial $ length uids
 
   let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
 
@@ -86,8 +114,8 @@ postCAddUserR tid ssh csh = do
       }
 
 
-registerUsers :: CourseId -> AddUsers -> WriterT [Message] (YesodJobDB UniWorX) ()
-registerUsers cid AddUsers{..} = do
+registerUsers :: CourseId -> Set Text -> WriterT [Message] (YesodJobDB UniWorX) [UserId]
+registerUsers cid auUsers = do
   avsUsers :: Map Text (Maybe UserId) <- sequenceA . flip Map.fromSet auUsers $
     liftHandler . upsertAvsUser -- TODO: upsertAvsUser should return whole Entity
 
@@ -98,6 +126,8 @@ registerUsers cid AddUsers{..} = do
       -- register retrieved users
       -> tell <=< lift . addParticipantsResultMessages <=< lift . execWriterT . mapM_ (registerUser cid) $ Map.toList avsUsers
 
+  return . catMaybes $ Map.elems avsUsers
+
 
 addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)
                               => AddParticipantsResult