hledger 0.17 → 0.18

raw patch · 18 files changed

+460/−1219 lines, 18 filesdep +shakespeare-textdep +textdep −csvdep ~hledger-libPVP ok

version bump matches the API change (PVP)

Dependencies added: shakespeare-text, text

Dependencies removed: csv

Dependency ranges changed: hledger-lib

API changes (from Hackage documentation)

Files

• Hledger/Cli.hs +50/−387
• Hledger/Cli/Add.hs +16/−17
• Hledger/Cli/Balance.hs +22/−10
• Hledger/Cli/Balancesheet.hs +53/−0
• Hledger/Cli/Cashflow.hs +53/−0
• Hledger/Cli/Convert.hs +0/−546
• Hledger/Cli/Format.hs +0/−133
• Hledger/Cli/Histogram.hs +10/−13
• Hledger/Cli/Incomestatement.hs +44/−0
• Hledger/Cli/Main.hs +20/−7
• Hledger/Cli/Options.hs +76/−31
• Hledger/Cli/Print.hs +49/−5
• Hledger/Cli/Register.hs +14/−5
• Hledger/Cli/Stats.hs +6/−6
• Hledger/Cli/Tests.hs +21/−38
• Hledger/Cli/Utils.hs +7/−11
• Hledger/Cli/Version.hs +5/−0
• hledger.cabal +14/−10

@@ -1,13 +1,19 @@ {-| -Hledger.Cli re-exports the options, utilities and commands provided by the-hledger command-line program.++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.Convert,+                     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,@@ -17,7 +23,6 @@                      tests_Hledger_Cli               ) where-import Control.Monad import qualified Data.Map as Map import Data.Time.Calendar import System.Time (ClockTime(TOD))@@ -26,8 +31,10 @@ import Hledger import Hledger.Cli.Add import Hledger.Cli.Balance-import Hledger.Cli.Convert+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@@ -35,17 +42,17 @@ import Hledger.Cli.Utils import Hledger.Cli.Version --- | hledger and hledger-lib's unit tests aggregated from all modules--- plus some more which are easier to define here for now.+ tests_Hledger_Cli :: Test tests_Hledger_Cli = TestList  [-    tests_Hledger_Data-   ,tests_Hledger_Read+    tests_Hledger    -- ,tests_Hledger_Cli_Add    -- ,tests_Hledger_Cli_Balance-   ,tests_Hledger_Cli_Convert+   ,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@@ -53,8 +60,8 @@      ,"account directive" ~:-   let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return-                                j2 <- readJournal Nothing str2 >>= either error' return+   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    [@@ -85,7 +92,7 @@                            )     ,"account directive should preserve \"virtual\" posting type" ~: do-      j <- readJournal Nothing "!account test\n2008/12/07 One\n  (from)  $-1\n  (to)  $1\n" >>= either error' return+      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@@ -93,7 +100,7 @@    ]     ,"account aliases" ~: do-      Right j <- readJournal Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food)  1\n"+      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" @@ -103,160 +110,12 @@       "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",       "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] -  ,"balance report tests" ~:-   let opts `gives` es = do-        j <- samplejournal-        d <- getCurrentDay-        accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts d) j) `is` es-   in TestList-   [-    "balance report with no args" ~:-    defreportopts `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" ~:-    defreportopts{depth_=Just 1} `gives`-    ["                 $-1  assets"-    ,"                  $2  expenses"-    ,"                 $-2  income"-    ,"                  $1  liabilities"-    ,"--------------------"-    ,"                   0"-    ]-    -   ,"balance report with account pattern o" ~:-    defreportopts{patterns_=["o"]} `gives`-    ["                  $1  expenses:food"-    ,"                 $-2  income"-    ,"                 $-1    gifts"-    ,"                 $-1    salary"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern o and --depth 1" ~:-    defreportopts{patterns_=["o"],depth_=Just 1} `gives`-    ["                  $1  expenses"-    ,"                 $-2  income"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern a" ~:-    defreportopts{patterns_=["a"]} `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"                 $-1  income:salary"-    ,"                  $1  liabilities:debts"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with account pattern e" ~:-    defreportopts{patterns_=["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" ~: -    defreportopts{patterns_=["cash","saving"]} `gives`-    ["                 $-1  assets"-    ,"                  $1    bank:saving"-    ,"                 $-2    cash"-    ,"--------------------"-    ,"                 $-1"-    ]--   ,"balance report with multi-part account name" ~: -    defreportopts{patterns_=["expenses:food"]} `gives`-    ["                  $1  expenses:food"-    ,"--------------------"-    ,"                  $1"-    ]--   ,"balance report with negative account pattern" ~:-    defreportopts{patterns_=["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" ~: -    defreportopts{patterns_=["not:e"]} `gives`-    ["--------------------"-    ,"                   0"-    ]--   ,"balance report negative patterns affect totals" ~: -    defreportopts{patterns_=["expenses","not:food"]} `gives`-    ["                  $1  expenses:supplies"-    ,"--------------------"-    ,"                  $1"-    ]--   ,"balance report with -E shows zero-balance accounts" ~:-    defreportopts{patterns_=["assets"],empty_=True} `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-      accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j') `is`-        ["                $500  a:b"-        ,"               $-500  c:d"-        ,"--------------------"-        ,"                   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=[]}]+    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@@ -266,215 +125,17 @@   --     `is` "aa:aa:aaaaaaaaaaaaaa")    ,"default year" ~: do-    j <- readJournal Nothing defaultyear_journal_str >>= either error' return+    j <- readJournal Nothing Nothing Nothing defaultyear_journal_str >>= either error' return     tdate (head $ jtxns j) `is` fromGregorian 2009 1 1     return () -  ,"print report tests" ~: TestList-  [--   "print expenses" ~:-   do -    let opts = defreportopts{patterns_=["expenses"]}-    j <- samplejournal-    d <- getCurrentDay-    showTransactions opts (optsToFilterSpec opts d) j `is` unlines-     ["2008/06/03 * eat & shop"-     ,"    expenses:food                $1"-     ,"    expenses:supplies            $1"-     ,"    assets:cash                 $-2"-     ,""-     ]--  , "print report with depth arg" ~:-   do -    let opts = defreportopts{depth_=Just 2}-    j <- samplejournal-    d <- getCurrentDay-    showTransactions opts (optsToFilterSpec opts d) j `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 -    j <- samplejournal-    let opts = defreportopts-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `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 = defreportopts{cleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `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 = defreportopts{uncleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `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 -    j <- readJournal' $ unlines-        ["2008/02/02 a"-        ,"  b  1"-        ,"  c"-        ,""-        ,"2008/01/01 d"-        ,"  e  1"-        ,"  f"-        ]-    let opts = defreportopts-    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/02/02"]--  ,"register report with account pattern" ~:-   do-    j <- samplejournal-    let opts = defreportopts{patterns_=["cash"]}-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"register report with account pattern, case insensitive" ~:-   do -    j <- samplejournal-    let opts = defreportopts{patterns_=["cAsH"]}-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"register report with display expression" ~:-   do -    j <- samplejournal-    let gives displayexpr = -            (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is`)-                where opts = defreportopts{display_=Just 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 -    j <- samplejournal-    let periodexpr `gives` dates = do-          j' <- samplejournal-          registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j') `is` dates-              where opts = defreportopts{period_=maybePeriod date1 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 = defreportopts{period_=maybePeriod date1 "yearly"}-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `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 = defreportopts{period_=maybePeriod date1 "quarterly"}-    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}-    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]--  ]--  , "register report with depth arg" ~:-   do -    j <- samplejournal-    let opts = defreportopts{depth_=Just 2}-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `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-    j <- readJournal'-      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"-    let opts = defreportopts-    accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts date1) j) `is`-      ["                -100  актив:наличные"-      ,"                 100  расходы:покупки"-      ,"--------------------"-      ,"                   0"-      ]+  ,"show dollars" ~: showAmount (dollars 1) ~?= "$1.00" -  ,"unicode in register layout" ~: do-    j <- readJournal'-      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"-    let opts = defreportopts-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines-      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"-      ,"                                актив:наличные                 -100            0"]+  ,"show hours" ~: showAmount (hours 1) ~?= "1.0h"    ,"subAccounts" ~: do-    l <- liftM (journalToLedger nullfilterspec) samplejournal-    let a = ledgerAccount l "assets"+    let l = journalToLedger Any samplejournal+        a = ledgerAccount l "assets"     map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]   ]@@ -482,9 +143,10 @@    -- fixtures/test data -date1 = parsedate "2008/11/26"+-- date1 = parsedate "2008/11/26" -- t1 = LocalTime date1 midday +{- samplejournal = readJournal' sample_journal_str  sample_journal_str = unlines@@ -529,6 +191,7 @@  ,""  ,";final comment"  ]+-}  defaultyear_journal_str = unlines  ["Y2009"@@ -690,7 +353,7 @@              tcode="*",              tdescription="opening balance",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -698,7 +361,7 @@                 pamount=(Mixed [dollars 4.82]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -707,7 +370,7 @@                 pamount=(Mixed [dollars (-4.82)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -721,7 +384,7 @@              tcode="*",              tdescription="ayres suites",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -729,7 +392,7 @@                 pamount=(Mixed [dollars 179.92]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -738,7 +401,7 @@                 pamount=(Mixed [dollars (-179.92)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -752,7 +415,7 @@              tcode="*",              tdescription="auto transfer to savings",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -760,7 +423,7 @@                 pamount=(Mixed [dollars 200]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -769,7 +432,7 @@                 pamount=(Mixed [dollars (-200)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -783,7 +446,7 @@              tcode="*",              tdescription="poquito mas",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -791,7 +454,7 @@                 pamount=(Mixed [dollars 4.82]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -800,7 +463,7 @@                 pamount=(Mixed [dollars (-4.82)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -814,7 +477,7 @@              tcode="*",              tdescription="verizon",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -822,7 +485,7 @@                 pamount=(Mixed [dollars 95.11]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -831,7 +494,7 @@                 pamount=(Mixed [dollars (-95.11)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -845,7 +508,7 @@              tcode="*",              tdescription="discover",              tcomment="",-             tmetadata=[],+             ttags=[],              tpostings=[               Posting {                 pstatus=False,@@ -853,7 +516,7 @@                 pamount=(Mixed [dollars 80]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               },               Posting {@@ -862,7 +525,7 @@                 pamount=(Mixed [dollars (-80)]),                 pcomment="",                 ptype=RegularPosting,-                pmetadata=[],+                ptags=[],                 ptransaction=Nothing               }              ],@@ -876,7 +539,7 @@           []           (TOD 0 0) -ledger7 = journalToLedger nullfilterspec journal7+ledger7 = journalToLedger Any journal7  -- journal8_str = unlines --  ["2008/1/1 test           "@@ -907,4 +570,4 @@         nullctx         []         (TOD 0 0)-    where parse = fromparse . parseWithCtx nullctx someamount+    where parse = fromparse . parseWithCtx nullctx amount

@@ -10,7 +10,7 @@  module Hledger.Cli.Add where-import Control.Exception (throw)+import Control.Exception as C import Control.Monad import Control.Monad.Trans (liftIO) import Data.Char (toUpper)@@ -29,10 +29,9 @@  import Hledger import Prelude hiding (putStr, putStrLn, appendFile)-import Hledger.Utils.UTF8 (putStr, putStrLn, appendFile)+import Hledger.Utils.UTF8IOCompat (putStr, putStrLn, appendFile) import Hledger.Cli.Options import Hledger.Cli.Register (postingsReportAsText)-import Hledger.Cli.Utils   {- | Information used as the basis for suggested account names, amounts,@@ -57,7 +56,7 @@     ++"To stop adding transactions, enter . at a date prompt, or control-d/control-c."   today <- getCurrentDay   getAndAddTransactions j opts today-        `catch` (\e -> unless (isEOFError e) $ ioError e)+        `C.catch` (\e -> unless (isEOFError e) $ ioError e)       where f = journalFilePath j  -- | Read a number of transactions from the command line, prompting,@@ -82,7 +81,7 @@                          || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))   when (datestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing   description <- runInteractionDefault $ askFor "description" (Just "") Nothing-  let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description+  let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description       bestmatch | null historymatches = Nothing                 | otherwise = Just $ snd $ head historymatches       bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch@@ -150,16 +149,16 @@                 -- I think 1 or 4, whichever would show the most decimal places                 p = maxprecisionwithpoint       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+      let a  = fromparse $ runParser (amount <|> return missingmixedamt) ctx     "" amountstr+          a' = fromparse $ runParser (amount <|> return missingmixedamt) nullctx "" amountstr+          defaultamtused = Just (showMixedAmount a) == defaultamountstr           commodityadded | c == cwithnodef = Nothing                          | otherwise       = c-              where c          = maybemixedamountcommodity amount-                    cwithnodef = maybemixedamountcommodity amount'+              where c          = maybemixedamountcommodity a+                    cwithnodef = maybemixedamountcommodity a'                     maybemixedamountcommodity = maybe Nothing (Just . commodity) . headMay . amounts           p = nullposting{paccount=stripbrackets account,-                          pamount=amount,+                          pamount=a,                           ptype=postingtype account}           st' = if defaultamtused then st                    else st{psHistory = historicalps',@@ -181,7 +180,7 @@       postingtype _ = RegularPosting       stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse       validateamount = Just $ \s -> (null s && not (null enteredrealps))-                                   || isRight (runParser (someamount>>many spacenonewline>>eof) ctx "" s)+                                   || isRight (runParser (amount>>many spacenonewline>>eof) ctx "" s)  -- | Prompt for and read a string value, optionally with a default value -- and a validator. A validator causes the prompt to repeat until the@@ -198,7 +197,7 @@     Nothing -> return input     where         showdef s = " [" ++ s ++ "]"-        eofErr = throw $ mkIOError eofErrorType "end of input" Nothing Nothing+        eofErr = C.throw $ mkIOError eofErrorType "end of input" Nothing Nothing  -- | Append this transaction to the journal's file, and to the journal's -- transaction list.@@ -229,7 +228,7 @@ registerFromString s = do   d <- getCurrentDay   j <- readJournal' s-  return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts d) j+  return $ postingsReportAsText opts $ postingsReport opts (queryFromOpts d opts) j       where opts = defreportopts{empty_=True}  -- | Return a similarity measure, from 0 to 1, for two strings.@@ -257,14 +256,14 @@           t' = simplify t           simplify = filter (not . (`elem` "0123456789")) -transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)]-transactionsSimilarTo j apats s =+transactionsSimilarTo :: Journal -> Query -> String -> [(Double,Transaction)]+transactionsSimilarTo j q s =     sortBy compareRelevanceAndRecency                $ filter ((> threshold).fst)                [(compareDescriptions s $ tdescription t, t) | t <- ts]     where       compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)-      ts = jtxns $ filterJournalTransactionsByAccount apats j+      ts = filter (q `matchesTransaction`) $ jtxns j       threshold = 0  runInteraction :: Journal -> InputT IO a -> IO a

@@ -105,9 +105,8 @@  import Hledger import Prelude hiding (putStr)-import Hledger.Utils.UTF8 (putStr)-import Hledger.Cli.Format-import qualified Hledger.Cli.Format as Format+import Hledger.Utils.UTF8IOCompat (putStr)+import Hledger.Data.FormatStrings import Hledger.Cli.Options  @@ -117,7 +116,7 @@   d <- getCurrentDay   let lines = case formatFromOpts ropts of             Left err -> [err]-            Right _ -> accountsReportAsText ropts $ accountsReport ropts (optsToFilterSpec ropts d) j+            Right _ -> accountsReportAsText ropts $ accountsReport ropts (queryFromOpts d ropts) j   putStr $ unlines lines  -- | Render a balance report as plain text suitable for console output.@@ -134,6 +133,20 @@                 ,padleft 20 $ showMixedAmountWithoutPrice total                 ] +tests_accountsReportAsText = [+  "accountsReportAsText" ~: do+  -- "unicode in balance layout" ~: do+    j <- readJournal'+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    let opts = defreportopts+    accountsReportAsText opts (accountsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`+      ["                -100  актив:наличные"+      ,"                 100  расходы:покупки"+      ,"--------------------"+      ,"                   0"+      ]+ ]+ {- This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -170,15 +183,14 @@          FormatLiteral l -> l          FormatField ljust min max field  -> formatField opts accountName depth amount ljust min max field -formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String+formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String formatField opts accountName depth total ljust min max field = case field of-        Format.Account     -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName-        Format.DepthSpacer -> case min of+        AccountField     -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName+        DepthSpacerField -> case min of                                Just m  -> formatValue ljust Nothing max $ replicate (depth * m) ' '                                Nothing -> formatValue ljust Nothing max $ replicate depth ' '-        Format.Total       -> formatValue ljust min max $ showAmountWithoutPrice total+        TotalField       -> formatValue ljust min max $ showAmountWithoutPrice total         _                  -> ""  tests_Hledger_Cli_Balance = TestList- [- ]+  tests_accountsReportAsText

@@ -0,0 +1,53 @@+{-# LANGUAGE QuasiQuotes, RecordWildCards #-}+{-|++The @balancesheet@ command prints a simple balance sheet.++-}++module Hledger.Cli.Balancesheet (+  balancesheet+ ,tests_Hledger_Cli_Balancesheet+) where++import qualified Data.Text.Lazy.IO as LT+import Test.HUnit+import Text.Shakespeare.Text++import Hledger+import Hledger.Cli.Options+import Hledger.Cli.Balance+++-- | Print a simple balance sheet.+balancesheet :: CliOpts -> Journal -> IO ()+balancesheet CliOpts{reportopts_=ropts} j = do+  -- let lines = case formatFromOpts ropts of Left err, Right ...+  d <- getCurrentDay+  let q = queryFromOpts d (withoutBeginDate ropts)+      assetreport@(_,assets)          = accountsReport ropts (And [q, journalAssetAccountQuery j]) j+      liabilityreport@(_,liabilities) = accountsReport ropts (And [q, journalLiabilityAccountQuery j]) j+      equityreport@(_,equity)         = accountsReport ropts (And [q, journalEquityAccountQuery j]) j+      total = assets + liabilities + equity+  LT.putStr $ [lt|Balance Sheet++Assets:+#{unlines $ accountsReportAsText ropts assetreport}+Liabilities:+#{unlines $ accountsReportAsText ropts liabilityreport}+Equity:+#{unlines $ accountsReportAsText ropts equityreport}++Total:+--------------------+#{padleft 20 $ showMixedAmountWithoutPrice total}+|]++withoutBeginDate :: ReportOpts -> ReportOpts+withoutBeginDate ropts@ReportOpts{..} = ropts{begin_=Nothing, period_=p}+  where p = case period_ of Nothing -> Nothing+                            Just (i, DateSpan _ e) -> Just (i, DateSpan Nothing e)++tests_Hledger_Cli_Balancesheet = TestList+ [+ ]

@@ -0,0 +1,53 @@+{-# LANGUAGE QuasiQuotes, RecordWildCards #-}+{-|++The @cashflow@ command prints a simplified cashflow statement.  It just+shows the change in all "cash" accounts for the period (without the+traditional segmentation into operating, investing, and financing+cash flows.)++-}++module Hledger.Cli.Cashflow (+  cashflow+ ,tests_Hledger_Cli_Cashflow+) where++import qualified Data.Text.Lazy.IO as LT+import Test.HUnit+import Text.Shakespeare.Text++import Hledger+import Hledger.Cli.Options+import Hledger.Cli.Balance+++-- | Print a simple cashflow statement.+cashflow :: CliOpts -> Journal -> IO ()+cashflow CliOpts{reportopts_=ropts} j = do+  -- let lines = case formatFromOpts ropts of Left err, Right ...+  d <- getCurrentDay+  let q = queryFromOpts d (withoutBeginDate ropts)+      cashreport@(_,total) = accountsReport ropts (And [q, journalCashAccountQuery j]) j+      -- operatingreport@(_,operating) = accountsReport ropts (And [q, journalOperatingAccountMatcher j]) j+      -- investingreport@(_,investing) = accountsReport ropts (And [q, journalInvestingAccountMatcher j]) j+      -- financingreport@(_,financing) = accountsReport ropts (And [q, journalFinancingAccountMatcher j]) j+      -- total = operating + investing + financing+  LT.putStr $ [lt|Cashflow Statement++Cash flows:+#{unlines $ accountsReportAsText ropts cashreport}++Total:+--------------------+#{padleft 20 $ showMixedAmountWithoutPrice total}+|]++withoutBeginDate :: ReportOpts -> ReportOpts+withoutBeginDate ropts@ReportOpts{..} = ropts{begin_=Nothing, period_=p}+  where p = case period_ of Nothing -> Nothing+                            Just (i, DateSpan _ e) -> Just (i, DateSpan Nothing e)++tests_Hledger_Cli_Cashflow = TestList+ [+ ]

@@ -1,546 +0,0 @@-{-|-Convert account data in CSV format (eg downloaded from a bank) to journal-format, and print it on stdout. See the manual for more details.--}--module Hledger.Cli.Convert where-import Control.Monad (when, guard, liftM)-import Data.List-import Data.Maybe-import Data.Ord-import Data.Time.Format (parseTime)-import Safe-import System.Directory (doesFileExist)-import System.Exit (exitFailure)-import System.FilePath (takeBaseName, replaceExtension)-import System.IO (stderr)-import System.Locale (defaultTimeLocale)-import Test.HUnit-import Text.CSV (parseCSV, parseCSVFromFile, CSV)-import Text.ParserCombinators.Parsec-import Text.Printf (hPrintf)--import Prelude hiding (getContents)-import Hledger.Utils.UTF8 (getContents)-import Hledger-import Hledger.Cli.Format-import qualified Hledger.Cli.Format as Format-import Hledger.Cli.Options-import Hledger.Cli.Version--{- |-A set of data definitions and account-matching patterns sufficient to-convert a particular CSV data file into meaningful journal transactions. See above.--}-data CsvRules = CsvRules {-      dateField :: Maybe FieldPosition,-      dateFormat :: Maybe String,-      statusField :: Maybe FieldPosition,-      codeField :: Maybe FieldPosition,-      descriptionField :: [FormatString],-      amountField :: Maybe FieldPosition,-      amountInField :: Maybe FieldPosition,-      amountOutField :: Maybe FieldPosition,-      currencyField :: Maybe FieldPosition,-      baseCurrency :: Maybe String,-      accountField :: Maybe FieldPosition,-      account2Field :: Maybe FieldPosition,-      effectiveDateField :: Maybe FieldPosition,-      baseAccount :: AccountName,-      accountRules :: [AccountRule]-} deriving (Show, Eq)--nullrules = CsvRules {-      dateField=Nothing,-      dateFormat=Nothing,-      statusField=Nothing,-      codeField=Nothing,-      descriptionField=[],-      amountField=Nothing,-      amountInField=Nothing,-      amountOutField=Nothing,-      currencyField=Nothing,-      baseCurrency=Nothing,-      accountField=Nothing,-      account2Field=Nothing,-      effectiveDateField=Nothing,-      baseAccount="unknown",-      accountRules=[]-}--type FieldPosition = Int--type AccountRule = (-   [(String, Maybe String)] -- list of regex match patterns with optional replacements-  ,AccountName              -- account name to use for a transaction matching this rule-  )--type CsvRecord = [String]----- | Read the CSV file named as an argument and print equivalent journal transactions,--- using/creating a .rules file.-convert :: CliOpts -> IO ()-convert opts = do-  let csvfile = case headDef "" $ patterns_ $ reportopts_ opts of-                  "" -> "-"-                  s -> s-      usingStdin = csvfile == "-"-      rulesFileSpecified = isJust $ rules_file_ opts-      rulesfile = rulesFileFor opts csvfile-  when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin"-  csvparse <- parseCsv csvfile-  let records = case csvparse of-                  Left e -> error' $ show e-                  Right rs -> filter (/= [""]) rs-  exists <- doesFileExist rulesfile-  if (not exists) then do-                  hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile-                  writeFile rulesfile initialRulesFileContent-   else-      hPrintf stderr "using conversion rules file %s\n" rulesfile-  rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile-  let invalid = validateRules rules-  when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)-  when (isJust invalid) $ error (fromJust invalid)-  let requiredfields = max 2 (maxFieldIndex rules + 1)-      badrecords = take 1 $ filter ((< requiredfields).length) records-  if null badrecords-   then do-     mapM_ (putStr . show) $ sortBy (comparing tdate) $ map (transactionFromCsvRecord rules) records-   else do-     hPrintf stderr (unlines [-                      "Warning, at least one CSV record does not contain a field referenced by the"-                     ,"conversion rules file, or has less than two fields. Are you converting a"-                     ,"valid CSV file ? First bad record:\n%s"-                     ]) (show $ head badrecords)-     exitFailure--parseCsv :: FilePath -> IO (Either ParseError CSV)-parseCsv path =-  case path of-    "-" -> liftM (parseCSV "(stdin)") getContents-    p   -> parseCSVFromFile p---- | The highest (0-based) field index referenced in the field--- definitions, or -1 if no fields are defined.-maxFieldIndex :: CsvRules -> Int-maxFieldIndex r = maximumDef (-1) $ catMaybes [-                   dateField r-                  ,statusField r-                  ,codeField r-                  ,amountField r-                  ,amountInField r-                  ,amountOutField r-                  ,currencyField r-                  ,accountField r-                  ,account2Field r-                  ,effectiveDateField r-                  ]--rulesFileFor :: CliOpts -> FilePath -> FilePath-rulesFileFor CliOpts{rules_file_=Just f} _ = f-rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules"--initialRulesFileContent :: String-initialRulesFileContent =-    "# csv conversion rules file generated by " ++ prognameandversion ++ "\n" ++-    "# Add rules to this file for more accurate conversion, see\n"++-    "# http://hledger.org/MANUAL.html#convert\n" ++-    "\n" ++-    "base-account assets:bank:checking\n" ++-    "date-field 0\n" ++-    "description-field 4\n" ++-    "amount-field 1\n" ++-    "base-currency $\n" ++-    "\n" ++-    "# account-assigning rules\n" ++-    "\n" ++-    "SPECTRUM\n" ++-    "expenses:health:gym\n" ++-    "\n" ++-    "ITUNES\n" ++-    "BLKBSTR=BLOCKBUSTER\n" ++-    "expenses:entertainment\n" ++-    "\n" ++-    "(TO|FROM) SAVINGS\n" ++-    "assets:bank:savings\n"--validateRules :: CsvRules -> Maybe String-validateRules rules = let-    hasAmount = isJust $ amountField rules-    hasIn = isJust $ amountInField rules-    hasOut = isJust $ amountOutField rules-  in case (hasAmount, hasIn, hasOut) of-    (True, True, _) -> Just "Don't specify amount-in-field when specifying amount-field"-    (True, _, True) -> Just "Don't specify amount-out-field when specifying amount-field"-    (_, False, True) -> Just "Please specify amount-in-field when specifying amount-out-field"-    (_, True, False) -> Just "Please specify amount-out-field when specifying amount-in-field"-    (False, False, False) -> Just "Please specify either amount-field, or amount-in-field and amount-out-field"-    _ -> Nothing---- rules file parser--parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)-parseCsvRulesFile f = do-  s <- readFile f-  return $ parseCsvRules f s--parseCsvRules :: FilePath -> String -> Either ParseError CsvRules-parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s--csvrulesfile :: GenParser Char CsvRules CsvRules-csvrulesfile = do-  many blankorcommentline-  many definitions-  r <- getState-  ars <- many accountrule-  many blankorcommentline-  eof-  return r{accountRules=ars}--definitions :: GenParser Char CsvRules ()-definitions = do-  choice' [-    datefield-   ,dateformat-   ,statusfield-   ,codefield-   ,descriptionfield-   ,amountfield-   ,amountinfield-   ,amountoutfield-   ,currencyfield-   ,accountfield-   ,account2field-   ,effectivedatefield-   ,basecurrency-   ,baseaccount-   ,commentline-   ] <?> "definition"-  return ()--datefield = do-  string "date-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{dateField=readMay v})--effectivedatefield = do-  string "effective-date-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{effectiveDateField=readMay v})--dateformat = do-  string "date-format"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{dateFormat=Just v})--codefield = do-  string "code-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{codeField=readMay v})--statusfield = do-  string "status-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{statusField=readMay v})--descriptionFieldValue :: GenParser Char st [FormatString]-descriptionFieldValue = do---      try (fieldNo <* spacenonewline)-      try fieldNo-  <|> formatStrings-  where-    fieldNo = many1 digit >>= \x -> return [FormatField False Nothing Nothing $ FieldNo $ read x]--descriptionfield = do-  string "description-field"-  many1 spacenonewline-  formatS <- descriptionFieldValue-  restofline-  updateState (\x -> x{descriptionField=formatS})--amountfield = do-  string "amount-field"-  many1 spacenonewline-  v <- restofline-  x <- updateState (\r -> r{amountField=readMay v})-  return x--amountinfield = do-  choice [string "amount-in-field", string "in-field"]-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{amountInField=readMay v})--amountoutfield = do-  choice [string "amount-out-field", string "out-field"]-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{amountOutField=readMay v})--currencyfield = do-  string "currency-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{currencyField=readMay v})--accountfield = do-  string "account-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{accountField=readMay v})--account2field = do-  string "account2-field"-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{account2Field=readMay v})--basecurrency = do-  choice [string "base-currency", string "currency"]-  many1 spacenonewline-  v <- restofline-  updateState (\r -> r{baseCurrency=Just v})--baseaccount = do-  string "base-account"-  many1 spacenonewline-  v <- ledgeraccountname-  optional newline-  updateState (\r -> r{baseAccount=v})--accountrule :: GenParser Char CsvRules AccountRule-accountrule = do-  many blankorcommentline-  pats <- many1 matchreplacepattern-  guard $ length pats >= 2-  let pats' = init pats-      acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats-  many blankorcommentline-  return (pats',acct)- <?> "account rule"--blanklines = many1 blankline--blankline = many spacenonewline >> newline >> return () <?> "blank line"--commentchar = oneOf ";#"--commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"--blankorcommentline = choice' [blankline, commentline]--matchreplacepattern = do-  notFollowedBy commentchar-  matchpat <- many1 (noneOf "=\n")-  replpat <- optionMaybe $ do {char '='; many $ noneOf "\n"}-  newline-  return (matchpat,replpat)---- csv record conversion-formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> Field -> String-formatD record leftJustified min max f = case f of -  FieldNo n       -> maybe "" show $ atMay record n-  -- Some of these might in theory in read from fields-  Format.Account  -> ""-  DepthSpacer     -> ""-  Total           -> ""-  DefaultDate     -> ""-  Description     -> ""- where-   show = formatValue leftJustified min max--formatDescription :: CsvRecord -> [FormatString] -> String-formatDescription _ [] = ""-formatDescription record (f:fs) = s ++ (formatDescription record fs)-  where s = case f of-                FormatLiteral l -> l-                FormatField leftJustified min max field  -> formatD record leftJustified min max field--transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction-transactionFromCsvRecord rules fields =-  let -      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 = formatDescription fields (descriptionField rules)-      comment = ""-      precomment = ""-      baseacc = maybe (baseAccount rules) (atDef "" fields) (accountField rules)-      amountstr = getAmount rules fields-      amountstr' = strnegate amountstr where strnegate ('-':s) = s-                                             strnegate s = '-':s-      currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)-      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-      acct = maybe acct' (atDef "" fields) (account2Field rules)-      t = Transaction {-              tdate=date,-              teffectivedate=effectivedate,-              tstatus=status,-              tcode=code,-              tdescription=newdesc,-              tcomment=comment,-              tpreceding_comment_lines=precomment,-              tmetadata=[],-              tpostings=[-                   Posting {-                     pstatus=False,-                     paccount=acct,-                     pamount=amount,-                     pcomment="",-                     ptype=RegularPosting,-                     pmetadata=[],-                     ptransaction=Just t-                   },-                   Posting {-                     pstatus=False,-                     paccount=baseacc,-                     pamount=(-baseamount),-                     pcomment="",-                     ptype=RegularPosting,-                     pmetadata=[],-                     ptransaction=Just t-                   }-                  ]-            }-  in t---- | Convert some date string with unknown format to YYYY/MM/DD.-normaliseDate :: Maybe String -- ^ User-supplied date format: this should be tried in preference to all others-              -> String -> String-normaliseDate mb_user_format s =-    let parsewith = flip (parseTime defaultTimeLocale) s in-    maybe (error' $ "could not parse \""++s++"\" as a date, consider adding a date-format directive or upgrading")-          showDate $-          firstJust $ (map parsewith $-                       maybe [] (:[]) mb_user_format-                       -- the - modifier requires time-1.2.0.5, released-                       -- in 2011/5, so for now we emulate it for wider-                       -- compatibility.  time < 1.2.0.5 also has a buggy-                       -- %y which we don't do anything about.-                       -- ++ [-                       -- "%Y/%m/%d"-                       -- ,"%Y/%-m/%-d"-                       -- ,"%Y-%m-%d"-                       -- ,"%Y-%-m-%-d"-                       -- ,"%m/%d/%Y"-                       -- ,"%-m/%-d/%Y"-                       -- ,"%m-%d-%Y"-                       -- ,"%-m-%-d-%Y"-                       -- ]-                      )-                      ++ [-                       parseTime defaultTimeLocale "%Y/%m/%e" s-                      ,parseTime defaultTimeLocale "%Y-%m-%e" s-                      ,parseTime defaultTimeLocale "%m/%e/%Y" s-                      ,parseTime defaultTimeLocale "%m-%e-%Y" s-                      ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)-                      ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)-                      ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)-                      ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)-                      ]---- | Apply account matching rules to a transaction description to obtain--- the most appropriate account and a new description.-identify :: [AccountRule] -> String -> String -> (String,String)-identify rules defacct desc | null matchingrules = (defacct,desc)-                            | otherwise = (acct,newdesc)-    where-      matchingrules = filter ismatch rules :: [AccountRule]-          where ismatch = any ((`regexMatchesCI` desc) . fst) . fst-      (prs,acct) = head matchingrules-      p_ms_r = filter (\(_,m,_) -> m) $ map (\(p,r) -> (p, p `regexMatchesCI` desc, r)) prs-      (p,_,r) = head p_ms_r-      newdesc = case r of Just repl -> regexReplaceCI p repl desc-                          Nothing   -> desc--caseinsensitive = ("(?i)"++)--getAmount :: CsvRules -> CsvRecord -> String-getAmount rules fields = case amountField rules of-  Just f  -> maybe "" (atDef "" fields) $ Just f-  Nothing ->-    case (i, o) of-      (x, "") -> x-      ("", x) -> "-"++x-      p -> error' $ "using amount-in-field and amount-out-field, found a value in both fields: "++show p-    where-      i = maybe "" (atDef "" fields) (amountInField rules)-      o = maybe "" (atDef "" fields) (amountOutField rules)--tests_Hledger_Cli_Convert = TestList (test_parser ++ test_description_parsing)--test_description_parsing = [-      "description-field 1" ~: assertParseDescription "description-field 1\n" [FormatField False Nothing Nothing (FieldNo 1)]-    , "description-field 1 " ~: assertParseDescription "description-field 1 \n" [FormatField False Nothing Nothing (FieldNo 1)]-    , "description-field %(1)" ~: assertParseDescription "description-field %(1)\n" [FormatField False Nothing Nothing (FieldNo 1)]-    , "description-field %(1)/$(2)" ~: assertParseDescription "description-field %(1)/%(2)\n" [-          FormatField False Nothing Nothing (FieldNo 1)-        , FormatLiteral "/"-        , FormatField False Nothing Nothing (FieldNo 2)-        ]-    ]-  where-    assertParseDescription string expected = do assertParseEqual (parseDescription string) (nullrules {descriptionField = expected})-    parseDescription :: String -> Either ParseError CsvRules-    parseDescription x = runParser descriptionfieldWrapper nullrules "(unknown)" x-    descriptionfieldWrapper :: GenParser Char CsvRules CsvRules-    descriptionfieldWrapper = do-      descriptionfield-      r <- getState-      return r--test_parser =  [--   "convert rules parsing: empty file" ~: do-     -- let assertMixedAmountParse parseresult mixedamount =-     --         (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)-    assertParseEqual (parseCsvRules "unknown" "") nullrules--  ,"convert rules parsing: accountrule" ~: do-     assertParseEqual (parseWithCtx nullrules accountrule "A\na\n") -- leading blank line required-                 ([("A",Nothing)], "a")--  ,"convert rules parsing: trailing comments" ~: do-     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#\n")--  ,"convert rules parsing: trailing blank lines" ~: do-     assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  \n")--  -- not supported-  -- ,"convert rules parsing: no final newline" ~: do-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na")-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#")-  --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  ")--                 -- (nullrules{-                 --   -- dateField=Maybe FieldPosition,-                 --   -- statusField=Maybe FieldPosition,-                 --   -- codeField=Maybe FieldPosition,-                 --   -- descriptionField=Maybe FieldPosition,-                 --   -- amountField=Maybe FieldPosition,-                 --   -- currencyField=Maybe FieldPosition,-                 --   -- baseCurrency=Maybe String,-                 --   -- baseAccount=AccountName,-                 --   accountRules=[-                 --        ([("A",Nothing)], "a")-                 --       ]-                 --  })--  ]

@@ -1,133 +0,0 @@-module Hledger.Cli.Format (-          parseFormatString-        , formatStrings-        , formatValue-        , FormatString(..)-        , Field(..)-        , tests-        ) where--import Numeric-import Data.Char (isPrint)-import Data.Maybe-import Test.HUnit-import Text.ParserCombinators.Parsec-import Text.Printf---data Field =-    Account-  | DefaultDate-  | Description-  | Total-  | DepthSpacer-  | FieldNo Int-    deriving (Show, Eq)--data FormatString =-    FormatLiteral String-  | FormatField Bool        -- Left justified ?-                (Maybe Int) -- Min width-                (Maybe Int) -- Max width-                Field       -- Field-  deriving (Show, Eq)--formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String-formatValue leftJustified min max value = printf formatS value-    where-      l = if leftJustified then "-" else ""-      min' = maybe "" show min-      max' = maybe "" (\i -> "." ++ (show i)) max-      formatS = "%" ++ l ++ min' ++ max' ++ "s"--parseFormatString :: String -> Either String [FormatString]-parseFormatString input = case (runParser formatStrings () "(unknown)") input of-    Left y -> Left $ show y-    Right x -> Right x--{--Parsers--}--field :: GenParser Char st Field-field = do-        try (string "account" >> return Account)-    <|> try (string "depth_spacer" >> return DepthSpacer)-    <|> try (string "date" >> return Description)-    <|> try (string "description" >> return Description)-    <|> try (string "total" >> return Total)-    <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))--formatField :: GenParser Char st FormatString-formatField = do-    char '%'-    leftJustified <- optionMaybe (char '-')-    minWidth <- optionMaybe (many1 $ digit)-    maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit)-    char '('-    f <- field-    char ')'-    return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f-    where-      parseDec s = case s of-        Just text -> Just m where ((m,_):_) = readDec text-        _ -> Nothing--formatLiteral :: GenParser Char st FormatString-formatLiteral = do-    s <- many1 c-    return $ FormatLiteral s-    where-      isPrintableButNotPercentage x = isPrint x && (not $ x == '%')-      c =     (satisfy isPrintableButNotPercentage <?> "printable character")-          <|> try (string "%%" >> return '%')--formatString :: GenParser Char st FormatString-formatString =-        formatField-    <|> formatLiteral--formatStrings :: GenParser Char st [FormatString]-formatStrings = many formatString--testFormat :: FormatString -> String -> String -> Assertion-testFormat fs value expected = assertEqual name expected actual-    where-        (name, actual) = case fs of-            FormatLiteral l -> ("literal", formatValue False Nothing Nothing l)-            FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)--testParser :: String -> [FormatString] -> Assertion-testParser s expected = case (parseFormatString s) of-    Left  error -> assertFailure $ show error-    Right actual -> assertEqual ("Input: " ++ s) expected actual--tests = test [ formattingTests ++ parserTests ]--formattingTests = [-      testFormat (FormatLiteral " ")                                ""            " "-    , testFormat (FormatField False Nothing Nothing Description)    "description" "description"-    , testFormat (FormatField False (Just 20) Nothing Description)  "description" "         description"-    , testFormat (FormatField False Nothing (Just 20) Description)  "description" "description"-    , testFormat (FormatField True Nothing (Just 20) Description)   "description" "description"-    , testFormat (FormatField True (Just 20) Nothing Description)   "description" "description         "-    , testFormat (FormatField True (Just 20) (Just 20) Description) "description" "description         "-    , testFormat (FormatField True Nothing (Just 3) Description)    "description" "des"-    ]--parserTests = [-      testParser ""                             []-    , testParser "D"                            [FormatLiteral "D"]-    , testParser "%(date)"                      [FormatField False Nothing Nothing Description]-    , testParser "%(total)"                     [FormatField False Nothing Nothing Total]-    , testParser "Hello %(date)!"               [FormatLiteral "Hello ", FormatField False Nothing Nothing Description, FormatLiteral "!"]-    , testParser "%-(date)"                     [FormatField True Nothing Nothing Description]-    , testParser "%20(date)"                    [FormatField False (Just 20) Nothing Description]-    , testParser "%.10(date)"                   [FormatField False Nothing (Just 10) Description]-    , testParser "%20.10(date)"                 [FormatField False (Just 20) (Just 10) Description]-    , testParser "%20(account) %.10(total)\n"   [ FormatField False (Just 20) Nothing Account-                                                , FormatLiteral " "-                                                , FormatField False Nothing (Just 10) Total-                                                , FormatLiteral "\n"-                                                ]-  ]

@@ -14,8 +14,9 @@ import Hledger.Cli.Options import Hledger.Data import Hledger.Reports+import Hledger.Query import Prelude hiding (putStr)-import Hledger.Utils.UTF8 (putStr)+import Hledger.Utils.UTF8IOCompat (putStr)   barchar = '*'@@ -23,30 +24,26 @@ -- | Print a histogram of some statistic per reporting interval, such as -- number of postings per day. histogram :: CliOpts -> Journal -> IO ()-histogram CliOpts{reportopts_=reportopts_} j = do+histogram CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay-  putStr $ showHistogram reportopts_ (optsToFilterSpec reportopts_ d) j+  putStr $ showHistogram ropts (queryFromOpts d ropts) j -showHistogram :: ReportOpts -> FilterSpec -> Journal -> String-showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps+showHistogram :: ReportOpts -> Query -> Journal -> String+showHistogram opts q j = concatMap (printDayWith countBar) spanps     where       i = intervalFromOpts opts       interval | i == NoInterval = Days 1                | otherwise = i-      span = datespan filterspec `orDatesFrom` journalDateSpan j+      span = queryDateSpan (effective_ opts) q `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+      -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j+      ps = sortBy (comparing postingDate) $ filterempties $ filter (q `matchesPosting`) $ journalPostings j       filterempties-          | empty_ opts = id+          | queryEmpty q = id           | otherwise = filter (not . isZeroMixedAmount . pamount)-      matchapats = matchpats apats . paccount-      apats = acctpats filterspec-      filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)-                  | otherwise = id-      depth = fromMaybe 99999 $ depth_ opts  printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) 

@@ -0,0 +1,44 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}+{-|++The @incomestatement@ command prints a simple income statement (profit & loss) report.++-}++module Hledger.Cli.Incomestatement (+  incomestatement+ ,tests_Hledger_Cli_Incomestatement+) where++import qualified Data.Text.Lazy.IO as LT+import Test.HUnit+import Text.Shakespeare.Text++import Hledger+import Hledger.Cli.Options+import Hledger.Cli.Balance++-- | Print a simple income statement.+incomestatement :: CliOpts -> Journal -> IO ()+incomestatement CliOpts{reportopts_=ropts} j = do+  d <- getCurrentDay+  let q = queryFromOpts d ropts+      incomereport@(_,income)    = accountsReport ropts (And [q, journalIncomeAccountQuery j]) j+      expensereport@(_,expenses) = accountsReport ropts (And [q, journalExpenseAccountQuery j]) j+      total = income + expenses+  LT.putStr $ [lt|Income Statement++Revenues:+#{unlines $ accountsReportAsText ropts incomereport}+Expenses:+#{unlines $ accountsReportAsText ropts expensereport}++Total:+--------------------+#{padleft 20 $ showMixedAmountWithoutPrice total}+|]++tests_Hledger_Cli_Incomestatement :: Test+tests_Hledger_Cli_Incomestatement = TestList+ [+ ]

@@ -19,7 +19,7 @@ or ghci:  > $ ghci hledger-> > j <- readJournalFile "data/sample.journal"+> > j <- readJournalFile Nothing Nothing "data/sample.journal" > > register [] ["income","expenses"] j > 2008/01/01 income               income:salary                   $-1          $-1 > 2008/06/01 gift                 income:gifts                    $-1          $-2@@ -46,11 +46,13 @@ import System.Process import Text.Printf -import Hledger (ensureJournalFile)+import Hledger (ensureJournalFileExists) import Hledger.Cli.Add import Hledger.Cli.Balance-import Hledger.Cli.Convert+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@@ -59,13 +61,21 @@ import Hledger.Cli.Utils import Hledger.Cli.Version import Hledger.Utils+import Hledger.Reports+import Hledger.Data.Dates  main :: IO () main = do   args <- getArgs   addons <- getHledgerAddonCommands   opts <- getHledgerCliOpts addons-  when (debug_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)+  when (debug_ opts) $ do+    printf "%s\n" prognameandversion+    printf "args: %s\n" (show args)+    printf "opts: %s\n" (show opts)+    d <- getCurrentDay+    printf "query: %s\n" (show $ queryFromOpts d $ reportopts_ opts)+   run' opts addons args     where       run' opts@CliOpts{command_=cmd} addons args@@ -73,17 +83,20 @@        | (null matchedaddon) && "version" `in_` (rawopts_ opts)         = putStrLn prognameandversion        | (null matchedaddon) && "binary-filename" `in_` (rawopts_ opts) = putStrLn $ binaryfilename progname        | null cmd                                        = putStr $ showModeHelp mainmode'-       | cmd `isPrefixOf` "add"                          = showModeHelpOr addmode      $ journalFilePathFromOpts opts >>= ensureJournalFile >> withJournalDo opts add-       | cmd `isPrefixOf` "convert"                      = showModeHelpOr convertmode  $ convert opts-       | cmd `isPrefixOf` "test"                         = showModeHelpOr testmode     $ runtests opts+       | cmd `isPrefixOf` "add"                          = showModeHelpOr addmode      $ journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add+       | cmd `isPrefixOf` "test"                         = showModeHelpOr testmode     $ test' opts        | any (cmd `isPrefixOf`) ["accounts","balance"]   = showModeHelpOr accountsmode $ withJournalDo opts balance        | any (cmd `isPrefixOf`) ["entries","print"]      = showModeHelpOr entriesmode  $ withJournalDo opts print'        | any (cmd `isPrefixOf`) ["postings","register"]  = showModeHelpOr postingsmode $ withJournalDo opts register        | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram+       | any (cmd `isPrefixOf`) ["incomestatement","is"] = showModeHelpOr incomestatementmode $ withJournalDo opts incomestatement+       | any (cmd `isPrefixOf`) ["balancesheet","bs"]    = showModeHelpOr balancesheetmode $ withJournalDo opts balancesheet+       | any (cmd `isPrefixOf`) ["cashflow","cf"]        = showModeHelpOr cashflowmode $ withJournalDo opts cashflow        | cmd `isPrefixOf` "stats"                        = showModeHelpOr statsmode    $ withJournalDo opts stats        | not (null matchedaddon)                           = do                                                              when (debug_ opts) $ printf "running %s\n" shellcmd                                                              system shellcmd >>= exitWith+       | cmd == "convert"                                = optserror ("convert is no longer needed, just use -f FILE.csv") >> exitFailure        | otherwise                                       = optserror ("command "++cmd++" is not recognized") >> exitFailure        where         mainmode' = mainmode addons

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} {-|  Command-line options for the hledger program, and option-parsing utilities.@@ -7,6 +7,7 @@  module Hledger.Cli.Options where+import Control.Exception as C import Data.List import Data.List.Split import Data.Maybe@@ -22,12 +23,12 @@ import Text.Printf  import Hledger-import Hledger.Cli.Format as Format+import Hledger.Data.FormatStrings as Format import Hledger.Cli.Version   -- 1. cmdargs mode and flag definitions, for the main and subcommand modes.--- Flag values are parsed initially to simple RawOpts to permit reuse.+-- Flag values are parsed initially to a simple association list to allow reuse.  type RawOpts = [(String,String)] @@ -59,11 +60,11 @@      groupUnnamed = [      ]     ,groupHidden = [+        convertmode      ]     ,groupNamed = [       ("Misc commands", [         addmode-       ,convertmode        ,testmode        ])      ,("\nReport commands", [@@ -72,6 +73,9 @@        ,postingsmode        -- ,transactionsmode        ,activitymode+       ,incomestatementmode+       ,balancesheetmode+       ,cashflowmode        ,statsmode        ])      ]@@ -80,6 +84,19 @@     }  } +-- backwards compatibility - allow cmdargs to recognise this command so we can detect and warn+convertmode = (commandmode ["convert"]) {+  modeValue = [("command","convert")]+ ,modeHelp = ""+ ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]")+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = []+    }+ }+--+ addonmode name = defmode {   modeNames = [name]  ,modeHelp = printf "[-- OPTIONS]   run the %s-%s program" progname name@@ -107,6 +124,7 @@  fileflags = [   flagReq ["file","f"]  (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"+ ,flagReq ["rules-file"]  (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"  ,flagReq ["alias"]  (\s opts -> Right $ setopt "alias" s opts)  "ACCT=ALIAS" "display ACCT's name as ALIAS in reports"  ] @@ -154,19 +172,6 @@     }  } -convertmode = (commandmode ["convert"]) {-  modeValue = [("command","convert")]- ,modeHelp = "show the specified CSV file as hledger journal entries"- ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[CSVFILE]")- ,modeGroupFlags = Group {-     groupUnnamed = [-      flagReq ["rules-file"]  (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)"-     ]-    ,groupHidden = []-    ,groupNamed = [(generalflagstitle, generalflags3)]-    }- }- testmode = (commandmode ["test"]) {   modeHelp = "run self-tests, or just the ones matching REGEXPS"  ,modeArgs = ([], Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]")@@ -177,7 +182,7 @@     }  } -accountsmode = (commandmode ["balance","accounts"]) {+accountsmode = (commandmode ["balance","bal","accounts"]) {   modeHelp = "(or accounts) show matched accounts and their balances"  ,modeArgs = ([], Just commandargsflag)  ,modeGroupFlags = Group {@@ -234,6 +239,36 @@     }  } +incomestatementmode = (commandmode ["incomestatement","is"]) {+  modeHelp = "show a standard income statement"+ ,modeArgs = ([], Just commandargsflag)+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [(generalflagstitle, generalflags1)]+    }+ }++balancesheetmode = (commandmode ["balancesheet","bs"]) {+  modeHelp = "show a standard balance sheet"+ ,modeArgs = ([], Just commandargsflag)+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [(generalflagstitle, generalflags1)]+    }+ }++cashflowmode = (commandmode ["cashflow","cf"]) {+  modeHelp = "show a simple cashflow statement"+ ,modeArgs = ([], Just commandargsflag)+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [(generalflagstitle, generalflags1)]+    }+ }+ statsmode = (commandmode ["stats"]) {   modeHelp = "show quick statistics for a journal (or part of it)"  ,modeArgs = ([], Just commandargsflag)@@ -253,10 +288,10 @@      rawopts_         :: RawOpts     ,command_         :: String     ,file_            :: Maybe FilePath+    ,rules_file_      :: Maybe FilePath     ,alias_           :: [String]     ,debug_           :: Bool     ,no_new_accounts_ :: Bool           -- add-    ,rules_file_      :: Maybe FilePath -- convert     ,reportopts_      :: ReportOpts  } deriving (Show) @@ -282,10 +317,10 @@               rawopts_         = rawopts              ,command_         = stringopt "command" rawopts              ,file_            = maybestringopt "file" rawopts-             ,alias_           = listofstringopt "alias" rawopts+             ,rules_file_      = maybestringopt "rules-file" rawopts+             ,alias_           = map stripquotes $ listofstringopt "alias" rawopts              ,debug_           = boolopt "debug" rawopts              ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add-             ,rules_file_      = maybestringopt "rules-file" rawopts -- convert              ,reportopts_ = defreportopts {                              begin_     = maybesmartdateopt d "begin" rawopts                             ,end_       = maybesmartdateopt d "end" rawopts@@ -308,7 +343,7 @@                             ,quarterly_ = boolopt "quarterly" rawopts                             ,yearly_    = boolopt "yearly" rawopts                             ,format_    = maybestringopt "format" rawopts-                            ,patterns_  = listofstringopt "args" rawopts+                            ,query_     = unwords $ listofstringopt "args" rawopts                             }              } @@ -336,11 +371,11 @@     where       hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof -getEnvSafe v = getEnv v `catch` (\_ -> return "")-getDirectoryContentsSafe d = getDirectoryContents d `catch` (\_ -> return [])+getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")+getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])  -- | Convert possibly encoded option values to regular unicode strings.-decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val))+decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))  -- A hacky workaround for http://code.google.com/p/ndmitchell/issues/detail?id=470 : -- we'd like to permit options before COMMAND as well as after it.@@ -364,7 +399,7 @@  stringopt name = fromMaybe "" . maybestringopt name -listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name]+listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name]  maybeintopt :: String -> RawOpts -> Maybe Int maybeintopt name rawopts =@@ -415,21 +450,31 @@ -- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)" defaultBalanceFormatString :: [FormatString] defaultBalanceFormatString = [-      FormatField False (Just 20) Nothing Total+      FormatField False (Just 20) Nothing TotalField     , FormatLiteral "  "-    , FormatField True (Just 2) Nothing DepthSpacer-    , FormatField True Nothing Nothing Format.Account+    , FormatField True (Just 2) Nothing DepthSpacerField+    , FormatField True Nothing Nothing AccountField     ]  -- | Get the journal file path from options, an environment variable, or a default.--- If the path contains a literal tilde raise an error to avoid confusion.+-- If the path contains a literal tilde raise an error to avoid confusion. XXX journalFilePathFromOpts :: CliOpts -> IO String journalFilePathFromOpts opts = do-  f <- myJournalPath+  f <- defaultJournalPath   let f' = fromMaybe f $ file_ opts   if '~' `elem` f'    then error' $ printf "~ in the journal file path is not supported, please adjust (%s)" f'    else return f'++-- | Get the rules file path from options, if any.+-- If the path contains a literal tilde raise an error to avoid confusion. XXX+rulesFilePathFromOpts :: CliOpts -> Maybe FilePath+rulesFilePathFromOpts opts =+  case rules_file_ opts of+    Nothing -> Nothing+    Just f -> if '~' `elem` f+               then error' $ printf "~ in file paths is not supported, please adjust (%s)" f+               else Just f  aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)] aliasesFromOpts = map parseAlias . alias_

@@ -7,23 +7,67 @@ module Hledger.Cli.Print (   print'  ,showTransactions+ ,tests_Hledger_Cli_Print ) where import Data.List+import Test.HUnit  import Hledger import Prelude hiding (putStr)-import Hledger.Utils.UTF8 (putStr)+import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options  -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO () print' CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay-  putStr $ showTransactions ropts (optsToFilterSpec ropts d) j+  putStr $ showTransactions ropts (queryFromOpts d ropts) j -showTransactions :: ReportOpts -> FilterSpec -> Journal -> String-showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j+showTransactions :: ReportOpts -> Query -> Journal -> String+showTransactions opts q j = entriesReportAsText opts q $ entriesReport opts q j -entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String+tests_showTransactions = [+  "showTransactions" ~: do++   -- "print expenses" ~:+   do +    let opts = defreportopts{query_="expenses"}+    d <- getCurrentDay+    showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines+     ["2008/06/03 * eat & shop"+     ,"    expenses:food                $1"+     ,"    expenses:supplies            $1"+     ,"    assets:cash                 $-2"+     ,""+     ]++  -- , "print report with depth arg" ~:+   do +    let opts = defreportopts{depth_=Just 2}+    d <- getCurrentDay+    showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines+      ["2008/01/01 income"+      ,"    assets:bank:checking            $1"+      ,"    income:salary                  $-1"+      ,""+      ,"2008/06/01 gift"+      ,"    assets:bank:checking            $1"+      ,"    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"+      ,"    assets:bank:checking           $-1"+      ,""+      ]+ ]++entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String entriesReportAsText _ _ items = concatMap showTransactionUnelided items +tests_Hledger_Cli_Print = TestList+  tests_showTransactions

@@ -18,7 +18,7 @@  import Hledger import Prelude hiding (putStr)-import Hledger.Utils.UTF8 (putStr)+import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options  @@ -26,12 +26,23 @@ register :: CliOpts -> Journal -> IO () register CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay-  putStr $ postingsReportAsText ropts $ postingsReport ropts (optsToFilterSpec ropts d) j+  putStr $ postingsReportAsText ropts $ postingsReport ropts (queryFromOpts d ropts) j  -- | Render a register report as plain text suitable for console output. postingsReportAsText :: ReportOpts -> PostingsReport -> String postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd +tests_postingsReportAsText = [+  "postingsReportAsText" ~: do+  -- "unicode in register layout" ~: do+    j <- readJournal'+      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"+    let opts = defreportopts+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines+      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"+      ,"                                актив:наличные                 -100            0"]+ ]+ -- | Render one register report line item as plain text. Eg: -- @ -- date (10)  description (20)     account (22)            amount (11)  balance (12)@@ -59,6 +70,4 @@  tests_Hledger_Cli_Register :: Test tests_Hledger_Cli_Register = TestList- [-- ]+  tests_postingsReportAsText

@@ -16,7 +16,7 @@ import Hledger import Hledger.Cli.Options import Prelude hiding (putStr)-import Hledger.Utils.UTF8 (putStr)+import Hledger.Utils.UTF8IOCompat (putStr)   -- like Register.summarisePostings@@ -24,9 +24,9 @@ stats :: CliOpts -> Journal -> IO () stats CliOpts{reportopts_=reportopts_} j = do   d <- getCurrentDay-  let filterspec = optsToFilterSpec reportopts_ d-      l = journalToLedger filterspec j-      reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)+  let q = queryFromOpts d reportopts_+      l = journalToLedger q j+      reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q)       intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan       showstats = showLedgerStats l d       s = intercalate "\n" $ map showstats intervalspans@@ -40,7 +40,7 @@       w1 = maximum $ map (length . fst) stats       w2 = maximum $ map (length . show . snd) stats       stats = [-         ("Journal file", journalFilePath $ journal l)+         ("Journal file", journalFilePath $ ledgerJournal l)         ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)         ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)         ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)@@ -55,7 +55,7 @@       -- Days since last transaction : %(recentelapsed)s        ]            where-             ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns $ journal l+             ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns $ ledgerJournal l              as = nub $ map paccount $ concatMap tpostings ts              cs = Map.keys $ canonicaliseCommodities $ nub $ map commodity $ concatMap amounts $ map pamount $ concatMap tpostings ts              lastdate | null ts = Nothing

@@ -1,28 +1,6 @@ {- | -This module contains hledger's unit tests. These are built in to hledger,-and can be run at any time by doing @hledger test@ (or, with a few more-options, by doing @make unittest@ in the hledger source tree.)--Other kinds of tests:--hledger's functional tests are a set of shell/command-line tests defined-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 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-@+A simple test runner for hledger's built-in unit tests.  -} @@ -37,22 +15,27 @@   -- | Run unit tests and exit with success or failure.-runtests :: CliOpts -> IO ()-runtests opts = do-  (hunitcounts,_) <- runtests' opts-  if errors hunitcounts > 0 || (failures hunitcounts > 0)+test' :: CliOpts -> IO ()+test' opts = do+  results <- runTests opts+  if errors results > 0 || failures results > 0    then exitFailure    else exitWith ExitSuccess --- | Run unit tests and exit on failure.-runTestsOrExit :: CliOpts -> IO ()-runTestsOrExit opts = do-  (hunitcounts,_) <- runtests' opts-  when (errors hunitcounts > 0 || (failures hunitcounts > 0)) $ exitFailure+-- | Run all or just the matched unit tests and return their HUnit result counts.+runTests :: CliOpts -> IO Counts+runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests -runtests' :: Num b => CliOpts -> IO (Counts, b)-runtests' opts = liftM (flip (,) 0) $ runTestTT ts-    where-      ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli  -- show flat test names-      -- ts = tfilter matchname $ TestList tests -- show hierarchical test names-      matchname = matchpats (patterns_ $ reportopts_ opts) . tname+-- | Run all or just the matched unit tests until the first failure or+-- error, returning the name of the problem test if any.+runTestsTillFailure :: CliOpts -> IO (Maybe String)+runTestsTillFailure _ = undefined -- do+  -- let ts = flatTests opts+  --     results = liftM (fst . flip (,) 0) $ runTestTT $+  --     firstproblem = find (\counts -> )++-- | All or pattern-matched tests, as a flat list to show simple names.+flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) $ flattenTests tests_Hledger_Cli++-- | All or pattern-matched tests, in the original suites to show hierarchical names.+hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-|  Utilities for top-level modules and ghci. See also Hledger.Read and@@ -8,7 +9,6 @@ module Hledger.Cli.Utils     (      withJournalDo,-     readJournal',      journalReload,      journalReloadIfChanged,      journalFileIsNewer,@@ -21,7 +21,7 @@      Test(TestList),     ) where-import Control.Exception+import Control.Exception as C import Data.List import Data.Maybe import Safe (readMay)@@ -48,20 +48,16 @@   -- We kludgily read the file before parsing to grab the full text, unless   -- it's stdin, or it doesn't exist and we are adding. We read it strictly   -- to let the add command work.-  journalFilePathFromOpts opts >>= readJournalFile Nothing >>=+  journalFilePathFromOpts opts >>= readJournalFile Nothing (rulesFilePathFromOpts opts) >>=     either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts))  -- -- | Get a journal from the given string and options, or throw an error. -- readJournalWithOpts :: CliOpts -> String -> IO Journal--- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return---- | Get a journal from the given string, or throw an error.-readJournal' :: String -> IO Journal-readJournal' s = readJournal Nothing s >>= either error' return+-- readJournalWithOpts opts s = readJournal Nothing Nothing Nothing s >>= either error' return  -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal)-journalReload j = readJournalFile Nothing $ journalFilePath j+journalReload j = readJournalFile Nothing Nothing $ journalFilePath j  -- | Re-read a journal from its data file mostly, only if the file has -- changed since last read (or if there is no file, ie data read from@@ -100,7 +96,7 @@ fileModificationTime :: FilePath -> IO ClockTime fileModificationTime f     | null f = getClockTime-    | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime+    | otherwise = getModificationTime f `C.catch` \(_::C.IOException) -> getClockTime  -- | Attempt to open a web browser on the given url, all platforms. openBrowserOn :: String -> IO ExitCode@@ -140,7 +136,7 @@ writeFileWithBackup f t = backUpFile f >> writeFile f t  readFileStrictly :: FilePath -> IO String-readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s+readFileStrictly f = readFile f >>= \s -> C.evaluate (length s) >> return s  -- | Back up this file with a (incrementing) numbered suffix, or give an error. backUpFile :: FilePath -> IO ()

@@ -19,8 +19,13 @@  -- package name and version from the cabal file progname, version, prognameandversion :: String+#if HADDOCK+progname = ""+version  = ""+#else progname = $(packageVariable (pkgName . package)) version  = $(packageVariable (pkgVersion . package))+#endif prognameandversion = progname ++ " " ++ version  -- developer build version strings include PATCHLEVEL (number of

@@ -1,5 +1,5 @@ name:           hledger-version: 0.17+version: 0.18 category:       Finance synopsis:       The main command-line interface for the hledger accounting tool. description:@@ -17,7 +17,7 @@ homepage:       http://hledger.org bug-reports:    http://code.google.com/p/hledger/issues stability:      beta-tested-with:    GHC==7.0, GHC==7.2+tested-with:    GHC==7.0.4, GHC==7.2.2, GHC==7.4.1 cabal-version:  >= 1.8 build-type:     Simple -- data-dir:       data@@ -47,26 +47,26 @@   exposed-modules:                   Hledger.Cli                   Hledger.Cli.Main-                  Hledger.Cli.Format                   Hledger.Cli.Options                   Hledger.Cli.Tests                   Hledger.Cli.Utils                   Hledger.Cli.Version                   Hledger.Cli.Add                   Hledger.Cli.Balance-                  Hledger.Cli.Convert+                  Hledger.Cli.Balancesheet+                  Hledger.Cli.Cashflow                   Hledger.Cli.Histogram+                  Hledger.Cli.Incomestatement                   Hledger.Cli.Print                   Hledger.Cli.Register                   Hledger.Cli.Stats   -- should be the same as below   build-depends:-                  hledger-lib == 0.17+                  hledger-lib == 0.18                  ,base >= 3 && < 5                  ,cabal-file-th                  ,containers                  ,cmdargs >= 0.9.1   && < 0.10-                 ,csv                  ,directory                  ,filepath                  ,haskeline == 0.6.*@@ -78,7 +78,9 @@                  ,process                  ,regexpr >= 0.5.1                  ,safe >= 0.2+                 ,shakespeare-text == 1.0.*                  ,split == 0.1.*+                 ,text == 0.11.*                  ,time                  ,utf8-string >= 0.3.5 && < 0.4 @@ -95,15 +97,16 @@   other-modules:                   Hledger.Cli                   Hledger.Cli.Main-                  Hledger.Cli.Format                   Hledger.Cli.Options                   Hledger.Cli.Tests                   Hledger.Cli.Utils                   Hledger.Cli.Version                   Hledger.Cli.Add                   Hledger.Cli.Balance-                  Hledger.Cli.Convert+                  Hledger.Cli.Balancesheet+                  Hledger.Cli.Cashflow                   Hledger.Cli.Histogram+                  Hledger.Cli.Incomestatement                   Hledger.Cli.Print                   Hledger.Cli.Register                   Hledger.Cli.Stats@@ -114,12 +117,11 @@        ghc-options:   -threaded  -- should be the same as above   build-depends:-                  hledger-lib == 0.17+                  hledger-lib == 0.18                  ,base >= 3 && < 5                  ,cabal-file-th                  ,containers                  ,cmdargs >= 0.9.1   && < 0.10-                 ,csv                  ,directory                  ,filepath                  ,haskeline == 0.6.*@@ -131,6 +133,8 @@                  ,process                  ,regexpr >= 0.5.1                  ,safe >= 0.2+                 ,shakespeare-text == 1.0.*                  ,split == 0.1.*+                 ,text == 0.11.*                  ,time                  ,utf8-string >= 0.3.5 && < 0.4