web: obey at least some command-line options, like --cost

Report filtering options like --period, and filter pattern arguments, are still ignored.
This commit is contained in:
Simon Michael 2011-09-14 19:53:05 +00:00
parent 4ca655b6a0
commit 187a7a1cc7
5 changed files with 17 additions and 22 deletions

View File

@ -15,7 +15,6 @@ import Network.Wai.Middleware.Debug (debugHandle)
import Yesod.Logger (makeLogger, flushLogger, Logger, logLazyText, logString)
import Yesod.Static
import Hledger
import Hledger.Web.Foundation
import Hledger.Web.Handlers
import Hledger.Web.Options
@ -30,8 +29,8 @@ mkYesodDispatch "App" resourcesApp
-- 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.
withApp :: AppConfig -> Logger -> (Application -> IO a) -> IO a
withApp conf logger f = do
withApp :: AppConfig -> Logger -> WebOpts -> (Application -> IO a) -> IO a
withApp conf logger opts f = do
#ifdef PRODUCTION
putStrLn $ "Production mode, using embedded web files"
let s = $(embed Hledger.Web.Settings.staticDir)
@ -42,9 +41,7 @@ withApp conf logger f = do
let a = App {settings=conf
,getLogger=logger
,getStatic=s
,appOpts=defwebopts
,appArgs=[]
,appJournal=nulljournal
,appOpts=opts
}
toWaiApp a >>= f
@ -58,8 +55,8 @@ withDevelAppPort =
conf <- Hledger.Web.Settings.loadConfig Hledger.Web.Settings.Development
let port = appPort conf
logger <- makeLogger
logString logger $ "Devel application launched, listening on port " ++ show port
withApp conf logger $ \app -> f (port, debugHandle (logHandle logger) app)
logString logger $ "Devel application launched with default options, listening on port " ++ show port
withApp conf logger defwebopts $ \app -> f (port, debugHandle (logHandle logger) app)
flushLogger logger
where
logHandle logger msg = logLazyText logger msg >> flushLogger logger

View File

@ -25,7 +25,6 @@ import Yesod.Static (Static, base64md5, StaticRoute(..))
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Hledger.Data
import Hledger.Web.Options
import Hledger.Web.Settings
import Hledger.Web.Settings.StaticFiles
@ -41,8 +40,7 @@ data App = App
, getStatic :: Static -- ^ Settings for static file serving.
,appOpts :: WebOpts
,appArgs :: [String]
,appJournal :: Journal
-- ,appJournal :: Journal
}
-- This is where we define all of the routes in our application. For a full

View File

@ -7,7 +7,7 @@ hledger-web's request handlers, and helpers.
module Hledger.Web.Handlers where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative ((<$>))
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Either (lefts,rights)
@ -857,7 +857,7 @@ viewdataWithDateAndParams d q a p =
let (querymatcher,queryopts) = parseQuery d q
(acctsmatcher,acctsopts) = parseQuery d a
in VD {
opts = defwebopts{cliopts_=defcliopts{reportopts_=defreportopts{no_elide_=True}}}
opts = defwebopts
,j = nulljournal
,here = RootR
,msg = Nothing
@ -879,9 +879,9 @@ getViewData = do
msg <- getMessageOr err
Just here <- getCurrentRoute
today <- liftIO getCurrentDay
q <- getParameter "q"
a <- getParameter "a"
p <- getParameter "p"
q <- getParameterOrNull "q"
a <- getParameterOrNull "a"
p <- getParameterOrNull "p"
return (viewdataWithDateAndParams today q a p){
opts=opts
,msg=msg
@ -905,9 +905,9 @@ getViewData = do
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Get the named request parameter.
getParameter :: String -> Handler String
getParameter p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)
-- | Get the named request parameter, or the empty string if not present.
getParameterOrNull :: String -> Handler String
getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)
-- | Get the message set by the last request, or the newer message provided, if any.
getMessageOr :: Maybe String -> Handler (Maybe Html)

View File

@ -42,6 +42,7 @@ import Data.Object
import qualified Data.Object.Yaml as YAML
import Control.Monad (join)
hledgerorgurl, manualurl :: String
hledgerorgurl = "http://hledger.org"
manualurl = hledgerorgurl++"/MANUAL.html"

View File

@ -91,12 +91,11 @@ server baseurl port opts j = do
, appPort = port_ opts
, appRoot = pack baseurl
}
#if PRODUCTION
withApp c logger $ run (appPort c)
withApp c logger opts $ run (appPort c)
#else
logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
withApp c logger $ run (appPort c) . debugHandle (logHandle logger)
withApp c logger opts $ run (appPort c) . debugHandle (logHandle logger)
flushLogger logger
where