on master help sign in
runInteractive
commit63dddc59301ffa1808845851603c6ee5aeacc785 authorMichael Snoyman <michael@snoyman.com> dateTue 25 Jan 2011, 22:40 (16 years ago) parentf0f3409
1 file changed+21−2
Network/Wai/Handler/Warp.hs+21−2
Network/Wai/Handler/Warp.hs+21−2
@@ -26,6 +26,7 @@ module Network.Wai.Handler.Warp
2626 ( -- * Run a Warp server
2727 run
2828 , runOnException
29+ , runInteractive
2930 , serveConnections
3031 -- * Datatypes
3132 , Port
@@ -56,7 +57,7 @@ import Network.Socket
5657 )
5758import qualified Network.Socket.ByteString as Sock
5859import Control.Exception (bracket, finally, Exception, SomeException, catch)
59−import Control.Concurrent (forkIO)
60+import Control.Concurrent (forkIO, threadDelay)
6061import Data.Maybe (fromMaybe)
6162
6263import Data.Typeable (Typeable)
@@ -79,10 +80,12 @@ import Control.Monad.IO.Class (liftIO)
7980import System.Timeout (timeout)
8081import Data.Word (Word8)
8182import Data.List (foldl')
83+import qualified Control.Concurrent.MVar as MV
84+import Control.Monad (forever)
8285
8386-- | Run an 'Application' on the given port, ignoring all exceptions.
8487run :: Port -> Application -> IO ()
85−run = runOnException print
88+run = runOnException (const $ return ())
8689
8790-- | Run an 'Application' on the given port, with the given exception handler.
8891-- Please note that you will also receive 'InvalidRequest' exceptions.
@@ -93,6 +96,22 @@ runOnException onE port = withSocketsDo . -- FIXME should this be called by clie
9396 sClose .
9497 serveConnections onE port
9598
99+-- | When using the standard 'run' function on Windows in GHCi, ctrl-C becomes
100+-- unresponsive. This function should be a drop-in replacement allowing normal
101+-- operations. This does have a minor performance hit, and therefore this
102+-- function is recommended only for development, not production.
103+runInteractive :: Port -> Application -> IO ()
104+runInteractive port app = withSocketsDo $ do
105+ var <- MV.newMVar Nothing
106+ let clean = MV.modifyMVar_ var $ \s -> maybe (return ()) sClose s >> return Nothing
107+ _ <- forkIO $ bracket
108+ (listenOn $ PortNumber $ fromIntegral port)
109+ (const clean)
110+ (\s -> do
111+ MV.modifyMVar_ var (\_ -> return $ Just s)
112+ serveConnections (const $ return ()) port app s)
113+ forever (threadDelay maxBound) `finally` clean
114+
96115type Port = Int
97116
98117-- | Runs a server, listening on the given socket. The user is responsible for