diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 764150b5a..48fb14f44 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index 81d678c44..81df1187c 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/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 diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 9b53902cf..3714c303e 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/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