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