feat(multi-user-field): improve placeholder

Remove MassInputTip

messages/uniworx/de-de-formal.msg

@@ -2149,7 +2149,7 @@ ExamOfficeFieldForced: Forcierte Einsicht
 InvalidExamOfficeFieldMode parseErr@Text: Konnte „#{parseErr}“ nicht interpretieren
 
 LdapIdentification: Campus-Kennung
-LdapIdentificationOrEmail: Campus-Kennung/E-Mail Addresse
+LdapIdentificationOrEmail: Campus-Kennung / E-Mail Addresse
 AdminUserTitle: Titel
 AdminUserFirstName: Vorname
 AdminUserSurname: Nachname

src/Database/Esqueleto/Utils.hs

@@ -200,6 +200,8 @@ lower = E.unsafeSqlFunction "LOWER"
 strip :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
 strip = E.unsafeSqlFunction "TRIM"
 
+infix 4 `ciEq`
+  
 ciEq :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
 ciEq a b = lower a E.==. lower b
 

src/Handler/Admin/Tokens.hs

@@ -29,9 +29,10 @@ data BearerTokenForm = BearerTokenForm
 bearerTokenForm :: WForm Handler (FormResult BearerTokenForm)
 bearerTokenForm = do
   muid <- maybeAuthId
+  mr <- getMessageRender
   
   btfAuthorityGroups <- aFormToWForm $ HashSet.fromList . map Left <$> massInputListA pathPieceField (const "") (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-groups" :: Text) (fslI MsgBearerTokenAuthorityGroups & setTooltip MsgBearerTokenAuthorityGroupsTip) False Nothing
-  btfAuthorityUsers <- fmap (fmap . ofoldMap $ HashSet.singleton . Right) <$> wopt (checkMap (foldMapM $ fmap Set.singleton . left MsgBearerTokenAuthorityUnknownUser) (Set.map Right) $ multiUserField False Nothing) (fslI MsgBearerTokenAuthorityUsers & setTooltip MsgBearerTokenAuthorityUsersTip) (Just $ Set.singleton <$> muid)
+  btfAuthorityUsers <- fmap (fmap . ofoldMap $ HashSet.singleton . Right) <$> wopt (checkMap (foldMapM $ fmap Set.singleton . left MsgBearerTokenAuthorityUnknownUser) (Set.map Right) $ multiUserField False Nothing) (fslpI MsgBearerTokenAuthorityUsers (mr MsgLdapIdentificationOrEmail) & setTooltip MsgBearerTokenAuthorityUsersTip) (Just $ Set.singleton <$> muid)
   let btfAuthority' :: FormResult (HashSet (Either UserGroupName UserId))
       btfAuthority'
         = (<>) <$> btfAuthorityGroups <*> ((hoistMaybe =<< btfAuthorityUsers) <|> pure HashSet.empty)

src/Handler/Course/Edit.hs

@@ -179,7 +179,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
         lecturerForm :: AForm Handler [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)]
         lecturerForm = formToAForm . over (mapped._2) pure . over (mapped._1.mapped) (map liftEither . Map.elems) $ massInput
                 MassInput{..}
-                (fslI MsgCourseLecturers & setTooltip (UniWorXMessages [SomeMessage MsgCourseLecturerRightsIdentical, SomeMessage MsgMassInputTip]))
+                (fslI MsgCourseLecturers & setTooltip MsgCourseLecturerRightsIdentical)
                 True
                 (Just . Map.fromList . zip [0..] $ maybe [(Right uid, Just CourseLecturer)] (map unliftEither . cfLecturers) template)
                 mempty

src/Handler/Course/ParticipantInvite.hs

@@ -130,8 +130,9 @@ postCAddUserR tid ssh csh = do
       let submissionGroupOpts = optionsPersist [SubmissionGroupCourse ==. cid] [Asc SubmissionGroupName] submissionGroupName <&> fmap (submissionGroupName . entityVal)
       mbGrp <- wopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
 
+      mr <- getMessageRender
       users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing)
-                 (fslI MsgCourseParticipantInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+                 (fslpI MsgCourseParticipantInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing
 
       return $ Map.fromSet . const <$> mbGrp <*> users
 

src/Handler/Exam/AddUser.hs

@@ -70,8 +70,9 @@ postEAddUserR tid ssh csh examn = do
       enlist <- wpopt checkBoxField (fslI MsgExamRegistrationEnlistDirectly & setTooltip MsgExamRegistrationEnlistDirectlyTip) (Just False)
       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)
-        (fslI MsgExamRegistrationInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+        (fslpI MsgExamRegistrationInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing
       return $ (,,,) <$> deadline <*> registerCourse <*> occurrence <*> users
 
     formResultModal usersToEnlist (CExamR tid ssh csh examn EUsersR) $ processUsers eEnt

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")) Nothing
+      (addRes, addView) <- mpreq (multiUserField False $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
       let
         addRes'
           | otherwise
@@ -147,7 +147,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
     miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()
     miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/examCorrectors/layout")
 
-  fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip (uniworxMessages [MsgExamCorrectorsTip, MsgMassInputTip])) False (Set.toList <$> mPrev)
+  fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' ("correctors" :: Text) (fslI MsgExamCorrectors & setTooltip MsgExamCorrectorsTip) False (Set.toList <$> mPrev)
 
 examOccurrenceForm :: Maybe (Set ExamOccurrenceForm) -> AForm Handler (Set ExamOccurrenceForm)
 examOccurrenceForm prev = wFormToAForm $ do
@@ -156,7 +156,7 @@ examOccurrenceForm prev = wFormToAForm $ do
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
 
-  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
+  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences) False $ Set.toList <$> prev
   where
     examOccurrenceForm' nudge mPrev csrf = do
       (eofIdRes, eofIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ eofId =<< mPrev)
@@ -198,7 +198,7 @@ examPartsForm prev = wFormToAForm $ do
     miButtonAction' :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
     miButtonAction' frag = Just . SomeRoute $ currentRoute :#: frag
 
-  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts & setTooltip MsgMassInputTip) False $ Set.toList <$> prev
+  fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts) False $ Set.toList <$> prev
   where
     examPartForm' nudge mPrev csrf = do
       (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)

src/Handler/ExternalExam/Form.hs

@@ -70,13 +70,13 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
         miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/schoolMassInput/layout")
         miIdent :: Text
         miIdent = "external-exams-school"
-        fSettings = fslI MsgExternalExamExamOfficeSchools & setTooltip (UniWorXMessages [SomeMessage MsgExternalExamExamOfficeSchoolsTip, SomeMessage MsgMassInputTip])
+        fSettings = fslI MsgExternalExamExamOfficeSchools & setTooltip MsgExternalExamExamOfficeSchoolsTip
         fRequired = False
     staffForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired
       where
         miAdd mkUnique submitView csrf = do
           MsgRenderer mr <- getMsgRenderer
-          (usersRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (mkUnique "email")) Nothing
+          (usersRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
           let
             usersRes' = usersRes <&> \newDat oldDat -> if
               | existing <- newDat `Set.intersection` Set.fromList oldDat
@@ -97,7 +97,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
         miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/staffMassInput/layout")
         miIdent :: Text
         miIdent = "external-exams-staff"
-        fSettings = fslI MsgExternalExamStaff & setTooltip (UniWorXMessages [SomeMessage MsgExternalExamStaffTip, SomeMessage MsgMassInputTip])
+        fSettings = fslI MsgExternalExamStaff & setTooltip MsgExternalExamStaffTip
         fRequired = True
 
 validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExternalExamForm m ()

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 MsgEMail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing
+      (addRes, addView) <- mpreq (multiUserField False $ 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
@@ -821,7 +821,7 @@ correctorForm loads' = wFormToAForm $ do
     filledData :: Maybe (Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)))
     filledData = Just . Map.fromList . zip [0..] $ Map.toList loads -- TODO orderBy Name?!
 
-  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) False filledData
+  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors) False filledData
 
 
 instance IsInvitableJunction SheetCorrector where

src/Handler/Submission.hs

@@ -178,9 +178,10 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
       | isAdmin   -> courseUsers
       | otherwise -> previousCoSubmittors uid
 
-    addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX
+    addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX
-    addFieldSettings  = fslI MsgSubmissionMembers
+    addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail
-    submittorSettings = fslI MsgSubmissionMembers & setTooltip MsgMassInputTip
+    submittorSettings, singleSubSettings :: FieldSettings UniWorX
+    submittorSettings = fslI MsgSubmissionMembers
     singleSubSettings = fslI MsgSubmissionMember
 
     maxSize | Arbitrary{..} <- grouping = Just maxParticipants
@@ -201,7 +202,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
           miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
           miAdd nudge btn csrf = do
             MsgRenderer mr <- getMsgRenderer
-            (addRes, addView) <- mpreq (addFieldLecturer uid) (addFieldSettings & addName (nudge "emails")) Nothing
+            (addRes, addView) <- mpreq (addFieldLecturer uid) (addFieldSettings mr & addName (nudge "emails")) Nothing
             let addRes' = addRes <&> \newData oldData -> if
                   | existing <- newData `Set.intersection` Set.fromList oldData
                   , not $ Set.null existing
@@ -228,7 +229,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
                 -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
           miAdd _ _ nudge btn = Just $ \csrf -> do
             MsgRenderer mr <- getMsgRenderer
-            (addRes, addView) <- mpreq (addField uid) (addFieldSettings & addName (nudge "emails")) Nothing
+            (addRes, addView) <- mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing
             let addRes' = addRes <&> \newData oldData -> if
                   | existing <- newData `Set.intersection` setOf folded oldData
                   , not $ Set.null existing

src/Handler/Term.hs

@@ -245,7 +245,7 @@ newTermForm template = validateForm validateTerm $ \html -> do
         (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder))
         (const Nothing)
         ("holidays" :: Text)
-        (fslI MsgTermHolidays & setTooltip MsgMassInputTip)
+        (fslI MsgTermHolidays)
         True
         (tftHolidays template)
     flip (renderAForm FormStandard) html $ Term

src/Handler/Tutorial/Form.hs

@@ -36,11 +36,11 @@ tutorialForm cid template html = do
   uid <- liftHandler requireAuthId
 
   let
-    tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' ("tutors" :: Text) (fslI MsgTutorialTutors & setTooltip MsgMassInputTip) False (Set.toList . tfTutors <$> template)
+    tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' ("tutors" :: Text) (fslI MsgTutorialTutors) False (Set.toList . tfTutors <$> template)
       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")) Nothing
+          (addRes, addView) <- mpreq (multiUserField False . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
           let
             addRes'
               | otherwise

src/Handler/Users.hs

@@ -613,10 +613,12 @@ postAdminNewFunctionaryInviteR = do
         _other           -> UTCTime (utctDay now) 0
       defDeadline = beginToday{ utctDay = 14 `addDays` utctDay beginToday }
 
+    mr <- getMessageRender
+
     function <- wreq (selectField optionsFinite) (fslI MsgFunctionaryInviteFunction) Nothing
     school   <- wreq (schoolFieldFor $ map E.unValue userSchools) (fslI MsgFunctionaryInviteSchool) Nothing
     deadline <- wreq utcTimeField (fslI MsgExamRegistrationInviteDeadline) (Just defDeadline)
-    users    <- wreq (multiUserField False Nothing) (fslI MsgFunctionaryInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+    users    <- wreq (multiUserField False Nothing) (fslpI MsgFunctionaryInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing
     return $ (,,,) <$> function <*> school <*> deadline <*> users
 
   formResultModal invitesResult UsersR $ \(function, schoolId, deadline, users) -> do

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 MsgEMail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "email")) Nothing
+            (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgEMail (mr MsgLdapIdentificationOrEmail) & 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"))

src/Handler/Utils/Form.hs

@@ -610,7 +610,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
             currentRoute <- currentRoute'
             return . SomeRoute $ currentRoute :#: frag
       miIdent <- ("specific-files--" <>) <$> newIdent
-      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles & setTooltip MsgMassInputTip) True (preProcess <$> prev ^? _Just . _specificFiles)
+      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles) True (preProcess <$> prev ^? _Just . _specificFiles)
       where
         preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
         preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
@@ -1529,7 +1529,15 @@ multiUserField onlySuggested suggestions = Field{..}
       whenIsJust suggestions $ \suggestions' -> do
         suggestedEmails <- fmap (Map.assocs . Map.fromListWith min . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do
           user <- suggestions'
-          return $ (user E.^. UserEmail, user E.^. UserDisplayName)
+          return $ ( E.case_
+                       [ E.when_ (unique UserDisplayEmail user)
+                         E.then_ (user E.^. UserDisplayEmail)
+                       , E.when_ (unique UserEmail user)
+                         E.then_ (user E.^. UserEmail)
+                       ]
+                       ( E.else_ $ user E.^. UserIdent)
+                   , user E.^. UserDisplayName
+                   )
         [whamlet|
           $newline never
           <datalist id=#{datalistId}>
@@ -1546,7 +1554,13 @@ multiUserField onlySuggested suggestions = Field{..}
         Just lookupExpr' -> do
             dbRes <- fmap (setOf $ folded . _Value). liftHandler . runDB . E.select $ do
               user <- lookupExpr'
-              E.where_ $ user E.^. UserEmail E.==. E.val email
+              E.where_ $ user E.^. UserIdent `E.ciEq` E.val email
+                   E.||. (       user E.^. UserDisplayEmail `E.ciEq` E.val email
+                           E.&&. unique UserDisplayEmail user
+                         )
+                   E.||. (       user E.^. UserEmail `E.ciEq` E.val email
+                           E.&&. unique UserEmail user
+                         )
               return $ user E.^. UserId
             if | Set.null dbRes
                  -> return $ Left email
@@ -1555,6 +1569,16 @@ multiUserField onlySuggested suggestions = Field{..}
                | otherwise
                  -> throwE $ SomeMessage MsgAmbiguousEmail
 
+    unique field user = case lookupExpr of
+      Just lookupExpr' -> E.not_ . E.exists $ do
+        user' <- lookupExpr'
+        E.where_ $ user' E.^. UserId E.!=. user E.^. UserId
+             E.&&. (       user' E.^. UserIdent        `E.ciEq` user E.^. field
+                     E.||. user' E.^. UserEmail        `E.ciEq` user E.^. field
+                     E.||. user' E.^. UserDisplayEmail `E.ciEq` user E.^. field
+                   )
+      Nothing -> E.true
+
 examResultField :: forall m res.
                    ( MonadHandler m
                    , HandlerSite m ~ UniWorX

src/Handler/Utils/Form/Occurrences.hs

@@ -44,7 +44,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
       (\p -> Just . SomeRoute $ cRoute :#: p)
       miLayout'
       (miIdent' <> "__scheduled" :: Text)
-      (fslI MsgScheduleRegular & setTooltip MsgMassInputTip)
+      (fslI MsgScheduleRegular)
       False
       (Set.toList . occurrencesScheduled <$> mPrev)
       where
@@ -80,7 +80,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
       (\p -> Just . SomeRoute $ cRoute :#: p)
       miLayout'
       (miIdent' <> "__exceptions" :: Text)
-      (fslI MsgScheduleExceptions & setTooltip (UniWorXMessages [SomeMessage MsgScheduleExceptionsTip, SomeMessage MsgMassInputTip]))
+      (fslI MsgScheduleExceptions & setTooltip MsgScheduleExceptionsTip)
       False
       (Set.toList . occurrencesExceptions <$> mPrev)
       where