From 0f3f6bd6cb1233c0e585779f38ec13f8ab32d65b Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 23 Sep 2011 08:31:47 +0300 Subject: [PATCH] runWaiApp --- yesod-default/Yesod/Default/Util.hs | 27 ++++++++++++++++++++++ yesod-default/yesod-default.cabal | 5 ++++ yesod/scaffold/Application.hs.cg | 28 ++++++++--------------- yesod/scaffold/Settings/StaticFiles.hs.cg | 11 +-------- yesod/scaffold/tiny/Application.hs.cg | 6 +++-- 5 files changed, 46 insertions(+), 31 deletions(-) diff --git a/yesod-default/Yesod/Default/Util.hs b/yesod-default/Yesod/Default/Util.hs index e715f002..c344b5c6 100644 --- a/yesod-default/Yesod/Default/Util.hs +++ b/yesod-default/Yesod/Default/Util.hs @@ -1,11 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} -- | Various utilities used in the scaffolded site. module Yesod.Default.Util ( addStaticContentExternal , globFile , widgetFileProduction , widgetFileDebug + , runWaiApp ) where import Control.Monad.IO.Class (liftIO) @@ -19,6 +21,13 @@ import Text.Lucius (luciusFile, luciusFileDebug) import Text.Julius (juliusFile, juliusFileDebug) import Text.Cassius (cassiusFile, cassiusFileDebug) import Data.Monoid (mempty) +import Network.Wai (Application) + +#ifndef WINDOWS +import qualified System.Posix.Signals as Signal +import Control.Concurrent (forkIO, killThread) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +#endif -- | An implementation of 'addStaticContent' which stores the contents in an -- external file. Files are created in the given static folder with names based @@ -76,3 +85,21 @@ whenExists x glob f = do let fn = globFile glob x e <- qRunIO $ doesFileExist fn if e then f fn else [|mempty|] + +-- | A signal-aware runner for WAI applications. On Windows, this doesn't do +-- anything special. On POSIX systems, this installs a signal handler for INT +-- and automatically kills the application when the signal is received. This +-- allows you to add cleanup code (like log flushing) after an application +-- exits. +runWaiApp :: (Application -> IO ()) -> Application -> IO () +#ifdef WINDOWS +runWaiApp f app = f app +#else +runWaiApp f app = do + tid <- forkIO $ f app >> return () + flag <- newEmptyMVar + _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do + killThread tid + putMVar flag ()) Nothing + takeMVar flag +#endif diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index 96be62c0..aca6a020 100644 --- a/yesod-default/yesod-default.cabal +++ b/yesod-default/yesod-default.cabal @@ -28,6 +28,11 @@ library , shakespeare-js >= 0.10 && < 0.11 , template-haskell + if os(windows) + cpp-options: -DWINDOWS + else + build-depends: unix + exposed-modules: Yesod.Default.Config , Yesod.Default.Main , Yesod.Default.Util diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 6c9a5c65..56735e75 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -10,21 +10,16 @@ module Application import Foundation import Settings -import Settings.StaticFiles (static) +import Yesod.Static import Yesod.Auth import Yesod.Default.Config import Yesod.Default.Main +import Yesod.Default.Util (runWaiApp) import Yesod.Logger (Logger) import Database.Persist.~importGenericDB~ import Data.ByteString (ByteString) 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 Handler.Root @@ -45,22 +40,17 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO () +with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO () with~sitearg~ conf logger f = do +#ifdef PRODUCTION s <- static Settings.staticDir +#else + s <- staticDevel Settings.staticDir +#endif Settings.withConnectionPool conf $ \p -> do~runMigration~ let h = ~sitearg~ conf logger s p -#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 + app <- toWaiApp h + runWaiApp f app -- for yesod devel withDevelAppPort :: Dynamic diff --git a/yesod/scaffold/Settings/StaticFiles.hs.cg b/yesod/scaffold/Settings/StaticFiles.hs.cg index b59d0ca0..1be2b4ba 100644 --- a/yesod/scaffold/Settings/StaticFiles.hs.cg +++ b/yesod/scaffold/Settings/StaticFiles.hs.cg @@ -1,16 +1,7 @@ {-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies #-} module Settings.StaticFiles where -import Yesod.Static -import qualified Yesod.Static as Static - -static :: FilePath -> IO Static -#ifdef PRODUCTION -static = Static.static -#else -static = Static.staticDevel -#endif - +import Yesod.Static (staticFiles) -- | This generates easy references to files in the static directory at compile time. -- The upside to this is that you have compile-time verification that referenced files diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index 0bd1d218..a13991fc 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -13,6 +13,7 @@ import Settings import Yesod.Static import Yesod.Default.Config import Yesod.Default.Main (defaultDevelApp) +import Yesod.Default.Util (runWaiApp) import Yesod.Logger (Logger) import Data.ByteString (ByteString) import Network.Wai (Application) @@ -38,7 +39,7 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO a +with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO () with~sitearg~ conf logger f = do #ifdef PRODUCTION s <- static Settings.staticDir @@ -46,7 +47,8 @@ with~sitearg~ conf logger f = do s <- staticDevel Settings.staticDir #endif let h = ~sitearg~ conf logger s - toWaiApp h >>= f + app <- toWaiApp h + runWaiApp f app -- for yesod devel withDevelAppPort :: Dynamic