{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Web.Application
( makeApplication
, makeApp
, makeAppWith
) where
import Data.IORef (newIORef, writeIORef)
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
import Network.HTTP.Client (defaultManagerSettings)
import Network.HTTP.Conduit (newManager)
import Yesod.Default.Config
import Hledger.Data (Journal, nulljournal)
import Hledger.Web.Handler.AddR
import Hledger.Web.Handler.MiscR
import Hledger.Web.Handler.EditR
import Hledger.Web.Handler.UploadR
import Hledger.Web.Handler.JournalR
import Hledger.Web.Handler.RegisterR
import Hledger.Web.Import
import Hledger.Web.WebOptions (ServerMode(..), WebOpts(server_mode_), corsPolicy)
mkYesodDispatch "App" resourcesApp
makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
makeApplication WebOpts
opts' Journal
j' AppConfig DefaultEnv Extra
conf' = do
app <- AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeApp AppConfig DefaultEnv Extra
conf' WebOpts
opts'
writeIORef (appJournal app) j'
(logWare . (corsPolicy opts')) <$> toWaiApp app
where
logWare :: Middleware
logWare | Bool
development = Middleware
logStdoutDev
| WebOpts -> ServerMode
server_mode_ WebOpts
opts' ServerMode -> [ServerMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ServerMode
Serve, ServerMode
ServeJson] = Middleware
logStdout
| Bool
otherwise = Middleware
forall a. a -> a
id
makeApp :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeApp :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeApp = Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeAppWith Journal
nulljournal
makeAppWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeAppWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeAppWith Journal
j' AppConfig DefaultEnv Extra
aconf WebOpts
wopts = do
s <- IO Static
staticSite
m <- newManager defaultManagerSettings
jref <- newIORef j'
return App{
settings = aconf
, getStatic = s
, httpManager = m
, appOpts = wopts
, appJournal = jref
}