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.Logger (makeLogger, flushLogger, Logger, logLazyText, logString)
import Yesod.Static import Yesod.Static
import Hledger
import Hledger.Web.Foundation import Hledger.Web.Foundation
import Hledger.Web.Handlers import Hledger.Web.Handlers
import Hledger.Web.Options import Hledger.Web.Options
@ -30,8 +29,8 @@ mkYesodDispatch "App" resourcesApp
-- performs initialization and creates a WAI application. This is also the -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
withApp :: AppConfig -> Logger -> (Application -> IO a) -> IO a withApp :: AppConfig -> Logger -> WebOpts -> (Application -> IO a) -> IO a
withApp conf logger f = do withApp conf logger opts f = do
#ifdef PRODUCTION #ifdef PRODUCTION
putStrLn $ "Production mode, using embedded web files" putStrLn $ "Production mode, using embedded web files"
let s = $(embed Hledger.Web.Settings.staticDir) let s = $(embed Hledger.Web.Settings.staticDir)
@ -42,9 +41,7 @@ withApp conf logger f = do
let a = App {settings=conf let a = App {settings=conf
,getLogger=logger ,getLogger=logger
,getStatic=s ,getStatic=s
,appOpts=defwebopts ,appOpts=opts
,appArgs=[]
,appJournal=nulljournal
} }
toWaiApp a >>= f toWaiApp a >>= f
@ -58,8 +55,8 @@ withDevelAppPort =
conf <- Hledger.Web.Settings.loadConfig Hledger.Web.Settings.Development conf <- Hledger.Web.Settings.loadConfig Hledger.Web.Settings.Development
let port = appPort conf let port = appPort conf
logger <- makeLogger logger <- makeLogger
logString logger $ "Devel application launched, listening on port " ++ show port logString logger $ "Devel application launched with default options, listening on port " ++ show port
withApp conf logger $ \app -> f (port, debugHandle (logHandle logger) app) withApp conf logger defwebopts $ \app -> f (port, debugHandle (logHandle logger) app)
flushLogger logger flushLogger logger
where where
logHandle logger msg = logLazyText logger msg >> flushLogger logger 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.ByteString.Lazy as L
import qualified Data.Text as T import qualified Data.Text as T
import Hledger.Data
import Hledger.Web.Options import Hledger.Web.Options
import Hledger.Web.Settings import Hledger.Web.Settings
import Hledger.Web.Settings.StaticFiles import Hledger.Web.Settings.StaticFiles
@ -41,8 +40,7 @@ data App = App
, getStatic :: Static -- ^ Settings for static file serving. , getStatic :: Static -- ^ Settings for static file serving.
,appOpts :: WebOpts ,appOpts :: WebOpts
,appArgs :: [String] -- ,appJournal :: Journal
,appJournal :: Journal
} }
-- This is where we define all of the routes in our application. For a full -- 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 module Hledger.Web.Handlers where
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>))
import Data.Aeson import Data.Aeson
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Either (lefts,rights) import Data.Either (lefts,rights)
@ -857,7 +857,7 @@ viewdataWithDateAndParams d q a p =
let (querymatcher,queryopts) = parseQuery d q let (querymatcher,queryopts) = parseQuery d q
(acctsmatcher,acctsopts) = parseQuery d a (acctsmatcher,acctsopts) = parseQuery d a
in VD { in VD {
opts = defwebopts{cliopts_=defcliopts{reportopts_=defreportopts{no_elide_=True}}} opts = defwebopts
,j = nulljournal ,j = nulljournal
,here = RootR ,here = RootR
,msg = Nothing ,msg = Nothing
@ -879,9 +879,9 @@ getViewData = do
msg <- getMessageOr err msg <- getMessageOr err
Just here <- getCurrentRoute Just here <- getCurrentRoute
today <- liftIO getCurrentDay today <- liftIO getCurrentDay
q <- getParameter "q" q <- getParameterOrNull "q"
a <- getParameter "a" a <- getParameterOrNull "a"
p <- getParameter "p" p <- getParameterOrNull "p"
return (viewdataWithDateAndParams today q a p){ return (viewdataWithDateAndParams today q a p){
opts=opts opts=opts
,msg=msg ,msg=msg
@ -905,9 +905,9 @@ getViewData = do
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-} Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
return (j, Just e) return (j, Just e)
-- | Get the named request parameter. -- | Get the named request parameter, or the empty string if not present.
getParameter :: String -> Handler String getParameterOrNull :: String -> Handler String
getParameter p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)
-- | Get the message set by the last request, or the newer message provided, if any. -- | Get the message set by the last request, or the newer message provided, if any.
getMessageOr :: Maybe String -> Handler (Maybe Html) getMessageOr :: Maybe String -> Handler (Maybe Html)

View File

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

View File

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