diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 9c09b41f9..3ee7284c9 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -50,6 +50,7 @@ module Database.Esqueleto.Utils
, subSelectCountDistinct
, selectCountRows, selectCountDistinct
, str2text, str2text'
+ , str2citext
, num2text --, text2num
, day, day', dayMaybe, interval, diffDays, diffTimes
, exprLift
@@ -79,6 +80,7 @@ import Database.Esqueleto.Utils.TH
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.CaseInsensitive as CI
import Crypto.Hash (Digest, SHA256)
@@ -537,6 +539,7 @@ strip = E.unsafeSqlFunction "TRIM"
infix 4 `ciEq`
+-- Note that this function is unnecessary if the DB type is citext
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
@@ -750,6 +753,9 @@ str2text = E.unsafeSqlCastAs "text"
str2text' :: E.SqlString a => E.SqlExpr (E.Value (Maybe a)) -> E.SqlExpr (E.Value (Maybe Text))
str2text' = E.unsafeSqlCastAs "text"
+str2citext :: E.SqlString a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value (CI.CI Text))
+str2citext = E.unsafeSqlCastAs "citext"
+
-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
num2text = E.unsafeSqlCastAs "text"
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 084874b02..5f0e8d4e5 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1920,6 +1920,109 @@ userField onlySuggested suggestions = Field{..}
Nothing -> E.true
+knownUserField :: forall m.
+ ( MonadHandler m
+ , HandlerSite m ~ UniWorX
+ )
+ => Bool -- ^ Only resolve suggested users?
+ -> Maybe (E.SqlQuery (E.SqlExpr (Entity User))) -- ^ Suggested users
+ -> Field m UserId
+knownUserField 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 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
+
+ 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 user $ Left UserDisplayEmail)
+ E.then_ (user E.^. UserDisplayEmail)
+ , E.when_ (unique user $ Left UserEmail)
+ E.then_ (user E.^. UserEmail)
+ ]
+ ( E.else_ $ user E.^. UserIdent)
+ , user E.^. UserDisplayName
+ )
+ [whamlet|
+ $newline never
+