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