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.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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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" | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user