diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 80d5f42b0..f0012dbe0 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -286,3 +286,9 @@ CourseExamRegistrationTime: Angemeldet seit CourseParticipantStateIsActiveFilter: Ansicht CourseApply: Zum Kurs bewerben 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 a7e8abbc5..d99c81ffd 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -285,3 +285,9 @@ CourseExamRegistrationTime: Registered since CourseParticipantStateIsActiveFilter: View CourseApply: Apply for course 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/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg index 2552a6418..059524d1e 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg @@ -137,6 +137,7 @@ BreadcrumbCourseEventEdit: Kurstermin bearbeiten BreadcrumbExamList: Prüfungen BreadcrumbExamNew: Neue Prüfung anlegen BreadcrumbCourseApplications: Bewerbungen +BreadcrumbCourseAvsRegister: AVS-Teilnehmer:innen anmelden BreadcrumbExamEdit: Prüfung bearbeiten BreadcrumbExamUsers: Teilnehmer:innen BreadcrumbExamGrades: Prüfungsleistungen diff --git a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg index 2c8f601c5..ce41cf679 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg @@ -131,6 +131,7 @@ BreadcrumbCourseNewsNew: Add course news BreadcrumbCourseNewsEdit: Edit course news BreadcrumbCourseEventNew: New course occurrence BreadcrumbCourseEventEdit: Edit course occurrence +BreadcrumbCourseAvsRegister: Register AVS participants BreadcrumbExamList: Exams BreadcrumbExamNew: Create new exam BreadcrumbCourseApplications: Applications diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 803e46860..091a28614 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -147,5 +147,7 @@ MenuApc: Druckerei MenuPrintSend: Manueller Briefversand MenuPrintDownload: Brief herunterladen +MenuCourseAvsRegister: AVS-Teilnehmer:innen anmelden + MenuApiDocs: API-Dokumentation (Englisch) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 73f58d1f3..3f9ca4ee8 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -148,5 +148,7 @@ MenuApc: Printing MenuPrintSend: Send Letter MenuPrintDownload: Download Letter +MenuCourseAvsRegister: Register AVS participants + MenuApiDocs: API documentation MenuSwagger: OpenAPI 2.0 (Swagger) diff --git a/routes b/routes index 435ca94d3..09531b5bd 100644 --- a/routes +++ b/routes @@ -176,6 +176,8 @@ !/users/new CAddUserR GET POST !lecturerANDallocation-time !/users/invite CInviteR GET POST /users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant !lecturerANDapplicant + /avs CAvsR: + /register CAvsRegisterR GET POST !lecturer /correctors CHiWisR GET /communication CCommR GET POST /notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access! diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index b17708671..472547818 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -250,6 +250,7 @@ breadcrumb (CourseR tid ssh csh CEditR) = i18nCrumb MsgMenuCourseEdit . Just breadcrumb (CourseR tid ssh csh CUsersR) = i18nCrumb MsgMenuCourseMembers . Just $ CourseR tid ssh csh CShowR breadcrumb (CourseR tid ssh csh CAddUserR) = i18nCrumb MsgMenuCourseAddMembers . Just $ CourseR tid ssh csh CUsersR breadcrumb (CourseR tid ssh csh CInviteR) = i18nCrumb MsgBreadcrumbCourseParticipantInvitation . Just $ CourseR tid ssh csh CShowR +breadcrumb (CourseR tid ssh csh (CAvsR CAvsRegisterR)) = i18nCrumb MsgBreadcrumbCourseAvsRegister . Just $ CourseR tid ssh csh CUsersR breadcrumb (CourseR tid ssh csh CExamOfficeR) = i18nCrumb MsgMenuCourseExamOffice . Just $ CourseR tid ssh csh CShowR breadcrumb (CourseR tid ssh csh (CUserR cID)) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbUser . Just $ CourseR tid ssh csh CUsersR) $ do guardM . lift . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID @@ -985,6 +986,17 @@ pageActions (CourseR tid ssh csh CShowR) = do return $ [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseAvsRegister + , navRoute = CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navAccess' = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = mempty + } + , NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuMaterialList , navRoute = CourseR tid ssh csh MaterialListR @@ -1717,6 +1729,17 @@ pageActions (CourseR tid ssh csh SheetListR) = do ] pageActions (CourseR tid ssh csh CUsersR) = return [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseAvsRegister + , navRoute = CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navAccess' = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = mempty + } + , NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuCourseAddMembers , navRoute = CourseR tid ssh csh CAddUserR @@ -1791,6 +1814,17 @@ pageActions (CMaterialR tid ssh csh mnm MShowR) = return ] pageActions (CourseR tid ssh csh CTutorialListR) = return [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseAvsRegister + , navRoute = CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navAccess' = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = mempty + } + , NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuTutorialNew , navRoute = CourseR tid ssh csh CTutorialNewR @@ -1837,6 +1871,17 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = return } , navChildren = [] } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseAvsRegister + , navRoute = CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navAccess' = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = mempty + } , NavPageActionSecondary { navLink = NavLink { navLabel = MsgMenuTutorialDelete diff --git a/src/Foundation/Routes.hs b/src/Foundation/Routes.hs index a6ce7b7fd..6ece00b0b 100644 --- a/src/Foundation/Routes.hs +++ b/src/Foundation/Routes.hs @@ -34,6 +34,7 @@ import ServantApi.ExternalApis.Type mkYesodData "UniWorX" uniworxRoutes deriving instance Generic CourseR +deriving instance Generic CAvsR deriving instance Generic SheetR deriving instance Generic SubmissionR deriving instance Generic MaterialR @@ -51,6 +52,7 @@ deriving instance Generic (Route UniWorX) instance Hashable CourseR +instance Hashable CAvsR instance Hashable SheetR instance Hashable SubmissionR instance Hashable MaterialR @@ -76,6 +78,7 @@ instance Ord (Route EmbeddedStatic) where compare = compare `on` renderRoute deriving instance Ord CourseR +deriving instance Ord CAvsR deriving instance Ord SheetR deriving instance Ord SubmissionR deriving instance Ord MaterialR diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 5786e3566..1efd5a085 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -11,6 +11,7 @@ import Import import qualified Database.Esqueleto.Legacy as E import qualified Database.Persist as P +import Handler.Course.Avs as Handler.Course import Handler.Course.Communication as Handler.Course import Handler.Course.Delete as Handler.Course import Handler.Course.Edit as Handler.Course diff --git a/src/Handler/Course/Avs.hs b/src/Handler/Course/Avs.hs new file mode 100644 index 000000000..fbc20efc1 --- /dev/null +++ b/src/Handler/Course/Avs.hs @@ -0,0 +1,53 @@ +-- SPDX-FileCopyrightText: 2022 Sarah Vaupel +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Handler.Course.Avs + ( getCAvsRegisterR, postCAvsRegisterR + ) where + +import Import + +import Handler.Utils + +import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Time.Zones as TZ + + +data CourseAvsRegisterForm = CourseAvsRegisterForm + { cavsregParticipants :: Set Text -- TODO: NonEmpty + , cavsregTutorial :: Maybe Day + } + deriving (Eq, Ord, Show, Read, Generic, Typeable) + +makeLenses_ ''CourseAvsRegisterForm + +courseAvsRegisterForm :: Maybe CourseAvsRegisterForm -> AForm Handler CourseAvsRegisterForm +courseAvsRegisterForm template = wFormToAForm $ do + today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime + + let + cfCommaSeparatedSet :: forall m. Functor m => Field m Text -> Field m (Set Text) + cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . Set.toList) + + aFormToWForm $ CourseAvsRegisterForm + <$> areq (textField & cfCommaSeparatedSet) (fslI MsgCourseAvsRegisterParticipants & setTooltip MsgCourseAvsRegisterParticipantsTip) (cavsregParticipants <$> template) + <*> optionalActionA + ( areq dayField (fslI MsgCourseAvsRegisterTutorialDay) (Just . fromMaybe today . join $ cavsregTutorial <$> template) + ) + (fslI MsgCourseAvsRegisterCreateTutorial) (is _Just . cavsregTutorial <$> template) + + +getCAvsRegisterR, postCAvsRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCAvsRegisterR = postCAvsRegisterR +postCAvsRegisterR _tid _ssh _csh = do + ((_result, formView), formEnctype) <- runFormPost . renderAForm FormStandard $ courseAvsRegisterForm Nothing + + -- TODO: process result + + defaultLayout $ do + setTitleI MsgCourseAvsRegisterTitle + wrapForm formView def + { formEncoding = formEnctype + }