{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Hledger.Web.Application
( makeApplication
, makeFoundation
, makeFoundationWith
) 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 (WebOpts(serve_,serve_api_), 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
foundation <- AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundation AppConfig DefaultEnv Extra
conf' WebOpts
opts'
forall a. IORef a -> a -> IO ()
writeIORef (App -> IORef Journal
appJournal App
foundation) Journal
j'
(Application -> Application
logWare forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WebOpts -> Application -> Application
corsPolicy WebOpts
opts')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall site. YesodDispatch site => site -> IO Application
toWaiApp App
foundation
where
logWare :: Application -> Application
logWare | Bool
development = Application -> Application
logStdoutDev
| WebOpts -> Bool
serve_ WebOpts
opts' Bool -> Bool -> Bool
|| WebOpts -> Bool
serve_api_ WebOpts
opts' = Application -> Application
logStdout
| Bool
otherwise = forall a. a -> a
id
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundation AppConfig DefaultEnv Extra
conf WebOpts
opts' = do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
Static
s <- IO Static
staticSite
IORef Journal
jref <- forall a. a -> IO (IORef a)
newIORef Journal
nulljournal
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppConfig DefaultEnv Extra
-> Static -> Manager -> WebOpts -> IORef Journal -> App
App AppConfig DefaultEnv Extra
conf Static
s Manager
manager WebOpts
opts' IORef Journal
jref
makeFoundationWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundationWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundationWith Journal
j' AppConfig DefaultEnv Extra
conf WebOpts
opts' = do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
Static
s <- IO Static
staticSite
IORef Journal
jref <- forall a. a -> IO (IORef a)
newIORef Journal
j'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppConfig DefaultEnv Extra
-> Static -> Manager -> WebOpts -> IORef Journal -> App
App AppConfig DefaultEnv Extra
conf Static
s Manager
manager WebOpts
opts' IORef Journal
jref