diff options
author | Clint Adams <clint@softwarefreedom.org> | 2015-04-24 12:53:02 -0400 |
---|---|---|
committer | Clint Adams <clint@softwarefreedom.org> | 2015-04-24 12:53:02 -0400 |
commit | 62597317839c7945bfbc4b7a00f55d2db6459ab6 (patch) | |
tree | 6ad8c079d5eea66b05326d435e30cc2b1de43266 /Application.hs |
Diffstat (limited to 'Application.hs')
-rw-r--r-- | Application.hs | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/Application.hs b/Application.hs new file mode 100644 index 0000000..9dc03c3 --- /dev/null +++ b/Application.hs @@ -0,0 +1,62 @@ +{-# 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 Yesod.Logger (Logger, logBS, toProduction) +import Network.Wai.Middleware.RequestLogger (logCallback, logCallbackDev) +import qualified Database.Persist.Store +import Database.Persist.GenericSql (runMigration) +import Network.HTTP.Conduit (newManager, def) + +-- Import all relevant handler modules here. +-- Don't forget to add new modules to your cabal file! +import Handler.Home +import Handler.Me + +-- This line actually creates our YesodSite 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 -> Logger -> IO Application +makeApplication conf logger = do + foundation <- makeFoundation conf setLogger + app <- toWaiAppPlain foundation + return $ logWare app + where + setLogger = if development then logger else toProduction logger + logWare = if development then logCallbackDev (logBS setLogger) + else logCallback (logBS setLogger) + +makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App +makeFoundation conf setLogger = do + manager <- newManager def + s <- staticSite + dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) + Database.Persist.Store.loadConfig >>= + Database.Persist.Store.applyEnv + p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) + Database.Persist.Store.runPool dbconf (runMigration migrateAll) p + return $ App conf setLogger s p manager dbconf + +-- for yesod devel +getApplicationDev :: IO (Int, Application) +getApplicationDev = + defaultDevelApp loader makeApplication + where + loader = loadConfig (configSettings Development) + { csParseExtra = parseExtra + } |