From 187a7a1cc7344e19edd030572e4e4d9e466e1113 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 14 Sep 2011 19:53:05 +0000 Subject: [PATCH] web: obey at least some command-line options, like --cost Report filtering options like --period, and filter pattern arguments, are still ignored. --- hledger-web/Hledger/Web/Application.hs | 13 +++++-------- hledger-web/Hledger/Web/Foundation.hs | 4 +--- hledger-web/Hledger/Web/Handlers.hs | 16 ++++++++-------- hledger-web/Hledger/Web/Settings.hs | 1 + hledger-web/hledger-web.hs | 5 ++--- 5 files changed, 17 insertions(+), 22 deletions(-) diff --git a/hledger-web/Hledger/Web/Application.hs b/hledger-web/Hledger/Web/Application.hs index f20a1dc43..2bb4ab173 100644 --- a/hledger-web/Hledger/Web/Application.hs +++ b/hledger-web/Hledger/Web/Application.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Foundation.hs b/hledger-web/Hledger/Web/Foundation.hs index 3de09e9c7..58efac0d6 100644 --- a/hledger-web/Hledger/Web/Foundation.hs +++ b/hledger-web/Hledger/Web/Foundation.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index eb49e313b..59f1b6ccc 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -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) diff --git a/hledger-web/Hledger/Web/Settings.hs b/hledger-web/Hledger/Web/Settings.hs index efe63af54..68acba967 100644 --- a/hledger-web/Hledger/Web/Settings.hs +++ b/hledger-web/Hledger/Web/Settings.hs @@ -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" diff --git a/hledger-web/hledger-web.hs b/hledger-web/hledger-web.hs index e2455b19f..46a394fab 100644 --- a/hledger-web/hledger-web.hs +++ b/hledger-web/hledger-web.hs @@ -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