--effective option uses transactions' effective dates, if any

This commit is contained in:
Simon Michael 2009-07-08 23:37:44 +00:00
parent 9bdb1ab0ec
commit 06eb2a9aa8
10 changed files with 97 additions and 45 deletions

View File

@ -5,10 +5,11 @@ Utilities for doing I/O with ledger files.
module Ledger.IO module Ledger.IO
where where
import Control.Monad.Error import Control.Monad.Error
import Data.Maybe (fromMaybe)
import Ledger.Ledger (cacheLedger) import Ledger.Ledger (cacheLedger)
import Ledger.Parse (parseLedger) import Ledger.Parse (parseLedger)
import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger) import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger)
import Ledger.Types (DateSpan(..),RawLedger,Ledger(..)) import Ledger.Types (DateSpan(..),LedgerTransaction(..),RawLedger(..),Ledger(..))
import Ledger.Utils (getCurrentLocalTime) import Ledger.Utils (getCurrentLocalTime)
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.Environment (getEnv) import System.Environment (getEnv)
@ -21,29 +22,19 @@ timelogenvvar = "TIMELOG"
ledgerdefaultfilename = ".ledger" ledgerdefaultfilename = ".ledger"
timelogdefaultfilename = ".timelog" timelogdefaultfilename = ".timelog"
-- | A tuple of arguments specifying how to filter a raw ledger file: -- | A tuple of arguments specifying how to filter a raw ledger file.
-- type IOArgs = (DateSpan -- ^ only include transactions in this date span
-- - only include transactions in this date span ,Maybe Bool -- ^ only include if cleared\/uncleared\/don't care
-- ,Bool -- ^ only include if real\/don't care
-- - only include if cleared\/uncleared\/don't care ,Bool -- ^ convert all amounts to cost basis
-- ,[String] -- ^ only include if matching these account patterns
-- - only include if real\/don't care ,[String] -- ^ only include if matching these description patterns
-- ,WhichDate -- ^ which dates to use (transaction or effective)
-- - convert all amounts to cost basis
--
-- - only include if matching these account patterns
--
-- - only include if matching these description patterns
type IOArgs = (DateSpan
,Maybe Bool
,Bool
,Bool
,[String]
,[String]
) )
noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], []) data WhichDate = TransactionDate | EffectiveDate
noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [], TransactionDate)
-- | Get the user's default ledger file path. -- | Get the user's default ledger file path.
myLedgerPath :: IO String myLedgerPath :: IO String
@ -90,12 +81,21 @@ rawLedgerFromString s = do
-- | Convert a RawLedger to a canonicalised, cached and filtered Ledger. -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger.
filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger
filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats) rawtext rl = filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats,whichdate) rawtext rl =
(cacheLedger apats (cacheLedger apats
$ filterRawLedger span dpats cleared real $ filterRawLedger span dpats cleared real
$ selectDates whichdate
$ canonicaliseAmounts costbasis rl $ canonicaliseAmounts costbasis rl
){rawledgertext=rawtext} ){rawledgertext=rawtext}
selectDates :: WhichDate -> RawLedger -> RawLedger
selectDates TransactionDate rl = rl
selectDates EffectiveDate rl = rl{ledger_txns=ts}
where
ts = map selectdate $ ledger_txns rl
selectdate (t@LedgerTransaction{ltdate=d,lteffectivedate=e}) =
t{ltdate=fromMaybe d e}
-- -- | Expand ~ in a file path (does not handle ~name). -- -- | Expand ~ in a file path (does not handle ~name).
-- tildeExpand :: FilePath -> IO FilePath -- tildeExpand :: FilePath -> IO FilePath
-- tildeExpand ('~':[]) = getHomeDirectory -- tildeExpand ('~':[]) = getHomeDirectory

View File

@ -304,17 +304,27 @@ ledgerDefaultYear = do
ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction
ledgerTransaction = do ledgerTransaction = do
date <- ledgerdate <?> "transaction" date <- ledgerdate <?> "transaction"
edate <- ledgereffectivedate
status <- ledgerstatus status <- ledgerstatus
code <- ledgercode code <- ledgercode
description <- liftM rstrip (many1 (noneOf ";\n") <?> "description") description <- liftM rstrip (many1 (noneOf ";\n") <?> "description")
comment <- ledgercomment comment <- ledgercomment
restofline restofline
postings <- ledgerpostings postings <- ledgerpostings
let t = LedgerTransaction date status code description comment postings "" let t = LedgerTransaction date edate status code description comment postings ""
case balanceLedgerTransaction t of case balanceLedgerTransaction t of
Right t' -> return t' Right t' -> return t'
Left err -> fail err Left err -> fail err
ledgereffectivedate :: GenParser Char LedgerFileCtx (Maybe Day)
ledgereffectivedate =
try (do
string "[="
edate <- ledgerdate
char ']'
return $ Just edate)
<|> return Nothing
ledgerdate :: GenParser Char LedgerFileCtx Day ledgerdate :: GenParser Char LedgerFileCtx Day
ledgerdate = try ledgerfulldate <|> ledgerpartialdate ledgerdate = try ledgerfulldate <|> ledgerpartialdate

View File

@ -127,7 +127,7 @@ filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) =
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp
where where
fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction d ed s c de co (map fixrawposting ts) pr
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
fixmixedamount (Mixed as) = Mixed $ map fixamount as fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixcommodity . (if costbasis then costOfAmount else id) fixamount = fixcommodity . (if costbasis then costOfAmount else id)

View File

@ -30,7 +30,7 @@ showTransaction (Transaction _ stat d desc a amt ttype) =
-- is attached to the transactions to preserve their grouping - it should -- is attached to the transactions to preserve their grouping - it should
-- be unique per entry. -- be unique per entry.
flattenLedgerTransaction :: (LedgerTransaction, Int) -> [Transaction] flattenLedgerTransaction :: (LedgerTransaction, Int) -> [Transaction]
flattenLedgerTransaction (LedgerTransaction d s _ desc _ ps _, n) = flattenLedgerTransaction (LedgerTransaction d ed 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]

View File

@ -79,6 +79,7 @@ data PeriodicTransaction = PeriodicTransaction {
data LedgerTransaction = LedgerTransaction { data LedgerTransaction = LedgerTransaction {
ltdate :: Day, ltdate :: Day,
lteffectivedate :: Maybe Day,
ltstatus :: Bool, ltstatus :: Bool,
ltcode :: String, ltcode :: String,
ltdescription :: String, ltdescription :: String,
@ -115,7 +116,7 @@ data RawLedger = RawLedger {
data Transaction = Transaction { data Transaction = Transaction {
tnum :: Int, tnum :: Int,
tstatus :: Bool, -- ^ posting status tstatus :: Bool, -- ^ posting status
tdate :: Day, -- ^ ledger transaction date tdate :: Day, -- ^ transaction date
tdescription :: String, -- ^ ledger transaction description tdescription :: String, -- ^ ledger transaction description
taccount :: AccountName, -- ^ posting account taccount :: AccountName, -- ^ posting account
tamount :: MixedAmount, -- ^ posting amount tamount :: MixedAmount, -- ^ posting amount

View File

@ -7,7 +7,7 @@ module Options
where where
import System.Console.GetOpt import System.Console.GetOpt
import System.Environment import System.Environment
import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath) import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath,WhichDate(..))
import Ledger.Utils import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Dates import Ledger.Dates
@ -66,6 +66,7 @@ options = [
,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" ,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this"
,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++ ,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++
"EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)") "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")
,Option [] ["effective"] (NoArg Effective) "use transactions' effective dates, if any"
,Option ['E'] ["empty"] (NoArg Empty) "show empty/zero things which are normally elided" ,Option ['E'] ["empty"] (NoArg Empty) "show empty/zero things which are normally elided"
,Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions" ,Option ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions"
,Option [] ["no-total"] (NoArg NoTotal) "balance report: hide the final total" ,Option [] ["no-total"] (NoArg NoTotal) "balance report: hide the final total"
@ -93,6 +94,7 @@ data Opt =
CostBasis | CostBasis |
Depth {value::String} | Depth {value::String} |
Display {value::String} | Display {value::String} |
Effective |
Empty | Empty |
Real | Real |
NoTotal | NoTotal |
@ -235,5 +237,8 @@ optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts
,CostBasis `elem` opts ,CostBasis `elem` opts
,apats ,apats
,dpats ,dpats
,case Effective `elem` opts of
True -> EffectiveDate
_ -> TransactionDate
) where (apats,dpats) = parsePatternArgs args ) where (apats,dpats) = parsePatternArgs args

View File

@ -469,17 +469,17 @@ tests = [
,"balanceLedgerTransaction" ~: do ,"balanceLedgerTransaction" ~: do
assertBool "detect unbalanced entry, sign error" assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceLedgerTransaction (isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "test" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting, [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting Posting False "b" (Mixed [dollars 1]) "" RegularPosting
] "")) ] ""))
assertBool "detect unbalanced entry, multiple missing amounts" assertBool "detect unbalanced entry, multiple missing amounts"
(isLeft $ balanceLedgerTransaction (isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "test" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" missingamt "" RegularPosting, [Posting False "a" missingamt "" RegularPosting,
Posting False "b" missingamt "" RegularPosting Posting False "b" missingamt "" RegularPosting
] "")) ] ""))
let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") False "" "test" "" let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting, [Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" missingamt "" RegularPosting Posting False "b" missingamt "" RegularPosting
] "") ] "")
@ -567,43 +567,43 @@ tests = [
,"isLedgerTransactionBalanced" ~: do ,"isLedgerTransactionBalanced" ~: do
assertBool "detect balanced" assertBool "detect balanced"
(isLedgerTransactionBalanced (isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
] "")) ] ""))
assertBool "detect unbalanced" assertBool "detect unbalanced"
(not $ isLedgerTransactionBalanced (not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting
] "")) ] ""))
assertBool "detect unbalanced, one posting" assertBool "detect unbalanced, one posting"
(not $ isLedgerTransactionBalanced (not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
] "")) ] ""))
assertBool "one zero posting is considered balanced for now" assertBool "one zero posting is considered balanced for now"
(isLedgerTransactionBalanced (isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting [Posting False "b" (Mixed [dollars 0]) "" RegularPosting
] "")) ] ""))
assertBool "virtual postings don't need to balance" assertBool "virtual postings don't need to balance"
(isLedgerTransactionBalanced (isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting
] "")) ] ""))
assertBool "balanced virtual postings need to balance among themselves" assertBool "balanced virtual postings need to balance among themselves"
(not $ isLedgerTransactionBalanced (not $ isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
] "")) ] ""))
assertBool "balanced virtual postings need to balance among themselves (2)" assertBool "balanced virtual postings need to balance among themselves (2)"
(isLedgerTransactionBalanced (isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") False "" "a" "" (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
@ -839,7 +839,7 @@ tests = [
,"" ,""
]) ])
(showLedgerTransaction (showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting ,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] "")) ] ""))
@ -852,7 +852,7 @@ tests = [
,"" ,""
]) ])
(showLedgerTransaction (showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting ,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting
] "")) ] ""))
@ -863,7 +863,7 @@ tests = [
,"" ,""
]) ])
(showLedgerTransaction (showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
] "")) ] ""))
assertEqual "show a transaction with one posting and a missing amount" assertEqual "show a transaction with one posting and a missing amount"
@ -873,7 +873,7 @@ tests = [
,"" ,""
]) ])
(showLedgerTransaction (showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting [Posting False "expenses:food:groceries" missingamt "" RegularPosting
] "")) ] ""))
@ -1064,7 +1064,7 @@ entry1_str = unlines
] ]
entry1 = entry1 =
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting, [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "") Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "")
@ -1213,7 +1213,8 @@ rawledger7 = RawLedger
[] []
[ [
LedgerTransaction { LedgerTransaction {
ltdate= parsedate "2007/01/01", ltdate=parsedate "2007/01/01",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="opening balance", ltdescription="opening balance",
@ -1238,7 +1239,8 @@ rawledger7 = RawLedger
} }
, ,
LedgerTransaction { LedgerTransaction {
ltdate= parsedate "2007/02/01", ltdate=parsedate "2007/02/01",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="ayres suites", ltdescription="ayres suites",
@ -1264,6 +1266,7 @@ rawledger7 = RawLedger
, ,
LedgerTransaction { LedgerTransaction {
ltdate=parsedate "2007/01/02", ltdate=parsedate "2007/01/02",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="auto transfer to savings", ltdescription="auto transfer to savings",
@ -1289,6 +1292,7 @@ rawledger7 = RawLedger
, ,
LedgerTransaction { LedgerTransaction {
ltdate=parsedate "2007/01/03", ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="poquito mas", ltdescription="poquito mas",
@ -1314,6 +1318,7 @@ rawledger7 = RawLedger
, ,
LedgerTransaction { LedgerTransaction {
ltdate=parsedate "2007/01/03", ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="verizon", ltdescription="verizon",
@ -1339,6 +1344,7 @@ rawledger7 = RawLedger
, ,
LedgerTransaction { LedgerTransaction {
ltdate=parsedate "2007/01/03", ltdate=parsedate "2007/01/03",
lteffectivedate=Nothing,
ltstatus=False, ltstatus=False,
ltcode="*", ltcode="*",
ltdescription="discover", ltdescription="discover",

View File

@ -0,0 +1,12 @@
balance -p 'in 2009' --effective
<<<
2009/1/1 x
a 1
b
2009/1/1[=2010/1/1] x
a 10
b
>>>
1 a
-1 b

View File

@ -0,0 +1,10 @@
print --effective
<<<
2009/1/1[=2010/1/1] x
a 1
b
>>>
2010/01/01 x
a 1
b

View File

@ -0,0 +1,8 @@
register --effective
<<<
2009/1/1[=2010/1/1] x
a 1
b
>>>
2010/01/01 x a 1 1
b -1 0