diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 6df8a8afa..c82d1bb8e 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -776,6 +776,9 @@ section .allocation__courses margin: 20px 0 0 40px + .form-group__input > & + margin: 0 + .allocation-course display: grid grid-template-columns: minmax(105px, 1fr) 9fr diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 0aa58cc7c..14e103f49 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1375,6 +1375,7 @@ MenuAllocationUsers: Bewerber MenuAllocationPriorities: Zentrale Dringlichkeiten MenuAllocationCompute: Platzvergabe berechnen MenuAllocationAccept: Platzvergabe akzeptieren +MenuAllocationAddUser: Bewerber hinzufügen MenuFaq: FAQ MenuSheetPersonalisedFiles: Personalisierte Dateien herunterladen MenuCourseSheetPersonalisedFiles: Vorlage für personalisierte Übungsblatt-Dateien herunterladen @@ -1449,6 +1450,7 @@ BreadcrumbAllocationUsers: Bewerber BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten BreadcrumbAllocationCompute: Platzvergabe berechnen BreadcrumbAllocationAccept: Platzvergabe akzeptieren +BreadcrumbAllocationAddUser: Bewerber hinzufügen BreadcrumbMessageHide: Verstecken BreadcrumbFaq: FAQ BreadcrumbSheetPersonalisedFiles: Personalisierte Dateien herunterladen @@ -2707,12 +2709,34 @@ AllocationUsersCsvName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCa AllocationPrioritiesMode: Modus AllocationPrioritiesNumeric: Numerische Dringlichkeiten AllocationPrioritiesOrdinal: Dringlichkeiten durch Sortierung +AllocationPriorityNumeric': Numerisch +AllocationPriorityOrdinal': Nach Sortierung +AllocationPriorityNumericValues: Numerische Werte +AllocationPriorityNumericValuesTip: Komma-separierte ganze Zahlen +AllocationPriorityNumericNoValues: Es wurden keine numerischen Werte angegeben +AllocationPriorityNumericNoParse val@Text: Ganze Zahl konnte nicht geparst werden: „#{val}“ +AllocationPriorityOrdinalValueNegative: Sortier-Index darf nicht negativ sein +AllocationPriorityOrdinalValue: Sortier-Index +AllocationPriorityOrdinalValueTip: Null entspricht dem ersten Eintrag der Liste, höhere Indizes entsprechen später in der sortierten Liste vorkommenden Bewerbern und damit einer höheren Dringlichkeit AllocationPrioritiesTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Zentrale Dringlichkeiten AllocationPrioritiesFile: CSV-Datei AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt AllocationPrioritiesMissing num@Int64: Für #{num} Bewerber ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"} AllocationMissingPrioritiesIgnored: Bewerber, für die keine zentrale Priorität angegeben wird, werden bei der Vergabe ignoriert! +AllocationAddUserUserNotFound: E-Mail Adresse konnte keinem Benutzer zugeordnet werden +AllocationAddUserUser: Benutzer +AllocationAddUserUserPlaceholder: E-Mail +AllocationAddUserTotalCoursesLessThanOne: Anzahl angefragter Plätze muss größer null sein +AllocationAddUserTotalCourses: Angefragte Plätze +AllocationAddUserSetPriority: Zentrale Dringlichkeit eintragen? +AllocationAddUserPriority: Zentrale Dringlichkeit +AllocationAddUserApplications: Bewerbungen/Bewertungen +AllocationAddUserTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'} - #{allocation}: Bewerber hinzufügen +AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Bewerber hinzufügen +AllocationAddUserUserAdded: Bewerber erfolgreich zur Zentralanmeldung hinzugefügt +AllocationAddUserUserExists: Der angegebene Benutzer ist bereits ein Bewerber zur Zentralanmeldung + ExampleUser1FirstName: Max ZweiterName ExampleUser1Surname: Mustermann ExampleUser1DisplayName: Max Mustermann diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index b493635d6..fa8496197 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1375,6 +1375,7 @@ MenuAllocationUsers: Applicants MenuAllocationPriorities: Central priorities MenuAllocationCompute: Compute allocation MenuAllocationAccept: Accept allocation +MenuAllocationAddUser: Add applicant MenuFaq: FAQ MenuSheetPersonalisedFiles: Download personalised sheet files MenuCourseSheetPersonalisedFiles: Download template for personalised sheet files @@ -1449,6 +1450,7 @@ BreadcrumbAllocationUsers: Applicants BreadcrumbAllocationPriorities: Central priorities BreadcrumbAllocationCompute: Compute allocation BreadcrumbAllocationAccept: Accept allocation +BreadcrumbAllocationAddUser: Add applicant BreadcrumbMessageHide: Hide BreadcrumbFaq: FAQ BreadcrumbSheetPersonalisedFiles: Download personalised sheet files @@ -2707,12 +2709,34 @@ AllocationUsersCsvName tid ssh ash: #{foldCase (termToText (unTermKey tid))}-#{f AllocationPrioritiesMode: Mode AllocationPrioritiesNumeric: Numeric priorities AllocationPrioritiesOrdinal: Priorities based on sorted list +AllocationPriorityNumeric': Numerical +AllocationPriorityOrdinal': Based on sorted list +AllocationPriorityNumericValues: Numerical values +AllocationPriorityNumericValuesTip: Comma separated whole numbers +AllocationPriorityNumericNoValues: No numerical values were provided +AllocationPriorityNumericNoParse val: Whole number could not be parsed: “#{val}” +AllocationPriorityOrdinalValueNegative: Sorting index may not be negative +AllocationPriorityOrdinalValue: Sorting index +AllocationPriorityOrdinalValueTip: Zero corresponds to the first entry in the list; higher indices correspond to applicants occurring later in the sorted list and thus to higher central priorities AllocationPrioritiesTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Central priorities AllocationPrioritiesFile: CSV file AllocationPrioritiesSunk num: Successfully registered central priorities for #{num} #{pluralEN num "applicant" "applicants"} AllocationPrioritiesMissing num: Could not register central priorities for #{num} #{pluralEN num "applicant" "applicants"} because their matriculation was not found in the uploaded CSV file AllocationMissingPrioritiesIgnored: Applicants for whom no central priority has been registered will be ignored during assignment! +AllocationAddUserUserNotFound: Email could not be resolved to an user +AllocationAddUserUser: User +AllocationAddUserUserPlaceholder: Email +AllocationAddUserTotalCoursesLessThanOne: Number of requested courses needs to be greater than zero +AllocationAddUserTotalCourses: Requested courses +AllocationAddUserSetPriority: Set central priority? +AllocationAddUserPriority: Central priority +AllocationAddUserApplications: Applications/Ratings +AllocationAddUserTitle termText ssh' allocation: #{termText} - #{ssh'} - #{allocation}: Add applicant +AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Add applicant +AllocationAddUserUserAdded: Successfully added applicant to central allocation +AllocationAddUserUserExists: The specified user is already an applicant for the central allocation + ExampleUser1FirstName: Max SecondName ExampleUser1Surname: Mustermann ExampleUser1DisplayName: Max Mustermann diff --git a/routes b/routes index 6a60ab694..7658aa6ce 100644 --- a/routes +++ b/routes @@ -113,6 +113,7 @@ /register ARegisterR POST !time /course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered /users AUsersR GET POST !allocation-admin + /users/add AAddUserR GET POST !allocation-admin /priorities APriosR GET POST !allocation-admin /compute AComputeR GET POST !allocation-admin /accept AAcceptR GET POST !allocation-admin diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index f1e8281c1..99fc523e8 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -159,6 +159,7 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where APriosR -> i18nCrumb MsgBreadcrumbAllocationPriorities . Just $ AllocationR tid ssh ash AUsersR AComputeR -> i18nCrumb MsgBreadcrumbAllocationCompute . Just $ AllocationR tid ssh ash AUsersR AAcceptR -> i18nCrumb MsgBreadcrumbAllocationAccept . Just $ AllocationR tid ssh ash AUsersR + AAddUserR -> i18nCrumb MsgBreadcrumbAllocationAddUser . Just $ AllocationR tid ssh ash AUsersR breadcrumb ParticipantsListR = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR breadcrumb (ParticipantsR _ _) = i18nCrumb MsgBreadcrumbParticipants $ Just ParticipantsListR @@ -1332,6 +1333,17 @@ pageActions (AllocationR tid ssh ash AUsersR) = return } , navChildren = [] } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuAllocationAddUser + , navRoute = AllocationR tid ssh ash AAddUserR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } ] pageActions CourseListR = do participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs index 5162e86a5..088af6f42 100644 --- a/src/Handler/Allocation.hs +++ b/src/Handler/Allocation.hs @@ -8,6 +8,7 @@ import Handler.Allocation.Application as Handler.Allocation import Handler.Allocation.Register as Handler.Allocation import Handler.Allocation.List as Handler.Allocation import Handler.Allocation.Users as Handler.Allocation +import Handler.Allocation.AddUser as Handler.Allocation import Handler.Allocation.Prios as Handler.Allocation import Handler.Allocation.Compute as Handler.Allocation import Handler.Allocation.Accept as Handler.Allocation diff --git a/src/Handler/Allocation/AddUser.hs b/src/Handler/Allocation/AddUser.hs new file mode 100644 index 000000000..1eb83e59d --- /dev/null +++ b/src/Handler/Allocation/AddUser.hs @@ -0,0 +1,162 @@ +module Handler.Allocation.AddUser + ( getAAddUserR, postAAddUserR + ) where + +import Import +import Handler.Allocation.Application + +import Handler.Utils + +import qualified Data.Map as Map + +import qualified Data.Conduit.Combinators as C + +import qualified Database.Esqueleto as E + + +data AllocationAddUserForm = AllocationAddUserForm + { aauUser :: UserId + , aauTotalCourses :: Natural + , aauPriority :: Maybe AllocationPriority + , aauApplications :: Map CourseId ApplicationForm + } + + +getAAddUserR, postAAddUserR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html +getAAddUserR = postAAddUserR +postAAddUserR tid ssh ash = do + (Entity _ Allocation{..}, (addUserAct, addUserForm, addUserEnctype)) <- runDB $ do + alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash + allocCourses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse) -> do + E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId + E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId + return ( course + , E.exists . E.from $ \courseAppInstructionFile -> + E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId + ) + + MsgRenderer mr <- getMsgRenderer + ((addUserRes, addUserForm), addUserEnctype) <- liftHandler . runFormPost . renderAForm FormStandard $ AllocationAddUserForm + <$> areq (checkMap (first $ const MsgAllocationAddUserUserNotFound) Right $ userField False Nothing) (fslpI MsgAllocationAddUserUser (mr MsgAllocationAddUserUserPlaceholder)) Nothing + <*> areq (posIntFieldI MsgAllocationAddUserTotalCoursesLessThanOne) (fslI MsgAllocationAddUserTotalCourses) (Just 1) + <*> optionalActionA (allocationPriorityForm (fslI MsgAllocationAddUserPriority) Nothing) (fslI MsgAllocationAddUserSetPriority) (Just True) + <*> allocationApplicationsForm aId (Map.fromList [ (cId, (course, hasTemplate)) | (Entity cId course, E.Value hasTemplate) <- allocCourses ]) (fslI MsgAllocationAddUserApplications) False + + addUserAct <- formResultMaybe addUserRes $ \AllocationAddUserForm{..} -> Just <$> do + now <- liftIO getCurrentTime + + didInsert <- is _Just <$> insertUnique AllocationUser + { allocationUserAllocation = aId + , allocationUserUser = aauUser + , allocationUserTotalCourses = aauTotalCourses + , allocationUserPriority = aauPriority + } + + if + | didInsert -> do + oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] [] + forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do + delete appId + unless (courseApplicationCourse `Map.member` aauApplications) $ + audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId + + iforM_ aauApplications $ \cId ApplicationForm{..} -> maybeT (return ()) $ do + prio <- hoistMaybe afPriority + let rated = afRatingVeto || is _Just afRatingPoints + appId <- lift $ insert CourseApplication + { courseApplicationCourse = cId + , courseApplicationUser = aauUser + , courseApplicationText = afText + , courseApplicationRatingVeto = afRatingVeto + , courseApplicationRatingPoints = afRatingPoints + , courseApplicationRatingComment = afRatingComment + , courseApplicationAllocation = Just aId + , courseApplicationAllocationPriority = Just prio + , courseApplicationTime = now + , courseApplicationRatingTime = guardOn rated now + } + lift . runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId)) + lift . audit $ TransactionCourseApplicationEdit cId aauUser appId + + return $ do + addMessageI Success MsgAllocationAddUserUserAdded + redirect $ AllocationR tid ssh ash AAddUserR + | otherwise -> return $ addMessageI Error MsgAllocationAddUserUserExists + + return (alloc, (addUserAct, addUserForm, addUserEnctype)) + + sequence_ addUserAct + + MsgRenderer mr <- getMsgRenderer + let title = MsgAllocationAddUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName + shortTitle = MsgAllocationAddUserShortTitle allocationTerm allocationSchool allocationShorthand + + siteLayoutMsg title $ do + setTitleI shortTitle + wrapForm addUserForm FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ AllocationR tid ssh ash AAddUserR + , formEncoding = addUserEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Nothing :: Maybe Text + } + +allocationApplicationsForm :: AllocationId + -> Map CourseId (Course, Bool) + -> FieldSettings UniWorX + -> Bool + -> AForm Handler (Map CourseId ApplicationForm) +allocationApplicationsForm aId courses FieldSettings{..} fvRequired = formToAForm $ do + let afmApplicant = True + afmApplicantEdit = True + afmLecturer = True + + appsRes' <- iforM courses $ \cId (course, hasApplicationTemplate) -> over _2 (course, hasApplicationTemplate, ) <$> applicationForm (Just aId) cId Nothing ApplicationFormMode{..} Nothing + let appsRes = sequenceA $ view _1 <$> appsRes' + appsViews = view _2 <$> appsRes' + + let fvInput = + [whamlet| + $newline never +
+ $forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, hasApplicationTemplate, ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews +
+
+ _{MsgAllocationPriority} +
+ $maybe prioView <- afvPriority + ^{fvWidget prioView} + + #{courseName} + $if hasApplicationTemplate || is _Just courseApplicationsInstructions +
+ _{MsgCourseApplicationInstructionsApplication} +
+ $maybe aInst <- courseApplicationsInstructions +

+ #{aInst} + $if hasApplicationTemplate +

+ + #{iconRegisterTemplate} _{MsgCourseApplicationTemplateApplication} +

+ _{MsgCourseApplication} +
+ ^{renderFieldViews FormStandard afvForm} + |] + MsgRenderer mr <- getMsgRenderer + let fvLabel = toHtml $ mr fsLabel + fvTooltip = toHtml . mr <$> fsTooltip + fvErrors = case appsRes of + FormFailure errs -> Just + [shamlet| + $newline never +
    + $forall err <- errs +
  • #{err} + |] + _other -> Nothing + fvId <- maybe newIdent return fsId + + return (appsRes, pure FieldView{..}) diff --git a/src/Handler/Allocation/Application.hs b/src/Handler/Allocation/Application.hs index 7996f3af3..f01ba8589 100644 --- a/src/Handler/Allocation/Application.hs +++ b/src/Handler/Allocation/Application.hs @@ -71,16 +71,17 @@ instance Exception ApplicationFormException applicationForm :: Maybe AllocationId -> CourseId - -> UserId + -> Maybe UserId -> ApplicationFormMode -- ^ Which parts of the shared form to display - -> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView) -applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf = do + -> Maybe Html -- ^ If @Just@ also include action buttons for usage as standalone form + -> MForm Handler (FormResult ApplicationForm, ApplicationFormView) +applicationForm maId@(is _Just -> isAlloc) cid muid ApplicationFormMode{..} mcsrf = do (mApp, coursesNum, Course{..}, maxPrio) <- liftHandler . runDB $ do - mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1] + mApplication <- fmap join . for muid $ \uid -> listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1] coursesNum <- fromIntegral . fromMaybe 1 <$> for maId (\aId -> count [AllocationCourseAllocation ==. aId]) course <- getJust cid - (fromMaybe 0 -> maxPrio) <- fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \courseApplication -> do + (fromMaybe 0 -> maxPrio) <- fmap join . for muid $ \uid -> fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \courseApplication -> do E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val uid E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.val maId E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority) @@ -202,7 +203,9 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf , guardOn ( afmApplicantEdit && is _Nothing mApp ) BtnAllocationApply , guardOn ( afmApplicantEdit && is _Just mApp ) BtnAllocationApplicationRetract ] - (actionRes, buttonsView) <- buttonForm' buttons csrf + (actionRes, buttonsView) <- case mcsrf of + Just csrf -> buttonForm' buttons csrf + Nothing -> return (pure BtnAllocationApplicationEdit, mempty) ratingSection <- if | afmLecturer @@ -251,7 +254,7 @@ editApplicationR :: Maybe AllocationId editApplicationR maId uid cid mAppId afMode allowAction postAction = do Course{..} <- runDB $ get404 cid - ((appRes, appView), appEnc) <- runFormPost $ applicationForm maId cid uid afMode + ((appRes, appView), appEnc) <- runFormPost $ applicationForm maId cid (Just uid) afMode . Just formResult appRes $ \ApplicationForm{..} -> do if diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index 1280a4a64..0b44f9346 100644 --- a/src/Handler/Allocation/Show.hs +++ b/src/Handler/Allocation/Show.hs @@ -150,7 +150,7 @@ postAShowR tid ssh ash = do mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR isLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR - mApplyFormView <- liftHandler . for muid $ \uid -> generateFormPost . applicationForm (Just aId) cid uid $ ApplicationFormMode True mayApply isLecturer + mApplyFormView <- liftHandler . for muid $ \uid -> generateFormPost $ applicationForm (Just aId) cid (Just uid) (ApplicationFormMode True mayApply isLecturer) . Just tRoute <- case mApp of Nothing -> return . AllocationR tid ssh ash $ AApplyR cID Just (Entity appId _) -> CApplicationR courseTerm courseSchool courseShorthand <$> encrypt appId <*> pure CAEditR diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 25053ed09..5c755c043 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -44,6 +44,8 @@ import qualified Data.Set as Set import Data.Map ((!), (!?)) import qualified Data.Map as Map +import qualified Data.Vector as Vector + import qualified Data.HashMap.Lazy as HashMap import Control.Monad.Writer.Class @@ -488,7 +490,7 @@ termsAllowedField = selectField $ do optionsPersistKey termFilter [Desc TermStart] termName termField :: Field Handler TermId -termField = selectField $ optionsPersistKey [] [Asc TermName] termName +termField = selectField $ optionsPersistKey [] [Desc TermStart] termName termsSetField :: [TermId] -> Field Handler TermId termsSetField tids = selectField $ optionsPersistKey [TermName <-. (unTermKey <$> tids)] [Desc TermStart] termName @@ -1608,6 +1610,96 @@ multiUserField onlySuggested suggestions = Field{..} ) Nothing -> E.true +userField :: forall m. + ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => Bool -- ^ Only resolve suggested users? + -> Maybe (E.SqlQuery (E.SqlExpr (Entity User))) -- ^ Suggested users + -> Field m (Either UserEmail UserId) +userField onlySuggested suggestions = Field{..} + where + lookupExpr + | onlySuggested = suggestions + | otherwise = Just $ E.from return + + fieldEnctype = UrlEncoded + fieldView theId name attrs val isReq = do + val' <- case val of + Left t -> return t + Right v -> case v of + Right uid -> case lookupExpr of + Nothing -> return mempty + Just lookupExpr' -> do + dbRes <- liftHandler . runDB . E.select $ do + user <- lookupExpr' + E.where_ $ user E.^. UserId E.==. E.val uid + return $ user E.^. UserEmail + case dbRes of + [E.Value email] -> return $ CI.original email + _other -> return mempty + Left email -> return $ CI.original email + + datalistId <- maybe (return $ error "Not to be used") (const newIdent) suggestions + + [whamlet| + $newline never + + |] + + 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 ( 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 + + $forall (email, dName) <- suggestedEmails +