diff options
author | Daniel Gnoutcheff <gnoutchd@softwarefreedom.org> | 2016-05-27 16:00:00 -0400 |
---|---|---|
committer | Daniel Gnoutcheff <gnoutchd@softwarefreedom.org> | 2018-09-26 18:11:11 -0400 |
commit | a1a17acb326020f1b57f587230cb439e901784df (patch) | |
tree | 358a1ea916a242609a981ff46e2a6814a2208cec /Application.hs | |
parent | f1a294e5ddb8ae0ccdcef1a12561e603ff996cfe (diff) |
Ported to Debian jessie
Most of the churn here comes from rebasing the Yesod boilerplate.
Diffstat (limited to 'Application.hs')
-rw-r--r-- | Application.hs | 64 |
1 files changed, 42 insertions, 22 deletions
diff --git a/Application.hs b/Application.hs index a74c493..2a16ab7 100644 --- a/Application.hs +++ b/Application.hs @@ -6,16 +6,20 @@ module Application ) 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 Network.HTTP.Conduit (newManager, def) +import Network.Wai.Middleware.RequestLogger + ( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination + ) +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger +import Network.HTTP.Client.Conduit (newManager) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) +import Network.Wai.Logger (clockDateCacher) +import Data.Default (def) import Data.Yaml ((.:)) import Control.Monad (mzero) +import Yesod.Core.Types (loggerSet, Logger (Logger)) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -23,31 +27,47 @@ import Handler.Home import Handler.Journal import Handler.Register --- 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. +-- 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 -> Logger -> IO Application -makeApplication conf logger = do - foundation <- makeFoundation conf setLogger +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 - return $ logWare app - where - setLogger = if development then logger else toProduction logger - logWare = if development then logCallbackDev (logBS setLogger) - else logCallback (logBS setLogger) + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare $ defaultMiddlewaresNoLogging app, logFunc) -makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App -makeFoundation conf setLogger = do - manager <- newManager def +-- | 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 ledgerconf <- withYamlEnvironment "config/hledger.yml" (appEnv conf) loadLedgerFileList - return $ App conf setLogger s manager ledgerconf + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, _) <- clockDateCacher + + let logger = Yesod.Core.Types.Logger loggerSet' getter + foundation = App conf s manager ledgerconf logger + + return $ foundation where loadLedgerFileList (Object o) = o .: "ledgers" loadLedgerFileList _ = mzero @@ -55,8 +75,8 @@ makeFoundation conf setLogger = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where - loader = loadConfig (configSettings Development) + loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra } |