mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 02:08:01 +03:00
rename Ledger -> RawLedger, CachedLedger -> Ledger
This commit is contained in:
Simon Michael
parent
df55743697
commit
bd84e95f5e
26
Account.hs
26
Account.hs
@ -9,7 +9,7 @@ import Amount
|
||||
import Entry
|
||||
import Transaction
|
||||
import EntryTransaction
|
||||
import Ledger
|
||||
import RawLedger
|
||||
|
||||
|
||||
-- an Account caches an account's name, balance (including sub-accounts)
|
||||
@ -20,7 +20,7 @@ instance Show Account where
|
||||
|
||||
nullacct = Account "" [] nullamt
|
||||
|
||||
ledgerAccount :: Ledger -> AccountName -> Account
|
||||
ledgerAccount :: RawLedger -> AccountName -> Account
|
||||
ledgerAccount l a =
|
||||
Account
|
||||
a
|
||||
@ -29,24 +29,24 @@ ledgerAccount l a =
|
||||
|
||||
-- queries
|
||||
|
||||
balanceInAccountNamed :: Ledger -> AccountName -> Amount
|
||||
balanceInAccountNamed :: RawLedger -> AccountName -> Amount
|
||||
balanceInAccountNamed l a =
|
||||
sumEntryTransactions (transactionsInAccountNamed l a)
|
||||
|
||||
aggregateBalanceInAccountNamed :: Ledger -> AccountName -> Amount
|
||||
aggregateBalanceInAccountNamed :: RawLedger -> AccountName -> Amount
|
||||
aggregateBalanceInAccountNamed l a =
|
||||
sumEntryTransactions (aggregateTransactionsInAccountNamed l a)
|
||||
|
||||
transactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction]
|
||||
transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
transactionsInAccountNamed l a =
|
||||
ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
|
||||
aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction]
|
||||
aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
aggregateTransactionsInAccountNamed l a =
|
||||
ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
|
||||
|
||||
-- build a tree of Accounts
|
||||
addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
|
||||
addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account
|
||||
addDataToAccountNameTree l ant =
|
||||
Node
|
||||
(ledgerAccount l $ root ant)
|
||||
@ -92,13 +92,13 @@ addDataToAccountNameTree l ant =
|
||||
-- $ checking
|
||||
-- $ saving
|
||||
|
||||
showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String
|
||||
showLedgerAccounts l acctpats showsubs maxdepth =
|
||||
concatMap
|
||||
(showAccountTree l)
|
||||
(branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
|
||||
|
||||
ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
|
||||
ledgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account
|
||||
ledgerAccountTreeMatching l [] showsubs maxdepth =
|
||||
ledgerAccountTreeMatching l [".*"] showsubs maxdepth
|
||||
ledgerAccountTreeMatching l acctpats showsubs maxdepth =
|
||||
@ -130,7 +130,7 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth =
|
||||
-- e
|
||||
-- f
|
||||
-- g
|
||||
showAccountTree :: Ledger -> Tree Account -> String
|
||||
showAccountTree :: RawLedger -> Tree Account -> String
|
||||
showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom
|
||||
|
||||
showAccountTree' l indentlevel t
|
||||
@ -149,7 +149,7 @@ showAccountTree' l indentlevel t
|
||||
boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct
|
||||
leafname = accountLeafName $ aname acct
|
||||
|
||||
isBoringInnerAccount :: Ledger -> Account -> Bool
|
||||
isBoringInnerAccount :: RawLedger -> Account -> Bool
|
||||
isBoringInnerAccount l a
|
||||
| name == "top" = False
|
||||
| (length txns == 0) && ((length subs) == 1) = True
|
||||
@ -160,7 +160,7 @@ isBoringInnerAccount l a
|
||||
subs = subAccountNamesFrom (ledgerAccountNames l) name
|
||||
|
||||
-- darnit, still need this
|
||||
isBoringInnerAccountName :: Ledger -> AccountName -> Bool
|
||||
isBoringInnerAccountName :: RawLedger -> AccountName -> Bool
|
||||
isBoringInnerAccountName l name
|
||||
| name == "top" = False
|
||||
| (length txns == 0) && ((length subs) == 1) = True
|
||||
@ -176,5 +176,5 @@ interestingAccountsFrom =
|
||||
hasbalance = (/= 0) . abalance
|
||||
hastxns = (> 0) . length . atransactions
|
||||
|
||||
ledgerAccountTree :: Ledger -> Tree Account
|
||||
ledgerAccountTree :: RawLedger -> Tree Account
|
||||
ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l)
|
||||
|
||||
@ -1,49 +0,0 @@
|
||||
module CachedLedger
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils
|
||||
import Types
|
||||
import Account
|
||||
import AccountName
|
||||
import EntryTransaction
|
||||
import Ledger
|
||||
|
||||
|
||||
cacheLedger :: Ledger -> CachedLedger
|
||||
cacheLedger l =
|
||||
CachedLedger
|
||||
l
|
||||
(ledgerAccountNameTree l)
|
||||
(Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l])
|
||||
|
||||
cLedgerTransactions :: CachedLedger -> [EntryTransaction]
|
||||
cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
|
||||
|
||||
-- unoptimised
|
||||
cLedgerTransactionsMatching :: ([String],[String]) -> CachedLedger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ uncached_ledger l
|
||||
|
||||
-- XXX optimise
|
||||
cLedgerTransactionsMatching1 :: ([String],[String]) -> CachedLedger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (uncached_ledger l)
|
||||
cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (uncached_ledger l)
|
||||
cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (uncached_ledger l)
|
||||
cLedgerTransactionsMatching1 (acctregexps,descregexps) l =
|
||||
intersect
|
||||
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
|
||||
(concat [filter (matchTransactionDescription r) ts | r <- descregexps])
|
||||
where ts = cLedgerTransactions l
|
||||
|
||||
-- unoptimised
|
||||
showCLedgerAccounts :: CachedLedger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts l acctpats showsubs maxdepth =
|
||||
showLedgerAccounts (uncached_ledger l) acctpats showsubs maxdepth
|
||||
|
||||
-- XXX optimise
|
||||
showCLedgerAccounts1 :: CachedLedger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts1 l acctpats showsubs maxdepth =
|
||||
concatMap
|
||||
(showAccountTree (uncached_ledger l))
|
||||
(branches (ledgerAccountTreeMatching (uncached_ledger l) acctpats showsubs maxdepth))
|
||||
|
||||
71
Ledger.hs
71
Ledger.hs
@ -3,54 +3,47 @@ where
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils
|
||||
import AccountName
|
||||
import Types
|
||||
import Entry
|
||||
import Account
|
||||
import AccountName
|
||||
import EntryTransaction
|
||||
import RawLedger
|
||||
|
||||
|
||||
instance Show Ledger where
|
||||
show l = printf "Ledger with %d entries"
|
||||
((length $ entries l) +
|
||||
(length $ modifier_entries l) +
|
||||
(length $ periodic_entries l))
|
||||
cacheLedger :: RawLedger -> Ledger
|
||||
cacheLedger l =
|
||||
Ledger
|
||||
l
|
||||
(ledgerAccountNameTree l)
|
||||
(Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l])
|
||||
|
||||
ledgerTransactions :: Ledger -> [EntryTransaction]
|
||||
ledgerTransactions l = entryTransactionsFrom $ entries l
|
||||
cLedgerTransactions :: Ledger -> [EntryTransaction]
|
||||
cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
|
||||
|
||||
ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
|
||||
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
|
||||
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
|
||||
ledgerTransactionsMatching (acctregexps,descregexps) l =
|
||||
-- unoptimised
|
||||
cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l
|
||||
|
||||
-- XXX optimise
|
||||
cLedgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (rawledger l)
|
||||
cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (rawledger l)
|
||||
cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (rawledger l)
|
||||
cLedgerTransactionsMatching1 (acctregexps,descregexps) l =
|
||||
intersect
|
||||
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
|
||||
(concat [filter (matchTransactionDescription r) ts | r <- descregexps])
|
||||
where ts = ledgerTransactions l
|
||||
|
||||
ledgerAccountTransactions :: Ledger -> AccountName -> [EntryTransaction]
|
||||
ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
|
||||
accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
|
||||
accountNamesFromTransactions ts = nub $ map account ts
|
||||
|
||||
ledgerAccountNamesUsed :: Ledger -> [AccountName]
|
||||
ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
|
||||
|
||||
ledgerAccountNames :: Ledger -> [AccountName]
|
||||
ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed
|
||||
|
||||
ledgerTopAccountNames :: Ledger -> [AccountName]
|
||||
ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l)
|
||||
|
||||
ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName]
|
||||
ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l
|
||||
ledgerAccountNamesMatching acctregexps l =
|
||||
concat [filter (matchAccountName r) accountNames | r <- acctregexps]
|
||||
where accountNames = ledgerTopAccountNames l
|
||||
|
||||
ledgerAccountNameTree :: Ledger -> Tree AccountName
|
||||
ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l
|
||||
where ts = cLedgerTransactions l
|
||||
|
||||
-- unoptimised
|
||||
showCLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts l acctpats showsubs maxdepth =
|
||||
showLedgerAccounts (rawledger l) acctpats showsubs maxdepth
|
||||
|
||||
-- XXX optimise
|
||||
showCLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts1 l acctpats showsubs maxdepth =
|
||||
concatMap
|
||||
(showAccountTree (rawledger l))
|
||||
(branches (ledgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth))
|
||||
|
||||
|
||||
@ -8,9 +8,9 @@ module Models (
|
||||
module Entry,
|
||||
module TimeLog,
|
||||
module EntryTransaction,
|
||||
module Ledger,
|
||||
module RawLedger,
|
||||
module Account,
|
||||
module CachedLedger,
|
||||
module Ledger,
|
||||
)
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
@ -23,7 +23,7 @@ import Transaction
|
||||
import Entry
|
||||
import TimeLog
|
||||
import EntryTransaction
|
||||
import Ledger
|
||||
import RawLedger
|
||||
import Account
|
||||
import CachedLedger
|
||||
import Ledger
|
||||
|
||||
|
||||
10
Parse.hs
10
Parse.hs
@ -36,7 +36,7 @@ reserved = P.reserved lexer
|
||||
reservedOp = P.reservedOp lexer
|
||||
|
||||
|
||||
ledgerfile :: Parser Ledger
|
||||
ledgerfile :: Parser RawLedger
|
||||
ledgerfile = ledger <|> ledgerfromtimelog
|
||||
|
||||
|
||||
@ -141,7 +141,7 @@ i, o, b, h
|
||||
-- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs
|
||||
-- sample data in Tests.hs
|
||||
|
||||
ledger :: Parser Ledger
|
||||
ledger :: Parser RawLedger
|
||||
ledger = do
|
||||
ledgernondatalines
|
||||
-- for now these must come first, unlike ledger
|
||||
@ -150,7 +150,7 @@ ledger = do
|
||||
--
|
||||
entries <- (many ledgerentry) <?> "entry"
|
||||
eof
|
||||
return $ Ledger modifier_entries periodic_entries entries
|
||||
return $ RawLedger modifier_entries periodic_entries entries
|
||||
|
||||
ledgernondatalines :: Parser [String]
|
||||
ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []})
|
||||
@ -287,7 +287,7 @@ o 2007/03/10 17:26:02
|
||||
|
||||
-}
|
||||
|
||||
ledgerfromtimelog :: Parser Ledger
|
||||
ledgerfromtimelog :: Parser RawLedger
|
||||
ledgerfromtimelog = do
|
||||
tl <- timelog
|
||||
return $ ledgerFromTimeLog tl
|
||||
@ -320,7 +320,7 @@ printParseResult :: Show v => Either ParseError v -> IO ()
|
||||
printParseResult r = case r of Left e -> parseError e
|
||||
Right v -> print v
|
||||
|
||||
parseLedgerFile :: String -> IO (Either ParseError Ledger)
|
||||
parseLedgerFile :: String -> IO (Either ParseError RawLedger)
|
||||
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
|
||||
parseLedgerFile f = parseFromFile ledgerfile f
|
||||
|
||||
|
||||
56
RawLedger.hs
Normal file
56
RawLedger.hs
Normal file
@ -0,0 +1,56 @@
|
||||
module RawLedger
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils
|
||||
import AccountName
|
||||
import Types
|
||||
import Entry
|
||||
import EntryTransaction
|
||||
|
||||
|
||||
instance Show RawLedger where
|
||||
show l = printf "RawLedger with %d entries"
|
||||
((length $ entries l) +
|
||||
(length $ modifier_entries l) +
|
||||
(length $ periodic_entries l))
|
||||
|
||||
ledgerTransactions :: RawLedger -> [EntryTransaction]
|
||||
ledgerTransactions l = entryTransactionsFrom $ entries l
|
||||
|
||||
ledgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction]
|
||||
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
|
||||
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
|
||||
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
|
||||
ledgerTransactionsMatching (acctregexps,descregexps) l =
|
||||
intersect
|
||||
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
|
||||
(concat [filter (matchTransactionDescription r) ts | r <- descregexps])
|
||||
where ts = ledgerTransactions l
|
||||
|
||||
ledgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
|
||||
accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
|
||||
accountNamesFromTransactions ts = nub $ map account ts
|
||||
|
||||
ledgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||
ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
|
||||
|
||||
ledgerAccountNames :: RawLedger -> [AccountName]
|
||||
ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed
|
||||
|
||||
ledgerTopAccountNames :: RawLedger -> [AccountName]
|
||||
ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l)
|
||||
|
||||
ledgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName]
|
||||
ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l
|
||||
ledgerAccountNamesMatching acctregexps l =
|
||||
concat [filter (matchAccountName r) accountNames | r <- acctregexps]
|
||||
where accountNames = ledgerTopAccountNames l
|
||||
|
||||
ledgerAccountNameTree :: RawLedger -> Tree AccountName
|
||||
ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l
|
||||
|
||||
|
||||
|
||||
2
Tests.hs
2
Tests.hs
@ -155,7 +155,7 @@ ledger7_str = "\
|
||||
\\n" --"
|
||||
|
||||
l = ledger7
|
||||
ledger7 = Ledger
|
||||
ledger7 = RawLedger
|
||||
[]
|
||||
[]
|
||||
[
|
||||
|
||||
@ -6,7 +6,7 @@ import Currency
|
||||
import Amount
|
||||
import Transaction
|
||||
import Entry
|
||||
import Ledger
|
||||
import RawLedger
|
||||
|
||||
instance Show TimeLogEntry where
|
||||
show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t)
|
||||
@ -14,9 +14,9 @@ instance Show TimeLogEntry where
|
||||
instance Show TimeLog where
|
||||
show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
|
||||
|
||||
ledgerFromTimeLog :: TimeLog -> Ledger
|
||||
ledgerFromTimeLog :: TimeLog -> RawLedger
|
||||
ledgerFromTimeLog tl =
|
||||
Ledger [] [] (entriesFromTimeLogEntries $ timelog_entries tl)
|
||||
RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl)
|
||||
|
||||
entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]
|
||||
|
||||
|
||||
12
Types.hs
12
Types.hs
@ -17,9 +17,9 @@ hledger
|
||||
Models
|
||||
TimeLog
|
||||
TimeLogEntry
|
||||
CachedLedger
|
||||
Ledger
|
||||
Account
|
||||
Ledger
|
||||
RawLedger
|
||||
EntryTransaction
|
||||
Entry
|
||||
Transaction
|
||||
@ -92,7 +92,7 @@ data TimeLog = TimeLog {
|
||||
} deriving (Eq)
|
||||
|
||||
-- a parsed ledger file
|
||||
data Ledger = Ledger {
|
||||
data RawLedger = RawLedger {
|
||||
modifier_entries :: [ModifierEntry],
|
||||
periodic_entries :: [PeriodicEntry],
|
||||
entries :: [Entry]
|
||||
@ -104,7 +104,7 @@ data Ledger = Ledger {
|
||||
-- "transactions" in modules above EntryTransaction.
|
||||
type EntryTransaction = (Entry,Transaction)
|
||||
|
||||
-- all information for a particular account, derived from a Ledger
|
||||
-- all information for a particular account, derived from a RawLedger
|
||||
data Account = Account {
|
||||
aname :: AccountName,
|
||||
atransactions :: [EntryTransaction], -- excludes sub-accounts
|
||||
@ -112,8 +112,8 @@ data Account = Account {
|
||||
}
|
||||
|
||||
-- a ledger with account info cached for faster queries
|
||||
data CachedLedger = CachedLedger {
|
||||
uncached_ledger :: Ledger,
|
||||
data Ledger = Ledger {
|
||||
rawledger :: RawLedger,
|
||||
accountnames :: Tree AccountName,
|
||||
accounts :: Map.Map AccountName Account
|
||||
}
|
||||
|
||||
@ -63,11 +63,11 @@ selftest = do
|
||||
|
||||
-- utils
|
||||
|
||||
doWithLedger :: [Flag] -> (CachedLedger -> IO ()) -> IO ()
|
||||
doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
|
||||
doWithLedger opts cmd = do
|
||||
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
|
||||
|
||||
doWithParsed :: (CachedLedger -> IO ()) -> (Either ParseError Ledger) -> IO ()
|
||||
doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO ()
|
||||
doWithParsed cmd parsed = do
|
||||
case parsed of Left e -> parseError e
|
||||
Right l -> cmd $ cacheLedger l
|
||||
@ -75,7 +75,7 @@ doWithParsed cmd parsed = do
|
||||
-- interactive testing:
|
||||
--
|
||||
-- p <- ledgerFilePath [] >>= parseLedgerFile
|
||||
-- let l = either (\_ -> Ledger [] [] []) id p
|
||||
-- let l = either (\_ -> RawLedger [] [] []) id p
|
||||
-- let ant = ledgerAccountNameTree l
|
||||
-- let at = ledgerAccountTreeMatching l [] True 999
|
||||
-- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999
|
||||
|
||||
Loading…
Reference in New Issue
Block a user