slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rename Ledger -> RawLedger, CachedLedger -> Ledger

Browse Source
This commit is contained in:
Simon Michael 2007-07-02 19:15:39 +00:00
parent df55743697
commit bd84e95f5e
10 changed files with 123 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Account.hs
View File

@ -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)

49
CachedLedger.hs
View File

@ -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
View File

@ -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
Models.hs
View File

@ -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
View File

@ -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
View 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
View File

@ -155,7 +155,7 @@ ledger7_str = "\
\\n" --"
l = ledger7
ledger7 = Ledger
ledger7 = RawLedger
[]
[]
[

6
TimeLog.hs
View File

@ -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
View File

@ -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
}

6
hledger.hs
View File

@ -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