Skip to content

Commit 1003248

Browse files
LaurentRDCLaurentRDC
committed
Remove dependency on rematch (#363)
1 parent ac9a4d3 commit 1003248

File tree

10 files changed

+17
-47
lines changed

10 files changed

+17
-47
lines changed

‎distributed-process-tests/distributed-process-tests.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,6 @@ library
3636
network-transport >= 0.4.1.0 && < 0.6,
3737
network >= 2.5 && < 3.2,
3838
random >= 1.0 && < 1.3,
39-
rematch >= 0.1.2.1,
4039
setenv >= 0.1.1.3,
4140
test-framework >= 0.6 && < 0.9,
4241
test-framework-hunit >= 0.2.0 && < 0.4,

‎distributed-process-tests/src/Control/Distributed/Process/Tests/CH.hs

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -45,11 +45,9 @@ import Control.Distributed.Process.Node
4545
import Control.Distributed.Process.Tests.Internal.Utils (pause)
4646
import Control.Distributed.Process.Serializable (Serializable)
4747
import Data.Maybe (isNothing, isJust)
48-
import Test.HUnit (Assertion, assertBool, assertFailure)
48+
import Test.HUnit (Assertion, assertBool, assertEqual, assertFailure)
4949
import Test.Framework (Test, testGroup)
5050
import Test.Framework.Providers.HUnit (testCase)
51-
import Control.Rematch hiding (match, isNothing, isJust)
52-
import Control.Rematch.Run (Match(..))
5351

5452
newtype Ping = Ping ProcessId
5553
deriving (Typeable, Binary, Show)
@@ -61,12 +59,6 @@ newtype Pong = Pong ProcessId
6159
-- Supporting definitions --
6260
--------------------------------------------------------------------------------
6361

64-
expectThat :: a -> Matcher a -> Assertion
65-
expectThat a matcher = case res of
66-
MatchSuccess -> return ()
67-
(MatchFailure msg) -> assertFailure msg
68-
where res = runMatch matcher a
69-
7062
-- | Like fork, but throw exceptions in the child thread to the parent
7163
forkTry :: IO () -> IO ThreadId
7264
forkTry p = do
@@ -1408,7 +1400,7 @@ testHandleMessageIf TestTransport{..} = do
14081400
return ()
14091401

14101402
result <- takeMVar done
1411-
expectThat result $ equalTo (5, 10)
1403+
assertEqual mempty (5, 10) result
14121404

14131405
testCatches :: TestTransport -> Assertion
14141406
testCatches TestTransport{..} = do
@@ -1436,7 +1428,7 @@ testMaskRestoreScope TestTransport{..} = do
14361428

14371429
parent <- liftIO $ takeMVar parentPid
14381430
child <- liftIO $ takeMVar spawnedPid
1439-
expectThat parent $ isNot $ equalTo child
1431+
assertBool mempty (not $ parent == child)
14401432

14411433
testDie :: TestTransport -> Assertion
14421434
testDie TestTransport{..} = do

‎distributed-process-tests/src/Control/Distributed/Process/Tests/Internal/Utils.hs

Lines changed: 2 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,8 @@ module Control.Distributed.Process.Tests.Internal.Utils
2121
, Ping(Ping)
2222
, ping
2323
, pause
24-
, shouldBe
25-
, shouldMatch
2624
, shouldContain
2725
, shouldNotContain
28-
, expectThat
2926
, synchronisedAssertion
3027
-- test process utilities
3128
, TestProcessControl
@@ -82,8 +79,6 @@ import Control.Exception (AsyncException(ThreadKilled), SomeException)
8279
import Control.Monad (forever, void)
8380
import Control.Monad.Catch (finally, catch)
8481
import Control.Monad.STM (atomically)
85-
import Control.Rematch hiding (match)
86-
import Control.Rematch.Run
8782
import Data.Binary
8883
import Data.Typeable (Typeable)
8984

@@ -142,23 +137,13 @@ synchronisedAssertion note localNode expected testProc lock = do
142137
stash :: TestResult a -> a -> Process ()
143138
stash mvar x = liftIO $ putMVar mvar x
144139

145-
expectThat :: a -> Matcher a -> Process ()
146-
expectThat a matcher = case res of
147-
MatchSuccess -> return ()
148-
(MatchFailure msg) -> liftIO $ assertFailure msg
149-
where res = runMatch matcher a
150-
151-
shouldBe :: a -> Matcher a -> Process ()
152-
shouldBe = expectThat
153140

154141
shouldContain :: (Show a, Eq a) => [a] -> a -> Process ()
155-
shouldContain xs x = expectThat xs $ hasItem (equalTo x)
142+
shouldContain xs x = liftIO $ assertBool mempty (x `elem` xs)
156143

157144
shouldNotContain :: (Show a, Eq a) => [a] -> a -> Process ()
158-
shouldNotContain xs x = expectThat xs $ isNot (hasItem (equalTo x))
145+
shouldNotContain xs x = liftIO $ assertBool mempty (not $ x `elem` xs)
159146

160-
shouldMatch :: a -> Matcher a -> Process ()
161-
shouldMatch = expectThat
162147

163148
-- | Run the supplied @testProc@ using an @MVar@ to collect and assert
164149
-- against its result. Uses the supplied @note@ if the assertion fails.

‎distributed-process-tests/src/Control/Distributed/Process/Tests/Mx.hs

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,6 @@ import Control.Distributed.Process.Management
3535
)
3636
import Control.Monad (void, unless)
3737
import Control.Monad.Catch(finally, bracket, try)
38-
import Control.Rematch (equalTo)
3938
import Data.Binary
4039
import Data.List (find, sort, intercalate)
4140
import Data.Maybe (isJust, fromJust, isNothing, fromMaybe, catMaybes)
@@ -50,6 +49,7 @@ import Test.Framework
5049
, testGroup
5150
)
5251
import Test.Framework.Providers.HUnit (testCase)
52+
import Test.HUnit (assertBool, assertEqual)
5353

5454
data Publish = Publish
5555
deriving (Typeable, Generic, Eq)
@@ -111,7 +111,7 @@ testAgentDualInput result = do
111111
died <- receiveTimeout 10000000 [
112112
matchIf (\(ProcessMonitorNotification r _ _) -> r == mRef) (const $ return True)
113113
]
114-
died `shouldBe` equalTo (Just True)
114+
liftIO $ assertEqual mempty (Just True) died
115115

116116
testAgentPrioritisation :: TestResult [String] -> Process ()
117117
testAgentPrioritisation result = do
@@ -257,22 +257,22 @@ testMxRegEvents result = do
257257

258258
register label p1
259259
reg1 <- receiveChanTimeout delay regSink
260-
reg1 `shouldBe` equalTo (Just (label, p1))
260+
liftIO $ assertEqual mempty (Just (label, p1)) reg1
261261

262262
unregister label
263263
unreg1 <- receiveChanTimeout delay unRegSink
264-
unreg1 `shouldBe` equalTo (Just (label, p1))
264+
liftIO $ assertEqual mempty (Just (label, p1)) unreg1
265265

266266
register label p2
267267
reg2 <- receiveChanTimeout delay regSink
268-
reg2 `shouldBe` equalTo (Just (label, p2))
268+
liftIO $ assertEqual mempty (Just (label, p2)) reg2
269269

270270
reregister label p1
271271
unreg2 <- receiveChanTimeout delay unRegSink
272-
unreg2 `shouldBe` equalTo (Just (label, p2))
272+
liftIO $ assertEqual mempty (Just (label, p2)) unreg2
273273

274274
reg3 <- receiveChanTimeout delay regSink
275-
reg3 `shouldBe` equalTo (Just (label, p1))
275+
liftIO $ assertEqual mempty (Just (label, p1)) reg3
276276

277277
mapM_ (flip kill $ "test-complete") [agent, p1, p2]
278278

@@ -308,17 +308,17 @@ testMxRegMon remoteNode result = do
308308

309309
register label1 p1
310310
reg1 <- receiveChanTimeout delay regSink
311-
reg1 `shouldBe` equalTo (Just (label1, p1))
311+
liftIO $ assertEqual mempty (Just (label1, p1)) reg1
312312

313313
register label2 p1
314314
reg2 <- receiveChanTimeout delay regSink
315-
reg2 `shouldBe` equalTo (Just (label2, p1))
315+
liftIO $ assertEqual mempty (Just (label2, p1)) reg2
316316

317317
n1 <- whereis label1
318-
n1 `shouldBe` equalTo (Just p1)
318+
liftIO $ assertEqual mempty (Just p1) n1
319319

320320
n2 <- whereis label2
321-
n2 `shouldBe` equalTo (Just p1)
321+
liftIO $ assertEqual mempty (Just p1) n2
322322

323323
kill p1 "goodbye"
324324

@@ -448,7 +448,7 @@ testMxSend mNode label test = do
448448

449449
case res of
450450
Left (ProcessExitException _ m) -> (liftIO $ putStrLn $ "SomeException-" ++ show m) >> die m
451-
Right tr -> tr `shouldBe` equalTo True
451+
Right tr -> liftIO $ assertBool mempty tr
452452

453453

454454
where

‎stack-ghc-8.10.7.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ packages:
66

77
extra-deps:
88
- distributed-static-0.3.9
9-
- rematch-0.2.0.0
109
- network-transport-tcp-0.8.0
1110
# This version has its containers dependency bumped
1211
- git: https://github.com/haskell-distributed/network-transport-inmemory.git

‎stack-ghc-9.0.2.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ packages:
66

77
extra-deps:
88
- distributed-static-0.3.9
9-
- rematch-0.2.0.0
109
- network-transport-tcp-0.8.0
1110
# This version has its containers dependency bumped
1211
- git: https://github.com/haskell-distributed/network-transport-inmemory.git

‎stack-ghc-9.2.4.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ extra-deps:
1111
# Change import of Data.ByteString.Lazy.Builder to Data.ByteString.Builder
1212
- lib/network-transport-tcp
1313
- distributed-static-0.3.9
14-
- rematch-0.2.0.0
1514
# This version has its containers dependency bumped
1615
- git: https://github.com/haskell-distributed/network-transport-inmemory.git
1716
commit: 0ce97924f15a8c1570b2355151834305c9bd2a28

‎stack-ghc-9.2.7.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ extra-deps:
1111
# right revisions (4/30/23).
1212
- distributed-static-0.3.9@sha256:f5e781867eddec660cb3b39805c849e3f096b7da245d43a07d8529e3c92b3a27
1313
- network-transport-inmemory-0.5.2@sha256:eead1fb207672127ccca1d04ae6a0eb20ee6ec10223eefb4274694dbbf4e9908
14-
- rematch-0.2.0.0
1514
- network-transport-tcp-0.8.1
1615

1716
flags:

‎stack-ghc-9.4.5.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ extra-deps:
1111
# right revisions (4/30/23).
1212
- distributed-static-0.3.9@sha256:f5e781867eddec660cb3b39805c849e3f096b7da245d43a07d8529e3c92b3a27
1313
- network-transport-inmemory-0.5.2@sha256:eead1fb207672127ccca1d04ae6a0eb20ee6ec10223eefb4274694dbbf4e9908
14-
- rematch-0.2.0.0
1514
- network-transport-tcp-0.8.1
1615

1716
flags:

‎stack-ghc-9.8.2.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ packages:
66

77
extra-deps:
88
- distributed-static-0.3.10
9-
- rematch-0.2.0.0
109
- network-transport-0.5.7
1110
- network-transport-tcp-0.8.2
1211
- network-transport-inmemory-0.5.3

0 commit comments

Comments
 (0)