diff --git a/Hledger/Cli/Commands/Add.hs b/Hledger/Cli/Commands/Add.hs index f1699ca47..f95563b96 100644 --- a/Hledger/Cli/Commands/Add.hs +++ b/Hledger/Cli/Commands/Add.hs @@ -19,42 +19,42 @@ import System.IO ( stderr, hFlush, hPutStrLn, hPutStr ) #endif import System.IO.Error import Text.ParserCombinators.Parsec -import Hledger.Cli.Utils (ledgerFromStringWithOpts) +import Hledger.Cli.Utils (journalFromStringWithOpts) import qualified Data.Foldable as Foldable (find) -- | Read ledger transactions from the terminal, prompting for each field, -- and append them to the ledger file. If the ledger came from stdin, this -- command has no effect. -add :: [Opt] -> [String] -> Ledger -> IO () -add opts args l - | filepath (journal l) == "-" = return () +add :: [Opt] -> [String] -> Journal -> IO () +add opts args j + | filepath j == "-" = return () | otherwise = do hPutStrLn stderr $ "Enter one or more transactions, which will be added to your ledger file.\n" ++"To complete a transaction, enter . as account name. To quit, press control-c." today <- getCurrentDay - getAndAddTransactions l opts args today `catch` (\e -> unless (isEOFError e) $ ioError e) + getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e) --- | Read a number of ledger transactions from the command line, --- prompting, validating, displaying and appending them to the ledger --- file, until end of input (then raise an EOF exception). Any --- command-line arguments are used as the first transaction's description. -getAndAddTransactions :: Ledger -> [Opt] -> [String] -> Day -> IO () -getAndAddTransactions l opts args defaultDate = do - (ledgerTransaction,date) <- getTransaction l opts args defaultDate - l <- ledgerAddTransaction l ledgerTransaction - getAndAddTransactions l opts args date +-- | Read a number of transactions from the command line, prompting, +-- validating, displaying and appending them to the journal file, until +-- end of input (then raise an EOF exception). Any command-line arguments +-- are used as the first transaction's description. +getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO () +getAndAddTransactions j opts args defaultDate = do + (t, d) <- getTransaction j opts args defaultDate + j <- journalAddTransaction j t + getAndAddTransactions j opts args d -- | Read a transaction from the command line, with history-aware prompting. -getTransaction :: Ledger -> [Opt] -> [String] -> Day -> IO (Transaction,Day) -getTransaction l opts args defaultDate = do +getTransaction :: Journal -> [Opt] -> [String] -> Day -> IO (Transaction,Day) +getTransaction j opts args defaultDate = do today <- getCurrentDay datestr <- askFor "date" (Just $ showDate defaultDate) (Just $ \s -> null s || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) description <- askFor "description" Nothing (Just $ not . null) - let historymatches = transactionsSimilarTo l args description + let historymatches = transactionsSimilarTo j args description bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch @@ -63,7 +63,7 @@ getTransaction l opts args defaultDate = do if NoNewAccts `elem` opts then isJust $ Foldable.find (== x) ant else True - where (ant,_,_,_) = groupPostings . journalPostings . journal $ l + where (ant,_,_,_) = groupPostings $ journalPostings j getpostingsandvalidate = do ps <- getPostings accept bestmatchpostings [] let t = nulltransaction{tdate=date @@ -129,30 +129,26 @@ askFor prompt def validator = do Nothing -> return input where showdef s = " [" ++ s ++ "]" --- | Append this transaction to the ledger's file. Also, to the ledger's +-- | Append this transaction to the journal's file. Also, to the journal's -- transaction list, but we don't bother updating the other fields - this -- is enough to include new transactions in the history matching. -ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger -ledgerAddTransaction l t = do - appendToLedgerFile l $ showTransaction t - putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) +journalAddTransaction :: Journal -> Transaction -> IO Journal +journalAddTransaction j@Journal{jtxns=ts} t = do + appendToJournalFile j $ showTransaction t + putStrLn $ printf "\nAdded transaction to %s:" (filepath j) putStrLn =<< registerFromString (show t) - return l{journal=rl{jtxns=ts}} - where rl = journal l - ts = jtxns rl ++ [t] + return j{jtxns=ts++[t]} --- | Append data to the ledger's file, ensuring proper separation from any --- existing data; or if the file is "-", dump it to stdout. -appendToLedgerFile :: Ledger -> String -> IO () -appendToLedgerFile l s = +-- | Append data to the journal's file, ensuring proper separation from +-- any existing data; or if the file is "-", dump it to stdout. +appendToJournalFile :: Journal -> String -> IO () +appendToJournalFile Journal{filepath=f, jtext=t} s = if f == "-" then putStr $ sep ++ s else appendFile f $ sep++s where - f = filepath $ journal l -- XXX we are looking at the original raw text from when the ledger -- was first read, but that's good enough for now - t = jtext $ journal l sep | null $ strip t = "" | otherwise = replicate (2 - min 2 (length lastnls)) '\n' where lastnls = takeWhile (=='\n') $ reverse t @@ -161,7 +157,7 @@ appendToLedgerFile l s = registerFromString :: String -> IO String registerFromString s = do now <- getCurrentLocalTime - l <- ledgerFromStringWithOpts [] s + l <- journalFromStringWithOpts [] s return $ showRegisterReport opts (optsToFilterSpec opts [] now) l where opts = [Empty] @@ -184,19 +180,19 @@ wordLetterPairs = concatMap letterPairs . words letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs _ = [] -compareLedgerDescriptions :: [Char] -> [Char] -> Double -compareLedgerDescriptions s t = compareStrings s' t' +compareDescriptions :: [Char] -> [Char] -> Double +compareDescriptions s t = compareStrings s' t' where s' = simplify s t' = simplify t simplify = filter (not . (`elem` "0123456789")) -transactionsSimilarTo :: Ledger -> [String] -> String -> [(Double,Transaction)] -transactionsSimilarTo l apats s = +transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)] +transactionsSimilarTo j apats s = sortBy compareRelevanceAndRecency $ filter ((> threshold).fst) - [(compareLedgerDescriptions s $ tdescription t, t) | t <- ts] + [(compareDescriptions s $ tdescription t, t) | t <- ts] where compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1) - ts = jtxns $ filterJournalTransactionsByAccount apats $ journal l + ts = jtxns $ filterJournalTransactionsByAccount apats j threshold = 0 diff --git a/Hledger/Cli/Commands/Balance.hs b/Hledger/Cli/Commands/Balance.hs index e5cdd0acc..9f0539034 100644 --- a/Hledger/Cli/Commands/Balance.hs +++ b/Hledger/Cli/Commands/Balance.hs @@ -111,27 +111,27 @@ import System.IO.UTF8 -- | Print a balance report. -balance :: [Opt] -> [String] -> Ledger -> IO () -balance opts args l = do +balance :: [Opt] -> [String] -> Journal -> IO () +balance opts args j = do t <- getCurrentLocalTime - putStr $ showBalanceReport opts (optsToFilterSpec opts args t) l + putStr $ showBalanceReport opts (optsToFilterSpec opts args t) j -- | Generate a balance report with the specified options for this ledger. -showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String -showBalanceReport opts filterspec l = acctsstr ++ totalstr +showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String +showBalanceReport opts filterspec j = acctsstr ++ totalstr where - l' = filterAndCacheLedger filterspec l + l = journalToLedger filterspec j acctsstr = unlines $ map showacct interestingaccts where - showacct = showInterestingAccount l' interestingaccts - interestingaccts = filter (isInteresting opts l') acctnames + showacct = showInterestingAccount l interestingaccts + interestingaccts = filter (isInteresting opts l) acctnames acctnames = sort $ tail $ flatten $ treemap aname accttree - accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l' + accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l totalstr | NoTotal `elem` opts = "" | notElem Empty opts && isZeroMixedAmount total = "" | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total where - total = sum $ map abalance $ ledgerTopAccounts l' + total = sum $ map abalance $ ledgerTopAccounts l -- | Display one line of the balance report with appropriate indenting and eliding. showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String diff --git a/Hledger/Cli/Commands/Chart.hs b/Hledger/Cli/Commands/Chart.hs index 3e7b1c8c1..12521181e 100644 --- a/Hledger/Cli/Commands/Chart.hs +++ b/Hledger/Cli/Commands/Chart.hs @@ -24,10 +24,10 @@ import Data.List import Safe (readDef) -- | Generate an image with the pie chart and write it to a file -chart :: [Opt] -> [String] -> Ledger -> IO () -chart opts args l = do +chart :: [Opt] -> [String] -> Journal -> IO () +chart opts args j = do t <- getCurrentLocalTime - let chart = genPie opts (optsToFilterSpec opts args t) l + let chart = genPie opts (optsToFilterSpec opts args t) j renderableToPNGFile (toRenderable chart) w h filename where filename = getOption opts ChartOutput chartoutput @@ -48,8 +48,8 @@ parseSize str = (read w, read h) (w,_:h) = splitAt x str -- | Generate pie chart -genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout -genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white +genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout +genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white , pie_plot_ = pie_chart } where pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems' @@ -60,7 +60,7 @@ genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ chartitems' = debug "chart" $ top num samesignitems (samesignitems, sign) = sameSignNonZero rawitems rawitems = debug "raw" $ flatten $ balances $ - ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ cacheLedger'' filterspec l + ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j top n t = topn ++ [other] where (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t diff --git a/Hledger/Cli/Commands/Convert.hs b/Hledger/Cli/Commands/Convert.hs index 2a8ab57fe..0e32b2d43 100644 --- a/Hledger/Cli/Commands/Convert.hs +++ b/Hledger/Cli/Commands/Convert.hs @@ -6,7 +6,7 @@ format, and print it on stdout. See the manual for more details. module Hledger.Cli.Commands.Convert where import Hledger.Cli.Options (Opt(Debug)) import Hledger.Cli.Version (versionstr) -import Hledger.Data.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..)) +import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..)) import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual) import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname) import Hledger.Data.Amount (nullmixedamt) @@ -66,9 +66,9 @@ type AccountRule = ( type CsvRecord = [String] --- | Read the CSV file named as an argument and print equivalent ledger transactions, +-- | Read the CSV file named as an argument and print equivalent journal transactions, -- using/creating a .rules file. -convert :: [Opt] -> [String] -> Ledger -> IO () +convert :: [Opt] -> [String] -> Journal -> IO () convert opts args _ = do when (null args) $ error "please specify a csv data file." let csvfile = head args diff --git a/Hledger/Cli/Commands/Histogram.hs b/Hledger/Cli/Commands/Histogram.hs index c56cd9ad0..62e740702 100644 --- a/Hledger/Cli/Commands/Histogram.hs +++ b/Hledger/Cli/Commands/Histogram.hs @@ -19,23 +19,23 @@ barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as -- number of postings per day. -histogram :: [Opt] -> [String] -> Ledger -> IO () -histogram opts args l = do +histogram :: [Opt] -> [String] -> Journal -> IO () +histogram opts args j = do t <- getCurrentLocalTime - putStr $ showHistogram opts (optsToFilterSpec opts args t) l + putStr $ showHistogram opts (optsToFilterSpec opts args t) j -showHistogram :: [Opt] -> FilterSpec -> Ledger -> String -showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps +showHistogram :: [Opt] -> FilterSpec -> Journal -> String +showHistogram opts filterspec j = concatMap (printDayWith countBar) dayps where i = intervalFromOpts opts interval | i == NoInterval = Daily | otherwise = i - fullspan = journalDateSpan $ journal l + fullspan = journalDateSpan j days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days] -- same as Register -- should count transactions, not postings ? - ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ ledgerPostings l + ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j filterempties | Empty `elem` opts = id | otherwise = filter (not . isZeroMixedAmount . pamount) diff --git a/Hledger/Cli/Commands/Print.hs b/Hledger/Cli/Commands/Print.hs index bfaede80c..931b4905a 100644 --- a/Hledger/Cli/Commands/Print.hs +++ b/Hledger/Cli/Commands/Print.hs @@ -16,14 +16,14 @@ import System.IO.UTF8 -- | Print ledger transactions in standard format. -print' :: [Opt] -> [String] -> Ledger -> IO () -print' opts args l = do +print' :: [Opt] -> [String] -> Journal -> IO () +print' opts args j = do t <- getCurrentLocalTime - putStr $ showTransactions (optsToFilterSpec opts args t) l + putStr $ showTransactions (optsToFilterSpec opts args t) j -showTransactions :: FilterSpec -> Ledger -> String -showTransactions filterspec l = +showTransactions :: FilterSpec -> Journal -> String +showTransactions filterspec j = concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns where effective = EffectiveDate == whichdate filterspec - txns = jtxns $ filterJournalTransactions filterspec $ journal l + txns = jtxns $ filterJournalTransactions filterspec j diff --git a/Hledger/Cli/Commands/Register.hs b/Hledger/Cli/Commands/Register.hs index 378dfc6bc..7119d7a49 100644 --- a/Hledger/Cli/Commands/Register.hs +++ b/Hledger/Cli/Commands/Register.hs @@ -22,21 +22,21 @@ import System.IO.UTF8 -- | Print a register report. -register :: [Opt] -> [String] -> Ledger -> IO () -register opts args l = do +register :: [Opt] -> [String] -> Journal -> IO () +register opts args j = do t <- getCurrentLocalTime - putStr $ showRegisterReport opts (optsToFilterSpec opts args t) l + putStr $ showRegisterReport opts (optsToFilterSpec opts args t) j -- | Generate the register report, which is a list of postings with transaction -- info and a running balance. -showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String -showRegisterReport opts filterspec l = showPostingsWithBalance ps nullposting startbal +showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String +showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal where ps | interval == NoInterval = displayableps | otherwise = summarisePostings interval depth empty filterspan displayableps startbal = sumPostings precedingps (precedingps,displayableps,_) = - postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec $ journal l + postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec j (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) filterspan = datespan filterspec @@ -99,7 +99,7 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames] anames = sort $ nub $ map paccount ps - -- aggregate balances by account, like cacheLedger, then do depth-clipping + -- aggregate balances by account, like journalToLedger, then do depth-clipping (_,_,exclbalof,inclbalof) = groupPostings ps clippedanames = nub $ map (clipAccountName d) anames isclipped a = accountNameLevel a >= d diff --git a/Hledger/Cli/Commands/Stats.hs b/Hledger/Cli/Commands/Stats.hs index ab0ea6586..909376b82 100644 --- a/Hledger/Cli/Commands/Stats.hs +++ b/Hledger/Cli/Commands/Stats.hs @@ -17,10 +17,10 @@ import qualified Data.Map as Map -- | Print various statistics for the ledger. -stats :: [Opt] -> [String] -> Ledger -> IO () -stats opts args l = do +stats :: [Opt] -> [String] -> Journal -> IO () +stats opts args j = do today <- getCurrentDay - putStr $ showStats opts args (filterAndCacheLedger nullfilterspec l) today + putStr $ showStats opts args (journalToLedger nullfilterspec j) today showStats :: [Opt] -> [String] -> Ledger -> Day -> String showStats _ _ l today = diff --git a/Hledger/Cli/Commands/Vty.hs b/Hledger/Cli/Commands/Vty.hs index 5346f75d7..ce15ee918 100644 --- a/Hledger/Cli/Commands/Vty.hs +++ b/Hledger/Cli/Commands/Vty.hs @@ -27,7 +27,7 @@ data AppState = AppState { ,amsg :: String -- ^ status message ,aopts :: [Opt] -- ^ command-line opts ,aargs :: [String] -- ^ command-line args at startup - ,aledger :: Ledger -- ^ parsed ledger + ,ajournal :: Journal -- ^ parsed journal ,abuf :: [String] -- ^ lines of the current buffered view ,alocs :: [Loc] -- ^ user's navigation trail within the UI -- ^ never null, head is current location @@ -49,8 +49,8 @@ data Screen = BalanceScreen -- ^ like hledger balance, shows accounts deriving (Eq,Show) -- | Run the vty (curses-style) ui. -vty :: [Opt] -> [String] -> Ledger -> IO () -vty opts args l = do +vty :: [Opt] -> [String] -> Journal -> IO () +vty opts args j = do v <- mkVty DisplayRegion w h <- display_bounds $ terminal v let opts' = SubTotal:opts @@ -63,7 +63,7 @@ vty opts args l = do ,amsg=helpmsg ,aopts=opts' ,aargs=args - ,aledger=l + ,ajournal=j ,abuf=[] ,alocs=[] } @@ -227,11 +227,11 @@ resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a -- | Regenerate the display data appropriate for the current screen. updateData :: LocalTime -> AppState -> AppState -updateData t a@AppState{aopts=opts,aledger=l} = +updateData t a@AppState{aopts=opts,ajournal=j} = case screen a of - BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec l} - RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec l} - PrintScreen -> a{abuf=lines $ showTransactions fspec l} + BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec j} + RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j} + PrintScreen -> a{abuf=lines $ showTransactions fspec j} where fspec = optsToFilterSpec opts (currentArgs a) t backout :: LocalTime -> AppState -> AppState @@ -285,9 +285,9 @@ scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY s -- the cursor on the register screen (or best guess). Results undefined -- while on other screens. currentTransaction :: AppState -> Maybe Transaction -currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p +currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p where - p = headDef nullposting $ filter ismatch $ ledgerPostings l + p = headDef nullposting $ filter ismatch $ journalPostings j ismatch p = postingDate p == parsedate (take 10 datedesc) && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt) datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index b8edd4d9e..171c40cb1 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -38,7 +38,7 @@ import Network.Loli.Utils (update) import HSP hiding (Request,catch) import qualified HSP (Request(..)) -import Hledger.Cli.Commands.Add (ledgerAddTransaction) +import Hledger.Cli.Commands.Add (journalAddTransaction) import Hledger.Cli.Commands.Balance import Hledger.Cli.Commands.Histogram import Hledger.Cli.Commands.Print @@ -60,22 +60,22 @@ tcpport = 5000 :: Int homeurl = printf "http://localhost:%d/" tcpport browserdelay = 100000 -- microseconds -web :: [Opt] -> [String] -> Ledger -> IO () -web opts args l = do +web :: [Opt] -> [String] -> Journal -> IO () +web opts args j = do unless (Debug `elem` opts) $ forkIO browser >> return () - server opts args l + server opts args j browser :: IO () browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return () -server :: [Opt] -> [String] -> Ledger -> IO () -server opts args l = +server :: [Opt] -> [String] -> Journal -> IO () +server opts args j = -- server initialisation withStore "hledger" $ do -- IO () printf "starting web server on port %d\n" tcpport t <- getCurrentLocalTime webfiles <- getDataFileName "web" - putValue "hledger" "ledger" l + putValue "hledger" "journal" j #ifdef WEBHAPPSTACK hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname" runWithConfig (ServerConf tcpport hostname) $ -- (Env -> IO Response) -> IO () @@ -88,18 +88,18 @@ server opts args l = p = intercalate "+" $ reqparam env "p" opts' = opts ++ [Period p] args' = args ++ (map urlDecode $ words a) - l' <- fromJust `fmap` getValue "hledger" "ledger" - l'' <- reloadIfChanged opts' args' l' + j' <- fromJust `fmap` getValue "hledger" "journal" + j'' <- journalReloadIfChanged opts' args' j' -- declare path-specific request handlers - let command :: [String] -> ([Opt] -> FilterSpec -> Ledger -> String) -> AppUnit - command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) l'' + let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit + command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j'' (loli $ -- State Loli () -> (Env -> IO Response) do get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli () get "/register" $ command [] showRegisterReport get "/histogram" $ command [] showHistogram - get "/transactions" $ ledgerpage [] l'' (showTransactions (optsToFilterSpec opts' args' t)) - post "/transactions" $ handleAddform l'' + get "/transactions" $ ledgerpage [] j'' (showTransactions (optsToFilterSpec opts' args' t)) + post "/transactions" $ handleAddform j'' get "/env" $ getenv >>= (text . show) get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params) get "/inputs" $ getenv >>= (text . show . Hack.Contrib.Request.inputs) @@ -118,41 +118,33 @@ reqparam env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env reqparam env p = map (decodeString.snd) $ filter ((==p).fst) $ Hack.Contrib.Request.params env #endif -ledgerFileModifiedTime :: Ledger -> IO ClockTime -ledgerFileModifiedTime l - | null path = getClockTime - | otherwise = getModificationTime path `Prelude.catch` \_ -> getClockTime - where path = filepath $ journal l - -ledgerFileReadTime :: Ledger -> ClockTime -ledgerFileReadTime l = filereadtime $ journal l - -reload :: Ledger -> IO Ledger -reload l = do - l' <- readLedger (filepath $ journal l) - putValue "hledger" "ledger" l' - return l' - -reloadIfChanged :: [Opt] -> [String] -> Ledger -> IO Ledger -reloadIfChanged opts _ l = do - tmod <- ledgerFileModifiedTime l - let tread = ledgerFileReadTime l - newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0) +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" (filepath $ journal l) - reload l - else return l + when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f + reload j + else return j --- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger --- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l) +journalFileModifiedTime :: Journal -> IO ClockTime +journalFileModifiedTime Journal{filepath=f} + | null f = getClockTime + | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime -ledgerpage :: [String] -> Ledger -> (Ledger -> String) -> AppUnit -ledgerpage msgs l f = do +reload :: Journal -> IO Journal +reload Journal{filepath=f} = do + j' <- readJournal f + putValue "hledger" "journal" j' + return j' + +ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit +ledgerpage msgs j f = do env <- getenv - l' <- io $ reloadIfChanged [] [] l - hsp msgs $ const
<% f l' %>
<% f j' %>