@@ -1,4 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3module RunSpec (main, spec) where
4module RunSpec (main, spec) where
@@ -19,7 +20,9 @@ import System.IO (hFlush, hClose)
19import System.IO.Unsafe (unsafePerformIO)
20import System.IO.Unsafe (unsafePerformIO)
20import Test.Hspec
21import Test.Hspec
21import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
22import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
22−import Control.Exception (bracket)
23+import Control.Exception (bracket, try, IOException, onException)
24+import Data.Conduit.Network (bindPort)
25+import Network.Socket (sClose)
24main :: IO ()
27main :: IO ()
25main = hspec spec
28main = hspec spec
@@ -68,7 +71,14 @@ nextPort :: I.IORef Int
68nextPort = unsafePerformIO $ I.newIORef 5000
71nextPort = unsafePerformIO $ I.newIORef 5000
70getPort :: IO Int
73getPort :: IO Int
71−getPort = I.atomicModifyIORef nextPort $ \p -> (p + 1, p)
75+ port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p)
76+ esocket <- try $ bindPort port HostIPv4
78+ Left (_ :: IOException) -> getPort
73withApp :: Settings -> Application -> (Int -> IO a) -> IO a
83withApp :: Settings -> Application -> (Int -> IO a) -> IO a
74withApp settings app f = do
84withApp settings app f = do
@@ -78,7 +88,7 @@ withApp settings app f = do
78 (forkIO $ runSettings settings
88 (forkIO $ runSettings settings
79 { settingsPort = port
89 { settingsPort = port
80 , settingsBeforeMainLoop = putMVar baton ()
90 , settingsBeforeMainLoop = putMVar baton ()
81− } app)
91+ } app `onException` putMVar baton ())
82 killThread
92 killThread
83 (const $ takeMVar baton >> f port)
93 (const $ takeMVar baton >> f port)