@@ -3,6 +3,7 @@ module Network.Wai.Handler.Warp.WithApplication (
33 withApplication,
44 testWithApplication,
55 openFreePort,
6+ withFreePort,
67) where
78
89import Control.Concurrent
@@ -16,8 +17,7 @@ import Network.Wai.Handler.Warp.Types
1617data App
1718 = App {
1819 appThread :: ThreadId,
19− appKilled :: Waiter (),
20− appPort :: Int
20+ appKilled :: Waiter ()
2121 }
2222
2323-- | Runs the given 'Application' on a free port. Passes the port to the given
@@ -26,25 +26,26 @@ data App
2626withApplication :: IO Application -> (Port -> IO a) -> IO a
2727withApplication mkApp action = do
2828 app <- mkApp
29− bracket (acquire app) free (\ runningApp -> action (appPort runningApp))
29+ withFreePort $ \ (port, sock) -> do
30+ bracket (start app sock) stop $ \ _ ->
31+ action port
3032 where
31− acquire :: Application -> IO App
32− acquire app = do
33− start <- mkWaiter
33+ start :: Application -> Socket -> IO App
34+ start app sock = do
35+ started <- mkWaiter
3436 killed <- mkWaiter
3537 thread <- forkIO $ do
36− (port, sock) <- openFreePort
3738 let settings =
3839 defaultSettings{
39− settingsBeforeMainLoop = notify start port
40+ settingsBeforeMainLoop = notify started ()
4041 }
4142 runSettingsSocket settings sock app
4243 `finally` notify killed ()
43− port <- waitFor start
44− return $ App thread killed port
44+ waitFor started
45+ return $ App thread killed
4546
46− free :: App -> IO ()
47− free runningApp = do
47+ stop :: App -> IO ()
48+ stop runningApp = do
4849 killThread $ appThread runningApp
4950 waitFor $ appKilled runningApp
5051
@@ -92,3 +93,7 @@ openFreePort = do
9293 listen s 1
9394 port <- socketPort s
9495 return (fromIntegral port, s)
96+
97+-- | Like 'openFreePort' but closes the socket before exiting.
98+withFreePort :: ((Port, Socket) -> IO a) -> IO a
99+withFreePort = bracket openFreePort (close . snd)