module Yesod.Default.Main
( defaultMain
, defaultRunner
, defaultDevelApp
, defaultDevelAppWith
) where
import Yesod.Core
import Yesod.Default.Config
import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Debug (debugHandle)
#ifndef WINDOWS
import qualified System.Posix.Signals as Signal
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
#endif
defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
defaultMain load withSite = do
config <- load
logger <- makeLogger
withSite config logger $ run (appPort config)
defaultRunner :: (YesodDispatch y y, Yesod y)
=> (Application -> IO a)
-> y
-> IO ()
defaultRunner f h =
#ifdef WINDOWS
toWaiApp h >>= f >> return ()
#else
do
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
defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ())
-> ((Int, Application) -> IO ())
-> IO ()
defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
defaultDevelAppWith :: (Show e, Read e)
=> IO (AppConfig e)
-> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ())
-> ((Int, Application) -> IO ()) -> IO ()
defaultDevelAppWith load withSite f = do
conf <- load
logger <- makeLogger
let p = appPort conf
logString logger $ "Devel application launched, listening on port " ++ show p
withSite conf logger $ \app -> f (p, debugHandle (logHandle logger) app)
flushLogger logger
where
logHandle logger msg = logLazyText logger msg >> flushLogger logger