happstack-helpers 0.45 → 0.46

raw patch · 2 files changed

+35/−6 lines, 2 files

Files

• Happstack/Server/Helpers.hs +34/−5
• happstack-helpers.cabal +1/−1

@@ -2,7 +2,8 @@ module Happstack.Server.Helpers     ( smartserver, exactdir, smartserver',getData',vhosts,vhost     ) where-+import qualified Control.Exception as E+import Data.IORef import Happstack.Server import Happstack.State import System.Environment@@ -12,6 +13,8 @@ import Debug.Trace.Helpers import Data.Maybe (fromMaybe) import qualified Data.ByteString.Char8 as B+import System.Exit+ -- run the happs server on some port -- include cookie fix, various other enhancements that make things simpler smartserver' :: (Methods st, Component st, ToMessage b, Monad m, Functor m) => @@ -23,19 +26,33 @@       control <- startSystemState stateProxy -- start the HAppS state system        putStrLn . ( "happs state started" ++ ) =<< time-      tid <- forkIO $ simpleHTTP' f conf handler-      putStrLn . ( ( "simpleHttp started on port " ++ (show . port $ conf) ++ "\n" +++      +      -- if the web server throws an error within 3 seconds, exit app gracefully (is there a better way to handle this?)+      (webserverTid,result) <- catchStartupErrorInForkIO (simpleHTTP' f conf handler) 3+      case result of+        Left e -> do putStrLn $ "smartserver' couldn't start http server: " ++ (show e) +                     stateShutdown control +                     exitWith $ ExitFailure 0+        _ -> putStrLn . ( ( "simpleHttp started on port " ++ (show . port $ conf) ++ "\n" ++                  "shut down with ctrl-c" ) ++) =<< time       waitForTermination-      killThread tid+      killThread webserverTid+      stateShutdown control++time = return . ("\ntime: " ++ ) . show  =<< getClockTime++stateShutdown control = do++       putStrLn . ( "creating checkpoint: " ++ ) =<< time       createCheckpoint control        putStrLn .  ( "shutting down system: " ++ ) =<< time       shutdownSystem control        putStrLn .  ( "exiting: " ++ ) =<< time-         where time = return . ("\ntime: " ++ ) . show  =<< getClockTime+   + smartserver :: (Methods st, Component st, ToMessage a) =>                Conf -> ServerPartT IO a -> Proxy st -> IO () smartserver = smartserver' id@@ -67,3 +84,15 @@   (d :: String) <- (B.unpack . fromMaybe (error "Happstack.Helpers.Server.vhost, no host header")) `liftM` getHeaderM "host"   guardRq $ \rq -> (d,p) == vh   sp++{-| If a forked IO action throws an exception within a certain amount of time, return the exception along with the threadId.+    wait time needs to be long enough for the exception to arise, so when in doubt, err on the side of longer wait time+-}+catchStartupErrorInForkIO :: IO () -> Int -> IO (ThreadId, Either E.SomeException ())+catchStartupErrorInForkIO ioAction waitSeconds = do+  eIOref <- newIORef $ Right ()+  tid <- forkIO $ ioAction `E.catch` (\e -> writeIORef eIOref (Left e))+  threadDelay $ waitSeconds * (10^6)+  new <- readIORef eIOref+  return (tid,new)+

@@ -1,5 +1,5 @@ Name: happstack-helpers-Version: 0.45+Version: 0.46 License: BSD3 License-file: bsd3.txt Description: Functions I found I was using repeatedly when programming Happstack based web-apps.