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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Ledger/IO.hs
View File

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

12
Ledger/Parse.hs
View File

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

2
Ledger/RawLedger.hs
View File

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

2
Ledger/Transaction.hs
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
-- 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]

3
Ledger/Types.hs
View File

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

7
Options.hs
View File

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

40
Tests.hs
View File

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

12
tests/effective-balance.test Normal file
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

10
tests/effective-print.test Normal file
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

8
tests/effective-register.test Normal file
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