{-# 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 Network.HTTP.Conduit (newManager, def) import Data.Yaml ((.:)) import Control.Monad (mzero) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! 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. 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 ledgerconf <- withYamlEnvironment "config/hledger.yml" (appEnv conf) loadLedgerFileList return $ App conf setLogger s manager ledgerconf where loadLedgerFileList (Object o) = o .: "ledgers" loadLedgerFileList _ = mzero -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = defaultDevelApp loader makeApplication where loader = loadConfig (configSettings Development) { csParseExtra = parseExtra }