2012-11-15 21:48:48 +04:00
|
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
2015-04-08 04:35:41 +03:00
|
|
|
{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}
|
2012-11-15 21:48:48 +04:00
|
|
|
module Application
|
|
|
|
( makeApplication
|
|
|
|
, getApplicationDev
|
|
|
|
, makeFoundation
|
|
|
|
) where
|
|
|
|
|
2013-04-09 20:33:19 +04:00
|
|
|
import Data.IORef
|
2012-11-15 21:48:48 +04:00
|
|
|
import Import
|
|
|
|
import Yesod.Default.Config
|
|
|
|
import Yesod.Default.Main
|
|
|
|
import Yesod.Default.Handlers
|
2013-05-01 18:23:59 +04:00
|
|
|
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
|
2013-12-09 22:06:53 +04:00
|
|
|
import Network.HTTP.Conduit (newManager)
|
2015-06-04 19:44:58 +03:00
|
|
|
import Prelude (head)
|
2013-12-09 22:06:53 +04:00
|
|
|
|
|
|
|
-- adapt to http-conduit 1.x or 2.x when cabal macros are available, otherwise assume 2.x
|
|
|
|
#ifdef MIN_VERSION_http_conduit
|
|
|
|
#if MIN_VERSION_http_conduit(2,0,0)
|
|
|
|
#define http_conduit_2
|
|
|
|
#endif
|
|
|
|
#else
|
|
|
|
#define http_conduit_2
|
|
|
|
#endif
|
|
|
|
#ifdef http_conduit_2
|
|
|
|
import Network.HTTP.Client (defaultManagerSettings)
|
|
|
|
#else
|
|
|
|
import Network.HTTP.Conduit (def)
|
|
|
|
#endif
|
2012-11-15 21:48:48 +04:00
|
|
|
|
|
|
|
-- Import all relevant handler modules here.
|
|
|
|
-- Don't forget to add new modules to your cabal file!
|
2012-11-20 06:23:23 +04:00
|
|
|
import Handler.RootR
|
|
|
|
import Handler.JournalR
|
|
|
|
import Handler.RegisterR
|
2014-06-13 03:14:41 +04:00
|
|
|
import Handler.SidebarR
|
2012-11-15 21:48:48 +04:00
|
|
|
|
2015-08-28 22:33:33 +03:00
|
|
|
import Hledger.Web.WebOptions (WebOpts(..), defwebopts)
|
2013-04-09 20:33:19 +04:00
|
|
|
import Hledger.Data (Journal, nulljournal)
|
|
|
|
import Hledger.Read (readJournalFile)
|
|
|
|
import Hledger.Utils (error')
|
2015-08-28 22:33:33 +03:00
|
|
|
import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts)
|
2012-11-15 21:48:48 +04:00
|
|
|
|
|
|
|
-- 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.
|
2013-05-01 18:23:59 +04:00
|
|
|
makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
|
|
|
|
makeApplication opts j conf = do
|
2015-06-25 17:32:37 +03:00
|
|
|
foundation <- makeFoundation conf opts
|
2013-04-09 20:33:19 +04:00
|
|
|
writeIORef (appJournal foundation) j
|
2012-11-15 21:48:48 +04:00
|
|
|
app <- toWaiAppPlain foundation
|
|
|
|
return $ logWare app
|
|
|
|
where
|
2013-05-01 18:23:59 +04:00
|
|
|
logWare | development = logStdoutDev
|
2016-11-21 18:38:58 +03:00
|
|
|
| serve_ opts = logStdout
|
2013-05-01 18:23:59 +04:00
|
|
|
| otherwise = id
|
2012-11-15 21:48:48 +04:00
|
|
|
|
2015-06-25 17:32:37 +03:00
|
|
|
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
|
|
|
makeFoundation conf opts = do
|
2013-12-09 22:06:53 +04:00
|
|
|
manager <- newManager
|
|
|
|
#ifdef http_conduit_2
|
|
|
|
defaultManagerSettings
|
|
|
|
#else
|
|
|
|
def
|
|
|
|
#endif
|
2012-11-15 21:48:48 +04:00
|
|
|
s <- staticSite
|
2013-04-09 20:33:19 +04:00
|
|
|
jref <- newIORef nulljournal
|
2015-06-25 17:32:37 +03:00
|
|
|
return $ App conf s manager opts jref
|
2012-11-15 21:48:48 +04:00
|
|
|
|
|
|
|
-- for yesod devel
|
2013-04-09 20:33:19 +04:00
|
|
|
-- uses the journal specified by the LEDGER_FILE env var, or ~/.hledger.journal
|
2012-11-15 21:48:48 +04:00
|
|
|
getApplicationDev :: IO (Int, Application)
|
2013-04-09 20:33:19 +04:00
|
|
|
getApplicationDev = do
|
2015-06-04 19:44:58 +03:00
|
|
|
f <- head `fmap` journalFilePathFromOpts defcliopts -- XXX head should be safe for now
|
2014-07-03 20:37:02 +04:00
|
|
|
j <- either error' id `fmap` readJournalFile Nothing Nothing True f
|
2013-05-01 18:23:59 +04:00
|
|
|
defaultDevelApp loader (makeApplication defwebopts j)
|
2012-11-15 21:48:48 +04:00
|
|
|
where
|
2013-05-15 02:36:44 +04:00
|
|
|
loader = Yesod.Default.Config.loadConfig (configSettings Development)
|
2012-11-15 21:48:48 +04:00
|
|
|
{ csParseExtra = parseExtra
|
|
|
|
}
|