diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs
index abe9096a6..e4f19163b 100644
--- a/Hledger/Cli/Commands/Web.hs
+++ b/Hledger/Cli/Commands/Web.hs
@@ -11,9 +11,7 @@ import Control.Applicative.Error (Failing(Success,Failure))
import Control.Concurrent
import Control.Monad.Reader (ask)
import Data.IORef (newIORef, atomicModifyIORef)
-import System.Directory (getModificationTime)
import System.IO.Storage (withStore, putValue, getValue)
-import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
import Text.ParserCombinators.Parsec (parse)
import Hack.Contrib.Constants (_TextHtmlUTF8)
@@ -36,7 +34,6 @@ import Hledger.Cli.Commands.Histogram
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Data
-import Hledger.Read
import Hledger.Read.Journal (someamount)
import Hledger.Cli.Options hiding (value)
#ifdef MAKE
@@ -44,7 +41,7 @@ import Paths_hledger_make (getDataFileName)
#else
import Paths_hledger (getDataFileName)
#endif
-import Hledger.Cli.Utils (openBrowserOn)
+import Hledger.Cli.Utils
tcpport = 5000 :: Int
@@ -73,7 +70,8 @@ server opts args j =
let opts' = opts ++ [Period $ unwords $ map decodeString $ reqParamUtf8 env "p"]
args' = args ++ map decodeString (reqParamUtf8 env "a")
j' <- fromJust `fmap` getValue "hledger" "journal"
- j'' <- journalReloadIfChanged opts' args' j'
+ (changed, j'') <- io $ journalReloadIfChanged opts j'
+ when changed $ putValue "hledger" "journal" j''
-- declare path-specific request handlers
let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit
command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j''
@@ -98,32 +96,10 @@ redirect u c = response $ Hack.Contrib.Response.redirect u c
reqParamUtf8 :: Hack.Env -> String -> [String]
reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env
-journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
-journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
- tmod <- journalFileModifiedTime j
- let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
- -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
- if newer
- then do
- when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
- reload j
- else return j
-
-journalFileModifiedTime :: Journal -> IO ClockTime
-journalFileModifiedTime Journal{filepath=f}
- | null f = getClockTime
- | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
-
-reload :: Journal -> IO Journal
-reload Journal{filepath=f} = do
- j' <- readJournalFile Nothing f
- putValue "hledger" "journal" j'
- return j'
-
ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit
ledgerpage msgs j f = do
env <- getenv
- j' <- io $ journalReloadIfChanged [] [] j
+ (_, j') <- io $ journalReloadIfChanged [] j
hsp msgs $ const
<% addform env %>
<% f j' %>
-- | A loli directive to serve a string in pre tags within the hledger web
@@ -329,7 +305,7 @@ handleAddform j = do
handle :: LocalTime -> Failing Transaction -> AppUnit
handle _ (Failure errs) = hsp errs addform
handle ti (Success t) = do
- io $ journalAddTransaction j t >> reload j
+ io $ journalAddTransaction j t >>= journalReload
ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))
where msg = printf "Added transaction:\n%s" (show t)
diff --git a/Hledger/Cli/Commands/WebYesod.hs b/Hledger/Cli/Commands/WebYesod.hs
index 971f0c9c4..92e2d3a42 100644
--- a/Hledger/Cli/Commands/WebYesod.hs
+++ b/Hledger/Cli/Commands/WebYesod.hs
@@ -6,29 +6,22 @@ A web-based UI.
module Hledger.Cli.Commands.WebYesod
where
--- import Codec.Binary.UTF8.String (decodeString)
import Control.Concurrent -- (forkIO)
import qualified Network.Wai (Request(pathInfo))
-import System.Directory (getModificationTime)
import System.FilePath ((>))
import System.IO.Storage (withStore, putValue, getValue)
-import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
import Text.Hamlet
--- import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Char8 as B
import Yesod
--- import Yesod.Helpers.Static
-- import Hledger.Cli.Commands.Add (journalAddTransaction)
import Hledger.Cli.Commands.Balance
--- import Hledger.Cli.Commands.Histogram
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Cli.Options hiding (value)
-import Hledger.Cli.Utils (openBrowserOn)
+import Hledger.Cli.Utils
import Hledger.Data
-import Hledger.Read
#ifdef MAKE
import Paths_hledger_make (getDataFileName)
#else
@@ -106,14 +99,6 @@ getRegisterPage = withLatestJournalRender showRegisterReport
getBalancePage :: Handler HledgerWebApp RepHtml
getBalancePage = withLatestJournalRender showBalanceReport
-getStyleCss :: Handler HledgerWebApp RepPlain
-getStyleCss = do
- app <- getYesod
- let dir = appWebdir app
- s <- liftIO $ readFile $ dir > "style.css"
- header "Content-Type" "text/css"
- return $ RepPlain $ toContent s
-
withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml
withLatestJournalRender f = do
app <- getYesod
@@ -126,36 +111,19 @@ withLatestJournalRender f = do
args = appArgs app ++ as
fs = optsToFilterSpec opts args t
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
- j' <- liftIO $ journalReloadIfChanged opts args j
+ (changed, j') <- liftIO $ journalReloadIfChanged opts j
+ when changed $ liftIO $ putValue "hledger" "journal" j'
let content = f opts fs j'
return $ RepHtml $ toContent $ renderHamlet id $ template req as ps "" content
-- hamletToRepHtml $ template "" s
-journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
-journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
- tmod <- journalFileModifiedTime j
- let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
- -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
- if newer
- then do
- when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
- reload j
- else return j
-
-journalFileModifiedTime :: Journal -> IO ClockTime
-journalFileModifiedTime Journal{filepath=f}
- | null f = getClockTime
- | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
-
-reload :: Journal -> IO Journal
-reload Journal{filepath=f} = do
- j' <- readJournalFile Nothing f
- putValue "hledger" "journal" j'
- return j'
-
-stylesheet = "/style.css"
--- stylesheet = StaticR "/style.css"
-metacontent = "text/html; charset=utf-8"
+getStyleCss :: Handler HledgerWebApp RepPlain
+getStyleCss = do
+ app <- getYesod
+ let dir = appWebdir app
+ s <- liftIO $ readFile $ dir > "style.css"
+ header "Content-Type" "text/css"
+ return $ RepPlain $ toContent s
template :: Request -> [String] -> [String] -> String -> String -> Hamlet String
template req as ps t s = [$hamlet|
@@ -173,6 +141,8 @@ template req as ps t s = [$hamlet|
|]
where msgs = intercalate ", " []
navbar' = navbar req as ps
+ stylesheet = "/style.css"
+ metacontent = "text/html; charset=utf-8"
navbar :: Request -> [String] -> [String] -> Hamlet String
navbar req as ps = [$hamlet|
diff --git a/Hledger/Cli/Tests.hs b/Hledger/Cli/Tests.hs
index 2efb4cdb0..64feae94a 100644
--- a/Hledger/Cli/Tests.hs
+++ b/Hledger/Cli/Tests.hs
@@ -44,7 +44,7 @@ import Hledger.Cli.Utils
-- | Run unit tests.
runtests :: [Opt] -> [String] -> IO ()
-runtests opts args = do
+runtests _ args = do
(counts,_) <- runner ts
if errors counts > 0 || (failures counts > 0)
then exitFailure
diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs
index 048a44e9a..26bb615c0 100644
--- a/Hledger/Cli/Utils.hs
+++ b/Hledger/Cli/Utils.hs
@@ -10,16 +10,20 @@ module Hledger.Cli.Utils
(
withJournalDo,
readJournalWithOpts,
+ journalReload,
+ journalReloadIfChanged,
+ journalFileModificationTime,
openBrowserOn
)
where
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
-import System.Directory (doesFileExist)
+import System.Directory (doesFileExist, getModificationTime)
import System.Exit
import System.Info (os)
import System.Process (readProcessWithExitCode)
+import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
-- | Parse the user's specified journal file and run a hledger command on
@@ -45,6 +49,34 @@ readJournalWithOpts opts s = do
let cost = CostBasis `elem` opts
return $ (if cost then journalConvertAmountsToCost else id) j
+-- | Re-read a journal from its data file.
+journalReload :: Journal -> IO Journal
+journalReload Journal{filepath=f} = readJournalFile Nothing f
+
+-- | Re-read a journal from its data file using the specified options,
+-- only if the file has changed since last read (or if there is no file,
+-- ie data read from stdin). Return a journal and a flag indicating
+-- whether it was re-read or not.
+journalReloadIfChanged :: [Opt] -> Journal -> IO (Bool, Journal)
+journalReloadIfChanged opts j@Journal{filepath=f,filereadtime=tread} = do
+ tmod <- journalFileModificationTime j
+ let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
+ -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
+ if newer
+ then do
+ when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
+ j' <- journalReload j
+ return (True, j')
+ else
+ return (False, j)
+
+-- | Get the last modified time of the journal's data file (or if there is no
+-- file, the current time).
+journalFileModificationTime :: Journal -> IO ClockTime
+journalFileModificationTime Journal{filepath=f}
+ | null f = getClockTime
+ | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
+
-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode
openBrowserOn u = trybrowsers browsers u