polysemy-check 0.8.0.0 → 0.8.1.0

raw patch · 4 files changed

+53/−2 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• polysemy-check.cabal +1/−1
• src/Polysemy/Check.hs +26/−1
• test/CommutativeSpec.hs +21/−0

@@ -1,5 +1,10 @@ # Changelog for polysemy-check +## v0.8.1.0 (2021-10-21)++- Added a new function, `prepropAllCommutative` which ensures every effect+    commutes with every other one.+ ## v0.8.0.0 (2021-10-21)  - `prepropCommutative` now accepts arbitrary rows to draw actions from, rather

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-check-version:        0.8.0.0+version:        0.8.1.0 synopsis:       QuickCheck for Polysemy description:    Please see the README on GitHub at <https://github.com/polysemy-research/polysemy-check#readme> category:       Polysemy

@@ -1,7 +1,9 @@ {-# LANGUAGE QuantifiedConstraints #-}+ module Polysemy.Check   ( -- * Effect Properties     prepropCommutative+  , prepropAllCommutative   , prepropEquivalent   , prepropLaw @@ -88,11 +90,34 @@     counterexample ("e2 = " <> show e2) $     counterexample ("k2  = " <> show m2) $     counterexample "" $-    counterexample "(e1 >> e2 >> k) /= (e2 >> e1 >> k)" $+    counterexample "(k1 >> e1 >> e2 >> k2) /= (k1 >> e2 >> e1 >> k2)" $       ioProperty $ do         r1 <- lower $ send m1 >> send e1 >> send e2 >> send m2         r2 <- lower $ send m1 >> send e2 >> send e1 >> send m2         pure $ r1 === r2+++class AllCommutative (effs :: EffectRow) r where+  ----------------------------------------------------------------------------+  -- | @'prepropAllCommutative' \@effs \@r interpreter@ generates an invocation+  -- of 'prepropCommutative' for every tail in @effs@. In essence, this ensures+  -- that every effect in @effs@ commutes with every other one.+  prepropAllCommutative+      :: ( forall a. Show a => Show (f a)+         , forall a. Eq a => Eq (f a)+         , Members effs r+         )+      => (forall a. Sem r a -> IO (f a))+      -> [Property]++instance {-# OVERLAPPING #-} AllCommutative '[e] r where+  prepropAllCommutative _ = []++instance (ArbitraryEff r r, ArbitraryEff es r, ArbitraryEff '[e] r, AllCommutative es r)+      => AllCommutative (e ': es) r where+  prepropAllCommutative lower+    = prepropCommutative @'[e] @es @r lower+    : prepropAllCommutative @es @r lower   ------------------------------------------------------------------------------

@@ -9,6 +9,9 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck+import Polysemy.Input+import Polysemy.Output+import Data.Foldable (traverse_)   spec :: Spec@@ -25,8 +28,26 @@     prepropCommutative @'[Error Int] @'[State Int] @'[Error Int, State Int] $       pure . Compose . run . runState 0 . runError +  let all_commutative_tests =+        prepropAllCommutative @BigEffs @BigEffs+          $ pure+          . Compose+          . Compose+          . run+          . runTraceList+          . runOutputList+          . runInputConst 10+          . runState 0 +  it "should have the right length" $+    length all_commutative_tests `shouldBe` 3++  traverse_ (prop "Big row is commutative") all_commutative_tests++ type TestEffs = '[State Int, Trace, State Int]++type BigEffs = '[State Int, Input Int, Output Bool, Trace]  runTestEffs :: Sem TestEffs a -> IO (Compose ((,) Int) ((,) [String]) a) runTestEffs =