{- |
hledger's test suite. Most tests are HUnit-based, and defined in the
@tests@ list below. These tests are built in to hledger and can be run at
any time with @hledger test@.
In addition, we have tests in doctest format, which can be run with @make
doctest@ in the hledger source tree. These have some advantages:
- easier to read and write than hunit, for functional/shell tests
- easier to read multi-line output from failing tests
- can also appear in, and test, docs
and disadvantages:
- not included in hledger's built-in tests
- not platform independent
Here are the hledger doctests (some may reappear in other modules as
examples):
Run a few with c++ ledger first:
@
$ ledger -f sample.ledger balance
$-1 assets
$1 bank:saving
$-2 cash
$2 expenses
$1 food
$1 supplies
$-2 income
$-1 gifts
$-1 salary
$1 liabilities:debts
@
@
$ ledger -f sample.ledger balance o
$1 expenses:food
$-2 income
$-1 gifts
$-1 salary
--------------------
$-1
@
Then hledger:
@
$ hledger -f sample.ledger balance
$-1 assets
$1 bank:saving
$-2 cash
$2 expenses
$1 food
$1 supplies
$-2 income
$-1 gifts
$-1 salary
$1 liabilities:debts
@
@
$ hledger -f sample.ledger balance o
$1 expenses:food
$-2 income
$-1 gifts
$-1 salary
--------------------
$-1
@
@
$ hledger -f sample.ledger balance --depth 1
$-1 assets
$2 expenses
$-2 income
$1 liabilities
@
-}
{-
@
$ printf "2009/1/1 a\n b 1.1\n c -1\n" | runhaskell hledger.hs -f- reg 2>&1 ; true
"-" (line 4, column 1):
unexpected end of input
could not balance this transaction, amounts do not add up to zero:
2009/01/01 a
b 1.1
c -1
@
@
$ printf "2009/1/1 x\n (virtual) 100\n a 1\n b\n" | runhaskell hledger.hs -f- print 2>&1 ; true
2009/01/01 x
(virtual) 100
a 1
b
@
Unicode input/output tests
-- layout of the balance command with unicode names
@
$ printf "2009-01-01 проверка\n τράπεζα 10 руб\n नकद\n" | hledger -f - bal
10 руб τράπεζα
-10 руб नकद
@
-- layout of the register command with unicode names
@
$ printf "2009-01-01 проверка\n τράπεζα 10 руб\n नकद\n" | hledger -f - reg
2009/01/01 проверка τράπεζα 10 руб 10 руб
नकद -10 руб 0
@
-- layout of the print command with unicode names
@
$ printf "2009-01-01 проверка\n счёт:первый 1\n счёт:второй\n" | hledger -f - print
2009/01/01 проверка
счёт:первый 1
счёт:второй
@
-- search for unicode account names
@
$ printf "2009-01-01 проверка\n τράπεζα 10 руб\n नकद\n" | hledger -f - reg τράπ
2009/01/01 проверка τράπεζα 10 руб 10 руб
@
-- search for unicode descriptions (should choose only the first entry)
@
$ printf "2009-01-01 аура (cyrillic letters)\n bank 10\n cash\n2010-01-01 aypa (roman letters)\n bank 20\n cash\n" | hledger -f - reg desc:аура
2009/01/01 аура (cyrillic let.. bank 10 10
cash -10 0
@
-- error message with unicode in ledger
-- not implemented yet
--@
$ printf "2009-01-01 broken entry\n дебит 1\n кредит -2\n" | hledger -f - 2>&1 ; true
hledger: could not balance this transaction, amounts do not add up to zero:
2009/01/01 broken entry
дебит 1
кредит -2
--@
@
$ printf "2009-01-01 x\n a 2\n b (b) b -1\n c\n" | hledger -f - print 2>&1; true
2009/01/01 x
a 2
b (b) b -1
c
@
Nafai's bug
@
$ printf "2009/1/1 x\n a: 13\n b\n" | hledger -f - bal -E 2>&1
"-" (line 2, column 1):
unexpected " "
accountname seems ill-formed: a:
@
Eliding, general layout
@
$ printf "2009/1/1 x\n aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa €1\n b\n" | hledger -f - bal 2>&1
€1 aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa
€-1 b
@
--@
$ printf "2009/1/1 x\n aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa €1\n b\n" | hledger -f - reg 2>&1
2009/01/01 x aa:aa:aaaaaaaaaaaaaaaa €1 €1
b €-1 0
@
--@
$ printf "2009/1/1 x\n aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa €1\n b\n" | hledger -f - print 2>&1
2009/01/01 x
aa:aaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa
b
@
-}
-- other test tools:
-- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework
-- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HTF
module Tests
where
import qualified Data.Map as Map
import Data.Time.Format
import Locale (defaultTimeLocale)
import Text.ParserCombinators.Parsec
import Test.HUnit.Tools (runVerboseTests)
import System.Exit (exitFailure,exitSuccess)
import Commands.All
import Ledger
import Options
import Utils
runtests opts args = do
(counts,_) <- runner ts
if errors counts > 0 || (failures counts > 0)
then exitFailure
else exitSuccess
where
runner | (Verbose `elem` opts) = runVerboseTests
| otherwise = \t -> runTestTT t >>= return . (flip (,) 0)
ts = TestList $ filter matchname $ concatMap tflatten tests
--ts = tfilter matchname $ TestList tests -- unflattened
matchname = matchpats args . tname
-- | Get a Test's label, or the empty string.
tname :: Test -> String
tname (TestLabel n _) = n
tname _ = ""
-- | Flatten a Test containing TestLists into a list of single tests.
tflatten :: Test -> [Test]
tflatten (TestLabel _ t@(TestList _)) = tflatten t
tflatten (TestList ts) = concatMap tflatten ts
tflatten t = [t]
-- | Filter TestLists in a Test, recursively, preserving the structure.
tfilter :: (Test -> Bool) -> Test -> Test
tfilter p (TestLabel l ts) = TestLabel l (tfilter p ts)
tfilter p (TestList ts) = TestList $ filter (any p . tflatten) $ map (tfilter p) ts
tfilter _ t = t
-- | Simple way to assert something is some expected value, with no label.
is :: (Eq a, Show a) => a -> a -> Assertion
a `is` e = assertEqual "" e a
-- | Assert a parse result is some expected value, or print a parse error.
parseis :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
parse `parseis` expected = either printParseError (`is` expected) parse
parseWithCtx :: GenParser Char LedgerFileCtx a -> String -> Either ParseError a
parseWithCtx p ts = runParser p emptyCtx "" ts
------------------------------------------------------------------------------
-- | Tests for any function or topic. Mostly ordered by test name.
tests :: [Test]
tests = [
"account directive" ~:
let sameParse str1 str2 = do l1 <- rawLedgerFromString str1
l2 <- rawLedgerFromString str2
l1 `is` l2
in TestList
[
"account directive 1" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 2" ~: sameParse
"2008/12/07 One\n test:foo:from $-1\n test:foo:to $1\n"
"!account test\n!account foo\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 3" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n!account foo\n!end\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 4" ~: sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
"!account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++
"!account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++
"!end\n2008/12/07 Four\n why $-4\n zed $4\n" ++
"!end\n2008/12/07 Five\n foo $-5\n bar $5\n"
)
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" ++
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" ++
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" ++
"2008/12/07 Five\n foo $-5\n bar $5\n"
)
]
,"accountnames" ~: do
accountnames ledger7 `is`
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
,"accountNameTreeFrom" ~: do
accountNameTreeFrom ["a"] `is` Node "top" [Node "a" []]
accountNameTreeFrom ["a","b"] `is` Node "top" [Node "a" [], Node "b" []]
accountNameTreeFrom ["a","a:b"] `is` Node "top" [Node "a" [Node "a:b" []]]
accountNameTreeFrom ["a:b:c"] `is` Node "top" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
,"amount arithmetic" ~: do
let a1 = dollars 1.23
let a2 = Amount (comm "$") (-1.23) Nothing
let a3 = Amount (comm "$") (-1.23) Nothing
(a1 + a2) `is` Amount (comm "$") 0 Nothing
(a1 + a3) `is` Amount (comm "$") 0 Nothing
(a2 + a3) `is` Amount (comm "$") (-2.46) Nothing
(a3 + a3) `is` Amount (comm "$") (-2.46) Nothing
(sum [a2,a3]) `is` Amount (comm "$") (-2.46) Nothing
(sum [a3,a3]) `is` Amount (comm "$") (-2.46) Nothing
(sum [a1,a2,a3,-a3]) `is` Amount (comm "$") 0 Nothing
,"balance report tests" ~:
let (opts,args) `gives` es = do
l <- sampleledgerwithopts opts args
showBalanceReport opts args l `is` unlines es
in TestList
[
"balance report with no args" ~:
([], []) `gives`
[" $-1 assets"
," $1 bank:saving"
," $-2 cash"
," $2 expenses"
," $1 food"
," $1 supplies"
," $-2 income"
," $-1 gifts"
," $-1 salary"
," $1 liabilities:debts"
]
,"balance report can be limited with --depth" ~:
([Depth "1"], []) `gives`
[" $-1 assets"
," $2 expenses"
," $-2 income"
," $1 liabilities"
]
,"balance report with account pattern o" ~:
([SubTotal], ["o"]) `gives`
[" $1 expenses:food"
," $-2 income"
," $-1 gifts"
," $-1 salary"
,"--------------------"
," $-1"
]
,"balance report with account pattern o and --depth 1" ~:
([Depth "1"], ["o"]) `gives`
[" $1 expenses"
," $-2 income"
,"--------------------"
," $-1"
]
,"balance report with account pattern a" ~:
([], ["a"]) `gives`
[" $-1 assets"
," $1 bank:saving"
," $-2 cash"
," $-1 income:salary"
," $1 liabilities:debts"
,"--------------------"
," $-1"
]
,"balance report with account pattern e" ~:
([], ["e"]) `gives`
[" $-1 assets"
," $1 bank:saving"
," $-2 cash"
," $2 expenses"
," $1 food"
," $1 supplies"
," $-2 income"
," $-1 gifts"
," $-1 salary"
," $1 liabilities:debts"
]
,"balance report with unmatched parent of two matched subaccounts" ~:
([], ["cash","saving"]) `gives`
[" $-1 assets"
," $1 bank:saving"
," $-2 cash"
,"--------------------"
," $-1"
]
,"balance report with multi-part account name" ~:
([], ["expenses:food"]) `gives`
[" $1 expenses:food"
,"--------------------"
," $1"
]
,"balance report with negative account pattern" ~:
([], ["not:assets"]) `gives`
[" $2 expenses"
," $1 food"
," $1 supplies"
," $-2 income"
," $-1 gifts"
," $-1 salary"
," $1 liabilities:debts"
,"--------------------"
," $1"
]
,"balance report negative account pattern always matches full name" ~:
([], ["not:e"]) `gives` []
,"balance report negative patterns affect totals" ~:
([], ["expenses","not:food"]) `gives`
[" $1 expenses:supplies"
,"--------------------"
," $1"
]
,"balance report with -E shows zero-balance accounts" ~:
([SubTotal,Empty], ["assets"]) `gives`
[" $-1 assets"
," $1 bank"
," $0 checking"
," $1 saving"
," $-2 cash"
,"--------------------"
," $-1"
]
,"balance report with cost basis" ~: do
rl <- rawLedgerFromString $ unlines
[""
,"2008/1/1 test "
," a:b 10h @ $50"
," c:d "
,""
]
let l = cacheLedger [] $
filterRawLedger (DateSpan Nothing Nothing) [] Nothing False $
canonicaliseAmounts True rl -- enable cost basis adjustment
showBalanceReport [] [] l `is`
unlines
[" $500 a:b"
," $-500 c:d"
]
,"balance report elides zero-balance root account(s)" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime
(unlines
["2008/1/1 one"
," test:a 1"
," test:b"
])
showBalanceReport [] [] l `is`
unlines
[" 1 test:a"
," -1 test:b"
]
]
,"balanceLedgerTransaction" ~: do
assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") 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" ""
[Posting False "a" missingamt "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] ""))
let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] "")
assertBool "one missing amount should be ok" (isRight e)
assertEqual "balancing amount is added"
(Mixed [dollars (-1)])
(case e of
Right e' -> (pamount $ last $ ltpostings e')
Left _ -> error "should not happen")
,"cacheLedger" ~: do
(length $ Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
,"canonicaliseAmounts" ~:
"use the greatest precision" ~: do
(rawLedgerPrecisions $ canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
,"commodities" ~: do
commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]
,"dateSpanFromOpts" ~: do
let todaysdate = parsedate "2008/11/26"
let opts `gives` spans = show (dateSpanFromOpts todaysdate opts) `is` spans
[] `gives` "DateSpan Nothing Nothing"
[Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
-- don't know what this should do
-- ,"elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aa:aaaaaaaaaaaaaa")
,"entriesFromTimeLogEntries" ~: do
today <- getCurrentDay
now' <- getCurrentTime
tz <- getCurrentTimeZone
let now = utcToLocalTime tz now'
nowstr = showtime now
yesterday = prevday today
clockin t a = TimeLogEntry In t a
mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
showtime t = formatTime defaultTimeLocale "%H:%M" t
assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)
assertEntriesGiveStrings "started yesterday, split session at midnight"
[clockin (mktime yesterday "23:00:00") ""]
["23:00-23:59","00:00-"++nowstr]
assertEntriesGiveStrings "split multi-day sessions at each midnight"
[clockin (mktime (addDays (-2) today) "23:00:00") ""]
["23:00-23:59","00:00-23:59","00:00-"++nowstr]
assertEntriesGiveStrings "auto-clock-out if needed"
[clockin (mktime today "00:00:00") ""]
["00:00-"++nowstr]
let future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future
assertEntriesGiveStrings "use the clockin time for auto-clockout if it's in the future"
[clockin future ""]
[printf "%s-%s" futurestr futurestr]
,"expandAccountNames" ~: do
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is`
["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
,"intervalFromOpts" ~: do
let opts `gives` interval = intervalFromOpts opts `is` interval
[] `gives` NoInterval
[WeeklyOpt] `gives` Weekly
[MonthlyOpt] `gives` Monthly
[QuarterlyOpt] `gives` Quarterly
[YearlyOpt] `gives` Yearly
[Period "weekly"] `gives` Weekly
[Period "monthly"] `gives` Monthly
[Period "quarterly"] `gives` Quarterly
[WeeklyOpt, Period "yearly"] `gives` Yearly
,"isAccountNamePrefixOf" ~: do
"assets" `isAccountNamePrefixOf` "assets" `is` False
"assets" `isAccountNamePrefixOf` "assets:bank" `is` True
"assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True
"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False
,"isLedgerTransactionBalanced" ~: do
assertBool "detect balanced"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") 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" ""
[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" ""
[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" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting
] ""))
assertBool "virtual postings don't need to balance"
(isLedgerTransactionBalanced
(LedgerTransaction (parsedate "2009/01/01") 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" ""
[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" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting
] ""))
,"isSubAccountNameOf" ~: do
"assets" `isSubAccountNameOf` "assets" `is` False
"assets:bank" `isSubAccountNameOf` "assets" `is` True
"assets:bank:checking" `isSubAccountNameOf` "assets" `is` False
"assets:bank" `isSubAccountNameOf` "my assets" `is` False
,"default year" ~: do
rl <- rawLedgerFromString defaultyear_ledger_str
(ltdate $ head $ ledger_txns rl) `is` fromGregorian 2009 1 1
return ()
,"ledgerFile" ~: do
assertBool "ledgerFile should parse an empty file" $ (isRight $ parseWithCtx ledgerFile "")
r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r
,"ledgerHistoricalPrice" ~: do
parseWithCtx ledgerHistoricalPrice price1_str `parseis` price1
,"ledgerTransaction" ~: do
parseWithCtx ledgerTransaction entry1_str `parseis` entry1
assertBool "ledgerTransaction should not parse just a date"
$ isLeft $ parseWithCtx ledgerTransaction "2009/1/1\n"
assertBool "ledgerTransaction should require some postings"
$ isLeft $ parseWithCtx ledgerTransaction "2009/1/1 a\n"
let t = parseWithCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n"
assertBool "ledgerTransaction should not include a comment in the description"
$ either (const False) ((== "a") . ltdescription) t
,"ledgeraccountname" ~: do
assertBool "ledgeraccountname parses a normal accountname" $ (isRight $ parsewith ledgeraccountname "a:b:c")
assertBool "ledgeraccountname rejects an empty inner component" $ (isLeft $ parsewith ledgeraccountname "a::c")
assertBool "ledgeraccountname rejects an empty leading component" $ (isLeft $ parsewith ledgeraccountname ":b:c")
assertBool "ledgeraccountname rejects an empty trailing component" $ (isLeft $ parsewith ledgeraccountname "a:b:")
,"ledgerposting" ~: do
parseWithCtx ledgerposting rawposting1_str `parseis` rawposting1
,"parsedate" ~: do
parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate
parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate
,"period expressions" ~: do
let todaysdate = parsedate "2008/11/26"
let str `gives` result = (show $ parsewith (periodexpr todaysdate) str) `is` ("Right "++result)
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"daily from aug" `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)"
"every week to 2009" `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))"
,"print report tests" ~: TestList
[
"print expenses" ~:
do
let args = ["expenses"]
l <- sampleledgerwithopts [] args
showLedgerTransactions [] args l `is` unlines
["2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
]
, "print report with depth arg" ~:
do
l <- sampleledger
showLedgerTransactions [Depth "2"] [] l `is` unlines
["2008/01/01 income"
," income:salary $-1"
,""
,"2008/06/01 gift"
," income:gifts $-1"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
,""
]
]
,"punctuatethousands 1" ~: punctuatethousands "" `is` ""
,"punctuatethousands 2" ~: punctuatethousands "1234567.8901" `is` "1,234,567.8901"
,"punctuatethousands 3" ~: punctuatethousands "-100" `is` "-100"
,"register report tests" ~:
let registerdates = filter (not . null) . map (strip . take 10) . lines
in
TestList
[
"register report with no args" ~:
do
l <- sampleledger
showRegisterReport [] [] l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1"
," income:gifts $-1 0"
,"2008/06/02 save assets:bank:saving $1 $1"
," assets:bank:checking $-1 0"
,"2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2"
," assets:cash $-2 0"
,"2008/12/31 pay off liabilities:debts $1 $1"
," assets:bank:checking $-1 0"
]
,"register report with cleared arg" ~:
do
l <- ledgerFromStringWithOpts [Cleared] [] sampletime sample_ledger_str
showRegisterReport [Cleared] [] l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2"
," assets:cash $-2 0"
,"2008/12/31 pay off liabilities:debts $1 $1"
," assets:bank:checking $-1 0"
]
,"register report with uncleared arg" ~:
do
l <- ledgerFromStringWithOpts [UnCleared] [] sampletime sample_ledger_str
showRegisterReport [UnCleared] [] l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1"
," income:gifts $-1 0"
,"2008/06/02 save assets:bank:saving $1 $1"
," assets:bank:checking $-1 0"
]
,"register report sorts by date" ~:
do
l <- ledgerFromStringWithOpts [] [] sampletime $ unlines
["2008/02/02 a"
," b 1"
," c"
,""
,"2008/01/01 d"
," e 1"
," f"
]
registerdates (showRegisterReport [] [] l) `is` ["2008/01/01","2008/02/02"]
,"register report with account pattern" ~:
do
l <- sampleledger
showRegisterReport [] ["cash"] l `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2"
]
,"register report with account pattern, case insensitive" ~:
do
l <- sampleledger
showRegisterReport [] ["cAsH"] l `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2"
]
,"register report with display expression" ~:
do
l <- sampleledger
let displayexpr `gives` dates =
registerdates (showRegisterReport [Display displayexpr] [] l) `is` dates
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
"d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
"d=[2008/6/2]" `gives` ["2008/06/02"]
"d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]
"d>[2008/6/2]" `gives` ["2008/06/03","2008/12/31"]
,"register report with period expression" ~:
do
l <- sampleledger
let periodexpr `gives` dates = do
lopts <- sampleledgerwithopts [Period periodexpr] []
registerdates (showRegisterReport [Period periodexpr] [] lopts) `is` dates
"" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
"2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
"2007" `gives` []
"june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
"monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
"quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
showRegisterReport [Period "yearly"] [] l `is` unlines
["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1"
," assets:cash $-2 $-1"
," expenses:food $1 0"
," expenses:supplies $1 $1"
," income:gifts $-1 0"
," income:salary $-1 $-1"
," liabilities:debts $1 0"
]
registerdates (showRegisterReport [Period "quarterly"] [] l) `is` ["2008/01/01","2008/04/01","2008/10/01"]
registerdates (showRegisterReport [Period "quarterly",Empty] [] l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
]
, "register report with depth arg" ~:
do
l <- sampleledger
showRegisterReport [Depth "2"] [] l `is` unlines
["2008/01/01 income income:salary $-1 $-1"
,"2008/06/01 gift income:gifts $-1 $-2"
,"2008/06/03 eat & shop expenses:food $1 $-1"
," expenses:supplies $1 0"
," assets:cash $-2 $-2"
,"2008/12/31 pay off liabilities:debts $1 $-1"
]
,"show dollars" ~: show (dollars 1) ~?= "$1.00"
,"show hours" ~: show (hours 1) ~?= "1.0h"
,"showLedgerTransaction" ~: do
assertEqual "show a balanced transaction, eliding last amount"
(unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting
] ""))
-- document some cases that arise in debug/testing:
assertEqual "show an unbalanced transaction, should not elide"
(unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking $-47.19"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting
] ""))
assertEqual "show an unbalanced transaction with one posting, should not elide"
(unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting
] ""))
assertEqual "show a transaction with one posting and a missing amount"
(unlines
["2007/01/28 coopportunity"
," expenses:food:groceries "
,""
])
(showLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting
] ""))
,"unicode in balance layout" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showBalanceReport [] [] l `is` unlines
[" -100 актив:наличные"
," 100 расходы:покупки"]
,"unicode in register layout" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showRegisterReport [] [] l `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"]
,"smart dates" ~: do
let str `gives` datestr = fixSmartDateStr (parsedate "2008/11/26") str `is` datestr
"1999-12-02" `gives` "1999/12/02"
"1999.12.02" `gives` "1999/12/02"
"1999/3/2" `gives` "1999/03/02"
"19990302" `gives` "1999/03/02"
"2008/2" `gives` "2008/02/01"
"20/2" `gives` "0020/02/01"
"1000" `gives` "1000/01/01"
"4/2" `gives` "2008/04/02"
"2" `gives` "2008/11/02"
"January" `gives` "2008/01/01"
"feb" `gives` "2008/02/01"
"today" `gives` "2008/11/26"
"yesterday" `gives` "2008/11/25"
"tomorrow" `gives` "2008/11/27"
"this day" `gives` "2008/11/26"
"last day" `gives` "2008/11/25"
"next day" `gives` "2008/11/27"
"this week" `gives` "2008/11/24" -- last monday
"last week" `gives` "2008/11/17" -- previous monday
"next week" `gives` "2008/12/01" -- next monday
"this month" `gives` "2008/11/01"
"last month" `gives` "2008/10/01"
"next month" `gives` "2008/12/01"
"this quarter" `gives` "2008/10/01"
"last quarter" `gives` "2008/07/01"
"next quarter" `gives` "2009/01/01"
"this year" `gives` "2008/01/01"
"last year" `gives` "2007/01/01"
"next year" `gives` "2009/01/01"
-- "last wed" `gives` "2008/11/19"
-- "next friday" `gives` "2008/11/28"
-- "next january" `gives` "2009/01/01"
,"splitSpan" ~: do
let (interval,span) `gives` spans = splitSpan interval span `is` spans
(NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives`
[mkdatespan "2008/01/01" "2009/01/01"]
(Quarterly,mkdatespan "2008/01/01" "2009/01/01") `gives`
[mkdatespan "2008/01/01" "2008/04/01"
,mkdatespan "2008/04/01" "2008/07/01"
,mkdatespan "2008/07/01" "2008/10/01"
,mkdatespan "2008/10/01" "2009/01/01"
]
(Quarterly,nulldatespan) `gives`
[nulldatespan]
(Daily,mkdatespan "2008/01/01" "2008/01/01") `gives`
[mkdatespan "2008/01/01" "2008/01/01"]
(Quarterly,mkdatespan "2008/01/01" "2008/01/01") `gives`
[mkdatespan "2008/01/01" "2008/01/01"]
,"subAccounts" ~: do
l <- sampleledger
let a = ledgerAccount l "assets"
(map aname $ ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseTransactionsInDateSpan" ~: do
let (b,e,tnum,depth,showempty,ts) `gives` summaryts =
summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts
let ts =
[
nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}
,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 2]}
,nulltxn{tdescription="desc",taccount="expenses:food", tamount=Mixed [dollars 4]}
,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,True,[]) `gives`
[
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31"}
]
("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
[
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food", tamount=Mixed [dollars 4]}
,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining", tamount=Mixed [dollars 10]}
,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`
[
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`
[
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`
[
nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="",tamount=Mixed [dollars 15]}
]
,"postingamount" ~: do
parseWithCtx postingamount " $47.18" `parseis` Mixed [dollars 47.18]
parseWithCtx postingamount " $1." `parseis`
Mixed [Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0}) 1 Nothing]
]
------------------------------------------------------------------------------
-- test data
sampledate = parsedate "2008/11/26"
sampletime = LocalTime sampledate midday
sampleledger = ledgerFromStringWithOpts [] [] sampletime sample_ledger_str
sampleledgerwithopts opts args = ledgerFromStringWithOpts opts args sampletime sample_ledger_str
sample_ledger_str = unlines
["; A sample ledger file."
,";"
,"; Sets up this account tree:"
,"; assets"
,"; bank"
,"; checking"
,"; saving"
,"; cash"
,"; expenses"
,"; food"
,"; supplies"
,"; income"
,"; gifts"
,"; salary"
,"; liabilities"
,"; debts"
,""
,"2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"2008/06/01 gift"
," assets:bank:checking $1"
," income:gifts"
,""
,"2008/06/02 save"
," assets:bank:saving $1"
," assets:bank:checking"
,""
,"2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
," assets:cash"
,""
,"2008/12/31 * pay off"
," liabilities:debts $1"
," assets:bank:checking"
,""
,""
,";final comment"
]
defaultyear_ledger_str = unlines
["Y2009"
,""
,"01/01 A"
," a $1"
," b"
]
write_sample_ledger = writeFile "sample.ledger" sample_ledger_str
rawposting1_str = " expenses:food:dining $10.00\n"
rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting
entry1_str = unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking"
,""
]
entry1 =
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "")
entry2_str = unlines
["2007/01/27 * joes diner"
," expenses:food:dining $10.00"
," expenses:gifts $10.00"
," assets:checking $-20.00"
,""
]
entry3_str = unlines
["2007/01/01 * opening balance"
," assets:cash $4.82"
," equity:opening balances"
,""
,"2007/01/01 * opening balance"
," assets:cash $4.82"
," equity:opening balances"
,""
,"2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking"
,""
]
periodic_entry1_str = unlines
["~ monthly from 2007/2/2"
," assets:saving $200.00"
," assets:checking"
,""
]
periodic_entry2_str = unlines
["~ monthly from 2007/2/2"
," assets:saving $200.00 ;auto savings"
," assets:checking"
,""
]
periodic_entry3_str = unlines
["~ monthly from 2007/01/01"
," assets:cash $4.82"
," equity:opening balances"
,""
,"~ monthly from 2007/01/01"
," assets:cash $4.82"
," equity:opening balances"
,""
]
ledger1_str = unlines
[""
,"2007/01/27 * joes diner"
," expenses:food:dining $10.00"
," expenses:gifts $10.00"
," assets:checking $-20.00"
,""
,""
,"2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking $-47.18"
,""
,""
]
ledger2_str = unlines
[";comment"
,"2007/01/27 * joes diner"
," expenses:food:dining $10.00"
," assets:checking $-47.18"
,""
]
ledger3_str = unlines
["2007/01/27 * joes diner"
," expenses:food:dining $10.00"
,";intra-entry comment"
," assets:checking $-47.18"
,""
]
ledger4_str = unlines
["!include \"somefile\""
,"2007/01/27 * joes diner"
," expenses:food:dining $10.00"
," assets:checking $-47.18"
,""
]
ledger5_str = ""
ledger6_str = unlines
["~ monthly from 2007/1/21"
," expenses:entertainment $16.23 ;netflix"
," assets:checking"
,""
,"; 2007/01/01 * opening balance"
,"; assets:saving $200.04"
,"; equity:opening balances "
,""
]
ledger7_str = unlines
["2007/01/01 * opening balance"
," assets:cash $4.82"
," equity:opening balances "
,""
,"2007/01/01 * opening balance"
," income:interest $-4.82"
," equity:opening balances "
,""
,"2007/01/02 * ayres suites"
," expenses:vacation $179.92"
," assets:checking "
,""
,"2007/01/02 * auto transfer to savings"
," assets:saving $200.00"
," assets:checking "
,""
,"2007/01/03 * poquito mas"
," expenses:food:dining $4.82"
," assets:cash "
,""
,"2007/01/03 * verizon"
," expenses:phone $95.11"
," assets:checking "
,""
,"2007/01/03 * discover"
," liabilities:credit cards:discover $80.00"
," assets:checking "
,""
,"2007/01/04 * blue cross"
," expenses:health:insurance $90.00"
," assets:checking "
,""
,"2007/01/05 * village market liquor"
," expenses:food:dining $6.48"
," assets:checking "
,""
]
rawledger7 = RawLedger
[]
[]
[
LedgerTransaction {
ltdate= parsedate "2007/01/01",
ltstatus=False,
ltcode="*",
ltdescription="opening balance",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="equity:opening balances",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
ltdate= parsedate "2007/02/01",
ltstatus=False,
ltcode="*",
ltdescription="ayres suites",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:vacation",
pamount=(Mixed [dollars 179.92]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-179.92)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
ltdate=parsedate "2007/01/02",
ltstatus=False,
ltcode="*",
ltdescription="auto transfer to savings",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="assets:saving",
pamount=(Mixed [dollars 200]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-200)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="poquito mas",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:food:dining",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="verizon",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:phone",
pamount=(Mixed [dollars 95.11]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-95.11)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
,
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="discover",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="liabilities:credit cards:discover",
pamount=(Mixed [dollars 80]),
pcomment="",
ptype=RegularPosting
},
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-80)]),
pcomment="",
ptype=RegularPosting
}
],
ltpreceding_comment_lines=""
}
]
[]
[]
""
""
ledger7 = cacheLedger [] rawledger7
ledger8_str = unlines
["2008/1/1 test "
," a:b 10h @ $40"
," c:d "
,""
]
timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"
timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger"
timelogentry2_str = "o 2007/03/11 16:30:00\n"
timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") ""
price1_str = "P 2004/05/01 XYZ $55\n"
price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" "$" 55
a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]
a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]
a3 = Mixed $ (amounts a1) ++ (amounts a2)
rawLedgerWithAmounts :: [String] -> RawLedger
rawLedgerWithAmounts as =
RawLedger
[]
[]
[nullledgertxn{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as]
[]
[]
""
""
where parse = fromparse . parseWithCtx postingamount . (" "++)