diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 6a59f0241..f8b488272 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -15,6 +15,7 @@ module Database.Esqueleto.Utils , (=?.), (?=.) , (=~.), (~=.) , (>~.), (<~.) + , (~.), (~*.) , or, and , any, all , not__, parens @@ -26,6 +27,7 @@ module Database.Esqueleto.Utils , mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus , mkDayFilter, mkDayFilterFrom, mkDayFilterTo , mkExistsFilter, mkExistsFilterWithComma + -- , mkRegExFilterWith , anyFilter, allFilter , ascNullsFirst, descNullsLast , orderByList @@ -163,6 +165,16 @@ infixl 4 <~. (<~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool) (<~.) a b = E.isNothing b E.||. (E.just a E.<. b) +infixr 2 ~., ~*. + +-- | PostgreSQL regular expression match, case sensitive. Works, but may throw SQL error for unblanced parenthesis, etc. Not suitable for dbTable filters +(~.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool) +(~.) = E.unsafeSqlBinOp " ~ " + +-- | PostgreSQL regular expression match, case insensitive. Works, but may throw SQL errors +(~*.) :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool) +(~*.) = E.unsafeSqlBinOp " ~* " + -- | Negation of `isNothing` which is missing isJust :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool) @@ -415,6 +427,18 @@ mkContainsFilterWithCommaPlus cast lenslike row (foldMap commaSeparatedText -> c cond_compulsory = all (hasInfix (lenslike row) . E.val . cast) compulsories cond_optional = any (hasInfix (lenslike row) . E.val . cast) alternatives +-- like `mkContainsFilterWith` but allows regular expression criterias +-- This works, but throws SQL errors for unbalanced parenthesis and similar invalid regex expressions +-- mkRegExFilterWith :: (E.SqlString b, Ord a) +-- => (a -> b) +-- -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element +-- -> t -- ^ query row +-- -> Set.Set a -- ^ needle collection +-- -> E.SqlExpr (E.Value Bool) +-- mkRegExFilterWith cast lenslike row criterias +-- | Set.null criterias = true +-- | otherwise = any ((~.) (lenslike row) . E.val . cast) criterias + mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element -> t -- ^ query row -> Last Day -- ^ a day to filter for diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index 2fe335e32..c6abfa015 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -107,12 +107,14 @@ mkMCTable = do dbtFilter = mconcat [ single ("sent" , FilterColumn . E.mkDayFilterTo $ views (to queryMail) (E.^. SentMailSentAt)) , single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryRecipient) (E.?. UserDisplayName)) - , single ("subject" , FilterColumn . E.mkContainsFilter $ views (to queryMail) (E.str2text . (E.^. SentMailHeaders))) + , single ("subject" , FilterColumn . E.mkContainsFilterWithCommaPlus id $ views (to queryMail) (E.str2text . (E.^. SentMailHeaders))) + -- , single ("regex" , FilterColumn . E.mkRegExFilterWith id $ views (to queryMail) (E.str2text . (E.^. SentMailHeaders))) ] dbtFilterUI mPrev = mconcat [ prismAForm (singletonFilter "sent" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) , prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus) , prismAForm (singletonFilter "subject" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject & setTooltip MsgTableFilterCommaPlusShort) + -- , prismAForm (singletonFilter "regex" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject ) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout} dbtIdent :: Text