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:
		
							parent
							
								
									4ca655b6a0
								
							
						
					
					
						commit
						187a7a1cc7
					
				| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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) | ||||||
|  | |||||||
| @ -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" | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user