install a signal handler on unix
This commit is contained in:
parent
4b6147aa1a
commit
0751543ca1
@ -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
|
||||||
|
|||||||
@ -64,5 +64,3 @@ executable ~project~
|
|||||||
, cmdargs
|
, cmdargs
|
||||||
, data-object
|
, data-object
|
||||||
, data-object-yaml
|
, data-object-yaml
|
||||||
ghc-options: -Wall -threaded
|
|
||||||
|
|
||||||
|
|||||||
@ -75,3 +75,6 @@ executable ~project~
|
|||||||
, warp
|
, warp
|
||||||
, blaze-builder
|
, blaze-builder
|
||||||
, cmdargs
|
, cmdargs
|
||||||
|
|
||||||
|
if !os(windows)
|
||||||
|
build-depends: unix
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user