install a signal handler on unix

This commit is contained in:
Greg Weber 2011-08-04 13:34:11 -07:00
parent 4b6147aa1a
commit 0751543ca1
3 changed files with 23 additions and 7 deletions

View File

@ -17,6 +17,12 @@ import Database.Persist.GenericSql
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Dynamic (Dynamic, toDyn) import Data.Dynamic (Dynamic, toDyn)
#ifndef WINDOWS
import qualified System.Posix.Signals as Signal
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
#endif
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
import Handler.Root import Handler.Root
@ -37,22 +43,31 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- performs initialization and creates a WAI application. This is also the -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO a with~sitearg~ :: AppConfig -> Logger -> (Application -> IO a) -> IO ()
with~sitearg~ conf logger f = do with~sitearg~ conf logger f = do
Settings.withConnectionPool conf $ \p -> do Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ conf logger s p let h = ~sitearg~ conf logger s p
toWaiApp h >>= f #ifdef WINDOWS
toWaiApp h >>= f >> return ()
#else
tid <- forkIO $ toWaiApp h >>= f >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
putStrLn "Caught an interrupt"
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif
where where
s = static Settings.staticDir s = static Settings.staticDir
with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO ()
with~sitearg~LoadConfig env f = do with~sitearg~LoadConfig env f = do
conf <- Settings.loadConfig env conf <- Settings.loadConfig env
logger <- makeLogger logger <- makeLogger
r <- with~sitearg~ conf logger f with~sitearg~ conf logger f
flushLogger logger flushLogger logger
return r
-- for yesod devel -- for yesod devel
withDevelApp :: Dynamic withDevelApp :: Dynamic

View File

@ -64,5 +64,3 @@ executable ~project~
, cmdargs , cmdargs
, data-object , data-object
, data-object-yaml , data-object-yaml
ghc-options: -Wall -threaded

View File

@ -75,3 +75,6 @@ executable ~project~
, warp , warp
, blaze-builder , blaze-builder
, cmdargs , cmdargs
if !os(windows)
build-depends: unix