diff --git a/Ledger/IO.hs b/Ledger/IO.hs index 8057c3a73..04112ddbf 100644 --- a/Ledger/IO.hs +++ b/Ledger/IO.hs @@ -5,10 +5,11 @@ Utilities for doing I/O with ledger files. module Ledger.IO where import Control.Monad.Error +import Data.Maybe (fromMaybe) import Ledger.Ledger (cacheLedger) import Ledger.Parse (parseLedger) import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger) -import Ledger.Types (DateSpan(..),RawLedger,Ledger(..)) +import Ledger.Types (DateSpan(..),LedgerTransaction(..),RawLedger(..),Ledger(..)) import Ledger.Utils (getCurrentLocalTime) import System.Directory (getHomeDirectory) import System.Environment (getEnv) @@ -21,29 +22,19 @@ timelogenvvar = "TIMELOG" ledgerdefaultfilename = ".ledger" timelogdefaultfilename = ".timelog" --- | A tuple of arguments specifying how to filter a raw ledger file: --- --- - only include transactions in this date span --- --- - only include if cleared\/uncleared\/don't care --- --- - only include if real\/don't care --- --- - 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] +-- | A tuple of arguments specifying how to filter a raw ledger file. +type IOArgs = (DateSpan -- ^ 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 + ,Bool -- ^ convert all amounts to cost basis + ,[String] -- ^ only include if matching these account patterns + ,[String] -- ^ only include if matching these description patterns + ,WhichDate -- ^ which dates to use (transaction or effective) ) -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. myLedgerPath :: IO String @@ -90,12 +81,21 @@ rawLedgerFromString s = do -- | Convert a RawLedger to a canonicalised, cached and filtered 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 $ filterRawLedger span dpats cleared real + $ selectDates whichdate $ canonicaliseAmounts costbasis rl ){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). -- tildeExpand :: FilePath -> IO FilePath -- tildeExpand ('~':[]) = getHomeDirectory diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index d17ef8223..0bdab12db 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -304,17 +304,27 @@ ledgerDefaultYear = do ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction ledgerTransaction = do date <- ledgerdate "transaction" + edate <- ledgereffectivedate status <- ledgerstatus code <- ledgercode description <- liftM rstrip (many1 (noneOf ";\n") "description") comment <- ledgercomment restofline 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 Right t' -> return t' 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 = try ledgerfulldate <|> ledgerpartialdate diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 08fda1c10..94da39867 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -127,7 +127,7 @@ filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp) = 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 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 fixmixedamount (Mixed as) = Mixed $ map fixamount as fixamount = fixcommodity . (if costbasis then costOfAmount else id) diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 45d44faa7..0bde34dbf 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -30,7 +30,7 @@ showTransaction (Transaction _ stat d desc a amt ttype) = -- is attached to the transactions to preserve their grouping - it should -- be unique per entry. 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] accountNamesFromTransactions :: [Transaction] -> [AccountName] diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 221234c2d..3a9aab91f 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -79,6 +79,7 @@ data PeriodicTransaction = PeriodicTransaction { data LedgerTransaction = LedgerTransaction { ltdate :: Day, + lteffectivedate :: Maybe Day, ltstatus :: Bool, ltcode :: String, ltdescription :: String, @@ -115,7 +116,7 @@ data RawLedger = RawLedger { data Transaction = Transaction { tnum :: Int, tstatus :: Bool, -- ^ posting status - tdate :: Day, -- ^ ledger transaction date + tdate :: Day, -- ^ transaction date tdescription :: String, -- ^ ledger transaction description taccount :: AccountName, -- ^ posting account tamount :: MixedAmount, -- ^ posting amount diff --git a/Options.hs b/Options.hs index 94941ac3c..e7e959373 100644 --- a/Options.hs +++ b/Options.hs @@ -7,7 +7,7 @@ module Options where import System.Console.GetOpt import System.Environment -import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath) +import Ledger.IO (IOArgs,myLedgerPath,myTimelogPath,WhichDate(..)) import Ledger.Utils import Ledger.Types import Ledger.Dates @@ -66,6 +66,7 @@ options = [ ,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" ,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++ "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 ['R'] ["real"] (NoArg Real) "report only on real (non-virtual) transactions" ,Option [] ["no-total"] (NoArg NoTotal) "balance report: hide the final total" @@ -93,6 +94,7 @@ data Opt = CostBasis | Depth {value::String} | Display {value::String} | + Effective | Empty | Real | NoTotal | @@ -235,5 +237,8 @@ optsToIOArgs opts args t = (dateSpanFromOpts (localDay t) opts ,CostBasis `elem` opts ,apats ,dpats + ,case Effective `elem` opts of + True -> EffectiveDate + _ -> TransactionDate ) where (apats,dpats) = parsePatternArgs args diff --git a/Tests.hs b/Tests.hs index 2632a46ba..2faf93331 100644 --- a/Tests.hs +++ b/Tests.hs @@ -469,17 +469,17 @@ tests = [ ,"balanceLedgerTransaction" ~: do assertBool "detect unbalanced entry, sign error" (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 "b" (Mixed [dollars 1]) "" RegularPosting ] "")) assertBool "detect unbalanced entry, multiple missing amounts" (isLeft $ balanceLedgerTransaction - (LedgerTransaction (parsedate "2007/01/28") False "" "test" "" + (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "test" "" [Posting False "a" 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 "b" missingamt "" RegularPosting ] "") @@ -567,43 +567,43 @@ tests = [ ,"isLedgerTransactionBalanced" ~: do assertBool "detect balanced" (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 "c" (Mixed [dollars (-1.00)]) "" RegularPosting ] "")) assertBool "detect unbalanced" (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 "c" (Mixed [dollars (-1.01)]) "" RegularPosting ] "")) assertBool "detect unbalanced, one posting" (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 ] "")) assertBool "one zero posting is considered balanced for now" (isLedgerTransactionBalanced - (LedgerTransaction (parsedate "2009/01/01") False "" "a" "" + (LedgerTransaction (parsedate "2009/01/01") Nothing False "" "a" "" [Posting False "b" (Mixed [dollars 0]) "" RegularPosting ] "")) assertBool "virtual postings don't need to balance" (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 "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting ] "")) assertBool "balanced virtual postings need to balance among themselves" (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 "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting ] "")) assertBool "balanced virtual postings need to balance among themselves (2)" (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 "c" (Mixed [dollars (-1.00)]) "" RegularPosting ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting @@ -839,7 +839,7 @@ tests = [ ,"" ]) (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 "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting ] "")) @@ -852,7 +852,7 @@ tests = [ ,"" ]) (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 "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting ] "")) @@ -863,7 +863,7 @@ tests = [ ,"" ]) (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 ] "")) assertEqual "show a transaction with one posting and a missing amount" @@ -873,7 +873,7 @@ tests = [ ,"" ]) (showLedgerTransaction - (LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" "" + (LedgerTransaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" [Posting False "expenses:food:groceries" missingamt "" RegularPosting ] "")) @@ -1064,7 +1064,7 @@ entry1_str = unlines ] 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 "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "") @@ -1213,7 +1213,8 @@ rawledger7 = RawLedger [] [ LedgerTransaction { - ltdate= parsedate "2007/01/01", + ltdate=parsedate "2007/01/01", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="opening balance", @@ -1238,7 +1239,8 @@ rawledger7 = RawLedger } , LedgerTransaction { - ltdate= parsedate "2007/02/01", + ltdate=parsedate "2007/02/01", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="ayres suites", @@ -1264,6 +1266,7 @@ rawledger7 = RawLedger , LedgerTransaction { ltdate=parsedate "2007/01/02", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="auto transfer to savings", @@ -1289,6 +1292,7 @@ rawledger7 = RawLedger , LedgerTransaction { ltdate=parsedate "2007/01/03", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="poquito mas", @@ -1314,6 +1318,7 @@ rawledger7 = RawLedger , LedgerTransaction { ltdate=parsedate "2007/01/03", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="verizon", @@ -1339,6 +1344,7 @@ rawledger7 = RawLedger , LedgerTransaction { ltdate=parsedate "2007/01/03", + lteffectivedate=Nothing, ltstatus=False, ltcode="*", ltdescription="discover", diff --git a/tests/effective-balance.test b/tests/effective-balance.test new file mode 100644 index 000000000..8c1a19cc9 --- /dev/null +++ b/tests/effective-balance.test @@ -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 diff --git a/tests/effective-print.test b/tests/effective-print.test new file mode 100644 index 000000000..1193144dc --- /dev/null +++ b/tests/effective-print.test @@ -0,0 +1,10 @@ +print --effective +<<< +2009/1/1[=2010/1/1] x + a 1 + b +>>> +2010/01/01 x + a 1 + b + diff --git a/tests/effective-register.test b/tests/effective-register.test new file mode 100644 index 000000000..3852c7e6a --- /dev/null +++ b/tests/effective-register.test @@ -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