From 394ce3066c47ab6a937fea5e4753799593964456 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 2 Feb 2023 09:57:02 +0100 Subject: [PATCH] chore(course): direct link for add participant to existing tutorial --- .../utils/navigation/menu/de-de-formal.msg | 1 + .../uniworx/utils/navigation/menu/en-eu.msg | 3 ++- routes | 1 + src/Foundation/Navigation.hs | 22 ++++++++++++++----- src/Handler/Course/ParticipantInvite.hs | 17 +++++++++----- 5 files changed, 33 insertions(+), 11 deletions(-) diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index ae5a5eff4..7e22bc31c 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -30,6 +30,7 @@ MenuLogout !ident-ok: Logout MenuCourseList: Kurse MenuCourseMembers: Kursteilnehmer:innen MenuCourseAddMembers: Kursteilnehmer:innen hinzufügen +MenuTutorialAddMembers: Tutorium Teilnehmer:innen hinzufügen MenuCourseCommunication: Kursmitteilung (E-Mail) MenuCourseExamOffice: Prüfungsbeauftragte MenuTermShow: Semester diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 938038732..b517d4136 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -29,7 +29,8 @@ MenuLogin: Login MenuLogout: Logout MenuCourseList: Courses MenuCourseMembers: Participants -MenuCourseAddMembers: Add participants +MenuCourseAddMembers: Add course participants +MenuTutorialAddMembers: Add tutorium participants MenuCourseCommunication: Course message (email) MenuCourseExamOffice: Exam offices MenuTermShow: Semesters diff --git a/routes b/routes index 5246a375a..1005a6a7e 100644 --- a/routes +++ b/routes @@ -209,6 +209,7 @@ /edit TEditR GET POST !tutorANDtutor-control /delete TDeleteR GET POST /participants TUsersR GET POST !tutor + /participants/add TAddUserR GET POST !tutor /register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered /communication TCommR GET POST !tutor /tutor-invite TInviteR GET POST !tutorANDtutor-control diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 5191afa77..c47b1f295 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -283,11 +283,12 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of TUsersR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR) - TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR - TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR - TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR - TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR - TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR + TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR + TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR + TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR + TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR + TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR + TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of SShowR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do @@ -1619,6 +1620,17 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = do membersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CUsersR return [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTutorialAddMembers + , navRoute = CTutorialR tid ssh csh tutn TAddUserR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuCourseMembers , navRoute = CourseR tid ssh csh CUsersR diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index de3941e78..e129b9d53 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -4,6 +4,7 @@ module Handler.Course.ParticipantInvite ( getCAddUserR, postCAddUserR + , getTAddUserR, postTAddUserR ) where import Import @@ -116,9 +117,16 @@ instance Monoid AddParticipantsResult where mappend = (<>) -getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCAddUserR = postCAddUserR -postCAddUserR tid ssh csh = do +postCAddUserR tid ssh csh = do + today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime + postTAddUserR tid ssh csh (CI.mk $ tshow today) -- Don't use user date display setting, so that tutorial default names conform to all users + + +getTAddUserR, postTAddUserR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html +getTAddUserR = postTAddUserR +postTAddUserR tid ssh csh tut = do cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute @@ -141,11 +149,10 @@ postCAddUserR tid ssh csh = do | otherwise -> redirect $ CourseR tid ssh csh CUsersR - ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do - today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime + ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty auReqTutorial <- optionalActionW - ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting + ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just tut) ) ( fslI MsgCourseParticipantsRegisterTutorialOption ) ( Just True ) return $ AddUserRequest <$> auReqUsers <*> auReqTutorial