runWaiApp

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

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

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
+        app <- toWaiApp h
-        toWaiApp h >>= f >> return ()
+        runWaiApp f app
-#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
 
 -- for yesod devel
 withDevelAppPort :: Dynamic

yesod/scaffold/Settings/StaticFiles.hs.cg

@@ -1,16 +1,7 @@
 {-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies #-}
 module Settings.StaticFiles where
 
-import Yesod.Static
+import Yesod.Static (staticFiles)
-import qualified Yesod.Static as Static
-
-static :: FilePath -> IO Static
-#ifdef PRODUCTION
-static = Static.static
-#else
-static = Static.staticDevel
-#endif
-
 
 -- | 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

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