Migrate to property-matchers

This comes with a few API changes, and uses a version that hackage hasn't yet published in the index, but will soon.
kadena-io · Dec 16, 2024 · ed10e1b · ed10e1b
1 parent 6d6a754
commit ed10e1b
Show file tree

Hide file tree

Showing 7 changed files with 245 additions and 241 deletions.
diff --git a/cabal.project b/cabal.project
@@ -150,12 +150,6 @@ source-repository-package
     tag: 90247042ab3b8662809210af2a78e6dee0f9b4ac
     --sha256: 0dqsrjxm0cm35xcihm49dhwdvmz79vsv4sd5qs2izc4sbnd0d8n6
 
-source-repository-package
-    type: git
-    location: https://gitlab.com/edmundnoble/predicate-transformers
-    tag: 67c77e68ade204f56d91ad5952fe432188b40d23
-    --sha256: 0q7nwl56lgic5andc956zv4zipdv5rxjkalm21cxr75r6grkzfmy
-
 -- -------------------------------------------------------------------------- --
 -- Relaxed Bounds
 

diff --git a/cabal.project.freeze b/cabal.project.freeze
@@ -98,7 +98,7 @@ constraints: any.Cabal ==3.10.2.0,
              clock -llvm,
              any.cmdargs ==0.10.22,
              cmdargs +quotation -testprog,
-             any.co-log-core ==0.3.2.2,
+             any.co-log-core ==0.3.2.3,
              any.code-page ==0.2.1,
              any.colour ==2.3.6,
              any.commonmark ==0.2.6.1,
@@ -308,9 +308,10 @@ constraints: any.Cabal ==3.10.2.0,
              any.pem ==0.2.4,
              any.poly ==0.5.1.0,
              poly +sparse,
-             any.predicate-transformers ==0.15.0.0,
              any.pretty ==1.1.3.6,
              any.pretty-show ==1.10,
+             any.pretty-simple ==4.1.3.0,
+             pretty-simple -buildexample +buildexe,
              any.prettyprinter ==1.7.1,
              prettyprinter -buildreadme +text,
              any.prettyprinter-ansi-terminal ==1.1.3,
@@ -320,11 +321,13 @@ constraints: any.Cabal ==3.10.2.0,
              any.primitive-unlifted ==2.1.0.0,
              any.process ==1.6.18.0,
              any.profunctors ==5.6.2,
+             any.property-matchers ==0.2.0.0,
              any.psqueues ==0.2.8.0,
              any.pvar ==1.0.0.0,
              any.quickcheck-instances ==0.3.32,
              any.ralist ==0.4.0.0,
              any.random ==1.2.1.3,
+             any.recover-rtti ==0.5.0,
              any.recv ==0.1.0,
              any.reducers ==3.12.5,
              any.reflection ==2.1.9,
@@ -514,4 +517,4 @@ constraints: any.Cabal ==3.10.2.0,
              zip-archive -executable,
              any.zlib ==0.7.1.0,
              zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
-index-state: hackage.haskell.org 2024-12-14T23:51:20Z
+index-state: hackage.haskell.org 2024-12-16T17:37:22Z
diff --git a/chainweb.cabal b/chainweb.cabal
@@ -725,7 +725,7 @@ test-suite chainweb-tests
         , pact-tng:pact-request-api
         , pact-tng:test-utils
         , patience >= 0.3
-        , predicate-transformers == 0.15.0.0
+        , property-matchers ^>= 0.2
         , pretty-show
         , quickcheck-instances >= 0.3
         , random >= 1.2

diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs
@@ -79,7 +79,8 @@ import Pact.Core.Hash qualified as Pact5
 import Pact.Core.Names
 import Pact.Core.PactValue
 import Pact.Types.Gas qualified as Pact4
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Test.Tasty
 import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)
 import Text.Printf (printf)
@@ -134,8 +135,8 @@ tests baseRdb = testGroup "Pact5 PactServiceTest"
     , testCase "failed txs should go into blocks" (failedTxsShouldGoIntoBlocks baseRdb)
     ]
 
-successfulTx :: Predicatory p => Pred p (CommandResult log err)
-successfulTx = pt _crResult ? match _PactResultOk something
+successfulTx :: P.Prop (CommandResult log err)
+successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 simpleEndToEnd :: RocksDb -> IO ()
 simpleEndToEnd baseRdb = runResourceT $ do
@@ -148,8 +149,8 @@ simpleEndToEnd baseRdb = runResourceT $ do
 
         -- we only care that they succeed; specifics regarding their outputs are in TransactionExecTest
         results &
-            predful ? onChain cid ?
-                predful ? Vector.replicate 2 successfulTx
+            P.propful ? onChain cid ?
+                P.propful ? Vector.replicate 2 successfulTx
 
 newBlockEmpty :: RocksDb -> IO ()
 newBlockEmpty baseRdb = runResourceT $ do
@@ -171,8 +172,8 @@ newBlockEmpty baseRdb = runResourceT $ do
             return $ finalizeBlock nonEmptyBip
 
         results &
-            predful ? onChain cid ?
-                predful ? Vector.replicate 1 successfulTx
+            P.propful ? onChain cid ?
+                P.propful ? Vector.replicate 1 successfulTx
 
 continueBlockSpec :: RocksDb -> IO ()
 continueBlockSpec baseRdb = runResourceT $ do
@@ -194,8 +195,8 @@ continueBlockSpec baseRdb = runResourceT $ do
             return $ finalizeBlock bipAllAtOnce
         -- assert that 3 successful txs are in the block
         allAtOnceResults &
-            predful ? onChain cid ?
-            predful ? Vector.replicate 3 successfulTx
+            P.propful ? onChain cid ?
+            P.propful ? Vector.replicate 3 successfulTx
 
         -- reset back to the empty block for the next phase
         -- next, produce the same block by repeatedly extending a block
@@ -231,7 +232,7 @@ continueBlockSpec baseRdb = runResourceT $ do
             return $ finalizeBlock bipFinal
 
         -- assert that the continued results are equal to doing it all at once
-        continuedResults & equals allAtOnceResults
+        continuedResults & P.equals allAtOnceResults
 
 -- * test that the NewBlock timeout works properly and doesn't leave any extra state from a timed-out transaction
 newBlockTimeoutSpec :: RocksDb -> IO ()
@@ -276,10 +277,10 @@ newBlockTimeoutSpec baseRdb = runResourceT $ do
                 newBlock noMiner NewBlockFill (ParentHeader ph) pactQueue
             -- Mempool orders by GasPrice. 'buildCwCmd' sets the gas price to the transfer amount.
             -- We hope for 'timeoutTx' to fail, meaning that only 'txTransfer2' is in the block.
-            bip & pt _blockInProgressTransactions ? pt _transactionPairs
-                ? predful ? Vector.fromList
-                    [ pair
-                        (pt _cmdHash ? equals (_cmdHash tx2))
+            bip & P.fun _blockInProgressTransactions ? P.fun _transactionPairs
+                ? P.propful ? Vector.fromList
+                    [ P.pair
+                        (P.fun _cmdHash ? P.equals (_cmdHash tx2))
                         successfulTx
                     ]
             return $ finalizeBlock bip

diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs
@@ -64,7 +64,7 @@ import Chainweb.Test.Pact5.CmdBuilder
 import Chainweb.Test.Pact5.CutFixture qualified as CutFixture
 import Chainweb.Test.Pact5.Utils
 import Chainweb.Test.TestVersions
-import Chainweb.Test.Utils (deadbeef)
+import Chainweb.Test.Utils (deadbeef, TestPact5CommandResult)
 import Chainweb.Test.Utils (testRetryPolicy)
 import Chainweb.Utils
 import Chainweb.Version
@@ -93,7 +93,8 @@ import Pact.Core.Errors
 import Pact.Core.Gas.Types
 import Pact.Core.Hash qualified as Pact5
 import Pact.JSON.Encode qualified as J
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Servant.Client
 import Test.Tasty
 import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)
@@ -276,21 +277,20 @@ spvTest baseRdb = runResourceT $ do
         _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture)
         recvCr <- fmap (HashMap.! recvReqKey) $ polling v targetChain clientEnv (NE.singleton recvReqKey)
         recvCr
-            & allTrue
-                [ pt _crResult ? match _PactResultOk something
-                , pt _crEvents ? predful
-                    [ something
-                    , allTrue
-                        [ pt _peName ? equals "TRANSFER_XCHAIN_RECD"
-                        , pt _peArgs ? traceFailShow ? equals
+            & P.allTrue
+                [ P.fun _crResult ? P.match _PactResultOk P.succeed
+                , P.fun _crEvents ? P.propful
+                    [ P.succeed
+                    , P.allTrue
+                        [ P.fun _peName ? P.equals "TRANSFER_XCHAIN_RECD"
+                        , P.fun _peArgs ? P.equals
                             [PString "", PString "sender01", PDecimal 1.0, PString (chainIdToText srcChain)]
                         ]
-                    , pt _peName ? equals "X_RESUME"
-                    , something
+                    , P.fun _peName ? P.equals "X_RESUME"
+                    , P.succeed
                     ]
                 ]
 
-
         pure ()
 
     pure ()
@@ -419,11 +419,9 @@ trivialTx cid n = defaultCmd
     , _cbGasLimit = GasLimit (Gas 1_000)
     }
 
-_successfulTx :: Predicatory p => Pred p (CommandResult log err)
-_successfulTx = pt _crResult ? match _PactResultOk something
+_successfulTx :: P.Prop (CommandResult log err)
+_successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 pactDeadBeef :: RequestKey
 pactDeadBeef = case deadbeef of
     TransactionHash bytes -> RequestKey (Pact5.Hash bytes)
-
-type TestPact5CommandResult = CommandResult Pact5.Hash (PactErrorCompat (LocatedErrorInfo Info))
diff --git a/test/unit/Chainweb/Test/Pact5/SPVTest.hs b/test/unit/Chainweb/Test/Pact5/SPVTest.hs
@@ -157,7 +157,8 @@ import Pact.Core.Serialise
 import Pact.Core.StableEncoding (encodeStable)
 import Pact.Core.Verifiers
 import Pact.Types.Gas qualified as Pact4
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Streaming.Prelude qualified as Stream
 import System.LogLevel
 import System.LogLevel (LogLevel (..))
@@ -252,8 +253,8 @@ tests baseRdb = testGroup "Pact5 SPVTest"
     [ --testCase "simple end to end" (simpleEndToEnd baseRdb)
     ]
 
-successfulTx :: Predicatory p => Pred p (CommandResult log err)
-successfulTx = pt _crResult ? match _PactResultOk something
+successfulTx :: P.Prop (CommandResult log err)
+successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 cid = unsafeChainId 0
 v = pact5InstantCpmTestVersion singletonChainGraph