From c9d06c9ec7d1cd2589aa4f11d7db8cba682e8e74 Mon Sep 17 00:00:00 2001
From: Joel Stanley <intractable@gmail.com>
Date: Wed, 25 May 2016 10:34:03 -0700
Subject: [PATCH] Add runClientServer boilerplate reducer

---
 tests/LowLevelTests.hs | 49 +++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 24 deletions(-)

diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs
index 0b22eaa..4e84e0b 100644
--- a/tests/LowLevelTests.hs
+++ b/tests/LowLevelTests.hs
@@ -37,13 +37,6 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
 dummyMeta :: M.Map ByteString ByteString
 dummyMeta = M.fromList [("foo","bar")]
 
--- | Boilerplate for naming a GRPC unit test
-gtc :: TestName -> (GRPC -> IO ()) -> TestTree
-gtc nm = testCase nm . withGRPC
-
-nop :: Monad m => a -> m ()
-nop = const (return ())
-
 testGRPCBracket :: TestTree
 testGRPCBracket = gtc "Start/stop GRPC" nop
 
@@ -141,19 +134,13 @@ testServerUnregisteredAwaitNoClient =
 
 testPayloadLowLevel :: TestTree
 testPayloadLowLevel =
-  gtc "Client/Server - low-level (registered) request/response" $ \grpc -> do
-  withAsync (testPayloadLowLevelServer grpc) $ \a1 -> do
-    withAsync (testPayloadLowLevelClient grpc) $ \a2 -> do
-      wait a1
-      wait a2
+  gtc "Client/Server - low-level (registered) request/response" $
+  runClientServer testPayloadLowLevelClient testPayloadLowLevelServer
 
 testPayloadLowLevelUnregistered :: TestTree
 testPayloadLowLevelUnregistered =
-  gtc "Client/Server - low-level unregistered request/response" $ \grpc -> do
-  withAsync (testPayloadLowLevelServerUnregistered grpc) $ \a1 ->
-    withAsync (testPayloadLowLevelClientUnregistered grpc) $ \a2 -> do
-      wait a1
-      wait a2
+  gtc "Client/Server - low-level unregistered request/response" $
+  runClientServer testPayloadLowLevelClientUnregistered testPayloadLowLevelServerUnregistered
 
 testWithServerCall :: TestTree
 testWithServerCall =
@@ -179,8 +166,8 @@ assertCqEventComplete e = do
   eventCompletionType e HU.@?= OpComplete
   eventSuccess e HU.@?= True
 
-testPayloadClient :: IO ()
-testPayloadClient = do
+testPayloadClient :: GRPC -> IO ()
+testPayloadClient _grpc = do
   client <- grpcInsecureChannelCreate "localhost:50051" nullPtr reserved
   cq <- grpcCompletionQueueCreate reserved
   withMetadataArrayPtr $ \initialMetadataRecv -> do
@@ -226,8 +213,8 @@ testPayloadClient = do
         grpcCompletionQueueDestroy cq
         grpcChannelDestroy client
 
-testPayloadServer :: IO ()
-testPayloadServer = do
+testPayloadServer :: GRPC -> IO ()
+testPayloadServer _grpc = do
   server <- grpcServerCreate nullPtr reserved
   cq <- grpcCompletionQueueCreate reserved
   grpcServerRegisterCompletionQueue server cq reserved
@@ -300,8 +287,22 @@ testPayloadServer = do
 -- minimal abstractions on top of it.
 testPayload :: TestTree
 testPayload =
-  gtc "Client/Server - End-to-end request/response" $ \_ ->
-  withAsync testPayloadServer $ \a1 -> do
-    withAsync testPayloadClient $ \a2 -> do
+  gtc "Client/Server - End-to-end request/response" $
+  runClientServer testPayloadClient testPayloadServer
+
+--------------------------------------------------------------------------------
+-- Utility functions
+
+-- | Boilerplate for naming a GRPC unit test
+gtc :: TestName -> (GRPC -> IO ()) -> TestTree
+gtc nm = testCase nm . withGRPC
+
+nop :: Monad m => a -> m ()
+nop = const (return ())
+
+runClientServer :: (GRPC -> IO ()) -> (GRPC -> IO ()) -> GRPC -> IO ()
+runClientServer client server grpc = do
+  withAsync (server grpc) $ \a1 -> do
+    withAsync (client grpc) $ \a2 -> do
       wait a1
       wait a2