Add predicate combinators

Author: drlkf

.hlint.yaml

@@ -1558,6 +1558,12 @@
     name: "Use 'bool' from Relude"
     note: "'bool' is already exported from Relude"
     rhs: bool
+- warn:
+    lhs: "(\\a -> f a && g a)"
+    rhs: "f .&& g"
+- warn:
+    lhs: "(\\a -> f a || g a)"
+    rhs: "f .|| g"
 - warn:
     lhs: Data.Hashable.Hashable
     name: "Use 'Hashable' from Relude"

CHANGELOG.md

@@ -6,6 +6,7 @@ The changelog is available [on GitHub][2].
 ## Unreleased
 
 - Allow containers-0.8.
+- Add predicate combinators
 
 ## 1.2.2.0 – Oct 13, 2024
 

hlint/hlint.dhall

@@ -541,6 +541,8 @@ in [ Rule.Arguments { arguments =
    , warnReexport "unless" "Control.Monad"
    , warnReexport "when" "Control.Monad"
    , warnReexport "bool" "Data.Bool"
+   , warnSimple "(\\a -> f a && g a)" "f .&& g"
+   , warnSimple "(\\a -> f a || g a)" "f .|| g"
 
    -- Container
    , warnReexport "Hashable"     "Data.Hashable"

relude.cabal

@@ -152,6 +152,7 @@ library
                            Relude.Applicative
                            Relude.Base
                            Relude.Bool
+                               Relude.Bool.Extra
                                Relude.Bool.Guard
                                Relude.Bool.Reexport
                            Relude.Container

src/Relude/Bool.hs

@@ -15,12 +15,16 @@ with monads.
 -}
 
 module Relude.Bool
-    ( module Relude.Bool.Reexport
+      -- $reexport
+    ( module Relude.Bool.Extra
+      -- $reexport
+    , module Relude.Bool.Reexport
       -- $reexport
     , module Relude.Bool.Guard
       -- $guard
     ) where
 
+import Relude.Bool.Extra
 import Relude.Bool.Guard
 import Relude.Bool.Reexport
 

src/Relude/Bool/Extra.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE Safe #-}
+
+{- |
+Module                  : Relude.Bool.Extra
+Copyright               : (c) 2025 drlkf
+                          (c) 2025 Kowainik
+SPDX-License-Identifier : MIT
+Maintainer              : Kowainik <[email protected]>
+Stability               : Stable
+Portability             : Portable
+
+Convenient functions to work with predicates.
+-}
+
+module Relude.Bool.Extra
+    ( (.&&)
+    , (.||)
+    ) where
+
+import Relude.Bool.Reexport (Bool, (&&), (||))
+
+{- | Predicate @and@ combinator.
+
+Combine two predicate functions into one with @and@ boolean logic.
+
+>>> even .&& (> 0) $ 2
+True
+
+>>> odd .&& (> 0) $ 2
+False
+
+>>> even .&& (< 0) $ 2
+False
+
+-}
+infixr 3 .&&
+(.&&)
+  :: (a -> Bool)
+  -> (a -> Bool)
+  -> (a -> Bool)
+(.&&) p1 p2 a = p1 a && p2 a
+{-# INLINE (.&&) #-}
+
+{- | Predicate @or@ combinator.
+
+Combine two predicate functions into one with @or@ boolean logic.
+Lazy in the second argument.
+
+>>> even .|| (> 0) $ 2
+True
+
+>>> even .|| (< 0) $ 2
+True
+
+>>> even .|| error "impossible" $ 2
+False
+
+-}
+infixr 2 .||
+(.||)
+  :: (a -> Bool)
+  -> (a -> Bool)
+  -> (a -> Bool)
+(.||) p1 p2 a = p1 a || p2 a
+{-# INLINE (.||) #-}

test/Test/Relude/Property.hs

@@ -8,14 +8,16 @@ import Data.List (nub)
 import Hedgehog (Group (..), Property, assert, forAll, property, (===))
 
 import Test.Relude.Container.One (oneProps)
-import Test.Relude.Gen (genBoolList, genIntList, genUtf8ByteString, genUtf8String, genUtf8Text)
+import Test.Relude.Gen (genBoolList, genInt, genIntList, genUtf8ByteString, genUtf8String,
+                        genUtf8Text)
 
 
 hedgehogTestList :: [Group]
 hedgehogTestList =
     [ utfProps
     , listProps
     , logicProps
+    , predicateOperatorProps
     , oneProps
     ]
 
@@ -106,3 +108,23 @@ prop_orM :: Property
 prop_orM = property $ do
     bs <- forAll genBoolList
     orM (pure <$> bs) === pure @Maybe (or bs)
+
+----------------------------------------------------------------------------
+-- predicate operators
+----------------------------------------------------------------------------
+
+predicateOperatorProps :: Group
+predicateOperatorProps = Group "predicate logic operators property tests"
+    [ (".&&", prop_andP)
+    , (".||", prop_orP)
+    ]
+
+prop_andP :: Property
+prop_andP = property $ do
+    x <- forAll genInt
+    (even x && x > 0) === (even .&& (> 0)) x
+
+prop_orP :: Property
+prop_orP = property $ do
+    x <- forAll genInt
+    (even x || x > 0) === (even .|| (> 0)) x