eidolon/Application.hs

120 lines
4.2 KiB
Haskell
Raw Normal View History

2014-08-09 18:33:22 +00:00
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( makeApplication
, getApplicationDev
, makeFoundation
) where
import Import
import Settings
2014-08-12 12:37:31 +00:00
-- import Yesod.Auth
2014-08-09 18:33:22 +00:00
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 Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager)
import Control.Monad.Logger (runLoggingT)
import Control.Concurrent (forkIO, threadDelay)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher)
import Data.Default (def)
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
2014-08-12 12:37:31 +00:00
import Handler.Signup
import Handler.Login
import Handler.Activate
import Handler.Profile
import Handler.Upload
2014-08-13 22:49:37 +00:00
import Handler.NewAlbum
2014-08-17 20:59:17 +00:00
import Handler.Album
2014-08-18 04:06:16 +00:00
import Handler.Medium
2014-08-28 16:08:56 +00:00
import Handler.AlbumSettings
2014-08-30 18:25:08 +00:00
import Handler.MediumSettings
2014-09-04 01:57:01 +00:00
import Handler.Reactivate
2014-09-05 18:40:12 +00:00
import Handler.ProfileSettings
import Handler.ProfileDelete
import Handler.Admin
import Handler.AdminProfileSettings
2014-09-07 04:56:34 +00:00
import Handler.AdminAlbumSettings
2014-09-09 02:25:47 +00:00
import Handler.AdminMediumSettings
2014-09-14 03:03:13 +00:00
import Handler.Tag
2014-08-09 18:33:22 +00:00
-- 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 $ defaultMiddlewaresNoLogging 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/sqlite.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
flushLogStr loggerSet'
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
}