1 files changed, 61 insertions, 0 deletions
diff --git a/Application.hs b/Application.hs
new file mode 100644
index 0000000..5c9bf83
--- /dev/null
+++ b/Application.hs
@@ -0,0 +1,61 @@
+{-# 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.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
+        }