refactor: clarify the roles of Journal (primary data) and Ledger (derived report)

This commit is contained in:
Simon Michael 2010-05-23 17:41:25 +00:00
parent fc330b5c9f
commit bf5ee88a30
18 changed files with 214 additions and 299 deletions

View File

@ -19,42 +19,42 @@ import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )
#endif #endif
import System.IO.Error import System.IO.Error
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import Hledger.Cli.Utils (ledgerFromStringWithOpts) import Hledger.Cli.Utils (journalFromStringWithOpts)
import qualified Data.Foldable as Foldable (find) import qualified Data.Foldable as Foldable (find)
-- | Read ledger transactions from the terminal, prompting for each field, -- | Read ledger transactions from the terminal, prompting for each field,
-- and append them to the ledger file. If the ledger came from stdin, this -- and append them to the ledger file. If the ledger came from stdin, this
-- command has no effect. -- command has no effect.
add :: [Opt] -> [String] -> Ledger -> IO () add :: [Opt] -> [String] -> Journal -> IO ()
add opts args l add opts args j
| filepath (journal l) == "-" = return () | filepath j == "-" = return ()
| otherwise = do | otherwise = do
hPutStrLn stderr $ hPutStrLn stderr $
"Enter one or more transactions, which will be added to your ledger file.\n" "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." ++"To complete a transaction, enter . as account name. To quit, press control-c."
today <- getCurrentDay 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, -- | Read a number of transactions from the command line, prompting,
-- prompting, validating, displaying and appending them to the ledger -- validating, displaying and appending them to the journal file, until
-- file, until end of input (then raise an EOF exception). Any -- end of input (then raise an EOF exception). Any command-line arguments
-- command-line arguments are used as the first transaction's description. -- are used as the first transaction's description.
getAndAddTransactions :: Ledger -> [Opt] -> [String] -> Day -> IO () getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
getAndAddTransactions l opts args defaultDate = do getAndAddTransactions j opts args defaultDate = do
(ledgerTransaction,date) <- getTransaction l opts args defaultDate (t, d) <- getTransaction j opts args defaultDate
l <- ledgerAddTransaction l ledgerTransaction j <- journalAddTransaction j t
getAndAddTransactions l opts args date getAndAddTransactions j opts args d
-- | Read a transaction from the command line, with history-aware prompting. -- | Read a transaction from the command line, with history-aware prompting.
getTransaction :: Ledger -> [Opt] -> [String] -> Day -> IO (Transaction,Day) getTransaction :: Journal -> [Opt] -> [String] -> Day -> IO (Transaction,Day)
getTransaction l opts args defaultDate = do getTransaction j opts args defaultDate = do
today <- getCurrentDay today <- getCurrentDay
datestr <- askFor "date" datestr <- askFor "date"
(Just $ showDate defaultDate) (Just $ showDate defaultDate)
(Just $ \s -> null s || (Just $ \s -> null s ||
isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
description <- askFor "description" Nothing (Just $ not . null) description <- askFor "description" Nothing (Just $ not . null)
let historymatches = transactionsSimilarTo l args description let historymatches = transactionsSimilarTo j args description
bestmatch | null historymatches = Nothing bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches | otherwise = Just $ snd $ head historymatches
bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch
@ -63,7 +63,7 @@ getTransaction l opts args defaultDate = do
if NoNewAccts `elem` opts if NoNewAccts `elem` opts
then isJust $ Foldable.find (== x) ant then isJust $ Foldable.find (== x) ant
else True else True
where (ant,_,_,_) = groupPostings . journalPostings . journal $ l where (ant,_,_,_) = groupPostings $ journalPostings j
getpostingsandvalidate = do getpostingsandvalidate = do
ps <- getPostings accept bestmatchpostings [] ps <- getPostings accept bestmatchpostings []
let t = nulltransaction{tdate=date let t = nulltransaction{tdate=date
@ -129,30 +129,26 @@ askFor prompt def validator = do
Nothing -> return input Nothing -> return input
where showdef s = " [" ++ s ++ "]" 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 -- transaction list, but we don't bother updating the other fields - this
-- is enough to include new transactions in the history matching. -- is enough to include new transactions in the history matching.
ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger journalAddTransaction :: Journal -> Transaction -> IO Journal
ledgerAddTransaction l t = do journalAddTransaction j@Journal{jtxns=ts} t = do
appendToLedgerFile l $ showTransaction t appendToJournalFile j $ showTransaction t
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l) putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
putStrLn =<< registerFromString (show t) putStrLn =<< registerFromString (show t)
return l{journal=rl{jtxns=ts}} return j{jtxns=ts++[t]}
where rl = journal l
ts = jtxns rl ++ [t]
-- | Append data to the ledger's file, ensuring proper separation from any -- | Append data to the journal's file, ensuring proper separation from
-- existing data; or if the file is "-", dump it to stdout. -- any existing data; or if the file is "-", dump it to stdout.
appendToLedgerFile :: Ledger -> String -> IO () appendToJournalFile :: Journal -> String -> IO ()
appendToLedgerFile l s = appendToJournalFile Journal{filepath=f, jtext=t} s =
if f == "-" if f == "-"
then putStr $ sep ++ s then putStr $ sep ++ s
else appendFile f $ sep++s else appendFile f $ sep++s
where where
f = filepath $ journal l
-- XXX we are looking at the original raw text from when the ledger -- XXX we are looking at the original raw text from when the ledger
-- was first read, but that's good enough for now -- was first read, but that's good enough for now
t = jtext $ journal l
sep | null $ strip t = "" sep | null $ strip t = ""
| otherwise = replicate (2 - min 2 (length lastnls)) '\n' | otherwise = replicate (2 - min 2 (length lastnls)) '\n'
where lastnls = takeWhile (=='\n') $ reverse t where lastnls = takeWhile (=='\n') $ reverse t
@ -161,7 +157,7 @@ appendToLedgerFile l s =
registerFromString :: String -> IO String registerFromString :: String -> IO String
registerFromString s = do registerFromString s = do
now <- getCurrentLocalTime now <- getCurrentLocalTime
l <- ledgerFromStringWithOpts [] s l <- journalFromStringWithOpts [] s
return $ showRegisterReport opts (optsToFilterSpec opts [] now) l return $ showRegisterReport opts (optsToFilterSpec opts [] now) l
where opts = [Empty] where opts = [Empty]
@ -184,19 +180,19 @@ wordLetterPairs = concatMap letterPairs . words
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
letterPairs _ = [] letterPairs _ = []
compareLedgerDescriptions :: [Char] -> [Char] -> Double compareDescriptions :: [Char] -> [Char] -> Double
compareLedgerDescriptions s t = compareStrings s' t' compareDescriptions s t = compareStrings s' t'
where s' = simplify s where s' = simplify s
t' = simplify t t' = simplify t
simplify = filter (not . (`elem` "0123456789")) simplify = filter (not . (`elem` "0123456789"))
transactionsSimilarTo :: Ledger -> [String] -> String -> [(Double,Transaction)] transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)]
transactionsSimilarTo l apats s = transactionsSimilarTo j apats s =
sortBy compareRelevanceAndRecency sortBy compareRelevanceAndRecency
$ filter ((> threshold).fst) $ filter ((> threshold).fst)
[(compareLedgerDescriptions s $ tdescription t, t) | t <- ts] [(compareDescriptions s $ tdescription t, t) | t <- ts]
where where
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1) 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 threshold = 0

View File

@ -111,27 +111,27 @@ import System.IO.UTF8
-- | Print a balance report. -- | Print a balance report.
balance :: [Opt] -> [String] -> Ledger -> IO () balance :: [Opt] -> [String] -> Journal -> IO ()
balance opts args l = do balance opts args j = do
t <- getCurrentLocalTime 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. -- | Generate a balance report with the specified options for this ledger.
showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String
showBalanceReport opts filterspec l = acctsstr ++ totalstr showBalanceReport opts filterspec j = acctsstr ++ totalstr
where where
l' = filterAndCacheLedger filterspec l l = journalToLedger filterspec j
acctsstr = unlines $ map showacct interestingaccts acctsstr = unlines $ map showacct interestingaccts
where where
showacct = showInterestingAccount l' interestingaccts showacct = showInterestingAccount l interestingaccts
interestingaccts = filter (isInteresting opts l') acctnames interestingaccts = filter (isInteresting opts l) acctnames
acctnames = sort $ tail $ flatten $ treemap aname accttree 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 = "" totalstr | NoTotal `elem` opts = ""
| notElem Empty opts && isZeroMixedAmount total = "" | notElem Empty opts && isZeroMixedAmount total = ""
| otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
where 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. -- | Display one line of the balance report with appropriate indenting and eliding.
showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String

View File

@ -24,10 +24,10 @@ import Data.List
import Safe (readDef) import Safe (readDef)
-- | Generate an image with the pie chart and write it to a file -- | Generate an image with the pie chart and write it to a file
chart :: [Opt] -> [String] -> Ledger -> IO () chart :: [Opt] -> [String] -> Journal -> IO ()
chart opts args l = do chart opts args j = do
t <- getCurrentLocalTime 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 renderableToPNGFile (toRenderable chart) w h filename
where where
filename = getOption opts ChartOutput chartoutput filename = getOption opts ChartOutput chartoutput
@ -48,8 +48,8 @@ parseSize str = (read w, read h)
(w,_:h) = splitAt x str (w,_:h) = splitAt x str
-- | Generate pie chart -- | Generate pie chart
genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout
genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
, pie_plot_ = pie_chart } , pie_plot_ = pie_chart }
where where
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems' 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 chartitems' = debug "chart" $ top num samesignitems
(samesignitems, sign) = sameSignNonZero rawitems (samesignitems, sign) = sameSignNonZero rawitems
rawitems = debug "raw" $ flatten $ balances $ 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] top n t = topn ++ [other]
where where
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t

View File

@ -6,7 +6,7 @@ format, and print it on stdout. See the manual for more details.
module Hledger.Cli.Commands.Convert where module Hledger.Cli.Commands.Convert where
import Hledger.Cli.Options (Opt(Debug)) import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr) 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.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)
import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname) import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt) import Hledger.Data.Amount (nullmixedamt)
@ -66,9 +66,9 @@ type AccountRule = (
type CsvRecord = [String] 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. -- using/creating a .rules file.
convert :: [Opt] -> [String] -> Ledger -> IO () convert :: [Opt] -> [String] -> Journal -> IO ()
convert opts args _ = do convert opts args _ = do
when (null args) $ error "please specify a csv data file." when (null args) $ error "please specify a csv data file."
let csvfile = head args let csvfile = head args

View File

@ -19,23 +19,23 @@ barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as -- | Print a histogram of some statistic per reporting interval, such as
-- number of postings per day. -- number of postings per day.
histogram :: [Opt] -> [String] -> Ledger -> IO () histogram :: [Opt] -> [String] -> Journal -> IO ()
histogram opts args l = do histogram opts args j = do
t <- getCurrentLocalTime t <- getCurrentLocalTime
putStr $ showHistogram opts (optsToFilterSpec opts args t) l putStr $ showHistogram opts (optsToFilterSpec opts args t) j
showHistogram :: [Opt] -> FilterSpec -> Ledger -> String showHistogram :: [Opt] -> FilterSpec -> Journal -> String
showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps showHistogram opts filterspec j = concatMap (printDayWith countBar) dayps
where where
i = intervalFromOpts opts i = intervalFromOpts opts
interval | i == NoInterval = Daily interval | i == NoInterval = Daily
| otherwise = i | otherwise = i
fullspan = journalDateSpan $ journal l fullspan = journalDateSpan j
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days] dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]
-- same as Register -- same as Register
-- should count transactions, not postings ? -- 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 filterempties
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . pamount) | otherwise = filter (not . isZeroMixedAmount . pamount)

View File

@ -16,14 +16,14 @@ import System.IO.UTF8
-- | Print ledger transactions in standard format. -- | Print ledger transactions in standard format.
print' :: [Opt] -> [String] -> Ledger -> IO () print' :: [Opt] -> [String] -> Journal -> IO ()
print' opts args l = do print' opts args j = do
t <- getCurrentLocalTime t <- getCurrentLocalTime
putStr $ showTransactions (optsToFilterSpec opts args t) l putStr $ showTransactions (optsToFilterSpec opts args t) j
showTransactions :: FilterSpec -> Ledger -> String showTransactions :: FilterSpec -> Journal -> String
showTransactions filterspec l = showTransactions filterspec j =
concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns
where where
effective = EffectiveDate == whichdate filterspec effective = EffectiveDate == whichdate filterspec
txns = jtxns $ filterJournalTransactions filterspec $ journal l txns = jtxns $ filterJournalTransactions filterspec j

View File

@ -22,21 +22,21 @@ import System.IO.UTF8
-- | Print a register report. -- | Print a register report.
register :: [Opt] -> [String] -> Ledger -> IO () register :: [Opt] -> [String] -> Journal -> IO ()
register opts args l = do register opts args j = do
t <- getCurrentLocalTime 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 -- | Generate the register report, which is a list of postings with transaction
-- info and a running balance. -- info and a running balance.
showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String
showRegisterReport opts filterspec l = showPostingsWithBalance ps nullposting startbal showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal
where where
ps | interval == NoInterval = displayableps ps | interval == NoInterval = displayableps
| otherwise = summarisePostings interval depth empty filterspan displayableps | otherwise = summarisePostings interval depth empty filterspan displayableps
startbal = sumPostings precedingps startbal = sumPostings precedingps
(precedingps,displayableps,_) = (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) (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
filterspan = datespan filterspec 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' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames] summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
anames = sort $ nub $ map paccount ps 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 (_,_,exclbalof,inclbalof) = groupPostings ps
clippedanames = nub $ map (clipAccountName d) anames clippedanames = nub $ map (clipAccountName d) anames
isclipped a = accountNameLevel a >= d isclipped a = accountNameLevel a >= d

View File

@ -17,10 +17,10 @@ import qualified Data.Map as Map
-- | Print various statistics for the ledger. -- | Print various statistics for the ledger.
stats :: [Opt] -> [String] -> Ledger -> IO () stats :: [Opt] -> [String] -> Journal -> IO ()
stats opts args l = do stats opts args j = do
today <- getCurrentDay 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 :: [Opt] -> [String] -> Ledger -> Day -> String
showStats _ _ l today = showStats _ _ l today =

View File

@ -27,7 +27,7 @@ data AppState = AppState {
,amsg :: String -- ^ status message ,amsg :: String -- ^ status message
,aopts :: [Opt] -- ^ command-line opts ,aopts :: [Opt] -- ^ command-line opts
,aargs :: [String] -- ^ command-line args at startup ,aargs :: [String] -- ^ command-line args at startup
,aledger :: Ledger -- ^ parsed ledger ,ajournal :: Journal -- ^ parsed journal
,abuf :: [String] -- ^ lines of the current buffered view ,abuf :: [String] -- ^ lines of the current buffered view
,alocs :: [Loc] -- ^ user's navigation trail within the UI ,alocs :: [Loc] -- ^ user's navigation trail within the UI
-- ^ never null, head is current location -- ^ never null, head is current location
@ -49,8 +49,8 @@ data Screen = BalanceScreen -- ^ like hledger balance, shows accounts
deriving (Eq,Show) deriving (Eq,Show)
-- | Run the vty (curses-style) ui. -- | Run the vty (curses-style) ui.
vty :: [Opt] -> [String] -> Ledger -> IO () vty :: [Opt] -> [String] -> Journal -> IO ()
vty opts args l = do vty opts args j = do
v <- mkVty v <- mkVty
DisplayRegion w h <- display_bounds $ terminal v DisplayRegion w h <- display_bounds $ terminal v
let opts' = SubTotal:opts let opts' = SubTotal:opts
@ -63,7 +63,7 @@ vty opts args l = do
,amsg=helpmsg ,amsg=helpmsg
,aopts=opts' ,aopts=opts'
,aargs=args ,aargs=args
,aledger=l ,ajournal=j
,abuf=[] ,abuf=[]
,alocs=[] ,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. -- | Regenerate the display data appropriate for the current screen.
updateData :: LocalTime -> AppState -> AppState updateData :: LocalTime -> AppState -> AppState
updateData t a@AppState{aopts=opts,aledger=l} = updateData t a@AppState{aopts=opts,ajournal=j} =
case screen a of case screen a of
BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec l} BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec j}
RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec l} RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j}
PrintScreen -> a{abuf=lines $ showTransactions fspec l} PrintScreen -> a{abuf=lines $ showTransactions fspec j}
where fspec = optsToFilterSpec opts (currentArgs a) t where fspec = optsToFilterSpec opts (currentArgs a) t
backout :: LocalTime -> AppState -> AppState 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 -- the cursor on the register screen (or best guess). Results undefined
-- while on other screens. -- while on other screens.
currentTransaction :: AppState -> Maybe Transaction currentTransaction :: AppState -> Maybe Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p
where where
p = headDef nullposting $ filter ismatch $ ledgerPostings l p = headDef nullposting $ filter ismatch $ journalPostings j
ismatch p = postingDate p == parsedate (take 10 datedesc) ismatch p = postingDate p == parsedate (take 10 datedesc)
&& take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt) && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above

View File

@ -38,7 +38,7 @@ import Network.Loli.Utils (update)
import HSP hiding (Request,catch) import HSP hiding (Request,catch)
import qualified HSP (Request(..)) 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.Balance
import Hledger.Cli.Commands.Histogram import Hledger.Cli.Commands.Histogram
import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Print
@ -60,22 +60,22 @@ tcpport = 5000 :: Int
homeurl = printf "http://localhost:%d/" tcpport homeurl = printf "http://localhost:%d/" tcpport
browserdelay = 100000 -- microseconds browserdelay = 100000 -- microseconds
web :: [Opt] -> [String] -> Ledger -> IO () web :: [Opt] -> [String] -> Journal -> IO ()
web opts args l = do web opts args j = do
unless (Debug `elem` opts) $ forkIO browser >> return () unless (Debug `elem` opts) $ forkIO browser >> return ()
server opts args l server opts args j
browser :: IO () browser :: IO ()
browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return () browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return ()
server :: [Opt] -> [String] -> Ledger -> IO () server :: [Opt] -> [String] -> Journal -> IO ()
server opts args l = server opts args j =
-- server initialisation -- server initialisation
withStore "hledger" $ do -- IO () withStore "hledger" $ do -- IO ()
printf "starting web server on port %d\n" tcpport printf "starting web server on port %d\n" tcpport
t <- getCurrentLocalTime t <- getCurrentLocalTime
webfiles <- getDataFileName "web" webfiles <- getDataFileName "web"
putValue "hledger" "ledger" l putValue "hledger" "journal" j
#ifdef WEBHAPPSTACK #ifdef WEBHAPPSTACK
hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname" hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname"
runWithConfig (ServerConf tcpport hostname) $ -- (Env -> IO Response) -> IO () runWithConfig (ServerConf tcpport hostname) $ -- (Env -> IO Response) -> IO ()
@ -88,18 +88,18 @@ server opts args l =
p = intercalate "+" $ reqparam env "p" p = intercalate "+" $ reqparam env "p"
opts' = opts ++ [Period p] opts' = opts ++ [Period p]
args' = args ++ (map urlDecode $ words a) args' = args ++ (map urlDecode $ words a)
l' <- fromJust `fmap` getValue "hledger" "ledger" j' <- fromJust `fmap` getValue "hledger" "journal"
l'' <- reloadIfChanged opts' args' l' j'' <- journalReloadIfChanged opts' args' j'
-- declare path-specific request handlers -- declare path-specific request handlers
let command :: [String] -> ([Opt] -> FilterSpec -> Ledger -> String) -> AppUnit let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit
command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) l'' command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j''
(loli $ -- State Loli () -> (Env -> IO Response) (loli $ -- State Loli () -> (Env -> IO Response)
do do
get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli () get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
get "/register" $ command [] showRegisterReport get "/register" $ command [] showRegisterReport
get "/histogram" $ command [] showHistogram get "/histogram" $ command [] showHistogram
get "/transactions" $ ledgerpage [] l'' (showTransactions (optsToFilterSpec opts' args' t)) get "/transactions" $ ledgerpage [] j'' (showTransactions (optsToFilterSpec opts' args' t))
post "/transactions" $ handleAddform l'' post "/transactions" $ handleAddform j''
get "/env" $ getenv >>= (text . show) get "/env" $ getenv >>= (text . show)
get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params) get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params)
get "/inputs" $ getenv >>= (text . show . Hack.Contrib.Request.inputs) 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 reqparam env p = map (decodeString.snd) $ filter ((==p).fst) $ Hack.Contrib.Request.params env
#endif #endif
ledgerFileModifiedTime :: Ledger -> IO ClockTime journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
ledgerFileModifiedTime l journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
| null path = getClockTime tmod <- journalFileModifiedTime j
| otherwise = getModificationTime path `Prelude.catch` \_ -> getClockTime let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
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)
-- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer) -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
if newer if newer
then do then do
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (filepath $ journal l) when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
reload l reload j
else return l else return j
-- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger journalFileModifiedTime :: Journal -> IO ClockTime
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l) journalFileModifiedTime Journal{filepath=f}
| null f = getClockTime
| otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
ledgerpage :: [String] -> Ledger -> (Ledger -> String) -> AppUnit reload :: Journal -> IO Journal
ledgerpage msgs l f = do 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 env <- getenv
l' <- io $ reloadIfChanged [] [] l j' <- io $ journalReloadIfChanged [] [] j
hsp msgs $ const <div><% addform env %><pre><% f l' %></pre></div> hsp msgs $ const <div><% addform env %><pre><% f j' %></pre></div>
-- | A loli directive to serve a string in pre tags within the hledger web -- | A loli directive to serve a string in pre tags within the hledger web
-- layout. -- layout.
@ -305,8 +297,8 @@ transactionfields n env = do
acctvar = numbered "acct" acctvar = numbered "acct"
amtvar = numbered "amt" amtvar = numbered "amt"
handleAddform :: Ledger -> AppUnit handleAddform :: Journal -> AppUnit
handleAddform l = do handleAddform j = do
env <- getenv env <- getenv
d <- io getCurrentDay d <- io getCurrentDay
t <- io getCurrentLocalTime t <- io getCurrentLocalTime
@ -380,8 +372,8 @@ handleAddform l = do
handle :: LocalTime -> Failing Transaction -> AppUnit handle :: LocalTime -> Failing Transaction -> AppUnit
handle _ (Failure errs) = hsp errs addform handle _ (Failure errs) = hsp errs addform
handle ti (Success t) = do handle ti (Success t) = do
io $ ledgerAddTransaction l t >> reload l io $ journalAddTransaction j t >> reload j
ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti)) ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))
where msg = printf "Added transaction:\n%s" (show t) where msg = printf "Added transaction:\n%s" (show t)
nbsp :: XML nbsp :: XML

View File

@ -20,8 +20,8 @@ You can use the command line:
or ghci: or ghci:
> $ ghci hledger > $ ghci hledger
> > l <- readLedger "sample.ledger" > > j <- readJournal "data/sample.journal"
> > register [] ["income","expenses"] l > > register [] ["income","expenses"] j
> 2008/01/01 income income:salary $-1 $-1 > 2008/01/01 income income:salary $-1 $-1
> 2008/06/01 gift income:gifts $-1 $-2 > 2008/06/01 gift income:gifts $-1 $-2
> 2008/06/03 eat & shop expenses:food $1 $-1 > 2008/06/03 eat & shop expenses:food $1 $-1
@ -48,7 +48,7 @@ import Hledger.Cli.Commands.All
import Hledger.Data import Hledger.Data
import Hledger.Cli.Options import Hledger.Cli.Options
import Hledger.Cli.Tests import Hledger.Cli.Tests
import Hledger.Cli.Utils (withLedgerDo) import Hledger.Cli.Utils (withJournalDo)
import Hledger.Cli.Version (versionmsg, binaryfilename) import Hledger.Cli.Version (versionmsg, binaryfilename)
main :: IO () main :: IO ()
@ -60,21 +60,21 @@ main = do
| Help `elem` opts = putStr usage | Help `elem` opts = putStr usage
| Version `elem` opts = putStrLn versionmsg | Version `elem` opts = putStrLn versionmsg
| BinaryFilename `elem` opts = putStrLn binaryfilename | BinaryFilename `elem` opts = putStrLn binaryfilename
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance | cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance
| cmd `isPrefixOf` "convert" = withLedgerDo opts args cmd convert | cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert
| cmd `isPrefixOf` "print" = withLedgerDo opts args cmd print' | cmd `isPrefixOf` "print" = withJournalDo opts args cmd print'
| cmd `isPrefixOf` "register" = withLedgerDo opts args cmd register | cmd `isPrefixOf` "register" = withJournalDo opts args cmd register
| cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram | cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram
| cmd `isPrefixOf` "add" = withLedgerDo opts args cmd add | cmd `isPrefixOf` "add" = withJournalDo opts args cmd add
| cmd `isPrefixOf` "stats" = withLedgerDo opts args cmd stats | cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats
#ifdef VTY #ifdef VTY
| cmd `isPrefixOf` "vty" = withLedgerDo opts args cmd vty | cmd `isPrefixOf` "vty" = withJournalDo opts args cmd vty
#endif #endif
#if defined(WEB) || defined(WEBHAPPSTACK) #if defined(WEB) || defined(WEBHAPPSTACK)
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web | cmd `isPrefixOf` "web" = withJournalDo opts args cmd web
#endif #endif
#ifdef CHART #ifdef CHART
| cmd `isPrefixOf` "chart" = withLedgerDo opts args cmd chart | cmd `isPrefixOf` "chart" = withJournalDo opts args cmd chart
#endif #endif
| cmd `isPrefixOf` "test" = runtests opts args >> return () | cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr usage | otherwise = putStr usage

View File

@ -228,9 +228,9 @@ usingTimeProgramName = do
progname <- getProgName progname <- getProgName
return $ map toLower progname == timeprogname return $ map toLower progname == timeprogname
-- | Get the ledger file path from options, an environment variable, or a default -- | Get the journal file path from options, an environment variable, or a default
ledgerFilePathFromOpts :: [Opt] -> IO String journalFilePathFromOpts :: [Opt] -> IO String
ledgerFilePathFromOpts opts = do journalFilePathFromOpts opts = do
istimequery <- usingTimeProgramName istimequery <- usingTimeProgramName
f <- if istimequery then myTimelogPath else myLedgerPath f <- if istimequery then myTimelogPath else myLedgerPath
return $ last $ f : optValuesForConstructor File opts return $ last $ f : optValuesForConstructor File opts

View File

@ -237,14 +237,14 @@ tests = TestList [
,"" ,""
] ]
let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
showBalanceReport [] nullfilterspec nullledger{journal=j'} `is` showBalanceReport [] nullfilterspec j' `is`
unlines unlines
[" $500 a:b" [" $500 a:b"
," $-500 c:d" ," $-500 c:d"
] ]
,"balance report elides zero-balance root account(s)" ~: do ,"balance report elides zero-balance root account(s)" ~: do
l <- ledgerFromStringWithOpts [] l <- journalFromStringWithOpts []
(unlines (unlines
["2008/1/1 one" ["2008/1/1 one"
," test:a 1" ," test:a 1"
@ -282,9 +282,6 @@ tests = TestList [
Right e' -> (pamount $ last $ tpostings e') Right e' -> (pamount $ last $ tpostings e')
Left _ -> error "should not happen") Left _ -> error "should not happen")
-- ,"cacheLedger" ~:
-- length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
,"journalCanonicaliseAmounts" ~: ,"journalCanonicaliseAmounts" ~:
"use the greatest precision" ~: "use the greatest precision" ~:
(map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
@ -471,7 +468,7 @@ tests = TestList [
,"register report with cleared option" ~: ,"register report with cleared option" ~:
do do
let opts = [Cleared] let opts = [Cleared]
l <- ledgerFromStringWithOpts opts sample_ledger_str l <- journalFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1" ["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2" ," expenses:supplies $1 $2"
@ -483,7 +480,7 @@ tests = TestList [
,"register report with uncleared option" ~: ,"register report with uncleared option" ~:
do do
let opts = [UnCleared] let opts = [UnCleared]
l <- ledgerFromStringWithOpts opts sample_ledger_str l <- journalFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1" ["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
@ -495,7 +492,7 @@ tests = TestList [
,"register report sorts by date" ~: ,"register report sorts by date" ~:
do do
l <- ledgerFromStringWithOpts [] $ unlines l <- journalFromStringWithOpts [] $ unlines
["2008/02/02 a" ["2008/02/02 a"
," b 1" ," b 1"
," c" ," c"
@ -580,14 +577,14 @@ tests = TestList [
,"show hours" ~: show (hours 1) ~?= "1.0h" ,"show hours" ~: show (hours 1) ~?= "1.0h"
,"unicode in balance layout" ~: do ,"unicode in balance layout" ~: do
l <- ledgerFromStringWithOpts [] l <- journalFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines
[" -100 актив:наличные" [" -100 актив:наличные"
," 100 расходы:покупки"] ," 100 расходы:покупки"]
,"unicode in register layout" ~: do ,"unicode in register layout" ~: do
l <- ledgerFromStringWithOpts [] l <- journalFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100" ["2009/01/01 медвежья шкура расходы:покупки 100 100"
@ -629,7 +626,7 @@ tests = TestList [
-- "next january" `gives` "2009/01/01" -- "next january" `gives` "2009/01/01"
,"subAccounts" ~: do ,"subAccounts" ~: do
l <- liftM (filterAndCacheLedger nullfilterspec) sampleledger l <- liftM (journalToLedger nullfilterspec) sampleledger
let a = ledgerAccount l "assets" let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
@ -676,8 +673,8 @@ tests = TestList [
date1 = parsedate "2008/11/26" date1 = parsedate "2008/11/26"
t1 = LocalTime date1 midday t1 = LocalTime date1 midday
sampleledger = ledgerFromStringWithOpts [] sample_ledger_str sampleledger = journalFromStringWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = ledgerFromStringWithOpts opts sample_ledger_str sampleledgerwithopts opts _ = journalFromStringWithOpts opts sample_ledger_str
sample_ledger_str = unlines sample_ledger_str = unlines
["; A sample ledger file." ["; A sample ledger file."
@ -1050,7 +1047,7 @@ journal7 = Journal
(TOD 0 0) (TOD 0 0)
"" ""
ledger7 = filterAndCacheLedger nullfilterspec $ makeUncachedLedger journal7 ledger7 = journalToLedger nullfilterspec journal7
ledger8_str = unlines ledger8_str = unlines
["2008/1/1 test " ["2008/1/1 test "

View File

@ -7,10 +7,15 @@ Hledger.Data.Utils.
-} -}
module Hledger.Cli.Utils module Hledger.Cli.Utils
(
withJournalDo,
journalFromStringWithOpts,
openBrowserOn
)
where where
import Control.Monad.Error import Control.Monad.Error
import Hledger.Data import Hledger.Data
import Hledger.Cli.Options (Opt(..),ledgerFilePathFromOpts) -- ,optsToFilterSpec) import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.IO (stderr) import System.IO (stderr)
#if __GLASGOW_HASKELL__ <= 610 #if __GLASGOW_HASKELL__ <= 610
@ -23,42 +28,29 @@ import System.Process (readProcessWithExitCode)
import System.Info (os) import System.Info (os)
-- | Parse the user's specified ledger file and run a hledger command on -- | Parse the user's specified journal file and run a hledger command on
-- it, or report a parse error. This function makes the whole thing go. -- it, or report a parse error. This function makes the whole thing go.
-- The command will receive an uncached/unfiltered ledger, so should withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
-- process it further if needed. withJournalDo opts args cmdname cmd = do
withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> UncachedLedger -> IO ()) -> IO ()
withLedgerDo opts args cmdname cmd = do
-- We kludgily read the file before parsing to grab the full text, unless -- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly -- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work. -- to let the add command work.
f <- ledgerFilePathFromOpts opts f <- journalFilePathFromOpts opts
fileexists <- doesFileExist f fileexists <- doesFileExist f
let creating = not fileexists && cmdname == "add" let creating = not fileexists && cmdname == "add"
cost = CostBasis `elem` opts costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
let runcmd = cmd opts args . makeUncachedLedger . (if cost then journalConvertAmountsToCost else id) runcmd = cmd opts args . costify
if creating if creating
then runcmd nulljournal then runcmd nulljournal
else (runErrorT . parseJournalFile) f >>= either parseerror runcmd else (runErrorT . parseJournalFile) f >>= either parseerror runcmd
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
-- | Get an uncached ledger from the given string and options, or raise an error. -- | Get a journal from the given string and options, or throw an error.
ledgerFromStringWithOpts :: [Opt] -> String -> IO UncachedLedger journalFromStringWithOpts :: [Opt] -> String -> IO Journal
ledgerFromStringWithOpts opts s = do journalFromStringWithOpts opts s = do
j <- journalFromString s j <- journalFromString s
let cost = CostBasis `elem` opts let cost = CostBasis `elem` opts
return $ makeUncachedLedger $ (if cost then journalConvertAmountsToCost else id) j return $ (if cost then journalConvertAmountsToCost else id) j
-- -- | Read a ledger from the given file, or give an error.
-- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger
-- readLedgerWithOpts opts args f = do
-- t <- getCurrentLocalTime
-- readLedger f
-- -- | Convert a Journal to a canonicalised, cached and filtered Ledger
-- -- based on the command-line options/arguments and a reference time.
-- filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> Journal -> Ledger
-- filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
-- | Attempt to open a web browser on the given url, all platforms. -- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode openBrowserOn :: String -> IO ExitCode

View File

@ -6,9 +6,8 @@ Utilities for doing I/O with ledger files.
module Hledger.Data.IO module Hledger.Data.IO
where where
import Control.Monad.Error import Control.Monad.Error
import Hledger.Data.Ledger (makeUncachedLedger)
import Hledger.Data.Parse (parseJournal) import Hledger.Data.Parse (parseJournal)
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..)) import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..))
import Hledger.Data.Dates (nulldatespan) import Hledger.Data.Dates (nulldatespan)
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.Environment (getEnv) import System.Environment (getEnv)
@ -52,32 +51,22 @@ myTimelogPath =
home <- getHomeDirectory home <- getHomeDirectory
return $ home </> timelogdefaultfilename) return $ home </> timelogdefaultfilename)
-- | Read the user's default ledger file, or give an error. -- | Read the user's default journal file, or give an error.
myLedger :: IO Ledger myJournal :: IO Journal
myLedger = myLedgerPath >>= readLedger myJournal = myLedgerPath >>= readJournal
-- | Read the user's default timelog file, or give an error. -- | Read the user's default timelog file, or give an error.
myTimelog :: IO Ledger myTimelog :: IO Journal
myTimelog = myTimelogPath >>= readLedger myTimelog = myTimelogPath >>= readJournal
-- | Read an unfiltered, uncached ledger from this file, or give an error. -- | Read a journal from this file, or give an error.
readLedger :: FilePath -> IO Ledger readJournal :: FilePath -> IO Journal
readLedger f = do readJournal f = do
s <- readFile f s <- readFile f
j <- journalFromString s journalFromString s
return $ makeUncachedLedger j
-- -- | Read a ledger from this file, filtering according to the filter spec.,
-- -- | or give an error.
-- readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
-- readLedgerWithFilterSpec fspec f = do
-- s <- readFile f
-- t <- getClockTime
-- j <- journalFromString s
-- return $ filterAndCacheLedger fspec s j{filepath=f, filereadtime=t}
-- | Read a Journal from the given string, using the current time as -- | Read a Journal from the given string, using the current time as
-- reference time, or give a parse error. -- reference time, or throw an error.
journalFromString :: String -> IO Journal journalFromString :: String -> IO Journal
journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(string)" s journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(string)" s

View File

@ -1,8 +1,7 @@
{-| {-|
A 'Journal' is a parsed ledger file, containing 'Transaction's. A 'Journal' is a set of 'Transaction's and related data, usually parsed
It can be filtered and massaged in various ways, then \"crunched\" from a hledger/ledger journal file or timelog.
to form a 'Ledger'.
-} -}

View File

@ -1,53 +1,9 @@
{-| {-|
A compound data type for efficiency. A 'Ledger' caches information derived A 'Ledger' is derived from a 'Journal' by applying a filter specification
from a 'Journal' for easier querying. Also it typically has had to select 'Transaction's and 'Posting's of interest. It contains the
uninteresting 'Transaction's and 'Posting's filtered out. It filtered journal and knows the resulting chart of accounts, account
contains: balances, and postings in each account.
- the original unfiltered 'Journal'
- a tree of 'AccountName's
- a map from account names to 'Account's
- the full text of the journal file, when available
This is the main object you'll deal with as a user of the Ledger
library. The most useful functions also have shorter, lower-case
aliases for easier interaction. Here's an example:
> > import Hledger.Data
> > l <- readLedger "sample.ledger"
> > accountnames l
> ["assets","assets:bank","assets:bank:checking","assets:bank:saving",...
> > accounts l
> [Account assets with 0 txns and $-1 balance,Account assets:bank with...
> > topaccounts l
> [Account assets with 0 txns and $-1 balance,Account expenses with...
> > account l "assets"
> Account assets with 0 txns and $-1 balance
> > accountsmatching ["ch"] l
> accountsmatching ["ch"] l
> [Account assets:bank:checking with 4 txns and $0 balance]
> > subaccounts l (account l "assets")
> subaccounts l (account l "assets")
> [Account assets:bank with 0 txns and $1 balance,Account assets:cash...
> > head $ transactions l
> 2008/01/01 income assets:bank:checking $1 RegularPosting
> > accounttree 2 l
> Node {rootLabel = Account top with 0 txns and 0 balance, subForest = [...
> > accounttreeat l (account l "assets")
> Just (Node {rootLabel = Account assets with 0 txns and $-1 balance, ...
> > datespan l -- disabled
> DateSpan (Just 2008-01-01) (Just 2009-01-01)
> > rawdatespan l
> DateSpan (Just 2008-01-01) (Just 2009-01-01)
> > ledgeramounts l
> [$1,$-1,$1,$-1,$1,$-1,$1,$1,$-2,$1,$-1]
> > commodities l
> [Commodity {symbol = "$", side = L, spaced = False, comma = False, ...
-} -}
@ -77,23 +33,17 @@ nullledger = Ledger{
accountmap = fromList [] accountmap = fromList []
} }
-- | Generate a ledger from a journal, but don't cache it yet.
makeUncachedLedger :: Journal -> UncachedLedger
makeUncachedLedger j = nullledger{journal=j}
-- | Filter a ledger's transactions as specified and generate derived data. -- | Filter a ledger's transactions as specified and generate derived data.
filterAndCacheLedger :: FilterSpec -> UncachedLedger -> Ledger journalToLedger :: FilterSpec -> Journal -> Ledger
filterAndCacheLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=t,accountmap=m} journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m}
where j' = filterJournalPostings filterspec{depth=Nothing} j where j' = filterJournalPostings fs{depth=Nothing} j
(t, m) = journalAccountInfo j' (t, m) = journalAccountInfo j'
-- | List a ledger's account names. -- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = drop 1 . flatten . accountnametree ledgerAccountNames = drop 1 . flatten . accountnametree
-- | Get the named account from a (cached) ledger. -- | Get the named account from a ledger.
-- If the ledger has not been cached (with crunchJournal or
-- cacheLedger'), this returns the null account.
ledgerAccount :: Ledger -> AccountName -> Account ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount l a = findWithDefault nullacct a $ accountmap l ledgerAccount l a = findWithDefault nullacct a $ accountmap l

View File

@ -4,26 +4,31 @@
Most data types are defined here to avoid import cycles. Most data types are defined here to avoid import cycles.
Here is an overview of the hledger data model: Here is an overview of the hledger data model:
> Ledger -- hledger's ledger is a journal file plus cached/derived data > Journal -- a journal is derived from one or more data files. It contains..
> Journal -- a representation of the journal file, containing.. > [Transaction] -- journal transactions, which have date, status, code, description and..
> [Transaction] -- ..journal transactions, which have date, status, code, description and.. > [Posting] -- multiple account postings (entries), which have account name and amount.
> [Posting] -- ..two or more account postings (account name and amount) > [HistoricalPrice] -- historical commodity prices
> Tree AccountName -- all account names as a tree >
> Map AccountName Account -- a map from account name to account info (postings and balances) > Ledger -- a ledger is derived from a journal, by applying a filter specification. It contains..
> Journal -- the filtered journal, containing only the transactions and postings we are interested in
> Tree AccountName -- account names referenced in the journal's transactions, as a tree
> Map AccountName Account -- per-account postings and balances from the journal's transactions, as a map from account name to account info
For more detailed documentation on each type, see the corresponding modules. For more detailed documentation on each type, see the corresponding modules.
Terminology has been in flux: Evolution of transaction/entry/posting terminology:
- ledger 2 had entries containing transactions. - ledger 2: entries contain transactions
- hledger 0.4 had Entrys containing RawTransactions, which were flattened to Transactions. - hledger 0.4: Entrys contain RawTransactions (which are flattened to Transactions)
- ledger 3 has transactions containing postings. - ledger 3: transactions contain postings
- hledger 0.5 had LedgerTransactions containing Postings, which were flattened to Transactions. - hledger 0.5: LedgerTransactions contain Postings (which are flattened to Transactions)
- hledger 0.8 has Transactions containing Postings, and no flattened type. - hledger 0.8: Transactions contain Postings (referencing Transactions, corecursively)
- hledger 0.10: Postings should be called Entrys, but are left as-is for now
-} -}
@ -123,7 +128,13 @@ data Journal = Journal {
filepath :: FilePath, filepath :: FilePath,
filereadtime :: ClockTime, filereadtime :: ClockTime,
jtext :: String jtext :: String
} deriving (Eq) } deriving (Eq, Typeable)
data Ledger = Ledger {
journal :: Journal,
accountnametree :: Tree AccountName,
accountmap :: Map.Map AccountName Account
}
data Account = Account { data Account = Account {
aname :: AccountName, aname :: AccountName,
@ -131,18 +142,7 @@ data Account = Account {
abalance :: MixedAmount -- ^ sum of postings in this account and subaccounts abalance :: MixedAmount -- ^ sum of postings in this account and subaccounts
} }
data Ledger = Ledger { -- | A generic, pure specification of how to filter transactions and postings.
journal :: Journal,
accountnametree :: Tree AccountName,
accountmap :: Map.Map AccountName Account
} deriving Typeable
-- | An incomplete ledger, containing just the journal. Currently just a
-- visual indicator used in a few places.
type UncachedLedger = Ledger
-- | A generic, pure specification of how to filter transactions/postings.
-- This exists to keep app-specific options out of the hledger library.
data FilterSpec = FilterSpec { data FilterSpec = FilterSpec {
datespan :: DateSpan -- ^ only include if in this date span datespan :: DateSpan -- ^ only include if in this date span
,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care ,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care