git.iko.soy/typeable/wai
on master help sign in
runInteractive
63dddc5Michael Snoyman
Network/Wai/Handler/Warp.hs+21−2
compare with master
unifiedsplit
@@ -26,6 +26,7 @@ module Network.Wai.Handler.Warp
26 ( -- * Run a Warp server
26 ( -- * Run a Warp server
27 run
27 run
28 , runOnException
28 , runOnException
29+ , runInteractive
29 , serveConnections
30 , serveConnections
30 -- * Datatypes
31 -- * Datatypes
31 , Port
32 , Port
@@ -56,7 +57,7 @@ import Network.Socket
56 )
57 )
57import qualified Network.Socket.ByteString as Sock
58import qualified Network.Socket.ByteString as Sock
58import Control.Exception (bracket, finally, Exception, SomeException, catch)
59import Control.Exception (bracket, finally, Exception, SomeException, catch)
59−import Control.Concurrent (forkIO)
60+import Control.Concurrent (forkIO, threadDelay)
60import Data.Maybe (fromMaybe)
61import Data.Maybe (fromMaybe)
61
62
62import Data.Typeable (Typeable)
63import Data.Typeable (Typeable)
@@ -79,10 +80,12 @@ import Control.Monad.IO.Class (liftIO)
79import System.Timeout (timeout)
80import System.Timeout (timeout)
80import Data.Word (Word8)
81import Data.Word (Word8)
81import Data.List (foldl')
82import Data.List (foldl')
83+import qualified Control.Concurrent.MVar as MV
84+import Control.Monad (forever)
82
85
83-- | Run an 'Application' on the given port, ignoring all exceptions.
86-- | Run an 'Application' on the given port, ignoring all exceptions.
84run :: Port -> Application -> IO ()
87run :: Port -> Application -> IO ()
85−run = runOnException print
88+run = runOnException (const $ return ())
86
89
87-- | Run an 'Application' on the given port, with the given exception handler.
90-- | Run an 'Application' on the given port, with the given exception handler.
88-- Please note that you will also receive 'InvalidRequest' exceptions.
91-- Please note that you will also receive 'InvalidRequest' exceptions.
@@ -93,6 +96,22 @@ runOnException onE port = withSocketsDo . -- FIXME should this be called by clie
93 sClose .
96 sClose .
94 serveConnections onE port
97 serveConnections onE port
95
98
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+
96type Port = Int
115type Port = Int
97
116
98-- | Runs a server, listening on the given socket. The user is responsible for
117-- | Runs a server, listening on the given socket. The user is responsible for