use a consistent prefix for Transaction field accessors
This commit is contained in:
parent
622db5f25d
commit
1572622ae6
@ -29,13 +29,13 @@ histogram opts args l =
|
|||||||
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
|
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
|
||||||
daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
|
daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
|
||||||
-- same as RegisterCommand
|
-- same as RegisterCommand
|
||||||
ts = sortBy (comparing date) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
||||||
filterempties
|
filterempties
|
||||||
| Empty `elem` opts = id
|
| Empty `elem` opts = id
|
||||||
| otherwise = filter (not . isZeroMixedAmount . amount)
|
| otherwise = filter (not . isZeroMixedAmount . tamount)
|
||||||
matchapats t = matchpats apats $ account t
|
matchapats t = matchpats apats $ taccount t
|
||||||
(apats,_) = parsePatternArgs args
|
(apats,_) = parsePatternArgs args
|
||||||
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ account t) <= depth)
|
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
depth = depthFromOpts opts
|
depth = depthFromOpts opts
|
||||||
|
|
||||||
|
|||||||
@ -56,7 +56,7 @@ groupTransactions :: [Transaction] -> (Tree AccountName,
|
|||||||
(AccountName -> MixedAmount))
|
(AccountName -> MixedAmount))
|
||||||
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
|
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
|
||||||
where
|
where
|
||||||
txnanames = sort $ nub $ map account ts
|
txnanames = sort $ nub $ map taccount ts
|
||||||
ant = accountNameTreeFrom $ expandAccountNames $ txnanames
|
ant = accountNameTreeFrom $ expandAccountNames $ txnanames
|
||||||
allanames = flatten ant
|
allanames = flatten ant
|
||||||
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
|
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames])
|
||||||
@ -86,14 +86,14 @@ calculateBalances ant txnsof = addbalances ant
|
|||||||
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
|
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
|
||||||
transactionsByAccount ts = m'
|
transactionsByAccount ts = m'
|
||||||
where
|
where
|
||||||
sortedts = sortBy (comparing account) ts
|
sortedts = sortBy (comparing taccount) ts
|
||||||
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts
|
||||||
m' = Map.fromList [(account $ head g, g) | g <- groupedts]
|
m' = Map.fromList [(taccount $ head g, g) | g <- groupedts]
|
||||||
-- The special account name "top" can be used to look up all transactions. ?
|
-- The special account name "top" can be used to look up all transactions. ?
|
||||||
-- m' = Map.insert "top" sortedts m
|
-- m' = Map.insert "top" sortedts m
|
||||||
|
|
||||||
filtertxns :: [String] -> [Transaction] -> [Transaction]
|
filtertxns :: [String] -> [Transaction] -> [Transaction]
|
||||||
filtertxns apats ts = filter (matchpats apats . account) ts
|
filtertxns apats ts = filter (matchpats apats . taccount) ts
|
||||||
|
|
||||||
-- | List a ledger's account names.
|
-- | List a ledger's account names.
|
||||||
accountnames :: Ledger -> [AccountName]
|
accountnames :: Ledger -> [AccountName]
|
||||||
@ -137,6 +137,6 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
|||||||
ledgerDateSpan :: Ledger -> DateSpan
|
ledgerDateSpan :: Ledger -> DateSpan
|
||||||
ledgerDateSpan l
|
ledgerDateSpan l
|
||||||
| null ts = DateSpan Nothing Nothing
|
| null ts = DateSpan Nothing Nothing
|
||||||
| otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts)
|
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
|
||||||
where
|
where
|
||||||
ts = sortBy (comparing date) $ ledgerTransactions l
|
ts = sortBy (comparing tdate) $ ledgerTransactions l
|
||||||
|
|||||||
@ -567,14 +567,14 @@ datedisplayexpr = do
|
|||||||
(y,m,d) <- smartdate
|
(y,m,d) <- smartdate
|
||||||
char ']'
|
char ']'
|
||||||
let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d
|
let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d
|
||||||
let matcher = \(Transaction{date=tdate}) ->
|
let matcher = \(Transaction{tdate=d}) ->
|
||||||
case op of
|
case op of
|
||||||
"<" -> tdate < ltdate
|
"<" -> d < ltdate
|
||||||
"<=" -> tdate <= ltdate
|
"<=" -> d <= ltdate
|
||||||
"=" -> tdate == ltdate
|
"=" -> d == ltdate
|
||||||
"==" -> tdate == ltdate -- just in case
|
"==" -> d == ltdate -- just in case
|
||||||
">=" -> tdate >= ltdate
|
">=" -> d >= ltdate
|
||||||
">" -> tdate > ltdate
|
">" -> d > ltdate
|
||||||
return matcher
|
return matcher
|
||||||
|
|
||||||
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
|
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]
|
||||||
|
|||||||
@ -142,11 +142,11 @@ canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms
|
|||||||
commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
|
commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
|
||||||
commoditieswithsymbol s = filter ((s==) . symbol) commodities
|
commoditieswithsymbol s = filter ((s==) . symbol) commodities
|
||||||
commoditysymbols = nub $ map symbol commodities
|
commoditysymbols = nub $ map symbol commodities
|
||||||
commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l
|
commodities = map commodity $ concatMap (amounts . tamount) $ rawLedgerTransactions l
|
||||||
|
|
||||||
-- | Get just the amounts from a ledger, in the order parsed.
|
-- | Get just the amounts from a ledger, in the order parsed.
|
||||||
rawLedgerAmounts :: RawLedger -> [MixedAmount]
|
rawLedgerAmounts :: RawLedger -> [MixedAmount]
|
||||||
rawLedgerAmounts = map amount . rawLedgerTransactions
|
rawLedgerAmounts = map tamount . rawLedgerTransactions
|
||||||
|
|
||||||
-- | Get just the ammount commodities from a ledger, in the order parsed.
|
-- | Get just the ammount commodities from a ledger, in the order parsed.
|
||||||
rawLedgerCommodities :: RawLedger -> [Commodity]
|
rawLedgerCommodities :: RawLedger -> [Commodity]
|
||||||
|
|||||||
@ -33,10 +33,10 @@ flattenLedgerTransaction (LedgerTransaction d s _ desc _ ps _, n) =
|
|||||||
[Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps]
|
[Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps]
|
||||||
|
|
||||||
accountNamesFromTransactions :: [Transaction] -> [AccountName]
|
accountNamesFromTransactions :: [Transaction] -> [AccountName]
|
||||||
accountNamesFromTransactions ts = nub $ map account ts
|
accountNamesFromTransactions ts = nub $ map taccount ts
|
||||||
|
|
||||||
sumTransactions :: [Transaction] -> MixedAmount
|
sumTransactions :: [Transaction] -> MixedAmount
|
||||||
sumTransactions = sum . map amount
|
sumTransactions = sum . map tamount
|
||||||
|
|
||||||
nulltxn :: Transaction
|
nulltxn :: Transaction
|
||||||
nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting
|
nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting
|
||||||
@ -44,7 +44,7 @@ nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularP
|
|||||||
-- | Does the given transaction fall within the given date span ?
|
-- | Does the given transaction fall within the given date span ?
|
||||||
isTransactionInDateSpan :: DateSpan -> Transaction -> Bool
|
isTransactionInDateSpan :: DateSpan -> Transaction -> Bool
|
||||||
isTransactionInDateSpan (DateSpan Nothing Nothing) _ = True
|
isTransactionInDateSpan (DateSpan Nothing Nothing) _ = True
|
||||||
isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{date=d}) = d<e
|
isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{tdate=d}) = d<e
|
||||||
isTransactionInDateSpan (DateSpan (Just b) Nothing) (Transaction{date=d}) = d>=b
|
isTransactionInDateSpan (DateSpan (Just b) Nothing) (Transaction{tdate=d}) = d>=b
|
||||||
isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d<e
|
isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{tdate=d}) = d>=b && d<e
|
||||||
|
|
||||||
|
|||||||
@ -114,11 +114,11 @@ data RawLedger = RawLedger {
|
|||||||
|
|
||||||
data Transaction = Transaction {
|
data Transaction = Transaction {
|
||||||
tnum :: Int,
|
tnum :: Int,
|
||||||
status :: Bool, -- ^ posting status
|
tstatus :: Bool, -- ^ posting status
|
||||||
date :: Day, -- ^ ledger transaction date
|
tdate :: Day, -- ^ ledger transaction date
|
||||||
description :: String, -- ^ ledger transaction description
|
tdescription :: String, -- ^ ledger transaction description
|
||||||
account :: AccountName, -- ^ posting account
|
taccount :: AccountName, -- ^ posting account
|
||||||
amount :: MixedAmount, -- ^ posting amount
|
tamount :: MixedAmount, -- ^ posting amount
|
||||||
ttype :: PostingType -- ^ posting type
|
ttype :: PostingType -- ^ posting type
|
||||||
} deriving (Eq)
|
} deriving (Eq)
|
||||||
|
|
||||||
|
|||||||
@ -35,16 +35,16 @@ showRegisterReport opts args l
|
|||||||
| otherwise = showtxns summaryts nulltxn startbal
|
| otherwise = showtxns summaryts nulltxn startbal
|
||||||
where
|
where
|
||||||
interval = intervalFromOpts opts
|
interval = intervalFromOpts opts
|
||||||
ts = sortBy (comparing date) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
||||||
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ account t) <= depth)
|
filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
filterempties
|
filterempties
|
||||||
| Empty `elem` opts = id
|
| Empty `elem` opts = id
|
||||||
| otherwise = filter (not . isZeroMixedAmount . amount)
|
| otherwise = filter (not . isZeroMixedAmount . tamount)
|
||||||
(precedingts, ts') = break (matchdisplayopt dopt) ts
|
(precedingts, ts') = break (matchdisplayopt dopt) ts
|
||||||
(displayedts, _) = span (matchdisplayopt dopt) ts'
|
(displayedts, _) = span (matchdisplayopt dopt) ts'
|
||||||
startbal = sumTransactions precedingts
|
startbal = sumTransactions precedingts
|
||||||
matchapats t = matchpats apats $ account t
|
matchapats t = matchpats apats $ taccount t
|
||||||
apats = fst $ parseAccountDescriptionArgs opts args
|
apats = fst $ parseAccountDescriptionArgs opts args
|
||||||
matchdisplayopt Nothing t = True
|
matchdisplayopt Nothing t = True
|
||||||
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
|
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
|
||||||
@ -77,20 +77,20 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts
|
|||||||
| null ts = []
|
| null ts = []
|
||||||
| otherwise = summaryts'
|
| otherwise = summaryts'
|
||||||
where
|
where
|
||||||
txn = nulltxn{tnum=tnum, date=b', description="- "++(showDate $ addDays (-1) e')}
|
txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++(showDate $ addDays (-1) e')}
|
||||||
b' = fromMaybe (date $ head ts) b
|
b' = fromMaybe (tdate $ head ts) b
|
||||||
e' = fromMaybe (date $ last ts) e
|
e' = fromMaybe (tdate $ last ts) e
|
||||||
summaryts'
|
summaryts'
|
||||||
| showempty = summaryts
|
| showempty = summaryts
|
||||||
| otherwise = filter (not . isZeroMixedAmount . amount) summaryts
|
| otherwise = filter (not . isZeroMixedAmount . tamount) summaryts
|
||||||
txnanames = sort $ nub $ map account ts
|
txnanames = sort $ nub $ map taccount ts
|
||||||
-- aggregate balances by account, like cacheLedger, then do depth-clipping
|
-- aggregate balances by account, like cacheLedger, then do depth-clipping
|
||||||
(_,_,exclbalof,inclbalof) = groupTransactions ts
|
(_,_,exclbalof,inclbalof) = groupTransactions ts
|
||||||
clippedanames = clipAccountNames depth txnanames
|
clippedanames = clipAccountNames depth txnanames
|
||||||
isclipped a = accountNameLevel a >= depth
|
isclipped a = accountNameLevel a >= depth
|
||||||
balancetoshowfor a =
|
balancetoshowfor a =
|
||||||
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
|
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
|
||||||
summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames]
|
summaryts = [txn{taccount=a,tamount=balancetoshowfor a} | a <- clippedanames]
|
||||||
|
|
||||||
clipAccountNames :: Int -> [AccountName] -> [AccountName]
|
clipAccountNames :: Int -> [AccountName] -> [AccountName]
|
||||||
clipAccountNames d as = nub $ map (clip d) as
|
clipAccountNames d as = nub $ map (clip d) as
|
||||||
@ -99,11 +99,11 @@ clipAccountNames d as = nub $ map (clip d) as
|
|||||||
-- | Show transactions one per line, with each date/description appearing
|
-- | Show transactions one per line, with each date/description appearing
|
||||||
-- only once, and a running balance.
|
-- only once, and a running balance.
|
||||||
showtxns [] _ _ = ""
|
showtxns [] _ _ = ""
|
||||||
showtxns (t@Transaction{amount=a}:ts) tprev bal = this ++ showtxns ts t bal'
|
showtxns (t@Transaction{tamount=a}:ts) tprev bal = this ++ showtxns ts t bal'
|
||||||
where
|
where
|
||||||
this = showtxn (t `issame` tprev) t bal'
|
this = showtxn (t `issame` tprev) t bal'
|
||||||
issame t1 t2 = tnum t1 == tnum t2
|
issame t1 t2 = tnum t1 == tnum t2
|
||||||
bal' = bal + amount t
|
bal' = bal + tamount t
|
||||||
|
|
||||||
-- | Show one transaction line and balance with or without the entry details.
|
-- | Show one transaction line and balance with or without the entry details.
|
||||||
showtxn :: Bool -> Transaction -> MixedAmount -> String
|
showtxn :: Bool -> Transaction -> MixedAmount -> String
|
||||||
@ -114,5 +114,5 @@ showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
|
|||||||
desc = printf "%-20s" $ elideRight 20 de :: String
|
desc = printf "%-20s" $ elideRight 20 de :: String
|
||||||
p = showPosting $ Posting s a amt "" tt
|
p = showPosting $ Posting s a amt "" tt
|
||||||
bal = padleft 12 (showMixedAmountOrZero b)
|
bal = padleft 12 (showMixedAmountOrZero b)
|
||||||
Transaction{status=s,date=da,description=de,account=a,amount=amt,ttype=tt} = t
|
Transaction{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t
|
||||||
|
|
||||||
|
|||||||
22
Tests.hs
22
Tests.hs
@ -884,34 +884,34 @@ tests = [
|
|||||||
summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts
|
summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts
|
||||||
let ts =
|
let ts =
|
||||||
[
|
[
|
||||||
nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}
|
nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}
|
||||||
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]}
|
,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 2]}
|
||||||
,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]}
|
,nulltxn{tdescription="desc",taccount="expenses:food", tamount=Mixed [dollars 4]}
|
||||||
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]}
|
,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 8]}
|
||||||
]
|
]
|
||||||
("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
|
("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
|
||||||
[]
|
[]
|
||||||
("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
|
("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
|
||||||
[
|
[
|
||||||
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31"}
|
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31"}
|
||||||
]
|
]
|
||||||
("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
|
("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
|
||||||
[
|
[
|
||||||
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food", amount=Mixed [dollars 4]}
|
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food", tamount=Mixed [dollars 4]}
|
||||||
,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:dining", amount=Mixed [dollars 10]}
|
,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining", tamount=Mixed [dollars 10]}
|
||||||
,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:groceries",amount=Mixed [dollars 1]}
|
,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}
|
||||||
]
|
]
|
||||||
("2008/01/01","2009/01/01",0,2,False,ts) `gives`
|
("2008/01/01","2009/01/01",0,2,False,ts) `gives`
|
||||||
[
|
[
|
||||||
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food",amount=Mixed [dollars 15]}
|
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food",tamount=Mixed [dollars 15]}
|
||||||
]
|
]
|
||||||
("2008/01/01","2009/01/01",0,1,False,ts) `gives`
|
("2008/01/01","2009/01/01",0,1,False,ts) `gives`
|
||||||
[
|
[
|
||||||
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses",amount=Mixed [dollars 15]}
|
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses",tamount=Mixed [dollars 15]}
|
||||||
]
|
]
|
||||||
("2008/01/01","2009/01/01",0,0,False,ts) `gives`
|
("2008/01/01","2009/01/01",0,0,False,ts) `gives`
|
||||||
[
|
[
|
||||||
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="",amount=Mixed [dollars 15]}
|
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="",tamount=Mixed [dollars 15]}
|
||||||
]
|
]
|
||||||
|
|
||||||
,"postingamount" ~: do
|
,"postingamount" ~: do
|
||||||
|
|||||||
@ -281,7 +281,7 @@ currentLedgerTransaction :: AppState -> LedgerTransaction
|
|||||||
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
|
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
|
||||||
where
|
where
|
||||||
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
|
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
|
||||||
ismatch t = date t == (parsedate $ take 10 datedesc)
|
ismatch t = tdate t == (parsedate $ take 10 datedesc)
|
||||||
&& (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)
|
&& (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt)
|
||||||
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
|
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above
|
||||||
acctamt = drop 32 $ safehead "" rest
|
acctamt = drop 32 $ safehead "" rest
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user