diff --git a/Hledger/Cli.hs b/Hledger/Cli.hs new file mode 100644 --- /dev/null +++ b/Hledger/Cli.hs @@ -0,0 +1,909 @@ +{-| +Hledger.Cli re-exports the options, utilities and commands provided by the +hledger command-line program. +-} + +module Hledger.Cli ( + module Hledger.Cli.Add, + module Hledger.Cli.Balance, + module Hledger.Cli.Convert, + module Hledger.Cli.Histogram, + module Hledger.Cli.Print, + module Hledger.Cli.Register, + module Hledger.Cli.Stats, + module Hledger.Cli.Options, + module Hledger.Cli.Utils, + tests_Hledger_Cli + ) +where +import Hledger.Cli.Add +import Hledger.Cli.Balance +import Hledger.Cli.Convert +import Hledger.Cli.Histogram +import Hledger.Cli.Print +import Hledger.Cli.Register +import Hledger.Cli.Stats +import Hledger.Cli.Options +import Hledger.Cli.Utils + + +import qualified Data.Map as Map +import System.Time (ClockTime(TOD)) + +import Hledger.Data -- including testing utils in Hledger.Data.Utils +import Hledger.Read +import Hledger.Read.JournalReader (someamount) + + +-- | hledger and hledger-lib's unit tests aggregated from all modules +-- plus some more which are easier to define here for now. +-- tests_Hledger_Cli1 :: Test +tests_Hledger_Cli = TestList + [ + tests_Hledger_Data + ,tests_Hledger_Read + -- ,tests_Hledger_Cli_Add + -- ,tests_Hledger_Cli_Balance + ,tests_Hledger_Cli_Convert + -- ,tests_Hledger_Cli_Histogram + ,tests_Hledger_Cli_Options + -- ,tests_Hledger_Cli_Print + ,tests_Hledger_Cli_Register + -- ,tests_Hledger_Cli_Stats + + + ,"account directive" ~: + let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return + j2 <- readJournal Nothing str2 >>= either error' return + j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} + 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" + ) + ] + + ,"ledgerAccountNames" ~: + ledgerAccountNames 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"] + + ,"balance report tests" ~: + let (opts,args) `gives` es = do + l <- samplejournalwithopts opts args + t <- getCurrentLocalTime + balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) 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" + ,"--------------------" + ," 0" + ] + + ,"balance report can be limited with --depth" ~: + ([Depth "1"], []) `gives` + [" $-1 assets" + ," $2 expenses" + ," $-2 income" + ," $1 liabilities" + ,"--------------------" + ," 0" + ] + + ,"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" + ,"--------------------" + ," 0" + ] + + ,"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` + ["--------------------" + ," 0" + ] + + ,"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 + j <- (readJournal Nothing $ unlines + ["" + ,"2008/1/1 test " + ," a:b 10h @ $50" + ," c:d " + ]) >>= either error' return + let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment + balanceReportAsText [] (balanceReport [] nullfilterspec j') `is` + unlines + [" $500 a:b" + ," $-500 c:d" + ,"--------------------" + ," 0" + ] + + ,"balance report elides zero-balance root account(s)" ~: do + l <- readJournalWithOpts [] + (unlines + ["2008/1/1 one" + ," test:a 1" + ," test:b" + ]) + balanceReportAsText [] (balanceReport [] nullfilterspec l) `is` + unlines + [" 1 test:a" + ," -1 test:b" + ,"--------------------" + ," 0" + ] + + ] + + ,"journalCanonicaliseAmounts" ~: + "use the greatest precision" ~: + (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] + + ,"commodities" ~: + Map.elems (commodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, decimalpoint='.', precision=2, separator=',', separatorpositions=[]}] + + -- 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") + + ,"default year" ~: do + rl <- readJournal Nothing defaultyear_journal_str >>= either error' return + tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1 + return () + + ,"print report tests" ~: TestList + [ + + "print expenses" ~: + do + let args = ["expenses"] + l <- samplejournalwithopts [] args + t <- getCurrentLocalTime + showTransactions (optsToFilterSpec [] args t) l `is` unlines + ["2008/06/03 * eat & shop" + ," expenses:food $1" + ," expenses:supplies $1" + ," assets:cash $-2" + ,"" + ] + + , "print report with depth arg" ~: + do + l <- samplejournal + t <- getCurrentLocalTime + showTransactions (optsToFilterSpec [Depth "2"] [] t) 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 $-2" + ,"" + ,"2008/12/31 * pay off" + ," liabilities:debts $1" + ,"" + ] + + ] + + ,"register report tests" ~: + let registerdates = filter (not . null) . map (strip . take 10) . lines + in + TestList + [ + + "register report with no args" ~: + do + l <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) 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 option" ~: + do + let opts = [Cleared] + l <- readJournalWithOpts opts sample_journal_str + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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 option" ~: + do + let opts = [UnCleared] + l <- readJournalWithOpts opts sample_journal_str + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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 <- readJournalWithOpts [] $ unlines + ["2008/02/02 a" + ," b 1" + ," c" + ,"" + ,"2008/01/01 d" + ," e 1" + ," f" + ] + registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"] + + ,"register report with account pattern" ~: + do + l <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) l) `is` unlines + ["2008/06/03 eat & shop assets:cash $-2 $-2" + ] + + ,"register report with account pattern, case insensitive" ~: + do + l <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) l) `is` unlines + ["2008/06/03 eat & shop assets:cash $-2 $-2" + ] + + ,"register report with display expression" ~: + do + l <- samplejournal + let gives displayexpr = + (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is`) + where opts = [Display displayexpr] + "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 <- samplejournal + let periodexpr `gives` dates = do + l' <- samplejournalwithopts opts [] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l') `is` dates + where opts = [Period periodexpr] + "" `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"] + let opts = [Period "yearly"] + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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" + ] + let opts = [Period "quarterly"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"] + let opts = [Period "quarterly",Empty] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + + ] + + , "register report with depth arg" ~: + do + l <- samplejournal + let opts = [Depth "2"] + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines + ["2008/01/01 income assets:bank $1 $1" + ," income:salary $-1 0" + ,"2008/06/01 gift assets:bank $1 $1" + ," income:gifts $-1 0" + ,"2008/06/02 save assets:bank $1 $1" + ," assets:bank $-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 $-1 0" + ] + + ,"show dollars" ~: show (dollars 1) ~?= "$1.00" + + ,"show hours" ~: show (hours 1) ~?= "1.0h" + + ,"unicode in balance layout" ~: do + l <- readJournalWithOpts [] + "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + [" -100 актив:наличные" + ," 100 расходы:покупки" + ,"--------------------" + ," 0" + ] + + ,"unicode in register layout" ~: do + l <- readJournalWithOpts [] + "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + ["2009/01/01 медвежья шкура расходы:покупки 100 100" + ," актив:наличные -100 0"] + + ,"subAccounts" ~: do + l <- liftM (journalToLedger nullfilterspec) samplejournal + let a = ledgerAccount l "assets" + map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] + + ] + + +-- fixtures/test data + +t1 = LocalTime date1 midday where date1 = parsedate "2008/11/26" + +samplejournal = readJournalWithOpts [] sample_journal_str +samplejournalwithopts opts _ = readJournalWithOpts opts sample_journal_str + +sample_journal_str = unlines + ["; A sample journal 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_journal_str = unlines + ["Y2009" + ,"" + ,"01/01 A" + ," a $1" + ," b" + ] + +-- write_sample_journal = writeFile "sample.journal" sample_journal_str + +-- 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" +-- ,"" +-- ] + +-- journal1_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" +-- ,"" +-- ,"" +-- ] + +-- journal2_str = unlines +-- [";comment" +-- ,"2007/01/27 * joes diner" +-- ," expenses:food:dining $10.00" +-- ," assets:checking $-47.18" +-- ,"" +-- ] + +-- journal3_str = unlines +-- ["2007/01/27 * joes diner" +-- ," expenses:food:dining $10.00" +-- ,";intra-entry comment" +-- ," assets:checking $-47.18" +-- ,"" +-- ] + +-- journal4_str = unlines +-- ["!include \"somefile\"" +-- ,"2007/01/27 * joes diner" +-- ," expenses:food:dining $10.00" +-- ," assets:checking $-47.18" +-- ,"" +-- ] + +-- journal5_str = "" + +-- journal6_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 " +-- ,"" +-- ] + +-- journal7_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 " +-- ,"" +-- ] + +journal7 = Journal + [] + [] + [ + txnTieKnot $ Transaction { + tdate=parsedate "2007/01/01", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="opening balance", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:cash", + pamount=(Mixed [dollars 4.82]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="equity:opening balances", + pamount=(Mixed [dollars (-4.82)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2007/02/01", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="ayres suites", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="expenses:vacation", + pamount=(Mixed [dollars 179.92]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:checking", + pamount=(Mixed [dollars (-179.92)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2007/01/02", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="auto transfer to savings", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="assets:saving", + pamount=(Mixed [dollars 200]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:checking", + pamount=(Mixed [dollars (-200)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="poquito mas", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="expenses:food:dining", + pamount=(Mixed [dollars 4.82]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:cash", + pamount=(Mixed [dollars (-4.82)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="verizon", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="expenses:phone", + pamount=(Mixed [dollars 95.11]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:checking", + pamount=(Mixed [dollars (-95.11)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + , + txnTieKnot $ Transaction { + tdate=parsedate "2007/01/03", + teffectivedate=Nothing, + tstatus=False, + tcode="*", + tdescription="discover", + tcomment="", + tmetadata=[], + tpostings=[ + Posting { + pstatus=False, + paccount="liabilities:credit cards:discover", + pamount=(Mixed [dollars 80]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + }, + Posting { + pstatus=False, + paccount="assets:checking", + pamount=(Mixed [dollars (-80)]), + pcomment="", + ptype=RegularPosting, + pmetadata=[], + ptransaction=Nothing + } + ], + tpreceding_comment_lines="" + } + ] + [] + [] + "" + nullctx + [] + (TOD 0 0) + +ledger7 = journalToLedger nullfilterspec journal7 + +-- journal8_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") "" + +-- 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 + +journalWithAmounts :: [String] -> Journal +journalWithAmounts as = + Journal + [] + [] + [t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}] + [] + [] + "" + nullctx + [] + (TOD 0 0) + where parse = fromparse . parseWithCtx nullctx someamount + diff --git a/Hledger/Cli/Add.hs b/Hledger/Cli/Add.hs --- a/Hledger/Cli/Add.hs +++ b/Hledger/Cli/Add.hs @@ -3,6 +3,10 @@ A history-aware add command to help with data entry. +Note: this might not be sensible, but add has some aspirations of being +both user-fiendly and pipeable/scriptable and for this reason +informational messages are mostly written to stderr rather than stdout. + -} module Hledger.Cli.Add @@ -11,13 +15,10 @@ import Hledger.Read.JournalReader (someamount) import Hledger.Cli.Options import Hledger.Cli.Register (registerReport, registerReportAsText) -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding (putStr, putStrLn, getLine, appendFile) -import System.IO.UTF8 -import System.IO ( stderr ) -#else +import Prelude hiding (putStr, putStrLn, appendFile) +import Hledger.Data.UTF8 (putStr, putStrLn, appendFile) + import System.IO ( stderr, hPutStrLn, hPutStr ) -#endif import System.IO.Error import Text.ParserCombinators.Parsec import Hledger.Cli.Utils (readJournalWithOpts) @@ -30,6 +31,14 @@ import Safe (headMay) import Control.Exception (throw) +{- | Information used as the basis for suggested account names, amounts, + etc in add prompt +-} +data PostingState = PostingState { + psJournal :: Journal, + psAccept :: AccountName -> Bool, + psSuggestHistoricalAmount :: Bool, + psHistory :: Maybe [Posting]} -- | Read transactions from the terminal, prompting for each field, -- and append them to the journal file. If the journal came from stdin, this @@ -43,7 +52,7 @@ ++"To complete a transaction, enter . when prompted for an account.\n" ++"To quit, press control-d or control-c." today <- getCurrentDay - runInteraction j (getAndAddTransactions j opts args today) + getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e) where f = journalFilePath j @@ -51,22 +60,22 @@ -- validating, displaying and appending them to the journal file, until -- end of input (then raise an EOF exception). Any command-line arguments -- are used as the first transaction's description. -getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> InputT IO () +getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO () getAndAddTransactions j opts args defaultDate = do (t, d) <- getTransaction j opts args defaultDate - j <- liftIO $ journalAddTransaction j opts t + j <- journalAddTransaction j opts t getAndAddTransactions j opts args d -- | Read a transaction from the command line, with history-aware prompting. getTransaction :: Journal -> [Opt] -> [String] -> Day - -> InputT IO (Transaction,Day) + -> IO (Transaction,Day) getTransaction j opts args defaultDate = do - today <- liftIO getCurrentDay - datestr <- askFor "date" + today <- getCurrentDay + datestr <- runInteractionDefault $ askFor "date" (Just $ showDate defaultDate) (Just $ \s -> null s || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) - description <- askFor "description" (Just "") Nothing + description <- runInteractionDefault $ askFor "description" (Just "") Nothing let historymatches = transactionsSimilarTo j args description bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches @@ -78,7 +87,7 @@ else True where (ant,_,_,_) = groupPostings $ journalPostings j getpostingsandvalidate = do - ps <- getPostings (jContext j) accept bestmatchpostings [] + ps <- getPostings (PostingState j accept True bestmatchpostings) [] let t = nulltransaction{tdate=date ,tstatus=False ,tdescription=description @@ -97,14 +106,14 @@ -- fragile -- | Read postings from the command line until . is entered, using any -- provided historical postings and the journal context to guess defaults. -getPostings :: JournalContext -> (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> InputT IO [Posting] -getPostings ctx accept historicalps enteredps = do +getPostings :: PostingState -> [Posting] -> IO [Posting] +getPostings st enteredps = do let bestmatch | isNothing historicalps = Nothing | n <= length ps = Just $ ps !! (n-1) | otherwise = Nothing where Just ps = historicalps defaultaccount = maybe Nothing (Just . showacctname) bestmatch - account <- askFor (printf "account %d" n) defaultaccount (Just accept) + account <- runInteraction j $ askFor (printf "account %d" n) defaultaccount (Just accept) if account=="." then return enteredps else do @@ -114,17 +123,18 @@ | n <= length ps = Just $ ps !! (n-1) | otherwise = Nothing where Just ps = historicalps' - defaultamountstr | isJust bestmatch' = Just historicalamountstr + defaultamountstr | isJust bestmatch' && suggesthistorical = Just historicalamountstr | n > 1 = Just balancingamountstr | otherwise = Nothing where - historicalamountstr = showMixedAmountWithPrecision maxprecision $ pamount $ fromJust bestmatch' - balancingamountstr = showMixedAmountWithPrecision maxprecision $ negate $ sumMixedAmountsPreservingHighestPrecision $ map pamount enteredrealps - amountstr <- askFor (printf "amount %d" n) defaultamountstr validateamount + -- force a decimal point in the output in case there's a + -- digit group separator that would be mistaken for one + historicalamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ pamount $ fromJust bestmatch' + balancingamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ negate $ sumMixedAmountsPreservingHighestPrecision $ map pamount enteredrealps + amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount let amount = fromparse $ runParser (someamount <|> return missingamt) ctx "" amountstr amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr defaultamtused = Just (showMixedAmount amount) == defaultamountstr - historicalps'' = if defaultamtused then historicalps' else Nothing commodityadded | c == cwithnodef = Nothing | otherwise = c where c = maybemixedamountcommodity amount @@ -133,10 +143,18 @@ p = nullposting{paccount=stripbrackets account, pamount=amount, ptype=postingtype account} + st' = if defaultamtused then st + else st{psHistory = historicalps', + psSuggestHistoricalAmount = False} when (isJust commodityadded) $ liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (symbol $ fromJust commodityadded) - getPostings ctx accept historicalps'' $ enteredps ++ [p] + getPostings st' (enteredps ++ [p]) where + j = psJournal st + historicalps = psHistory st + ctx = jContext j + accept = psAccept st + suggesthistorical = psSuggestHistoricalAmount st n = length enteredps + 1 enteredrealps = filter isReal enteredps showacctname p = showAccountName Nothing (ptype p) $ paccount p @@ -234,6 +252,10 @@ runInteraction j m = do let cc = completionCache j runInputT (setComplete (accountCompletion cc) defaultSettings) m + +runInteractionDefault :: InputT IO a -> IO a +runInteractionDefault m = do + runInputT (setComplete noCompletion defaultSettings) m -- A precomputed list of all accounts previously entered into the journal. type CompletionCache = [AccountName] diff --git a/Hledger/Cli/Balance.hs b/Hledger/Cli/Balance.hs --- a/Hledger/Cli/Balance.hs +++ b/Hledger/Cli/Balance.hs @@ -101,6 +101,7 @@ ,balance ,balanceReport ,balanceReportAsText + ,tests_Hledger_Cli_Balance -- ,tests_Balance ) where import Hledger.Data.Utils @@ -110,10 +111,8 @@ import Hledger.Data.Posting import Hledger.Data.Ledger import Hledger.Cli.Options -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding ( putStr ) -import System.IO.UTF8 -#endif +import Prelude hiding (putStr) +import Hledger.Data.UTF8 (putStr) -- | A balance report is a chart of accounts with balances, and their grand total. @@ -211,3 +210,6 @@ isInterestingTree = treeany (isInteresting opts l . aname) subtrees = map (fromJust . ledgerAccountTreeAt l) $ ledgerSubAccounts l $ ledgerAccount l a +tests_Hledger_Cli_Balance = TestList + [ + ] diff --git a/Hledger/Cli/Commands.hs b/Hledger/Cli/Commands.hs deleted file mode 100644 --- a/Hledger/Cli/Commands.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE CPP #-} -{-| - -The Commands package defines all the commands offered by the hledger -application, like \"register\" and \"balance\". This module exports all -the commands; you can also import individual modules if you prefer. - --} - -module Hledger.Cli.Commands ( - module Hledger.Cli.Add, - module Hledger.Cli.Balance, - module Hledger.Cli.Convert, - module Hledger.Cli.Histogram, - module Hledger.Cli.Print, - module Hledger.Cli.Register, - module Hledger.Cli.Stats, - tests_Hledger_Commands - ) -where -import Hledger.Cli.Add -import Hledger.Cli.Balance -import Hledger.Cli.Convert -import Hledger.Cli.Histogram -import Hledger.Cli.Print -import Hledger.Cli.Register -import Hledger.Cli.Stats -import Test.HUnit (Test(TestList)) - - -tests_Hledger_Commands = TestList - [ --- Hledger.Cli.Add.tests_Add --- ,Hledger.Cli.Balance.tests_Balance - Hledger.Cli.Convert.tests_Convert --- ,Hledger.Cli.Histogram.tests_Histogram --- ,Hledger.Cli.Print.tests_Print - ,Hledger.Cli.Register.tests_Register --- ,Hledger.Cli.Stats.tests_Stats - ] diff --git a/Hledger/Cli/Convert.hs b/Hledger/Cli/Convert.hs --- a/Hledger/Cli/Convert.hs +++ b/Hledger/Cli/Convert.hs @@ -10,7 +10,7 @@ import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error') import Hledger.Read.JournalReader (someamount,ledgeraccountname) import Hledger.Data.Journal (nullctx) -import Hledger.Data.Amount (nullmixedamt) +import Hledger.Data.Amount (nullmixedamt, costOfMixedAmount) import Safe (atDef, maximumDef) import System.IO (stderr) import Text.CSV (parseCSVFromFile, printCSV) @@ -35,24 +35,30 @@ -} data CsvRules = CsvRules { dateField :: Maybe FieldPosition, + dateFormat :: Maybe String, statusField :: Maybe FieldPosition, codeField :: Maybe FieldPosition, descriptionField :: Maybe FieldPosition, amountField :: Maybe FieldPosition, currencyField :: Maybe FieldPosition, baseCurrency :: Maybe String, + accountField :: Maybe FieldPosition, + effectiveDateField :: Maybe FieldPosition, baseAccount :: AccountName, accountRules :: [AccountRule] } deriving (Show, Eq) nullrules = CsvRules { dateField=Nothing, + dateFormat=Nothing, statusField=Nothing, codeField=Nothing, descriptionField=Nothing, amountField=Nothing, currencyField=Nothing, baseCurrency=Nothing, + accountField=Nothing, + effectiveDateField=Nothing, baseAccount="unknown", accountRules=[] } @@ -109,6 +115,8 @@ ,descriptionField r ,amountField r ,currencyField r + ,accountField r + ,effectiveDateField r ] rulesFileFor :: FilePath -> FilePath @@ -165,11 +173,14 @@ definitions = do choice' [ datefield + ,dateformat ,statusfield ,codefield ,descriptionfield ,amountfield ,currencyfield + ,accountfield + ,effectivedatefield ,basecurrency ,baseaccount ,commentline @@ -183,6 +194,20 @@ r <- getState setState r{dateField=readMay v} +effectivedatefield = do + string "effective-date-field" + many1 spacenonewline + v <- restofline + r <- getState + setState r{effectiveDateField=readMay v} + +dateformat = do + string "date-format" + many1 spacenonewline + v <- restofline + r <- getState + setState r{dateFormat=Just v} + codefield = do string "code-field" many1 spacenonewline @@ -218,6 +243,14 @@ r <- getState setState r{currencyField=readMay v} +accountfield = do + string "account-field" + many1 spacenonewline + v <- restofline + r <- getState + setState r{accountField=readMay v} + + basecurrency = do string "currency" many1 spacenonewline @@ -271,12 +304,15 @@ transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction transactionFromCsvRecord rules fields = let - date = parsedate $ normaliseDate $ maybe "1900/1/1" (atDef "" fields) (dateField rules) + date = parsedate $ normaliseDate (dateFormat rules) $ maybe "1900/1/1" (atDef "" fields) (dateField rules) + effectivedate = do idx <- effectiveDateField rules + return $ parsedate $ normaliseDate (dateFormat rules) $ (atDef "" fields) idx status = maybe False (null . strip . (atDef "" fields)) (statusField rules) code = maybe "" (atDef "" fields) (codeField rules) desc = maybe "" (atDef "" fields) (descriptionField rules) comment = "" precomment = "" + baseacc = maybe (baseAccount rules) (atDef "" fields) (accountField rules) amountstr = maybe "" (atDef "" fields) (amountField rules) amountstr' = strnegate amountstr where strnegate ('-':s) = s strnegate s = '-':s @@ -284,12 +320,15 @@ amountstr'' = currency ++ amountstr' amountparse = runParser someamount nullctx "" amountstr'' amount = either (const nullmixedamt) id amountparse + -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD". + -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct" + baseamount = costOfMixedAmount amount unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown" | otherwise = "expenses:unknown" (acct,newdesc) = identify (accountRules rules) unknownacct desc t = Transaction { tdate=date, - teffectivedate=Nothing, + teffectivedate=effectivedate, tstatus=status, tcode=code, tdescription=newdesc, @@ -308,8 +347,8 @@ }, Posting { pstatus=False, - paccount=baseAccount rules, - pamount=(-amount), + paccount=baseacc, + pamount=(-baseamount), pcomment="", ptype=RegularPosting, pmetadata=[], @@ -320,9 +359,11 @@ in t -- | Convert some date string with unknown format to YYYY/MM/DD. -normaliseDate :: String -> String -normaliseDate s = maybe "0000/00/00" showDate $ - firstJust +normaliseDate :: Maybe String -- ^ User-supplied date format: this should be tried in preference to all others + -> String -> String +normaliseDate mb_user_format s = maybe "0000/00/00" showDate $ + firstJust $ + (maybe id (\user_format -> (parseTime defaultTimeLocale user_format s :)) mb_user_format) $ [parseTime defaultTimeLocale "%Y/%m/%e" s -- can't parse a month without leading 0, try adding one ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s) @@ -350,7 +391,7 @@ caseinsensitive = ("(?i)"++) -tests_Convert = TestList [ +tests_Hledger_Cli_Convert = TestList [ "convert rules parsing: empty file" ~: do -- let assertMixedAmountParse parseresult mixedamount = diff --git a/Hledger/Cli/Histogram.hs b/Hledger/Cli/Histogram.hs --- a/Hledger/Cli/Histogram.hs +++ b/Hledger/Cli/Histogram.hs @@ -9,10 +9,8 @@ where import Hledger.Data import Hledger.Cli.Options -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding ( putStr ) -import System.IO.UTF8 -#endif +import Prelude hiding (putStr) +import Hledger.Data.UTF8 (putStr) barchar = '*' @@ -25,14 +23,14 @@ putStr $ showHistogram opts (optsToFilterSpec opts args t) j showHistogram :: [Opt] -> FilterSpec -> Journal -> String -showHistogram opts filterspec j = concatMap (printDayWith countBar) dayps +showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps where i = intervalFromOpts opts - interval | i == NoInterval = Daily + interval | i == NoInterval = Days 1 | otherwise = i - fullspan = journalDateSpan j - days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan - dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days] + span = datespan filterspec `orDatesFrom` journalDateSpan j + spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span + spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] -- same as Register -- should count transactions, not postings ? ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE CPP #-} {-| hledger - a ledger-compatible accounting tool. -Copyright (c) 2007-2010 Simon Michael +Copyright (c) 2007-2011 Simon Michael Released under GPL version 3 or later. hledger is a partial haskell clone of John Wiegley's "ledger". It @@ -40,16 +39,11 @@ module Hledger.Cli.Main where -#if __GLASGOW_HASKELL__ <= 610 import Prelude hiding (putStr, putStrLn) -import System.IO.UTF8 -#endif - +import Hledger.Data.UTF8 (putStr, putStrLn) import Hledger.Data -import Hledger.Cli.Commands -import Hledger.Cli.Options +import Hledger.Cli import Hledger.Cli.Tests -import Hledger.Cli.Utils (withJournalDo) import Hledger.Cli.Version (progversionstr, binaryfilename) main :: IO () diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE CPP #-} {-| Command-line options for the application. -} module Hledger.Cli.Options where -import Codec.Binary.UTF8.String (decodeString) import System.Console.GetOpt import System.Environment @@ -148,7 +146,7 @@ -- provided usage string. parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String]) parseArgumentsWith options = do - rawargs <- map decodeString `fmap` getArgs + rawargs <- map fromPlatformString `fmap` getArgs let (opts,args,errs) = getOpt Permute options rawargs opts' <- fixOptDates opts let opts'' = if Debug `elem` opts' then Verbose:opts' else opts' @@ -199,11 +197,11 @@ ((p:_), _) -> case parsePeriodExpr (parsedate "0001/01/01") p of Right (i, _) -> i Left e -> parseerror e - (_, (DailyOpt:_)) -> Daily - (_, (WeeklyOpt:_)) -> Weekly - (_, (MonthlyOpt:_)) -> Monthly - (_, (QuarterlyOpt:_)) -> Quarterly - (_, (YearlyOpt:_)) -> Yearly + (_, (DailyOpt:_)) -> Days 1 + (_, (WeeklyOpt:_)) -> Weeks 1 + (_, (MonthlyOpt:_)) -> Months 1 + (_, (QuarterlyOpt:_)) -> Quarters 1 + (_, (YearlyOpt:_)) -> Years 1 (_, _) -> NoInterval where periodopts = reverse $ optValuesForConstructor Period opts @@ -295,3 +293,28 @@ -- where -- listtomaybe [] = Nothing -- listtomaybe vs = Just $ last vs + +tests_Hledger_Cli_Options = TestList + [ + "dateSpanFromOpts" ~: do + let todaysdate = parsedate "2008/11/26" + let gives = is . show . dateSpanFromOpts todaysdate + [] `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)" + + ,"intervalFromOpts" ~: do + let gives = is . intervalFromOpts + [] `gives` NoInterval + [DailyOpt] `gives` Days 1 + [WeeklyOpt] `gives` Weeks 1 + [MonthlyOpt] `gives` Months 1 + [QuarterlyOpt] `gives` Quarters 1 + [YearlyOpt] `gives` Years 1 + [Period "weekly"] `gives` Weeks 1 + [Period "monthly"] `gives` Months 1 + [Period "quarterly"] `gives` Quarters 1 + [WeeklyOpt, Period "yearly"] `gives` Years 1 + + ] diff --git a/Hledger/Cli/Print.hs b/Hledger/Cli/Print.hs --- a/Hledger/Cli/Print.hs +++ b/Hledger/Cli/Print.hs @@ -12,12 +12,10 @@ ,journalReport ,showTransactions ) where -import Hledger.Data import Hledger.Cli.Options -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding ( putStr ) -import System.IO.UTF8 -#endif +import Hledger.Data +import Prelude hiding (putStr) +import Hledger.Data.UTF8 (putStr) -- | A "journal report" is just a list of transactions. diff --git a/Hledger/Cli/Register.hs b/Hledger/Cli/Register.hs --- a/Hledger/Cli/Register.hs +++ b/Hledger/Cli/Register.hs @@ -12,19 +12,18 @@ ,registerReport ,registerReportAsText ,showPostingWithBalanceForVty - ,tests_Register + ,tests_Hledger_Cli_Register ) where import Safe (headMay, lastMay) -import Hledger.Data -import Hledger.Cli.Options -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding ( putStr ) -import System.IO.UTF8 -#endif import Text.ParserCombinators.Parsec +import Hledger.Cli.Options +import Hledger.Data +import Prelude hiding (putStr) +import Hledger.Data.UTF8 (putStr) + -- | A register report is a list of postings to an account or set of -- accounts, with a running total. Postings may be actual postings, or -- virtual postings aggregated over a reporting interval. @@ -198,10 +197,46 @@ depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a} -tests_Register :: Test -tests_Register = TestList [ +tests_Hledger_Cli_Register :: Test +tests_Hledger_Cli_Register = TestList + [ - "summarisePostingsByInterval" ~: do - summarisePostingsByInterval Quarterly Nothing False (DateSpan Nothing Nothing) [] ~?= [] + "summarisePostingsByInterval" ~: do + summarisePostingsByInterval (Quarters 1) Nothing False (DateSpan Nothing Nothing) [] ~?= [] - ] + -- ,"summarisePostingsInDateSpan" ~: do + -- let gives (b,e,depth,showempty,ps) = + -- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`) + -- let ps = + -- [ + -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 8]} + -- ] + -- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` + -- [] + -- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` + -- [ + -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"} + -- ] + -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` + -- [ + -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} + -- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 10]} + -- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} + -- ] + -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` + -- [ + -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]} + -- ] + -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` + -- [ + -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]} + -- ] + -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` + -- [ + -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]} + -- ] + + ] diff --git a/Hledger/Cli/Stats.hs b/Hledger/Cli/Stats.hs --- a/Hledger/Cli/Stats.hs +++ b/Hledger/Cli/Stats.hs @@ -7,13 +7,12 @@ module Hledger.Cli.Stats where -import Hledger.Data -import Hledger.Cli.Options import qualified Data.Map as Map -#if __GLASGOW_HASKELL__ <= 610 -import Prelude hiding ( putStr ) -import System.IO.UTF8 -#endif + +import Hledger.Cli.Options +import Hledger.Data +import Prelude hiding (putStr) +import Hledger.Data.UTF8 (putStr) -- like Register.summarisePostings diff --git a/Hledger/Cli/Tests.hs b/Hledger/Cli/Tests.hs --- a/Hledger/Cli/Tests.hs +++ b/Hledger/Cli/Tests.hs @@ -10,1106 +10,39 @@ by .test files in the tests\/ subdirectory. These can be run by doing @make functest@ in the hledger source tree. -hledger's doctests are shell tests defined in literal blocks in haddock -documentation in the source, run by doing @make doctest@ in the hledger -source tree. are They hardly used, but here is an example: - -@ -$ bin/hledger -f data/sample.journal balance o - $1 expenses:food - $-2 income - $-1 gifts - $-1 salary --------------------- - $-1 -@ - --} - -module Hledger.Cli.Tests -where -import qualified Data.Map as Map -import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible -import System.Time (ClockTime(TOD)) - -import Hledger.Data -- including testing utils in Hledger.Data.Utils -import Hledger.Read (readJournal) -import Hledger.Read.JournalReader (someamount) -import Hledger.Cli.Commands -import Hledger.Cli.Options -import Hledger.Cli.Utils - - --- | Run unit tests. -runtests :: [Opt] -> [String] -> IO () -runtests _ args = do - (counts,_) <- liftM (flip (,) 0) $ runTestTT ts - if errors counts > 0 || (failures counts > 0) - then exitFailure - else exitWith ExitSuccess - where - ts = TestList $ filter matchname $ tflatten tests -- show flat test names - -- ts = tfilter matchname $ TestList tests -- show hierarchical test names - matchname = matchpats args . tname - --- | unit tests, augmenting the ones defined in each module. Where that is --- inconvenient due to import cycles or whatever, we define them here. -tests :: Test -tests = TestList [ - tests_Hledger_Data, - tests_Hledger_Commands, - - "account directive" ~: - let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return - j2 <- readJournal Nothing str2 >>= either error' return - j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} - 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" ~: - 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" []]]] - - ,"balance report tests" ~: - let (opts,args) `gives` es = do - l <- samplejournalwithopts opts args - t <- getCurrentLocalTime - balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) 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" - ,"--------------------" - ," $0" - ] - - ,"balance report can be limited with --depth" ~: - ([Depth "1"], []) `gives` - [" $-1 assets" - ," $2 expenses" - ," $-2 income" - ," $1 liabilities" - ,"--------------------" - ," $0" - ] - - ,"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" - ,"--------------------" - ," $0" - ] - - ,"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` - ["--------------------" - ," 0" - ] - - ,"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 - j <- (readJournal Nothing $ unlines - ["" - ,"2008/1/1 test " - ," a:b 10h @ $50" - ," c:d " - ]) >>= either error' return - let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment - balanceReportAsText [] (balanceReport [] nullfilterspec j') `is` - unlines - [" $500 a:b" - ," $-500 c:d" - ,"--------------------" - ," $0" - ] - - ,"balance report elides zero-balance root account(s)" ~: do - l <- readJournalWithOpts [] - (unlines - ["2008/1/1 one" - ," test:a 1" - ," test:b" - ]) - balanceReportAsText [] (balanceReport [] nullfilterspec l) `is` - unlines - [" 1 test:a" - ," -1 test:b" - ,"--------------------" - ," 0" - ] - - ] - - ,"balanceTransaction" ~: do - assertBool "detect unbalanced entry, sign error" - (isLeft $ balanceTransaction Nothing - (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] - [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, - Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing - ] "")) - assertBool "detect unbalanced entry, multiple missing amounts" - (isLeft $ balanceTransaction Nothing - (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] - [Posting False "a" missingamt "" RegularPosting [] Nothing, - Posting False "b" missingamt "" RegularPosting [] Nothing - ] "")) - let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] - [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, - Posting False "b" missingamt "" RegularPosting [] Nothing - ] "") - assertBool "one missing amount should be ok" (isRight e) - assertEqual "balancing amount is added" - (Mixed [dollars (-1)]) - (case e of - Right e' -> (pamount $ last $ tpostings e') - Left _ -> error' "should not happen") - - ,"journalCanonicaliseAmounts" ~: - "use the greatest precision" ~: - (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] - - ,"commodities" ~: - Map.elems (commodities ledger7) `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}] - - ,"dateSpanFromOpts" ~: do - let todaysdate = parsedate "2008/11/26" - let gives = is . show . dateSpanFromOpts todaysdate - [] `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") - - ,"expandAccountNames" ~: - expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is` - ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] - - ,"intervalFromOpts" ~: do - let gives = is . intervalFromOpts - [] `gives` NoInterval - [DailyOpt] `gives` Daily - [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 - - ,"isTransactionBalanced" ~: do - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) - ] "" - assertBool "detect balanced" (isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting [] (Just t) - ] "" - assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ] "" - assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 0]) "" RegularPosting [] (Just t) - ] "" - assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) - ,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting [] (Just t) - ] "" - assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) - ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t) - ] "" - assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t) - let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] - [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) - ,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t) - ,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t) - ,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting [] (Just t) - ] "" - assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t) - - ,"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 <- readJournal Nothing defaultyear_journal_str >>= either error' return - tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1 - return () - - ,"normaliseMixedAmount" ~: do - normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt] - - ,"parsedate" ~: do - parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 - parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1 - - ,"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 <- samplejournalwithopts [] args - t <- getCurrentLocalTime - showTransactions (optsToFilterSpec [] args t) l `is` unlines - ["2008/06/03 * eat & shop" - ," expenses:food $1" - ," expenses:supplies $1" - ," assets:cash $-2" - ,"" - ] - - , "print report with depth arg" ~: - do - l <- samplejournal - t <- getCurrentLocalTime - showTransactions (optsToFilterSpec [Depth "2"] [] t) 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 $-2" - ,"" - ,"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 <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) 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 option" ~: - do - let opts = [Cleared] - l <- readJournalWithOpts opts sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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 option" ~: - do - let opts = [UnCleared] - l <- readJournalWithOpts opts sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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 <- readJournalWithOpts [] $ unlines - ["2008/02/02 a" - ," b 1" - ," c" - ,"" - ,"2008/01/01 d" - ," e 1" - ," f" - ] - registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"] - - ,"register report with account pattern" ~: - do - l <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) l) `is` unlines - ["2008/06/03 eat & shop assets:cash $-2 $-2" - ] - - ,"register report with account pattern, case insensitive" ~: - do - l <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) l) `is` unlines - ["2008/06/03 eat & shop assets:cash $-2 $-2" - ] - - ,"register report with display expression" ~: - do - l <- samplejournal - let gives displayexpr = - (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is`) - where opts = [Display displayexpr] - "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 <- samplejournal - let periodexpr `gives` dates = do - l' <- samplejournalwithopts opts [] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l') `is` dates - where opts = [Period periodexpr] - "" `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"] - let opts = [Period "yearly"] - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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" - ] - let opts = [Period "quarterly"] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"] - let opts = [Period "quarterly",Empty] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] - - ] - - , "register report with depth arg" ~: - do - l <- samplejournal - let opts = [Depth "2"] - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines - ["2008/01/01 income assets:bank $1 $1" - ," income:salary $-1 0" - ,"2008/06/01 gift assets:bank $1 $1" - ," income:gifts $-1 0" - ,"2008/06/02 save assets:bank $1 $1" - ," assets:bank $-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 $-1 0" - ] - - ,"show dollars" ~: show (dollars 1) ~?= "$1.00" - - ,"show hours" ~: show (hours 1) ~?= "1.0h" - - ,"unicode in balance layout" ~: do - l <- readJournalWithOpts [] - "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines - [" -100 актив:наличные" - ," 100 расходы:покупки" - ,"--------------------" - ," 0" - ] - - ,"unicode in register layout" ~: do - l <- readJournalWithOpts [] - "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines - ["2009/01/01 медвежья шкура расходы:покупки 100 100" - ," актив:наличные -100 0"] - - ,"fixSmartDateStr" ~: do - let gives = is . fixSmartDateStr (parsedate "2008/11/26") - "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" - "0020/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" - - ,"subAccounts" ~: do - l <- liftM (journalToLedger nullfilterspec) samplejournal - let a = ledgerAccount l "assets" - map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] - - -- ,"summarisePostingsInDateSpan" ~: do - -- let gives (b,e,depth,showempty,ps) = - -- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`) - -- let ps = - -- [ - -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 2]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 8]} - -- ] - -- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` - -- [] - -- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` - -- [ - -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"} - -- ] - -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` - -- [ - -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [dollars 4]} - -- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [dollars 10]} - -- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [dollars 1]} - -- ] - -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` - -- [ - -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [dollars 15]} - -- ] - -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` - -- [ - -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [dollars 15]} - -- ] - -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` - -- [ - -- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]} - -- ] - - ] - - --- fixtures/test data - -date1 = parsedate "2008/11/26" -t1 = LocalTime date1 midday - -samplejournal = readJournalWithOpts [] sample_journal_str -samplejournalwithopts opts _ = readJournalWithOpts opts sample_journal_str - -sample_journal_str = unlines - ["; A sample journal 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_journal_str = unlines - ["Y2009" - ,"" - ,"01/01 A" - ," a $1" - ," b" - ] - -write_sample_journal = writeFile "sample.journal" sample_journal_str - -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" - ,"" - ] - -journal1_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" - ,"" - ,"" - ] - -journal2_str = unlines - [";comment" - ,"2007/01/27 * joes diner" - ," expenses:food:dining $10.00" - ," assets:checking $-47.18" - ,"" - ] - -journal3_str = unlines - ["2007/01/27 * joes diner" - ," expenses:food:dining $10.00" - ,";intra-entry comment" - ," assets:checking $-47.18" - ,"" - ] - -journal4_str = unlines - ["!include \"somefile\"" - ,"2007/01/27 * joes diner" - ," expenses:food:dining $10.00" - ," assets:checking $-47.18" - ,"" - ] - -journal5_str = "" - -journal6_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 " - ,"" - ] - -journal7_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 " - ,"" - ] - -journal7 = Journal - [] - [] - [ - txnTieKnot $ Transaction { - tdate=parsedate "2007/01/01", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="opening balance", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="assets:cash", - pamount=(Mixed [dollars 4.82]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="equity:opening balances", - pamount=(Mixed [dollars (-4.82)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - , - txnTieKnot $ Transaction { - tdate=parsedate "2007/02/01", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="ayres suites", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="expenses:vacation", - pamount=(Mixed [dollars 179.92]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="assets:checking", - pamount=(Mixed [dollars (-179.92)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - , - txnTieKnot $ Transaction { - tdate=parsedate "2007/01/02", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="auto transfer to savings", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="assets:saving", - pamount=(Mixed [dollars 200]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="assets:checking", - pamount=(Mixed [dollars (-200)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - , - txnTieKnot $ Transaction { - tdate=parsedate "2007/01/03", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="poquito mas", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="expenses:food:dining", - pamount=(Mixed [dollars 4.82]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="assets:cash", - pamount=(Mixed [dollars (-4.82)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - , - txnTieKnot $ Transaction { - tdate=parsedate "2007/01/03", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="verizon", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="expenses:phone", - pamount=(Mixed [dollars 95.11]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="assets:checking", - pamount=(Mixed [dollars (-95.11)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - , - txnTieKnot $ Transaction { - tdate=parsedate "2007/01/03", - teffectivedate=Nothing, - tstatus=False, - tcode="*", - tdescription="discover", - tcomment="", - tmetadata=[], - tpostings=[ - Posting { - pstatus=False, - paccount="liabilities:credit cards:discover", - pamount=(Mixed [dollars 80]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - }, - Posting { - pstatus=False, - paccount="assets:checking", - pamount=(Mixed [dollars (-80)]), - pcomment="", - ptype=RegularPosting, - pmetadata=[], - ptransaction=Nothing - } - ], - tpreceding_comment_lines="" - } - ] - [] - [] - "" - nullctx - [] - (TOD 0 0) - -ledger7 = journalToLedger nullfilterspec journal7 - -journal8_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") "" - -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 - -journalWithAmounts :: [String] -> Journal -journalWithAmounts as = - Journal - [] - [] - [t | a <- as, let t = nulltransaction{tdescription=a,tpostings=[nullposting{pamount=parse a,ptransaction=Just t}]}] - [] - [] - "" - nullctx - [] - (TOD 0 0) - where parse = fromparse . parseWithCtx nullctx someamount +hledger's doctests are shell commands with expected output in literal +blocks in the haddock documentation, run by doing @make doctest@ in the +hledger source tree. They are hardly used, but here is an example: + +@ +$ bin/hledger -f data/sample.journal balance o + $1 expenses:food + $-2 income + $-1 gifts + $-1 salary +-------------------- + $-1 +@ + +-} + +module Hledger.Cli.Tests +where +import System.Exit (exitFailure, exitWith, ExitCode(ExitSuccess)) -- base 3 compatible + +import Hledger.Data -- including testing utils in Hledger.Data.Utils +import Hledger.Cli + + +-- | Run unit tests. +runtests :: [Opt] -> [String] -> IO () +runtests _ args = do + (counts,_) <- liftM (flip (,) 0) $ runTestTT ts + if errors counts > 0 || (failures counts > 0) + then exitFailure + else exitWith ExitSuccess + where + ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli -- show flat test names + -- ts = tfilter matchname $ TestList tests -- show hierarchical test names + matchname = matchpats args . tname diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs --- a/Hledger/Cli/Utils.hs +++ b/Hledger/Cli/Utils.hs @@ -19,6 +19,7 @@ writeFileWithBackup, writeFileWithBackupIfChanged, readFileStrictly, + Test(TestList), ) where import Hledger.Data diff --git a/Hledger/Cli/Version.hs b/Hledger/Cli/Version.hs --- a/Hledger/Cli/Version.hs +++ b/Hledger/Cli/Version.hs @@ -17,7 +17,7 @@ -- version and PATCHLEVEL are set by the make process -version = "0.13.0" +version = "0.14.0" #ifdef PATCHLEVEL patchlevel = "." ++ show PATCHLEVEL -- must be numeric ! diff --git a/hledger.cabal b/hledger.cabal --- a/hledger.cabal +++ b/hledger.cabal @@ -1,15 +1,13 @@ name: hledger -version: 0.13 +version: 0.14 category: Finance -synopsis: A command-line double-entry accounting tool. +synopsis: A robust command-line accounting tool with a simple human-editable data format, similar to ledger. description: - hledger reads a plain text general journal or time log - describing your transactions and displays precise - balance and register reports on the console. - It is a remix, in haskell, of John Wiegley's excellent c++ - ledger. hledger aims to be a practical, accessible tool - for end users and a useful library for finance-minded - haskell programmers. + hledger is a haskell port and friendly fork of John Wiegley's ledger accounting tool. + This package provides the main hledger command-line tool; see the other hledger-* packages for web and curses interfaces and chart generation. + hledger aims to be a reliable, practical financial reporting tool for day-to-day use, and also a useful library for building financial apps in haskell. + Given a plain text file describing transactions, of money or any other commodity, hledger will print the chart of accounts, account balances, or transactions you're interested in. + It can also help you add transactions to the journal file, or convert CSV data from your bank. license: GPL license-file: LICENSE @@ -41,7 +39,7 @@ Hledger.Cli.Tests Hledger.Cli.Utils Hledger.Cli.Version - Hledger.Cli.Commands + Hledger.Cli Hledger.Cli.Add Hledger.Cli.Balance Hledger.Cli.Convert @@ -50,7 +48,7 @@ Hledger.Cli.Register Hledger.Cli.Stats build-depends: - hledger-lib == 0.13 + hledger-lib == 0.14 ,HUnit ,base >= 3 && < 5 ,containers @@ -61,7 +59,7 @@ ,old-locale ,old-time ,parsec - ,process >= 1.0.1.4 && < 1.1 + ,process ,regexpr >= 0.5.1 ,safe >= 0.2 ,split == 0.1.* @@ -80,7 +78,7 @@ Hledger.Cli.Tests Hledger.Cli.Utils Hledger.Cli.Version - Hledger.Cli.Commands + Hledger.Cli Hledger.Cli.Add Hledger.Cli.Balance Hledger.Cli.Convert @@ -89,7 +87,7 @@ Hledger.Cli.Register Hledger.Cli.Stats build-depends: - hledger-lib == 0.13 + hledger-lib == 0.14 ,HUnit ,base >= 3 && < 5 ,containers