Skip to content

Commit

Permalink
Fixed windows build of network-mux
Browse files Browse the repository at this point in the history
  • Loading branch information
coot committed Mar 25, 2020
1 parent 1957446 commit 0e38adb
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 7 deletions.
9 changes: 5 additions & 4 deletions network-mux/demo/mux-demo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ import Test.Mux.ReqResp
import System.Win32
import System.Win32.NamedPipes
import qualified System.Win32.Async as Win32.Async
import System.IOManager

import System.IO
import System.Exit
Expand Down Expand Up @@ -71,7 +72,7 @@ defaultProtocolLimits =
-- | Server accept loop.
--
echoServer :: IO ()
echoServer = Win32.Async.withIOManager $ \iocp -> do
echoServer = withIOManager $ \ioManager -> do
hpipe <- createNamedPipe pipeName
(pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
(pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
Expand All @@ -80,7 +81,7 @@ echoServer = Win32.Async.withIOManager $ \iocp -> do
1024
0
Nothing
Win32.Async.associateWithIOCompletionPort (Left hpipe) iocp
associateWithIOManager ioManager (Left hpipe)
Win32.Async.connectNamedPipe hpipe
_ <- forkIO $ do
serverLoop hpipe
Expand Down Expand Up @@ -122,15 +123,15 @@ serverLoop h = do


client :: Int -> String -> IO ()
client n msg = Win32.Async.withIOManager $ \iocp -> do
client n msg = withIOManager $ \ioManager -> do
hpipe <- createFile pipeName
(gENERIC_READ .|. gENERIC_WRITE)
fILE_SHARE_NONE
Nothing
oPEN_EXISTING
fILE_FLAG_OVERLAPPED
Nothing
Win32.Async.associateWithIOCompletionPort (Left hpipe) iocp
associateWithIOManager ioManager (Left hpipe)
let pipeChannel = Mx.pipeChannelFromNamedPipe hpipe
bearer = Mx.pipeAsMuxBearer nullTracer pipeChannel
Mx.muxStart
Expand Down
7 changes: 4 additions & 3 deletions network-mux/test/Test/Mux.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ import Control.Tracer (Tracer (..), contramap, nullTracer)
import qualified System.Win32.NamedPipes as Win32.NamedPipes
import qualified System.Win32.File as Win32.File
import qualified System.Win32.Async as Win32.Async
import System.IOManager
#else
import System.IO (hClose)
import System.Process (createPipe)
Expand Down Expand Up @@ -460,7 +461,7 @@ runWithQueues initApp respApp = do
runWithPipe :: RunMuxApplications
runWithPipe initApp respApp =
#if defined(mingw32_HOST_OS)
Win32.Async.withIOManager $ \iocp -> do
withIOManager $ \ioManager -> do
let pipeName = "\\\\.\\pipe\\mux-test-pipe"
bracket
(Win32.NamedPipes.createNamedPipe
Expand All @@ -484,8 +485,8 @@ runWithPipe initApp respApp =
Nothing)
Win32.File.closeHandle
$ \hCli -> do
Win32.Async.associateWithIOCompletionPort (Left hSrv) iocp
Win32.Async.associateWithIOCompletionPort (Left hCli) iocp
associateWithIOManager ioManager (Left hSrv)
associateWithIOManager ioManager (Left hCli)

let clientChannel = pipeChannelFromNamedPipe hCli
serverChannel = pipeChannelFromNamedPipe hSrv
Expand Down

0 comments on commit 0e38adb

Please sign in to comment.