module Yesod.Default.Main
( defaultMain
, defaultRunner
, defaultDevelApp
) where
import Yesod.Default.Config
import Yesod.Logger (Logger, defaultDevelopmentLogger, logString)
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 -> IO Application)
-> IO ()
defaultMain load getApp = do
config <- load
logger <- defaultDevelopmentLogger
app <- getApp config logger
print $ appHost config
runSettings defaultSettings
{ settingsPort = appPort config
, settingsHost = appHost config
} app
defaultRunner :: (Application -> IO ()) -> Application -> IO ()
defaultRunner f app = do
exists <- doesDirectoryExist staticCache
when exists $ removeDirectoryRecursive staticCache
#ifdef WINDOWS
f (middlewares app)
#else
tid <- forkIO $ f (middlewares app) >> 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
:: (Show env, Read env)
=> IO (AppConfig env extra)
-> (AppConfig env extra -> Logger -> IO Application)
-> IO (Int, Application)
defaultDevelApp load getApp = do
conf <- load
logger <- defaultDevelopmentLogger
let p = appPort conf
logString logger $ "Devel application launched: http://localhost:" ++ show p
app <- getApp conf logger
return (p, app)