slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: preserve initial query when journal changes (#314)

Browse Source 
The initial query specified by command line arguments is now preserved
when the journal is reloaded. This does not appear in the web UI, it's
like an invisible extra filter.
This commit is contained in:
Simon Michael 2016-04-28 21:48:30 -07:00
parent f3360c8cfe
commit 739c8dc4cc
2 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
hledger-web/Foundation.hs
View File

@ -237,11 +237,11 @@ getViewData :: Handler ViewData
getViewData = do getViewData = do
app <- getYesod app <- getYesod
let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today <- liftIO getCurrentDay
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today
lastmsg <- getLastMessage lastmsg <- getLastMessage
let msg = maybe lastmsg (Just . toHtml) merr let msg = maybe lastmsg (Just . toHtml) merr
Just here <- getCurrentRoute Just here <- getCurrentRoute
today <- liftIO getCurrentDay
q <- getParameterOrNull "q" q <- getParameterOrNull "q"
a <- getParameterOrNull "a" a <- getParameterOrNull "a"
p <- getParameterOrNull "p" p <- getParameterOrNull "p"
@ -264,14 +264,14 @@ getViewData = do
-- | Update our copy of the journal if the file changed. If there is an -- | Update our copy of the journal if the file changed. If there is an
-- error while reloading, keep the old one and return the error, and set a -- error while reloading, keep the old one and return the error, and set a
-- ui message. -- ui message.
getCurrentJournal :: App -> CliOpts -> Handler (Journal, Maybe String) getCurrentJournal :: App -> CliOpts -> Day -> Handler (Journal, Maybe String)
getCurrentJournal app opts = do getCurrentJournal app opts d = do
-- XXX put this inside atomicModifyIORef' for thread safety -- XXX put this inside atomicModifyIORef' for thread safety
j <- liftIO $ readIORef $ appJournal app j <- liftIO $ readIORef $ appJournal app
(jE, changed) <- liftIO $ journalReloadIfChanged opts j (ej, changed) <- liftIO $ journalReloadIfChanged opts d j
if not changed if not changed
then return (j,Nothing) then return (j,Nothing)
else case jE of else case ej of
Right j' -> do liftIO $ writeIORef (appJournal app) j' Right j' -> do liftIO $ writeIORef (appJournal app) j'
return (j',Nothing) return (j',Nothing)
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-} Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}

3
hledger-web/Hledger/Web/Main.hs
View File

@ -69,7 +69,8 @@ withJournalDo' opts cmd = do
web :: WebOpts -> Journal -> IO () web :: WebOpts -> Journal -> IO ()
web opts j = do web opts j = do
d <- getCurrentDay d <- getCurrentDay
let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ $ cliopts_ opts) j let initq = queryFromOpts d $ reportopts_ $ cliopts_ opts
j' = filterJournalTransactions initq j
h = "127.0.0.1" h = "127.0.0.1"
p = port_ opts p = port_ opts
u = base_url_ opts u = base_url_ opts