property-matchers 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+375/−131 lines, 5 filesdep +hspecdep +lensdep +property-matchersdep ~adjunctionsdep ~basedep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, lens, property-matchers, smallcheck

Dependency ranges changed: adjunctions, base, deepseq, pretty-simple, prettyprinter, recover-rtti, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−11
• property-matchers.cabal +26/−2
• src/PropertyMatchers.hs +183/−118
• test/PropertyMatchersSpec.hs +136/−0
• test/Spec.hs +1/−0

@@ -1,6 +1,24 @@-# Revision history for predicate-transformers+# Revision history for property-matchers -## 0.17.0.0 -- 2024-10-13+## 0.2.0.0++* Add `bool` function+* Add hspec + smallcheck test suite+* Add `branch` for non-backtracking disjunction of properties+* Monomorphize `fail`, `succeed`, `assess`, `branch` for ease of use in hspec+* Rename `PropertyFailed` exception type to `PropertyException` to recognize the new case for `branch`+* Add `type Assertion = IO ()`+* Add a few pragmas+* Reorder `PropertyMatchers` module for intelligibility+++## 0.1.0.0++* Rename to property-matchers+* Rename kth to atIndex+* Change error message formatting for predicate failure++## predicate-transformers 0.17.0.0 -- 2024-10-13 * Rename multiple functions to shorter names with the intent that predicate-transformers be imported qualified.   In particular `also` renamed to `and`, `otherHand` renamed to `or`, etc. * Delete `lens` and `mtl` dependencies.@@ -9,27 +27,27 @@ * Delete `Exceptional` class, folding it into the newly renamed `Boolish`. * Delete `predJust`, `predLeft`, and `predRight` in favor of `match` uses. -## 0.16.0.0 -- 2024-10-13+## predicate-transformers 0.16.0.0 -- 2024-10-13 * Add predicate failure error messages that include the actual value under test and a message explaining what was expected. * Rename `just`, `left`, and `right` to `predJust`, `predLeft`, `predRight` -## 0.15.0.0 -- 2024-08-23+## predicate-transformers 0.15.0.0 -- 2024-08-23 * Change `?` to right associative so that it works with `.`. -## 0.14.0.0 -- 2024-08-23+## predicate-transformers 0.14.0.0 -- 2024-08-23 * Add `?` back in as a useful operator to work with `&`; `&` can be used as a predicate applicator, and `?` can be used as a predicate transformer applicator, allowing for a form of infix binary application like `x & f ? y = f x y`. * Add `match` back in as a type-restricted alias for `soleElementOf`. -## 0.13.0.0 -- 2024-07-23+## predicate-transformers 0.13.0.0 -- 2024-07-23 * Remove `?` -## 0.12.0.0 -- 2024-07-23+## predicate-transformers 0.12.0.0 -- 2024-07-23 * Rename `sole` to `soleElement` * Add `?`, an infix function application operator with lower   precedence than `!`. * Add `satAll = foldr also continue`. -## 0.11.0.0 -- 2024-07-21+## predicate-transformers 0.11.0.0 -- 2024-07-21 * Add documentation. * Rename `onlyContains` to `sole`. Add `soleOf`, generalizing over `Fold`s.   `soleOf` is likely a better replacement for `match` than `allOf1` was.@@ -37,7 +55,7 @@ * Implement `traceFailFunShow`. * Change `Exceptional`'s method `assess` to make it possible to implement for functional predicates, and delete `traceFailFun`, now redundant. -## 0.10.0.0 -- 2024-07-21+## predicate-transformers 0.10.0.0 -- 2024-07-21  * Rename `oneOfTwo` to `otherHand`, for easier reading. * Set `also` and `otherHand` precedences to those of `&&` and `||`@@ -52,7 +70,7 @@ * Make `otherHand` stop catching async exceptions. Otherwise a thread   being killed may appear as a predicate failure. -## 0.9.0.0 -- 2024-07-21+## predicate-transformers 0.9.0.0 -- 2024-07-21  * Add instance `Predicatory (e -> a)`. This will allow for adding extra   parameters to predicates, making it easier to compose them; maybe@@ -62,6 +80,6 @@ * Tupling sugar renamed from `==>` to `:=>`, to allow it to be a pattern synonym. * Minor code style changes. -## 0.1.0.0 -- 2019-10-05+## predicate-transformers 0.1.0.0 -- 2019-10-05  * First version. Released on an unsuspecting world.

@@ -1,7 +1,7 @@ cabal-version: 2.4  name: property-matchers-version: 0.1.0.0+version: 0.2.0.0 synopsis: A library for tests, based on transforming and writing properties description:   This package provides ways to write properties for testing such that they compose nicely and are easy to debug.@@ -17,7 +17,7 @@  library   exposed-modules: PropertyMatchers-  ghc-options: -Wall+  ghc-options: -Wall -Wno-missing-signatures -Wmissing-exported-signatures   build-depends:     base >=4.8 && <4.30    ,adjunctions >= 4.4.2 && < 5@@ -30,4 +30,28 @@     build-depends:       semigroups >= 0.8.4 && < 1   hs-source-dirs: src+  default-language: Haskell2010++test-suite property-matchers-tests+  type: exitcode-stdio-1.0++  hs-source-dirs: test/+  main-is: Spec.hs++  build-tool-depends: hspec-discover:hspec-discover+  build-depends:+    base+   ,adjunctions+   ,deepseq+   ,recover-rtti+   ,pretty-simple+   ,prettyprinter+   ,text+   ,lens++   ,hspec >= 2.11 && < 3+   ,smallcheck+   ,property-matchers++  other-modules: PropertyMatchersSpec   default-language: Haskell2010

@@ -11,6 +11,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeApplications #-}  -- | This library is based on the notion of a property transformer, the below -- type @PT a b@, which is a function from @a@ to properties on @b@.@@ -23,8 +25,12 @@ -- `either` (base) -- `Control.Lens.allOf` (lens) module PropertyMatchers-  ( Boolish(..)-  , PropertyFailed(..)+  ( Assertion+  , Boolish(..)+  , fail+  , succeed+  , branch+  , PropertyException(..)   , Prop   , PT   , endingWith@@ -36,70 +42,57 @@   , compose   , allTrue   , allOf1-  , pattern (:=>)   , pair   , fun-  , (?)   , traced   , tracedShow   , traceFailShow   , traceFail   , forced   , equals+  , bool+  , pattern (:=>)+  , (?)   )   where -import "base" Prelude hiding (and, fail, or)-import "base" Control.Concurrent (myThreadId)-import "base" Control.Exception-import "base" Control.Monad hiding (fail)-import "base" Data.Foldable (toList)-import "base" Data.Functor.Const-import "base" Data.Typeable-import "base" Debug.Trace-import "base" GHC.Conc (pseq)-import "base" GHC.Stack-import "base" System.IO.Unsafe+import Prelude hiding (and, fail, or)+import Control.Concurrent (myThreadId)+import Control.Exception+import Control.Monad hiding (fail)+import Data.Foldable (toList)+import Data.Functor.Const+import Data.Typeable+import Debug.Trace+import GHC.Stack -import "deepseq" Control.DeepSeq (NFData, force)-import "text" Data.Text.Lazy qualified as TL-import "adjunctions" Data.Functor.Rep (Representable (..))+import Control.DeepSeq (NFData, force)+import qualified Data.Text.Lazy as TL+import Data.Functor.Rep (Representable (..)) -import "pretty-simple" Text.Pretty.Simple qualified as Pretty.Simple-import "prettyprinter" Prettyprinter qualified as PP-import "prettyprinter" Prettyprinter.Render.String qualified as PP+import qualified "pretty-simple" Text.Pretty.Simple as Pretty.Simple+import qualified "prettyprinter" Prettyprinter as PP+import qualified "prettyprinter" Prettyprinter.Render.String as PP import "recover-rtti" Debug.RecoverRTTI (anythingToString)--type Getting r s a = (a -> Const r a) -> s -> Const r s---- | Class of possible property results.--- This is almost a lattice with `or` as disjunction, `and` as conjunction, `fail` as the falsy--- value, and `succeed` as the truthy value. However there may be multiple falsy values, and--- `and` will pick the first one it's passed, whereas `or` will pick the second it's passed.-class Boolish a where-  or :: a -> a -> a-  and :: a -> a -> a-  fail :: HasCallStack => PP.Doc ann -> v -> a-  succeed :: a-  -- | Check and execute a callback on failure.-  assess :: a -> IO () -> a-  {-# MINIMAL or, and, fail, succeed, assess #-}+import Data.IORef -instance Boolish a => Boolish (e -> a) where-  (f `or` f') e = f e `or` f' e-  (f `and` f') e = f e `and` f' e-  fail expected actual = withFrozenCallStack $ \_ -> fail expected actual-  succeed = \_ -> succeed-  assess f act = \e -> assess (f e) act+type Assertion = IO () -infixr 3 `and`-infixr 2 `or`+-- | Internal, mostly the same as `catch` in safe-exceptions.+trySync :: Exception e => IO a -> IO (Either e a)+trySync act = catches (Right <$> act)+  -- explicitly do not handle async exceptions.+  -- otherwise, a thread being killed may appear as a property failure.+  [ Handler $ \(ex :: SomeAsyncException) -> do+    tid <- myThreadId+    throwTo tid ex+    -- unreachable+    return undefined+  , Handler $ \(ex :: e) ->+    return $ Left ex+  ] --- | The exception thrown by properties of type `IO ()` by default. Other IOExceptions will work fine.-data PropertyFailed = forall actual ann. PropertyFailed !CallStack (PP.Doc ann) actual-  deriving (Typeable)-instance Show PropertyFailed where-  show = displayException+-------------------------------------------------------------------------------  anythingToTextPretty :: a -> TL.Text anythingToTextPretty = Pretty.Simple.pStringOpt opts . anythingToString@@ -112,7 +105,16 @@     , Pretty.Simple.outputOptionsInitialIndent = 0     } -instance Exception PropertyFailed where+-- | The exception thrown by properties of type `Assertion` by default.+-- Other non-async exceptions will work fine too.+data PropertyException+  = forall actual ann. PropertyFailed !CallStack (PP.Doc ann) actual+  | forall actual. NoBranchMatched !CallStack actual+  deriving (Typeable)+instance Show PropertyException where+  show = displayException++instance Exception PropertyException where   displayException (PropertyFailed cs expected actual) =     PP.renderString $ PP.layoutSmart PP.defaultLayoutOptions $       PP.group@@ -126,90 +128,141 @@       <> PP.hardline <> PP.pretty (prettyCallStack cs)     where     prettyActual = anythingToTextPretty actual+  displayException (NoBranchMatched cs actual) =+    PP.renderString $ PP.layoutSmart PP.defaultLayoutOptions $+      PP.group+        ( PP.line'+        <> PP.flatAlt "Actual:" "Actual value"+        <> PP.softline <> PP.pretty prettyActual+        <> PP.line' <> PP.line+        <> "did not match any branches"+        )+      <> PP.hardline <> PP.pretty (prettyCallStack cs)+    where+    prettyActual = anythingToTextPretty actual -instance Boolish Bool where-  or = (||)-  and = (&&)-  fail _ _ = False-  succeed = True-  assess b act-    | b = b-    | otherwise = unsafePerformIO act `pseq` b+-- | Successful assertion. Includes documentation of the failed expectation,+-- as well as the asserted-on value for printing to the user.+-- Doubles as an always-failing property,+fail :: HasCallStack => PP.Doc ann -> Prop a+fail expected actual = throwIO (PropertyFailed (popCallStack callStack) expected actual) +-- | Always-successful property, equivalent to `\_ -> pure ()`.+succeed :: actual -> Assertion+succeed _ = pure ()+{-# INLINE CONLIKE succeed #-}++-- | Class for combining properties and property results.+-- `or` and `and` should each be associative, idempotent, more or less+-- commutative (because there may be multiple falsy values) and distribute+-- over one another.+class Boolish p where+  or :: p -> p -> p+  and :: p -> p -> p+  {-# MINIMAL or, and #-}++infixr 3 `and`+infixr 2 `or`++instance Boolish a => Boolish (e -> a) where+  or :: Boolish a => (e -> a) -> (e -> a) -> e -> a+  (f `or` f') e = f e `or` f' e+  (f `and` f') e = f e `and` f' e+  {-# INLINE or #-}+  {-# INLINE and #-}+ instance a ~ () => Boolish (IO a) where   or x y = do     catches x-      -- explicitly do not handle async exceptions.-      -- otherwise, a thread being killed may appear as a property failure.       [ Handler $ \(ex :: SomeAsyncException) -> do         tid <- myThreadId         throwTo tid ex       , Handler $ \(_ex :: SomeException) -> y       ]   and = (>>)-  fail expected actual = throwIO (PropertyFailed (popCallStack callStack) expected actual)-  succeed = return ()-  assess x act =-    catches x-      -- explicitly do not handle async exceptions.-      -- otherwise, a thread being killed may appear as a property failure.-      [ Handler $ \(ex :: SomeAsyncException) -> do-        tid <- myThreadId-        throwTo tid ex-      , Handler $ \(ex :: SomeException) ->-        act >> throwIO ex-      ]+  {-# INLINE and #-} +-- | Non-backtracking branching. Use this to improve error messages and+-- performance by avoiding testing properties that can never succeed.+branch :: (HasCallStack, Foldable t) => t (PT a b, Prop a) -> Prop b+branch bs actual = foldr+    (\(cond, alt) fallback -> do+      triggeredRef <- newIORef False+      branchResult <- trySync @SomeException+        (cond (\i -> writeIORef triggeredRef True >> alt i) actual)+      triggered <- readIORef triggeredRef+      -- if `cond` called its input predicate,+      -- that predicate may have failed or succeeded, and we+      -- commit to that result.+      -- if `cond` didn't call its input predicate, it counts+      -- as a success, but if it fails, we do not commit to that.+      case branchResult of+        Left exception+          | triggered -> throwIO exception+          | otherwise -> fallback+        Right successfulResult -> succeed successfulResult+    )+    (throwIO (NoBranchMatched (popCallStack callStack) actual))+    bs+{-# INLINABLE branch #-}+ -- | A convenient alias for properties.-type Prop p a = a -> p+type Prop a = a -> Assertion  -- | Property transformers form a category where composition is ordinary function composition. --  Forms a category with `.` and `id`. --  Multiple are already provided by the standard library, --  for instance `Data.Foldable.all` and `Data.Foldable.any`.-type PT p a b = Prop p a -> Prop p b+type PT a b = Prop a -> Prop b  -- | Operate on the last value in a foldable, or fail if it's not present.-endingWith :: (HasCallStack, Boolish p, Foldable f) => PT p a (f a)+endingWith :: (HasCallStack, Foldable f) => PT a (f a) endingWith _ actual@(toList -> []) = fail "nonempty foldable" actual endingWith p (toList -> xs) = p $ last xs+{-# INLINABLE endingWith #-}  -- | Operate on the first value in a foldable, or fail if it's not present.-startingWith :: (HasCallStack, Boolish p, Foldable f) => PT p a (f a)+startingWith :: (HasCallStack, Foldable f) => PT a (f a) startingWith _ actual@(toList -> []) = fail "nonempty foldable" actual startingWith p (toList -> (x : _)) = p x+{-# INLINABLE startingWith #-} --- | Require that a @Prism@ matches, and apply the property to its contents.--- This works for folds, too.+-- | Internal, just for `match`.+type Getting r s a = (a -> Const r a) -> s -> Const r s++-- | Require that a @Prism@ or any other @Fold@ matches, and apply the property+-- to its target, only succeeding if there's exactly one target. match-  :: (HasCallStack, Boolish p)+  :: (HasCallStack)   => Getting [a] s a-  -> PT p a s+  -> PT a s match f p s =   case f (Const . pure) s of     Const [x] -> p x     _ -> fail "fold to match" s  -- | Test the element of a foldable at some index.-atIndex :: (Boolish p, Foldable f) => Int -> PT p a (f a)+atIndex :: (Foldable f) => Int -> PT a (f a) atIndex k p = startingWith p . drop k . toList --- | Given a list of properties and a list of values, ensure that each property holds for each respective value.---  Fails if the two lists have different lengths.-list :: (HasCallStack, Boolish p) => [Prop p a] -> [a] -> p+-- | Given a list of properties and a list of values, ensure that each property+-- holds for each respective value. Fails if the two lists have different+-- lengths.+list :: (HasCallStack) => [Prop a] -> [a] -> Assertion list ps xs-  | psl == length xs = foldr and succeed (zipWith ($) ps xs)+  | psl == length xs = foldr and (succeed xs) (zipWith ($) ps xs)   | otherwise = fail ("list with length " <> PP.pretty psl) xs   where   psl = length ps --- | Given a functor-full of properties, and a functor-full of values, ensure that the structures---  of the two functors match and apply all of the properties to all of the values.---  Generalized version of `list`.+-- | Given a functor-full of properties, and a functor-full of values, ensure+-- that the structures of the two functors match and apply all of the properties+-- to all of the values.+-- Generalized version of `list`. propful ::-  (HasCallStack, Boolish p, Eq (f ()), Functor f, Foldable f) =>-  f (Prop p a) ->-  Prop p (f a)+  (HasCallStack, Eq (f ()), Functor f, Foldable f) =>+  f (Prop a) ->+  Prop (f a) propful props values   | void props == void values =     list (toList props) (toList values)@@ -220,73 +273,85 @@ --  yield a representable functor-full of booleans. Similar to `propful`. compose ::   Representable f =>-  f (Prop p a) ->+  f (Prop a) ->   f a ->-  f p+  f Assertion compose pr fa = tabulate (\r -> index pr r $ index fa r)  -- | Test all properties against one value.-allTrue :: (Boolish p, Foldable f) => f (Prop p a) -> Prop p a-allTrue ps a = foldr (\p r -> p a `and` r) succeed ps+allTrue :: (Foldable f) => f (Prop a) -> Prop a+allTrue ps a = foldr (\p r -> p a `and` r) (succeed a) ps+{-# INLINABLE allTrue #-}  -- | Check that a property is true for all values behind a generalized getter --  and that there's at least one value for which it's true. allOf1-  :: (HasCallStack, Boolish p)+  :: (HasCallStack)   => Getting [a] s a-  -> PT p a s+  -> PT a s allOf1 g p vs   | [] <- vsList =-    foldr (\x r -> p x `and` r) succeed vsList+    foldr (\x r -> p x `and` r) (succeed vs) vsList   | otherwise = fail "non-empty for fold" vs   where   Const vsList = g (Const . pure) vs --- | Sugar for tupling.-pattern (:=>) :: a -> b -> (a, b)-pattern a :=> b = (a, b)- -- | A pair of properties, made into a property of pairs.-pair :: Boolish p => Prop p a -> Prop p b -> Prop p (a, b)+pair :: Prop a -> Prop b -> Prop (a, b) pair f s (a, b) = f a `and` s b  -- | Flipped function composition; @pf f@ for a function @f@ is a property transformer -- such that @pf f p i == p (f i)@.-fun :: (a -> b) -> PT p b a+fun :: (a -> b) -> PT b a fun f p = p . f --- | Higher precedence '$', to work well with '&'.--- The intended use is something like `x & match _Right ? equals 2`.-(?) :: (a -> b) -> a -> b-(?) = ($)-infixr 8 ?- -- | Prints the input of a property, if the property fails, using `Show`. --   Requires that the property's output type can be checked for failure.-traceFailShow :: (Boolish p, Show a) => PT p a a+traceFailShow :: Show a => PT a a traceFailShow = traceFail show  -- | Prints the input of a property over functions, if the property fails. --   Requires that the property's output type can be checked for failure.-traceFail :: (Boolish p) => (a -> String) -> PT p a a+traceFail :: (a -> String) -> PT a a traceFail s p a =   assess (p a) $ traceIO (s a) +-- | Internal. Run an extra effect if the input assertion fails.+assess :: Assertion -> IO () -> Assertion+assess x eff = trySync @SomeException x >>= either (\ex -> eff >> throwIO ex) return+ -- | Prints the input of a property, for debugging.-traced :: Show a => (a -> String) -> PT c a a+traced :: Show a => (a -> String) -> PT a a traced s p a = trace (s a) (p a)  -- | Prints the input of a property, for debugging.-tracedShow :: Show a => PT c a a+tracedShow :: Show a => PT a a tracedShow = traced show  -- | Property which triggers full evaluation of its input and succeeds. --  Useful for testing that an exception isn't thrown.-forced :: (Boolish p, NFData a) => Prop p a-forced a = force a `seq` succeed+forced :: (NFData a) => Prop a+forced a = force a `seq` succeed a  -- | The property of being equal to some expected value.-equals :: (HasCallStack, Boolish p, Eq a) => a -> Prop p a+equals :: (HasCallStack, Eq a) => a -> Prop a equals expected actual-  | expected == actual = succeed+  | expected == actual = succeed actual   | otherwise = fail (PP.pretty (anythingToTextPretty expected)) actual++bool :: HasCallStack => Bool -> Assertion+bool b+  | b = succeed b+  | otherwise = fail (PP.pretty True) b++-- | Sugar for tupling.+-- The intended use is something like+-- `(x :: Either Int Int) & branch [match _Left :=> equals 1, match _Right :=> equals 2]`+pattern (:=>) :: a -> b -> (a, b)+pattern a :=> b = (a, b)++-- | Higher precedence '$', to work well with '&'.+-- The intended use is something like `x & match _Right ? equals 2`.+(?) :: (a -> b) -> a -> b+(?) = ($)+infixr 8 ?

@@ -0,0 +1,136 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+module PropertyMatchersSpec(spec) where++import Control.Applicative+import Control.Exception+import Control.Lens+import GHC.Generics (Generic)++import qualified Prettyprinter as PP+import qualified Prettyprinter.Render.Text as PP++import qualified PropertyMatchers as P+import PropertyMatchers (pattern (:=>), (?))++import Test.Hspec+import Test.SmallCheck hiding (over)+import Test.SmallCheck.Drivers+import qualified Test.SmallCheck.Series as SC+import Debug.RecoverRTTI (anythingToString)+import System.IO.Unsafe (unsafePerformIO)+import Data.Text (Text)++data AndOrTree = And AndOrTree AndOrTree | Or AndOrTree AndOrTree | Fail String | Error String | Succeed+  deriving stock (Generic, Show)+instance Monad m => SC.Serial m AndOrTree where+andsAndOrs (And x y) = P.and (andsAndOrs x) (andsAndOrs y)+andsAndOrs (Or x y) = P.or (andsAndOrs x) (andsAndOrs y)+andsAndOrs (Fail str) = P.fail (PP.pretty str) ()+andsAndOrs (Error str) = error str+andsAndOrs Succeed = P.succeed ()++check :: Testable IO a => Depth -> a -> IO ()+check d e = smallCheckM d e >>= \case+  Nothing -> return ()+  Just failure -> error (show failure)++pattern PropertyFailed :: Text -> String -> P.PropertyException+pattern PropertyFailed msg actual <- P.PropertyFailed _ (PP.renderStrict . PP.layoutCompact -> msg) (anythingToString -> actual)+_PropertyFailed :: Fold P.PropertyException (Text, String)+_PropertyFailed = to+  (\case+    PropertyFailed msg actual -> Just (msg, actual)+    _ -> Nothing) . folded++spec :: Spec+spec = do+  it "succeed" $ do+    P.succeed ()+    P.succeed 1+    P.succeed (\_ -> 1)++  it "fail" $ do+    try (P.fail "test string" 42) >>= \case+      Left+        (PropertyFailed "test string" "42") -> return ()+      _ -> error "expected correct PropertyFailed"++  describe "and/or" $ do+    let runWithMsg t = over _Left displayException <$> try @SomeException (andsAndOrs t)+    let runWithoutMsg t = over _Left (\_ -> ()) <$> try @SomeException (andsAndOrs t)+    it "and idempotency" $ do+      check 3 $ forAll $ \x -> unsafePerformIO $+        (==) <$> runWithMsg x <*> runWithMsg (And x x)+    it "or idempotency" $ do+      check 3 $ forAll $ \x -> unsafePerformIO $+        (==) <$> runWithMsg x <*> runWithMsg (Or x x)+    it "or associativity" $ do+      check 2 $ forAll $ \x y z ->+        unsafePerformIO $ (==) <$> runWithMsg (Or x (Or y z)) <*> runWithMsg (Or (Or x y) z)+    it "and associativity" $ do+      check 2 $ forAll $ \x y z ->+        unsafePerformIO $ (==) <$> runWithMsg (And x (And y z)) <*> runWithMsg (And (And x y) z)+    it "or commutativity" $ do+      check 2 $ forAll $ \x y -> unsafePerformIO $+        (==) <$> runWithoutMsg (Or x y) <*> runWithoutMsg (Or y x)+    it "and commutativity" $ do+      check 2 $ forAll $ \x y -> unsafePerformIO $+        (==) <$> runWithoutMsg (And x y) <*> runWithoutMsg (And y x)+    it "distributivity" $ do+      check 2 $ forAll $ \x y z -> unsafePerformIO $+        (==) <$> runWithMsg (And x (Or y z)) <*> runWithMsg (Or (And x y) (And x z))++  it "bool" $ do+    True & P.bool+    try (False & P.bool) >>= \case+      Left (PropertyFailed "True" "False") -> return ()+      r -> error $ "unexpected: " <> show r+++  it "equals" $ do+    1 & P.equals 1+    try (1 & P.equals 2) >>= \case+      Left (PropertyFailed "2" "1") -> return ()+      r -> error $ "unexpected: " <> show r++  it "match" $ do+    Left 1 & P.match _Left ? P.equals 1+    try (Left 1 & P.match _Right ? P.equals 1) >>= \case+      Left (PropertyFailed "fold to match" "Left 1") -> return ()+      r -> error $ "unexpected: " <> show r++  describe "branch" $ do+    it "singleton" $ do+      Left 2 & P.branch+        [ P.match _Left :=> P.equals 2+        ]+      try @SomeException+        (Right 2 &+          P.branch+            [ P.match _Left :=> P.equals 2 ]+        ) >>=+          P.match _Left P.succeed+    it "commits" $ do+      try @SomeException+        (Left 1 &+          P.branch+            [ P.match _Left :=> P.equals 2+            , const P.succeed :=> P.succeed+            ]+        ) >>= P.match _Left P.succeed+    it "disjunction" $ do+      Left 1 &+        P.branch+          [ P.match _Right :=> P.equals 2+          , P.match _Left :=> P.succeed+          ]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}