{-| Hledger.Cli re-exports the options, utilities and commands provided by the hledger command-line program. This module also aggregates the built-in unit tests defined throughout hledger and hledger-lib, and adds some more which are easier to define here. -} module Hledger.Cli ( module Hledger.Cli.Add, module Hledger.Cli.Balance, module Hledger.Cli.Balancesheet, module Hledger.Cli.Cashflow, module Hledger.Cli.Histogram, module Hledger.Cli.Incomestatement, module Hledger.Cli.Print, module Hledger.Cli.Register, module Hledger.Cli.Stats, module Hledger.Cli.Options, module Hledger.Cli.Utils, module Hledger.Cli.Version, tests_Hledger_Cli ) where import qualified Data.Map as Map import Data.Time.Calendar import System.Time (ClockTime(TOD)) import Test.HUnit import Hledger import Hledger.Cli.Add import Hledger.Cli.Balance import Hledger.Cli.Balancesheet import Hledger.Cli.Cashflow import Hledger.Cli.Histogram import Hledger.Cli.Incomestatement import Hledger.Cli.Print import Hledger.Cli.Register import Hledger.Cli.Stats import Hledger.Cli.Options import Hledger.Cli.Utils import Hledger.Cli.Version tests_Hledger_Cli :: Test tests_Hledger_Cli = TestList [ tests_Hledger -- ,tests_Hledger_Cli_Add -- ,tests_Hledger_Cli_Balance ,tests_Hledger_Cli_Balancesheet ,tests_Hledger_Cli_Cashflow -- ,tests_Hledger_Cli_Histogram ,tests_Hledger_Cli_Incomestatement ,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 Nothing Nothing str1 >>= either error' return j2 <- readJournal Nothing Nothing 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" ) ,"account directive should preserve \"virtual\" posting type" ~: do j <- readJournal Nothing Nothing Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ (paccount p) == "test:from" assertBool "" $ (ptype p) == VirtualPosting ] ,"account aliases" ~: do j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "equity:draw:personal:food" ,"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"] ,"journalCanonicaliseAmounts" ~: "use the greatest precision" ~: (map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] ,"commodities" ~: Map.elems (ledgerCommodities 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 j <- readJournal Nothing Nothing Nothing defaultyear_journal_str >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () ,"show dollars" ~: showAmount (dollars 1) ~?= "$1.00" ,"show hours" ~: showAmount (hours 1) ~?= "1.0h" ,"subAccounts" ~: do let l = journalToLedger Any samplejournal a = ledgerAccount l "assets" map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] ] -- fixtures/test data -- date1 = parsedate "2008/11/26" -- t1 = LocalTime date1 midday {- samplejournal = readJournal' 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="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="assets:cash", pamount=(Mixed [dollars 4.82]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="equity:opening balances", pamount=(Mixed [dollars (-4.82)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tdate=parsedate "2007/02/01", teffectivedate=Nothing, tstatus=False, tcode="*", tdescription="ayres suites", tcomment="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="expenses:vacation", pamount=(Mixed [dollars 179.92]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="assets:checking", pamount=(Mixed [dollars (-179.92)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tdate=parsedate "2007/01/02", teffectivedate=Nothing, tstatus=False, tcode="*", tdescription="auto transfer to savings", tcomment="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="assets:saving", pamount=(Mixed [dollars 200]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="assets:checking", pamount=(Mixed [dollars (-200)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tdate=parsedate "2007/01/03", teffectivedate=Nothing, tstatus=False, tcode="*", tdescription="poquito mas", tcomment="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="expenses:food:dining", pamount=(Mixed [dollars 4.82]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="assets:cash", pamount=(Mixed [dollars (-4.82)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tdate=parsedate "2007/01/03", teffectivedate=Nothing, tstatus=False, tcode="*", tdescription="verizon", tcomment="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="expenses:phone", pamount=(Mixed [dollars 95.11]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="assets:checking", pamount=(Mixed [dollars (-95.11)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } , txnTieKnot $ Transaction { tdate=parsedate "2007/01/03", teffectivedate=Nothing, tstatus=False, tcode="*", tdescription="discover", tcomment="", ttags=[], tpostings=[ Posting { pstatus=False, paccount="liabilities:credit cards:discover", pamount=(Mixed [dollars 80]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing }, Posting { pstatus=False, paccount="assets:checking", pamount=(Mixed [dollars (-80)]), pcomment="", ptype=RegularPosting, ptags=[], ptransaction=Nothing } ], tpreceding_comment_lines="" } ] [] [] "" nullctx [] (TOD 0 0) ledger7 = journalToLedger Any 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 amount