module Yesod.Default.Main
( defaultMain
, defaultRunner
, defaultDevelApp
, defaultDevelAppWith
) where
import Yesod.Core hiding (AppConfig (..))
import Yesod.Default.Config
import Yesod.Logger (Logger, makeDefaultLogger, logString, flushLogger)
import Network.Wai (Application)
import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort, settingsHost)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import Network.Wai.Middleware.Gzip (gzip', GzipFiles (GzipCacheFolder), gzipFiles, def)
import Network.Wai.Middleware.Autohead (autohead)
import Network.Wai.Middleware.Jsonp (jsonp)
import Control.Monad (when)
#ifndef WINDOWS
import qualified System.Posix.Signals as Signal
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
#endif
defaultMain :: (Show env, Read env)
=> IO (AppConfig env extra)
-> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ())
-> IO ()
defaultMain load withSite = do
config <- load
logger <- makeDefaultLogger
withSite config logger $ runSettings defaultSettings
{ settingsHost = "0.0.0.0"
, settingsPort = appPort config
}
defaultRunner :: (YesodDispatch y y, Yesod y)
=> (Application -> IO a)
-> y
-> IO ()
defaultRunner f h = do
exists <- doesDirectoryExist staticCache
when exists $ removeDirectoryRecursive staticCache
#ifdef WINDOWS
toWaiAppPlain h >>= f . middlewares >> return ()
#else
tid <- forkIO $ toWaiAppPlain h >>= f . middlewares >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
putStrLn "Caught an interrupt"
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif
where
middlewares = gzip' gset . jsonp . autohead
gset = def { gzipFiles = GzipCacheFolder staticCache }
staticCache = ".static-cache"
defaultDevelApp :: (AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ())
-> ((Int, Application) -> IO ())
-> IO ()
defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
defaultDevelAppWith :: (Show env, Read env)
=> IO (AppConfig env extra)
-> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ())
-> ((Int, Application) -> IO ()) -> IO ()
defaultDevelAppWith load withSite f = do
conf <- load
logger <- makeDefaultLogger
let p = appPort conf
logString logger $ "Devel application launched, listening on port " ++ show p
withSite conf logger $ \app -> f (p, app)
flushLogger logger