diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index d85781e83..27406536e 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -108,6 +108,8 @@ CourseParticipantEnlistDirectly: Bekannte Nutzer:innen sofort als Teilnehmer:in CourseSubmissionGroup: Feste Abgabegruppe SubmissionGroupEmptyIsUnsetTip: Leer lassen um Benutzer:innen aus den jeweiligen Abgabegruppen ersatzlos zu entfernen CourseParticipantsRegisterHeading: Kursteilnehmer:innen hinzufügen +CourseParticipantsRegisterActionAddParticipants: Personen zum Kurs anmelden +CourseParticipantsRegisterActionAddTutorialMembers: Personen zu Kurs und Übungsgruppe anmelden CourseParticipantsRegisterUsersField: Zum Kurs anzumeldende Personen CourseParticipantsRegisterUsersFieldTip: Bitte Personalnummer angeben. Mehrere Personen bitte mit Komma getrennt angeben. CourseParticipantsRegisterTutorialOption: Kursteilnehmer:innen zu Übungsgruppe anmelden? diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index 53d0e1193..6b8b0f257 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -108,6 +108,8 @@ CourseParticipantEnlistDirectly: Enrol known users directly CourseSubmissionGroup: Registered submission group SubmissionGroupEmptyIsUnsetTip: Leave empty to remove users from their respective submission groups CourseParticipantsRegisterHeading: Add course participants +CourseParticipantsRegisterActionAddParticipants: Add course participants +CourseParticipantsRegisterActionAddTutorialMembers: Add course and tutorial participants CourseParticipantsRegisterUsersField: Persons to register for course CourseParticipantsRegisterUsersFieldTip: Please enter personal number. Please separate multiple entries with commas. CourseParticipantsRegisterTutorialOption: Register course participants for tutorial? diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index f668b7015..25b3031d7 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -18,8 +18,10 @@ import Jobs.Queue --import qualified Data.Conduit.List as C (sourceList) --import qualified Data.Conduit.Combinators as C +import qualified Data.Aeson as Aeson import qualified Data.CaseInsensitive as CI --import Data.List (genericLength) +import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Text as Text import qualified Data.Time.Zones as TZ @@ -37,56 +39,74 @@ type UserSearchKey = Text type TutorialIdent = CI Text ---data ButtonCourseRegisterMode = BtnCourseRegisterAdd | BtnCourseRegisterConfirm | BtnCourseRegisterAbort --- deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) ---instance Universe ButtonCourseRegisterMode ---instance Finite ButtonCourseRegisterMode --- ---embedRenderMessage ''UniWorX ''ButtonCourseRegisterMode id --- ---nullaryPathPiece ''ButtonCourseRegisterMode $ camelToPathPiece' 1 --- ---instance Button UniWorX ButtonCourseRegisterMode where --- btnLabel x = [whamlet|_{x}|] --- --- btnClasses BtnCourseRegisterAdd = [BCIsButton, BCPrimary] --- btnClasses BtnCourseRegisterConfirm = [BCIsButton, BCPrimary] --- btnClasses BtnCourseRegisterAbort = [BCIsButton, BCDanger] --- --- btnValidate _ BtnCourseRegisterAbort = False --- btnValidate _ _ = True --- --- ---data CourseRegisterAction --- = CourseRegisterActionAddParticipant --- | CourseRegisterActionAddTutorialMember --- | CourseRegisterActionUnknownPerson --- deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) ---instance Universe CourseRegisterAction ---instance Finite CourseRegisterAction --- ---data CourseRegisterActionData --- = CourseRegisterActionAddParticipantData --- { crActAddParticipantUser :: UserId --- , crActAddParticipantTutorial :: Maybe TutorialIdent --- } --- | CourseRegisterActionAddTutorialMemberData --- { crActAddTutorialMemberParticipant :: CourseParticipantId --- , crActAddTutorialMemberTutorial :: TutorialIdent --- } --- | CourseRegisterActionUnknownPersonData -- pseudo-action; just for display --- { crActUnknownPersonIdent :: Text --- } --- deriving (Eq, Ord, Read, Show, Generic, Typeable) --- ---makeLenses_ ''CourseRegisterActionData --- ---classifyRegisterAction :: CourseRegisterActionData -> CourseRegisterAction ---classifyRegisterAction = \case --- CourseRegisterActionAddParticipantData{} -> CourseRegisterActionAddParticipant --- CourseRegisterActionAddTutorialMemberData{} -> CourseRegisterActionAddTutorialMember --- CourseRegisterActionUnknownPersonData{} -> CourseRegisterActionUnknownPerson --- +data ButtonCourseRegisterMode = BtnCourseRegisterAdd | BtnCourseRegisterConfirm | BtnCourseRegisterAbort + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) +instance Universe ButtonCourseRegisterMode +instance Finite ButtonCourseRegisterMode + +embedRenderMessage ''UniWorX ''ButtonCourseRegisterMode id + +nullaryPathPiece ''ButtonCourseRegisterMode $ camelToPathPiece' 1 + +instance Button UniWorX ButtonCourseRegisterMode where + btnLabel x = [whamlet|_{x}|] + + btnClasses BtnCourseRegisterAdd = [BCIsButton, BCPrimary] + btnClasses BtnCourseRegisterConfirm = [BCIsButton, BCPrimary] + btnClasses BtnCourseRegisterAbort = [BCIsButton, BCDanger] + + btnValidate _ BtnCourseRegisterAbort = False + btnValidate _ _ = True + + +data CourseRegisterAction + = CourseRegisterActionAddParticipant + | CourseRegisterActionAddTutorialMember +-- | CourseRegisterActionUnknownPerson + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) +instance Universe CourseRegisterAction +instance Finite CourseRegisterAction + +data CourseRegisterActionData + = CourseRegisterActionAddParticipantData + { crActAddParticipantIdent :: UserSearchKey + , crActAddParticipantUser :: UserId + } + | CourseRegisterActionAddTutorialMemberData + { crActAddTutorialMemberIdent :: UserSearchKey + , crActAddTutorialMemberUser :: UserId + , crActAddTutorialMemberTutorial :: TutorialIdent + } +-- | CourseRegisterActionUnknownPersonData -- pseudo-action; just for display +-- { crActUnknownPersonIdent :: Text +-- } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +makeLenses_ ''CourseRegisterActionData + +instance Aeson.FromJSON CourseRegisterActionData where + parseJSON = Aeson.genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } + +instance Aeson.ToJSON CourseRegisterActionData where + toJSON = Aeson.genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } + toEncoding = Aeson.genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 2 } + +_classifyRegisterAction :: CourseRegisterActionData -> CourseRegisterAction +_classifyRegisterAction = \case + CourseRegisterActionAddParticipantData{} -> CourseRegisterActionAddParticipant + CourseRegisterActionAddTutorialMemberData{} -> CourseRegisterActionAddTutorialMember +--CourseRegisterActionUnknownPersonData{} -> CourseRegisterActionUnknownPerson + +courseRegisterRenderActionClass :: CourseRegisterAction -> Widget +courseRegisterRenderActionClass = \case + CourseRegisterActionAddParticipant -> [whamlet|_{MsgCourseParticipantsRegisterActionAddParticipants}|] + CourseRegisterActionAddTutorialMember -> [whamlet|_{MsgCourseParticipantsRegisterActionAddTutorialMembers}|] + +courseRegisterRenderAction :: CourseRegisterActionData -> Widget +courseRegisterRenderAction = \case + CourseRegisterActionAddParticipantData{..} -> [whamlet|TODO USER (#{crActAddParticipantIdent})|] + CourseRegisterActionAddTutorialMemberData{..} -> [whamlet|TODO USER (#{crActAddTutorialMemberIdent})|] + --data CourseRegisterActionClass -- = CourseRegisterActionClassNew -- | CourseRegisterActionClassExisting @@ -175,7 +195,7 @@ instance Monoid AddParticipantsResult where getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCAddUserR = postCAddUserR postCAddUserR tid ssh csh = do - cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh + _cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute @@ -201,16 +221,58 @@ postCAddUserR tid ssh csh = do
_{MsgCourseAddUserConfirmationTip}
+$# _{MsgCourseAddUserConfirmationTip}