wai-handler-launch 3.0.1 → 3.0.2

raw patch · 3 files changed

+28/−15 lines, 3 filesdep +async

Dependencies added: async

Files

• ChangeLog.md +4/−0
• Network/Wai/Handler/Launch.hs +22/−14
• wai-handler-launch.cabal +2/−1

@@ -1,3 +1,7 @@+## 3.0.2++* Don't launch if server fails; kill server on exit [#537](https://github.com/yesodweb/wai/issues/537) [#541](https://github.com/yesodweb/wai/pull/541)+ ## 3.0.1  * make host configurable too (fixes #538) [#539](https://github.com/yesodweb/wai/pull/539)

@@ -15,7 +15,8 @@ import Data.IORef import Data.Monoid (mappend) import Data.String (fromString)-import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent (forkIO, threadDelay, newEmptyMVar, putMVar, takeMVar)+import Control.Concurrent.Async (race) import Control.Monad.IO.Class (liftIO) import Control.Monad (unless) import Control.Exception (throwIO)@@ -33,9 +34,9 @@ import qualified Data.Streaming.Zlib as Z  ping :: IORef Bool -> Middleware-ping  var app req sendResponse+ping  active app req sendResponse     | pathInfo req == ["_ping"] = do-        liftIO $ writeIORef var True+        liftIO $ writeIORef active True         sendResponse $ responseLBS status200 [] ""     | otherwise = app req $ \res -> do         let isHtml hs =@@ -195,20 +196,27 @@ -- @since 3.0.1 runHostPortUrl :: String -> Int -> String -> Application -> IO () runHostPortUrl host port url app = do-    x <- newIORef True-    _ <- forkIO $ Warp.runSettings-        ( Warp.setPort port-        $ Warp.setOnException (\_ _ -> return ())-        $ Warp.setHost (fromString host) Warp.defaultSettings)-        $ ping x app-    launch port url-    loop x+    ready <- newEmptyMVar+    active <- newIORef True+    let settings =+          Warp.setPort port $+          Warp.setOnException (\_ _ -> return ()) $+          Warp.setHost (fromString host) $+          Warp.setBeforeMainLoop (putMVar ready ()) $+          Warp.defaultSettings+    -- Run these threads concurrently; when either one terminates or+    -- raises an exception, the same happens to the other.+    fmap (either id id) $ race+      -- serve app, keep updating the activity flag+      (Warp.runSettings settings (ping active app))+      -- wait for server startup, launch browser, poll until server idle+      (takeMVar ready >> launch port url >> loop active)  loop :: IORef Bool -> IO ()-loop x = do+loop active = do     let seconds = 120     threadDelay $ 1000000 * seconds-    b <- readIORef x+    b <- readIORef active     if b-        then writeIORef x False >> loop x+        then writeIORef active False >> loop active         else return ()

@@ -1,5 +1,5 @@ Name:                wai-handler-launch-Version:             3.0.1+Version:             3.0.2 Synopsis:            Launch a web app in the default browser. description:         API docs and the README are available at <http://www.stackage.org/package/wai-handler-launch>. License:             MIT@@ -21,6 +21,7 @@                    , bytestring              >= 0.9.1.4                    , blaze-builder           >= 0.2.1.4 && < 0.5                    , streaming-commons+                   , async      if os(windows)         c-sources: windows.c