{-# OPTIONS_GHC -fno-warn-orphans #-} module Application ( makeApplication , getApplicationDev , makeFoundation ) where import Import import Settings import Yesod.Auth import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers import Network.Wai.Middleware.RequestLogger ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination ) import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Control.Monad.Logger (runLoggingT) import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Handler.Home -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- comments there for more details. mkYesodDispatch "App" resourcesApp -- This function allocates resources (such as a database connection pool), -- 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. makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf -- Initialize the logging middleware logWare <- mkRequestLogger def { outputFormat = if development then Detailed True else Apache FromSocket , destination = RequestLogger.Logger $ loggerSet $ appLogger foundation } -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation let logFunc = messageLoggerSource foundation (appLogger foundation) return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation conf = do manager <- newManager s <- staticSite dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) Database.Persist.loadConfig >>= Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) loggerSet' <- newStdoutLoggerSet defaultBufSize (getter, updater) <- clockDateCacher -- If the Yesod logger (as opposed to the request logger middleware) is -- used less than once a second on average, you may prefer to omit this -- thread and use "(updater >> getter)" in place of "getter" below. That -- would update the cache every time it is used, instead of every second. let updateLoop = do threadDelay 1000000 updater updateLoop _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf logger -- Perform database migration using our application's logging settings. runLoggingT (Database.Persist.runPool dbconf (runMigration migrateAll) p) (messageLoggerSource foundation logger) return foundation -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra }