Remove all dependencies on rematch

haskell-distributed · Oct 30, 2024 · d8ab5ee · d8ab5ee
1 parent 0f8db66
commit d8ab5ee
Show file tree

Hide file tree

Showing 21 changed files with 95 additions and 183 deletions.
diff --git a/packages/distributed-process-async/distributed-process-async.cabal b/packages/distributed-process-async/distributed-process-async.cabal
@@ -79,7 +79,6 @@ test-suite AsyncTests
                    stm >= 2.3 && < 2.6,
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
-                   rematch >= 0.2.0.0,
                    transformers
   hs-source-dirs:
                    tests

diff --git a/packages/distributed-process-client-server/distributed-process-client-server.cabal b/packages/distributed-process-client-server/distributed-process-client-server.cabal
@@ -92,7 +92,6 @@ test-suite ManagedProcessTests
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
                    transformers,
-                   rematch >= 0.2.0.0,
                    ghc-prim,
                    exceptions
   other-modules:   Counter,
@@ -131,7 +130,6 @@ test-suite PrioritisedProcessTests
                    test-framework,
                    test-framework-hunit,
                    transformers,
-                   rematch,
                    ghc-prim,
                    exceptions
   other-modules:   ManagedProcessCommon,

diff --git a/packages/distributed-process-client-server/tests/TestManagedProcess.hs b/packages/distributed-process-client-server/tests/TestManagedProcess.hs
@@ -20,6 +20,7 @@ import Control.Distributed.Process.ManagedProcess
 import Control.Distributed.Process.SysTest.Utils
 import Control.Distributed.Process.Extras.Time
 import Control.Distributed.Process.Serializable()
+import Control.Monad (replicateM_)
 
 import MathsDemo
 import Counter
@@ -197,7 +198,7 @@ testCounterExceedsLimit result = do
   mref <- monitor pid
 
   -- exceed the limit
-  9 `times` (void $ incCount pid)
+  9 `replicateM_` (void $ incCount pid)
 
   -- this time we should fail
   _ <- (incCount pid)

diff --git a/packages/distributed-process-execution/distributed-process-execution.cabal b/packages/distributed-process-execution/distributed-process-execution.cabal
@@ -98,7 +98,6 @@ test-suite ExchangeTests
                    QuickCheck >= 2.4,
                    test-framework-quickcheck2,
                    transformers,
-                   rematch >= 0.2.0.0,
                    ghc-prim
   hs-source-dirs:
                    tests
@@ -139,7 +138,6 @@ test-suite MailboxTests
                    QuickCheck >= 2.4,
                    test-framework-quickcheck2,
                    transformers,
-                   rematch >= 0.2.0.0,
                    ghc-prim
   hs-source-dirs:
                    tests

diff --git a/packages/distributed-process-execution/tests/TestExchange.hs b/packages/distributed-process-execution/tests/TestExchange.hs
@@ -18,13 +18,13 @@ import qualified Control.Distributed.Process.Execution.EventManager as EventMana
   )
 import Control.Distributed.Process.SysTest.Utils
 import Control.Monad (void, forM, forever)
-import Control.Rematch (equalTo)
 
 import Prelude hiding (drop)
 import Network.Transport.TCP
 import qualified Network.Transport as NT
 import Test.Framework as TF (defaultMain, testGroup, Test)
 import Test.Framework.Providers.HUnit
+import Test.HUnit (assertEqual, assertBool)
 
 testKeyBasedRouting :: TestResult Bool -> Process ()
 testKeyBasedRouting result = do
@@ -67,20 +67,22 @@ testMultipleRoutes result = do
   received <- forM (replicate (2 * 3) us) (const $ receiveChanTimeout 1000 rp)
 
   -- all bindings for 'abc' fired correctly
-  received `shouldContain` Just (p1, Left "Hello")
-  received `shouldContain` Just (p3, Left "Hello")
-  received `shouldContain` Just (p1, Right (123 :: Int))
-  received `shouldContain` Just (p3, Right (123 :: Int))
-
-  -- however the bindings for 'def' never fired
-  received `shouldContain` Nothing
-  received `shouldNotContain` Just (p2, Left "Hello")
-  received `shouldNotContain` Just (p2, Right (123 :: Int))
-
-  -- none of the bindings should have examined the headers!
-  received `shouldNotContain` Just (p1, Left "Goodbye")
-  received `shouldNotContain` Just (p2, Left "Goodbye")
-  received `shouldNotContain` Just (p3, Left "Goodbye")
+  liftIO $ do
+
+    assertBool mempty $ Just (p1, Left "Hello") `elem` received
+    assertBool mempty $ Just (p3, Left "Hello") `elem` received
+    assertBool mempty $ Just (p1, Right (123 :: Int)) `elem` received
+    assertBool mempty $ Just (p3, Right (123 :: Int)) `elem` received
+
+    -- however the bindings for 'def' never fired
+    assertBool mempty $ Nothing `elem` received
+    assertBool mempty $ Just (p2, Left "Hello") `notElem` received
+    assertBool mempty $ Just (p2, Right (123 :: Int)) `notElem` received
+
+    -- none of the bindings should have examined the headers!
+    assertBool mempty $ Just (p1, Left "Goodbye") `notElem` received
+    assertBool mempty $ Just (p2, Left "Goodbye") `notElem` received
+    assertBool mempty $ Just (p3, Left "Goodbye") `notElem` received
 
 testHeaderBasedRouting :: TestResult () -> Process ()
 testHeaderBasedRouting result = do
@@ -110,14 +112,16 @@ testHeaderBasedRouting result = do
   received <- forM (replicate 5 us) (const $ receiveChanTimeout 1000 rp)
 
   -- all bindings fired correctly
-  received `shouldContain` Just (p1, Left "Hello")
-  received `shouldContain` Just (p1, Right (123 :: Int))
-  received `shouldContain` Just (p2, Right (456 :: Int))
-  received `shouldContain` Just (p2, Right (789 :: Int))
-  received `shouldContain` Nothing
+  liftIO $ do
+    assertBool mempty $ Just (p1, Left "Hello") `elem` received
+    assertBool mempty $ Just (p1, Left "Hello") `elem` received
+    assertBool mempty $ Just (p1, Right (123 :: Int)) `elem` received
+    assertBool mempty $ Just (p2, Right (456 :: Int)) `elem` received
+    assertBool mempty $ Just (p2, Right (789 :: Int)) `elem` received
+    assertBool mempty $ Nothing `elem` received
 
   -- simple check that no other bindings have fired
-  length received `shouldBe` equalTo (5 :: Int)
+  liftIO $ assertEqual mempty 5 (length received)
 
 testSimpleEventHandling :: TestResult Bool -> Process ()
 testSimpleEventHandling result = do

diff --git a/packages/distributed-process-execution/tests/TestMailbox.hs b/packages/distributed-process-execution/tests/TestMailbox.hs
@@ -13,15 +13,13 @@ import Control.Distributed.Process.Extras.Time
 import Control.Distributed.Process.Extras.Timer
 import Control.Distributed.Process.SysTest.Utils
 
-
-import Control.Rematch (equalTo)
-
 import Prelude hiding (drop)
 
 import Data.Maybe (catMaybes)
 
 import Test.Framework as TF (defaultMain, testGroup, Test)
 import Test.Framework.Providers.HUnit
+import Test.HUnit (assertEqual)
 
 import qualified MailboxTestFilters (__remoteTable)
 import MailboxTestFilters (myFilter, intFilter)
@@ -77,9 +75,10 @@ bufferLimiting buffT result = do
   MailboxStats{ pendingMessages = pending'
               , droppedMessages = dropped'
               , currentLimit    = limit' } <- statistics mbox
-  pending' `shouldBe` equalTo 4
-  dropped' `shouldBe` equalTo 3
-  limit'   `shouldBe` equalTo 4
+  liftIO $ do
+    assertEqual mempty 4 pending'
+    assertEqual mempty 3 dropped'
+    assertEqual mempty 4 limit'  
 
   active mbox acceptEverything
   Just Delivery{ messages = recvd

diff --git a/packages/distributed-process-extras/distributed-process-extras.cabal b/packages/distributed-process-extras/distributed-process-extras.cabal
@@ -81,7 +81,6 @@ test-suite InternalQueueTests
                    test-framework-hunit,
                    QuickCheck >= 2.4,
                    test-framework-quickcheck2,
-                   rematch >= 0.2.0.0,
                    ghc-prim
   hs-source-dirs:  tests
   ghc-options:     -rtsopts
@@ -110,7 +109,6 @@ test-suite PrimitivesTests
                    stm,
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
-                   rematch >= 0.2.0.0,
                    transformers
   hs-source-dirs:  tests
   ghc-options:     -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
@@ -135,7 +133,6 @@ test-suite TimerTests
                    test-framework-hunit,
                    QuickCheck >= 2.4,
                    test-framework-quickcheck2,
-                   rematch >= 0.2.0.0,
                    ghc-prim
   hs-source-dirs:  tests
   ghc-options:     -rtsopts
@@ -172,7 +169,6 @@ test-suite LoggerTests
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
                    transformers,
-                   rematch >= 0.2.0.0,
                    ghc-prim
   hs-source-dirs:  tests
   ghc-options:     -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

diff --git a/packages/distributed-process-extras/tests/TestLog.hs b/packages/distributed-process-extras/tests/TestLog.hs
@@ -4,15 +4,14 @@
 
 module Main where
 
--- import Control.Exception (SomeException)
 import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar, newEmptyMVar)
 import Control.Concurrent.STM (atomically)
 import Control.Concurrent.STM.TChan
 import Control.Distributed.Process hiding (monitor)
 import Control.Distributed.Process.Closure (remotable, mkStaticClosure)
 import Control.Distributed.Process.Node
 import Control.Distributed.Process.Extras hiding (__remoteTable)
-import qualified Control.Distributed.Process.Extras.SystemLog as Log (Logger, error)
+import qualified Control.Distributed.Process.Extras.SystemLog as Log (Logger)
 import Control.Distributed.Process.Extras.SystemLog hiding (Logger, error)
 import Control.Distributed.Process.SysTest.Utils
 import Control.Distributed.Process.Extras.Time
@@ -31,7 +30,6 @@ import GHC.Read
 import Text.ParserCombinators.ReadP as P
 import Text.ParserCombinators.ReadPrec
 
-import qualified Network.Transport as NT
 
 logLevelFormatter :: Message -> Process (Maybe String)
 logLevelFormatter m = handleMessage m showLevel

diff --git a/packages/distributed-process-extras/tests/TestPrimitives.hs b/packages/distributed-process-extras/tests/TestPrimitives.hs
@@ -16,11 +16,9 @@ import Control.Distributed.Process.Extras.Call
 import Control.Distributed.Process.Extras.Monitoring
 import Control.Distributed.Process.Extras.Time
 import Control.Monad (void)
-import Control.Rematch hiding (match)
-import qualified Network.Transport as NT (Transport)
 import Network.Transport.TCP()
 
-import Test.HUnit (Assertion)
+import Test.HUnit (Assertion, assertEqual, assertBool)
 import Test.Framework (Test, testGroup, defaultMain)
 import Test.Framework.Providers.HUnit (testCase)
 import Network.Transport.TCP
@@ -113,8 +111,9 @@ testMonitorNodeDeath transport result = do
     mn1 <- liftIO $ takeMVar nid2
     mn2 <- liftIO $ takeMVar nid3
 
-    [mn1, mn2] `shouldContain` n1
-    [mn1, mn2] `shouldContain` n2
+    liftIO $ do
+      assertBool mempty $ n1 `elem` [mn1, mn2]
+      assertBool mempty $ n2 `elem` [mn1, mn2]
 
     nid4 <- liftIO $ newEmptyMVar
     node4 <- liftIO $ newLocalNode transport initRemoteTable
@@ -125,7 +124,7 @@ testMonitorNodeDeath transport result = do
 
     mn3 <- liftIO $ takeMVar nid4
     NodeUp n3 <- expect
-    mn3 `shouldBe` (equalTo n3)
+    liftIO $ assertEqual mempty n3 mn3
 
     liftIO $ closeLocalNode node4
     stash result ()

diff --git a/packages/distributed-process-extras/tests/TestQueues.hs b/packages/distributed-process-extras/tests/TestQueues.hs
@@ -1,26 +1,20 @@
 {-# LANGUAGE PatternGuards  #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Main where
 
 import qualified Control.Distributed.Process.Extras.Internal.Queue.SeqQ as FIFO
 import Control.Distributed.Process.Extras.Internal.Queue.SeqQ ( SeqQ )
 import qualified Control.Distributed.Process.Extras.Internal.Queue.PriorityQ as PQ
 
-import Control.Rematch hiding (on)
-import Control.Rematch.Run
 import Data.Function (on)
-import Data.List
+import Data.List ( sortBy )
 import Test.Framework as TF (defaultMain, testGroup, Test)
 import Test.Framework.Providers.HUnit
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (Assertion, assertFailure)
+import Test.HUnit (assertBool, assertEqual)
 
 import Prelude
 
-expectThat :: a -> Matcher a -> Assertion
-expectThat a matcher = case res of
-  MatchSuccess -> return ()
-  (MatchFailure msg) -> assertFailure msg
-  where res = runMatch matcher a
 
 -- NB: these tests/properties are not meant to be complete, but rather
 -- they exercise the small number of behaviours that we actually use!
@@ -72,13 +66,11 @@ tests = [
      ],
      testGroup "FIFO Queue Tests" [
         testCase "New Queue Should Be Empty"
-          (expectThat (FIFO.isEmpty $ FIFO.empty) $ equalTo True),
+          (assertBool mempty (FIFO.isEmpty $ FIFO.empty)),
         testCase "Singleton Queue Should Contain One Element"
-          (expectThat (FIFO.dequeue $ FIFO.singleton "hello") $
-             equalTo $ Just ("hello", FIFO.empty)),
+          (assertEqual mempty (FIFO.dequeue $ FIFO.singleton "hello") $ Just ("hello", FIFO.empty)),
         testCase "Dequeue Empty Queue Should Be Nothing"
-          (expectThat (FIFO.dequeue $ (FIFO.empty :: SeqQ ())) $
-            is (Nothing :: Maybe ((), SeqQ ()))),
+          (assertEqual mempty  (FIFO.dequeue $ (FIFO.empty :: SeqQ ())) $ (Nothing :: Maybe ((), SeqQ ()))),
         testProperty "Enqueue/Dequeue should respect FIFO order"
             prop_fifo_enqueue,
         testProperty "Enqueue/Dequeue should respect isEmpty"

diff --git a/packages/distributed-process-extras/tests/TestTimer.hs b/packages/distributed-process-extras/tests/TestTimer.hs
@@ -9,7 +9,6 @@ import Control.Concurrent.MVar
   , takeMVar
   , withMVar
   )
-import qualified Network.Transport as NT (Transport)
 import Network.Transport.TCP()
 import Control.DeepSeq (NFData)
 import Control.Distributed.Process

diff --git a/packages/distributed-process-supervisor/distributed-process-supervisor.cabal b/packages/distributed-process-supervisor/distributed-process-supervisor.cabal
@@ -82,7 +82,6 @@ test-suite SupervisorTests
                    stm,
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
-                   rematch >= 0.2.0.0,
                    exceptions >= 0.10 && < 0.11
   hs-source-dirs:  tests
   ghc-options:     -threaded -rtsopts -with-rtsopts=-N -fno-warn-name-shadowing -fno-warn-unused-do-bind
@@ -111,7 +110,6 @@ test-suite NonThreadedSupervisorTests
                    stm,
                    test-framework >= 0.6 && < 0.9,
                    test-framework-hunit,
-                   rematch >= 0.2.0.0,
                    exceptions >= 0.10 && < 0.11
   hs-source-dirs:  tests
   ghc-options:     -rtsopts -fno-warn-unused-do-bind -fno-warn-name-shadowing