feat(multi-user-field): multi-user-invitation-field
This commit is contained in:
Gregor Kleen
parent
859ae5eea1
commit
c072b85299
@ -1358,3 +1358,6 @@ a.breadcrumbs__home
|
||||
|
||||
&:hover
|
||||
opacity: 1
|
||||
|
||||
.multi-user-invitation-field__wrapper
|
||||
max-width: 25rem
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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')
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"))
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"))
|
||||
|
||||
@ -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
|
||||
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val'}">
|
||||
|]
|
||||
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
|
||||
<div .multi-user-invitation-field__wrapper>
|
||||
^{fieldView baseField theId name attrs val isReq}
|
||||
<p .multi-user-invitation-field__explanation .explanation>
|
||||
^{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}
|
||||
<br />
|
||||
_{MsgMultiUserFieldInvitationExplanation}
|
||||
|]
|
||||
| onlySuggested
|
||||
= i18n MsgMultiUserFieldInvitationExplanationAlways
|
||||
| otherwise
|
||||
= [whamlet|
|
||||
$newline never
|
||||
_{MsgMultiUserFieldExplanationAnyUser}
|
||||
<br />
|
||||
_{MsgMultiUserFieldInvitationExplanation}
|
||||
|]
|
||||
|
||||
multiUserField :: forall m.
|
||||
( MonadHandler m
|
||||
|
||||
Loading…
Reference in New Issue
Block a user