From c072b85299f87f6ddfcdf72ff3db4881a079af41 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 12 May 2020 14:20:05 +0200 Subject: [PATCH] feat(multi-user-field): multi-user-invitation-field --- frontend/src/app.sass | 3 + messages/uniworx/de-de-formal.msg | 14 ++++- messages/uniworx/en-eu.msg | 13 ++++- src/Handler/Course/Edit.hs | 19 +++---- src/Handler/Course/ParticipantInvite.hs | 2 +- src/Handler/Exam/AddUser.hs | 2 +- src/Handler/Exam/Form.hs | 4 +- src/Handler/ExamOffice/Users.hs | 4 +- src/Handler/ExternalExam/Form.hs | 4 +- src/Handler/Sheet.hs | 4 +- src/Handler/Submission.hs | 14 +++-- src/Handler/Tutorial/Form.hs | 4 +- src/Handler/Utils/Communication.hs | 2 +- src/Handler/Utils/Form.hs | 75 ++++++++++++++++--------- 14 files changed, 102 insertions(+), 62 deletions(-) diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 9e1d04814..51a6a00cd 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -1358,3 +1358,6 @@ a.breadcrumbs__home &:hover opacity: 1 + +.multi-user-invitation-field__wrapper + max-width: 25rem diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 065d0eeba..72f677075 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -256,7 +256,7 @@ CourseFormSectionAdministration: Verwaltung CourseLecturers: Kursverwalter CourseLecturer: Dozent CourseAssistant: Assistent -CourseLecturerAlreadyAdded email@UserEmail: Es gibt bereits einen Kursverwalter mit E-Mail #{email} +CourseLecturerAlreadyAdded: Dieser Nutzer ist bereits als Kursverwalter eingetragen CourseRegistrationEndMustBeAfterStart: Ende des Anmeldezeitraums muss nach dem Anfang liegen CourseDeregistrationEndMustBeAfterStart: Ende des Abmeldezeitraums muss nach dem Anfang des Anmeldezeitraums liegen CourseUserMustBeLecturer: Aktueller Benutzer muss als Kursverwalter eingetragen sein @@ -1434,7 +1434,17 @@ RGTutorialParticipants: Tutorium-Teilnehmer MultiSelectFieldTip: Mehrfach-Auswahl ist möglich (Umschalt bzw. Strg) MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Addressen möglich -EmailInvitationWarning: Diese Adresse konnte mit Ihren aktuellen Rechten keinem Uni2work-Benutzer zugeordnet werden (ggf. unter gewissen Einschränkungen). Es wird eine Einladung per E-Mail versandt. + +EmailInvitationWarning: Diese Adresse konnte keinem Uni2work-Benutzer zugeordnet werden. Es wird eine Einladung per E-Mail versandt. +EmailInvitationWarningPrevCoSubmittors: Diese Adresse konnte keinem Kursteilnehmer, mit dem Sie schon einmal für diesen Kurs abgegeben haben, zugeordnet werden. Es wird eine Einladung per E-Mail versandt. +EmailInvitationWarningCourseParticipants: Diese Adresse konnte keinem Kursteilnehmer zugeordnet werden. Es wird eine Einladung per E-Mail versandt. + +MultiUserFieldExplanationAnyUser: Dieses Eingabefeld sucht in den Addressen aller Uni2work-Benutzer. +MultiUserFieldExplanationPrevCoSubmittors: Dieses Eingabefeld sucht in den Addressen von Kursteilnehmern, für die gesichert werden kann, dass Sie zusammen mit den dahinter stehenden Personen schon einmal für diesen Kurs abgegeben haben. +MultiUserFieldExplanationCourseParticipants: Dieses Eingabefeld sucht in den Addressen von Kursteilnehmern. + +MultiUserFieldInvitationExplanation: An Addressen, die so keinem Uni2work-Benutzer zugeordnet werden können, wird eine Einladung per E-Mail versandt. +MultiUserFieldInvitationExplanationAlways: Es wird an alle Addressen, die Sie hier angeben, eine Einladung per E-Mail versandt. LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lType} für #{csh} eingetragen LecturerInvitationDeclined csh@CourseShorthand: Sie haben die Einladung, Kursverwalter für #{csh} zu werden, abgelehnt diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 156bacecf..048b499d1 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -255,7 +255,7 @@ CourseFormSectionAdministration: Administration CourseLecturers: Course administrators CourseLecturer: Lecturer CourseAssistant: Assistant -CourseLecturerAlreadyAdded email: There already is a course administrator with email #{email} +CourseLecturerAlreadyAdded: This user is already configured as a course administrator CourseRegistrationEndMustBeAfterStart: The end of the registration period must be before its start CourseDeregistrationEndMustBeAfterStart: The end of the deregistration period must be after the start of the registration period CourseUserMustBeLecturer: The current user needs to be a course administrator @@ -1433,7 +1433,16 @@ RGTutorialParticipants: Tutorial participants MultiSelectFieldTip: Multiple selections are possible (Shift or Ctrl) MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated) -EmailInvitationWarning: This address could not be matched to any Uni2work-user under your current permissions (may be subject to some restrictions). An invitation will be sent via email. +EmailInvitationWarning: This address could not be matched to any Uni2work user. An invitation will be sent via email. +EmailInvitationWarningPrevCoSubmittors: This address could not be matched to any course participant with whom you have submitted for this course before. An Invitation will be sent via email. +EmailInvitationWarningCourseParticipants: This address coulde not be matched to any course participant. An Invitation will be sent via email. + +MultiUserFieldExplanationAnyUser: This input searches through the addresses of all Uni2work users. +MultiUserFieldExplanationPrevCoSubmittors: This input searches through the addresses of all course participants for whom it could be determined, that you have already submitted with that person for this course. +MultiUserFieldExplanationCourseParticipants: This input searches through the addresses of all course participants. + +MultiUserFieldInvitationExplanation: For addresses, which are not found in this way, an invitation will be sent via email. +MultiUserFieldInvitationExplanationAlways: An invitation will be sent via email to all addresses you enter here. LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh} LecturerInvitationDeclined csh: You have declined the invitation to become course administrator for #{csh} diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index 97ca649df..b9d82105d 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -128,16 +128,13 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB let miAdd :: ListPosition -> Natural -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) miAdd _ _ nudge btn = Just $ \csrf -> do - (addRes, addView) <- mpreq emailField ("" & addName (nudge "user")) Nothing - addRes' <- for addRes $ liftHandler . runDB . getKeyBy . UniqueEmail . CI.mk - let addRes'' = case (,) <$> addRes <*> addRes' of - FormSuccess (CI.mk -> email, mLid) -> - let new = maybe (Left email) Right mLid - in FormSuccess $ \prev -> if - | new `elem` Map.elems prev -> FormFailure [ mr $ MsgCourseLecturerAlreadyAdded email ] -- Since there is only ever one email address associated with any user, the case where a @Left email@ corresponds to a @Right lid@ can never occur (at least logically; might still be the same person, of course) - | otherwise -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax prev) new - FormFailure errs -> FormFailure errs - FormMissing -> FormMissing + (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + let addRes'' = addRes <&> \newDat oldDat -> if + | existing <- newDat `Set.intersection` Set.fromList (Map.elems oldDat) + , not $ Set.null existing + -> FormFailure [mr MsgCourseLecturerAlreadyAdded] + | otherwise + -> FormSuccess . Map.fromList . zip [maybe 0 succ . fmap fst $ Map.lookupMax oldDat ..] $ Set.toList newDat addView' = $(widgetFile "course/lecturerMassInput/add") return (addRes'', addView') @@ -149,7 +146,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB return (Just <$> lrwRes,lrwView') miCell _ (Left lEmail) defType nudge = \csrf -> do (lrwRes,lrwView) <- mopt (selectField optionsFinite) ("" & addName (nudge "lecturer-type")) defType - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning let lrwView' = $(widgetFile "course/lecturerMassInput/cellInvitation") return (lrwRes,lrwView') diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 36add3547..61a4316f9 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -131,7 +131,7 @@ postCAddUserR tid ssh csh = do mbGrp <- wopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing mr <- getMessageRender - users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing) + users <- wreq (multiUserInvitationField . maybe MUIAlwaysInvite (const $ MUILookupAnyUser Nothing) $ formResultToMaybe enlist) (fslpI MsgCourseParticipantInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing return $ Map.fromSet . const <$> mbGrp <*> users diff --git a/src/Handler/Exam/AddUser.hs b/src/Handler/Exam/AddUser.hs index f69219f9c..aeef1facc 100644 --- a/src/Handler/Exam/AddUser.hs +++ b/src/Handler/Exam/AddUser.hs @@ -71,7 +71,7 @@ postEAddUserR tid ssh csh examn = do registerCourse <- wpopt checkBoxField (fslI MsgExamRegistrationRegisterCourse & setTooltip MsgExamRegistrationRegisterCourseTip) (Just False) occurrence <- wopt (examOccurrenceField eid) (fslI MsgExamOccurrence) Nothing mr <- getMessageRender - users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing) + users <- wreq (multiUserInvitationField . maybe MUIAlwaysInvite (const $ MUILookupAnyUser Nothing) $ formResultToMaybe enlist) (fslpI MsgExamRegistrationInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing return $ (,,,) <$> deadline <*> registerCourse <*> occurrence <*> users diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 742fdcdab..c43706c03 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -114,7 +114,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge submitView csrf = do - (addRes, addView) <- mpreq (multiUserField False $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let addRes' | otherwise @@ -138,7 +138,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do miCell' :: Either UserEmail UserId -> Widget miCell' (Left email) = do - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning $(widgetFile "widgets/massinput/examCorrectors/cellInvitation") miCell' (Right userId) = do User{..} <- liftHandler . runDB $ get404 userId diff --git a/src/Handler/ExamOffice/Users.hs b/src/Handler/ExamOffice/Users.hs index 9071b269f..4ec34607b 100644 --- a/src/Handler/ExamOffice/Users.hs +++ b/src/Handler/ExamOffice/Users.hs @@ -95,7 +95,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge btn csrf = do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let res' :: FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) res' = addRes <&> \newUsers oldUsers -> if @@ -106,7 +106,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do return (res', $(widgetFile "widgets/massinput/examOfficeUsers/add")) miCell' :: Either UserEmail UserId -> Widget miCell' (Left email) = do - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning $(widgetFile "widgets/massinput/examOfficeUsers/cellInvitation") miCell' (Right uid) = do User{..} <- liftHandler . runDB $ getJust uid diff --git a/src/Handler/ExternalExam/Form.hs b/src/Handler/ExternalExam/Form.hs index 5025e9472..4b7ec6eb7 100644 --- a/src/Handler/ExternalExam/Form.hs +++ b/src/Handler/ExternalExam/Form.hs @@ -76,7 +76,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do where miAdd mkUnique submitView csrf = do MsgRenderer mr <- getMsgRenderer - (usersRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (usersRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let usersRes' = usersRes <&> \newDat oldDat -> if | existing <- newDat `Set.intersection` Set.fromList oldDat @@ -86,7 +86,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do -> FormSuccess $ Set.toList newDat return (usersRes', $(widgetFile "external-exam/staffMassInput/add")) miCell (Left email) = do - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning $(widgetFile "external-exam/staffMassInput/cellInvitation") miCell (Right userId) = do User{..} <- liftHandler . runDB $ getJust userId diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 83bee772d..52454e757 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -745,7 +745,7 @@ correctorForm loads' = wFormToAForm $ do -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) miAdd _ _ nudge submitView = Just $ \csrf -> do - (addRes, addView) <- mpreq (multiUserField False $ Just previousCorrectors) (fslpI MsgCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just previousCorrectors) (fslpI MsgCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing let addRes' = addRes <&> \nCorrs oldData@(maybe 0 (succ . fst) . Map.lookupMax -> kStart) -> if | existing <- Set.intersection nCorrs . Set.fromList $ Map.elems oldData , not $ null existing @@ -774,7 +774,7 @@ correctorForm loads' = wFormToAForm $ do Right uid -> do User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ getJust uid return $ nameEmailWidget userEmail userDisplayName userSurname - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning return (res, $(widgetFile "sheetCorrectors/cell")) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index ce9d657bb..75bbcdd13 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -131,7 +131,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident where miCell' :: Markup -> Either UserEmail UserId -> Widget miCell' csrf (Left email) = do - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail $ if + | isLecturer -> MsgEmailInvitationWarningCourseParticipants + | otherwise -> MsgEmailInvitationWarningPrevCoSubmittors $(widgetFile "widgets/massinput/submissionUsers/cellInvitation") miCell' csrf (Right uid) = do User{..} <- liftHandler . runDB $ getJust uid @@ -174,9 +176,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident addField, addFieldLecturer :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId)) addField = addField' False addFieldLecturer = addField' True - addField' isAdmin uid = multiUserField True . Just $ if - | isAdmin -> courseUsers - | otherwise -> previousCoSubmittors uid + addField' isAdmin uid + | isAdmin = multiUserInvitationField $ MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationCourseParticipants) courseUsers + | otherwise = multiUserInvitationField . MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationPrevCoSubmittors) $ previousCoSubmittors uid addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail @@ -282,8 +284,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident | otherwise -> Set.insert (Right uid) $ Set.take (pred $ fromIntegral maxSize') resultUsers' | otherwise = Set.singleton $ Right uid where resultUsers = setOf (folded . _1) valMap - when (maxSize > Just 1) $ - wformMessage =<< messageI Info MsgCosubmittorTip + -- when (maxSize > Just 1) $ + -- wformMessage =<< messageI Info MsgCosubmittorTip fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers) diff --git a/src/Handler/Tutorial/Form.hs b/src/Handler/Tutorial/Form.hs index 5147c0bee..7c2f7db46 100644 --- a/src/Handler/Tutorial/Form.hs +++ b/src/Handler/Tutorial/Form.hs @@ -40,7 +40,7 @@ tutorialForm cid template html = do where miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge submitView csrf = do - (addRes, addView) <- mpreq (multiUserField False . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let addRes' | otherwise @@ -55,7 +55,7 @@ tutorialForm cid template html = do miCell' :: Either UserEmail UserId -> Widget miCell' (Left email) = do - invWarnMsg <- messageI Warning MsgEmailInvitationWarning + invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning $(widgetFile "tutorial/tutorMassInput/cellInvitation") miCell' (Right userId) = do User{..} <- liftHandler . runDB $ get404 userId diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 94c577d8f..88560a5c3 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -127,7 +127,7 @@ commR CommunicationRoute{..} = do recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients') where miAdd (EnumPosition RecipientCustom, 0) 1 nudge submitView = Just $ \csrf -> do - (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgEMail (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "email")) Nothing + (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgEMail (mr MsgEMail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "email")) Nothing let addRes' = addRes <&> \(Set.toList -> nEmails) (maybe 0 (succ . snd . fst) . Map.lookupMax . Map.filterWithKey (\(EnumPosition c, _) _ -> c == RecipientCustom) -> kStart) -> FormSuccess . Map.fromList $ zip (map (EnumPosition RecipientCustom, ) [kStart..]) nEmails return (addRes', $(widgetFile "widgets/communication/recipientAdd")) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index ed8395922..7133be3ba 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1461,35 +1461,54 @@ formResultModal res finalDest handler = maybeT_ $ do forM_ messages $ \Message{..} -> addMessage messageStatus messageContent redirect finalDest -userMatriculationField :: forall m. - ( MonadHandler m - , HandlerSite m ~ UniWorX - ) - => Field m [Entity User] -userMatriculationField = Field{..} - where - fieldEnctype = UrlEncoded - fieldView theId name attrs val isReq = do - let val' = val <&> Text.intercalate ", " . mapMaybe (userMatrikelnummer . entityVal) - [whamlet| - $newline never - - |] - fieldParse (all Text.null -> True) _ = return $ Right Nothing - fieldParse ts _ = runExceptT . fmap Just $ do - let ts' = concatMap (Text.splitOn ",") ts - forM ts' $ \matr -> do - dbRes <- liftHandler . runDB . E.select . E.from $ \user -> do - E.where_ $ E.strip (user E.^. UserMatrikelnummer) `E.ciEq` E.just (E.val $ Text.strip matr) - return user - case dbRes of - [user] - -> return user - [] - -> throwE . SomeMessage $ MsgUserMatriculationNotFound matr - _other - -> throwE . SomeMessage $ MsgUserMatriculationAmbiguous matr +data MultiUserInvitationMode + = MUIAlwaysInvite + | MUILookupAnyUser (Maybe (E.SqlQuery (E.SqlExpr (Entity User)))) + | MUILookupSuggested (SomeMessage UniWorX) (E.SqlQuery (E.SqlExpr (Entity User))) + + +multiUserInvitationField :: forall m. + ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => MultiUserInvitationMode + -> Field m (Set (Either UserEmail UserId)) +multiUserInvitationField mode + = baseField + { fieldView = \theId name attrs val isReq -> + [whamlet| + $newline never +
+ ^{fieldView baseField theId name attrs val isReq} +

+ ^{explanation} + |] + } + where + (onlySuggested, suggestions) = case mode of + MUIAlwaysInvite -> (True , Nothing) + MUILookupAnyUser ms -> (False, ms ) + MUILookupSuggested _ s -> (True , Just s ) + baseField = multiUserField onlySuggested suggestions + + explanation + | MUILookupSuggested suggestExplain _ <- mode + = [whamlet| + $newline never + _{suggestExplain} +
+ _{MsgMultiUserFieldInvitationExplanation} + |] + | onlySuggested + = i18n MsgMultiUserFieldInvitationExplanationAlways + | otherwise + = [whamlet| + $newline never + _{MsgMultiUserFieldExplanationAnyUser} +
+ _{MsgMultiUserFieldInvitationExplanation} + |] multiUserField :: forall m. ( MonadHandler m