git.iko.soy/distributed-process
on master help sign in
adjust to deal with the latest network-transport-tcp API changes and refactor benchmarks and test runner accordingly
commit391cb937d1d0c96b1fb586b917b2e1df107b659d authorTim Watson <watson.timothy@gmail.com> dateSun 11 Nov 2018, 21:02 (8 years ago) parent9a316db
7 files changed+37−26
compare with master
unifiedsplit
benchmarks/Channels.hs+6−5 benchmarks/Latency.hs+7−5 benchmarks/ProcessRing.hs+2−2 benchmarks/Spawns.hs+6−5 benchmarks/Throughput.hs+6−5 distributed-process-tests/tests/runTCP.hs+2−2 stack-ghc-8.0.2.yaml+8−2
benchmarks/Channels.hs+6−5
@@ -4,7 +4,7 @@ import Control.Monad
44import Control.Applicative
55import Control.Distributed.Process
66import Control.Distributed.Process.Node
7−import Network.Transport.TCP (createTransport, defaultTCPParameters)
7+import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
88import Data.Binary (encode, decode)
99import qualified Data.ByteString.Lazy as BSL
1010
@@ -36,7 +36,8 @@ initialProcess "CLIENT" = do
3636main :: IO ()
3737main = do
3838 [role, host, port] <- getArgs
39− Right transport <- createTransport
40− host port (\sn -> (host, port)) defaultTCPParameters
41− node <- newLocalNode transport initRemoteTable
42− runProcess node $ initialProcess role
39+ trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
40+ case trans of
41+ Right transport -> do node <- newLocalNode transport initRemoteTable
42+ runProcess node $ initialProcess role
43+ Left other -> error $ show other
benchmarks/Latency.hs+7−5
@@ -3,7 +3,7 @@ import Control.Monad
33import Control.Applicative
44import Control.Distributed.Process
55import Control.Distributed.Process.Node
6−import Network.Transport.TCP (createTransport, defaultTCPParameters)
6+import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
77import Data.Binary (encode, decode)
88import qualified Data.ByteString.Lazy as BSL
99
@@ -31,7 +31,9 @@ initialProcess "CLIENT" = do
3131main :: IO ()
3232main = do
3333 [role, host, port] <- getArgs
34− Right transport <- createTransport
35− host port (\sn -> (host, sn)) defaultTCPParameters
36− node <- newLocalNode transport initRemoteTable
37− runProcess node $ initialProcess role
34+ trans <- createTransport
35+ (defaultTCPAddr host port) defaultTCPParameters
36+ case trans of
37+ Right transport -> do node <- newLocalNode transport initRemoteTable
38+ runProcess node $ initialProcess role
39+ Left other -> error $ show other
benchmarks/ProcessRing.hs+2−2
@@ -12,7 +12,7 @@ import Control.Monad
1212import Control.Distributed.Process hiding (catch)
1313import Control.Distributed.Process.Node
1414import Control.Exception (catch, SomeException)
15−import Network.Transport.TCP (createTransport, defaultTCPParameters)
15+import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
1616import System.Environment
1717import System.Console.GetOpt
1818
@@ -111,7 +111,7 @@ main = do
111111 (opt, _) <- parseArgv argv
112112 putStrLn $ "options: " ++ (show opt)
113113 Right transport <- createTransport
114− "127.0.0.1" "8090" (\sn -> ("127.0.0.1", sn)) defaultTCPParameters
114+ (defaultTCPAddr "127.0.0.1" "8090" ) defaultTCPParameters
115115 node <- newLocalNode transport initRemoteTable
116116 catch (void $ runProcess node $ initialProcess opt)
117117 (\(e :: SomeException) -> putStrLn $ "ERROR: " ++ (show e))
benchmarks/Spawns.hs+6−5
@@ -7,7 +7,7 @@ import Control.Monad
77import Control.Applicative
88import Control.Distributed.Process
99import Control.Distributed.Process.Node
10−import Network.Transport.TCP (createTransport, defaultTCPParameters)
10+import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
1111import Data.Binary (encode, decode)
1212import qualified Data.ByteString.Lazy as BSL
1313
@@ -42,7 +42,8 @@ initialProcess "CLIENT" = do
4242main :: IO ()
4343main = do
4444 [role, host, port] <- getArgs
45− Right transport <- createTransport
46− host port (\sn -> (host, sn)) defaultTCPParameters
47− node <- newLocalNode transport initRemoteTable
48− runProcess node $ initialProcess role
45+ trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
46+ case trans of
47+ Right transport -> do node <- newLocalNode transport initRemoteTable
48+ runProcess node $ initialProcess role
49+ Left other -> error $ show other
benchmarks/Throughput.hs+6−5
@@ -6,7 +6,7 @@ import Control.Monad
66import Control.Applicative
77import Control.Distributed.Process
88import Control.Distributed.Process.Node
9−import Network.Transport.TCP (createTransport, defaultTCPParameters)
9+import Network.Transport.TCP (createTransport, defaultTCPParameters, defaultTCPAddr)
1010import Data.Binary
1111import qualified Data.ByteString.Lazy as BSL
1212import Data.Typeable
@@ -67,7 +67,8 @@ initialProcess "CLIENT" = do
6767main :: IO ()
6868main = do
6969 [role, host, port] <- getArgs
70− Right transport <- createTransport
71− host port (\sn -> (host, sn)) defaultTCPParameters
72− node <- newLocalNode transport initRemoteTable
73− runProcess node $ initialProcess role
70+ trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
71+ case trans of
72+ Right transport -> do node <- newLocalNode transport initRemoteTable
73+ runProcess node $ initialProcess role
74+ Left other -> error $ show other
distributed-process-tests/tests/runTCP.hs+2−2
@@ -10,6 +10,7 @@ import Network.Transport.TCP
1010 ( createTransportExposeInternals
1111 , TransportInternals(socketBetween)
1212 , defaultTCPParameters
13+ , defaultTCPAddr
1314 , TCPParameters(..)
1415 )
1516import Test.Framework (defaultMainWithArgs)
@@ -24,8 +25,7 @@ main = do
2425 hSetBuffering stdout LineBuffering
2526 hSetBuffering stderr LineBuffering
2627 Right (transport, internals) <-
27− createTransportExposeInternals "127.0.0.1" "8080"
28− (\sn -> ("127.0.0.1", sn))
28+ createTransportExposeInternals (defaultTCPAddr "127.0.0.1" "8080")
2929 defaultTCPParameters { transportConnectTimeout = Just 3000000 }
3030 ts <- tests TestTransport
3131 { testTransport = transport
stack-ghc-8.0.2.yaml+8−2
@@ -1,14 +1,20 @@
1−resolver: lts-9.0
1+resolver: lts-9.21
2+
3+# added -location for network-transport-tcp-0.6.0
4+# since c7fd79 broke the client facing API for createTransport :/
25
36packages:
47- '.'
58- distributed-process-tests/
9+- location:
10+ git: https://github.com/haskell-distributed/network-transport-tcp.git
11+ commit: d87d6f55697a94a1fbf211ff9c1bb769a1e129cd
12+ extra-dep: true
613
714extra-deps:
815- rank1dynamic-0.4.0
916- distributed-static-0.3.8
1017- network-transport-0.5.2
11−- network-transport-tcp-0.6.0
1218- network-transport-inmemory-0.5.2
1319- rematch-0.2.0.0
1420