diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index d933bfb03..84dc73207 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -96,9 +96,9 @@ tests_Hledger_Cli = TestList ,"balance report tests" ~: let (opts,args) `gives` es = do - l <- samplejournalwithopts opts args + j <- samplejournal t <- getCurrentLocalTime - balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es + balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) j) `is` unlines es in TestList [ @@ -243,13 +243,13 @@ tests_Hledger_Cli = TestList ] ,"balance report elides zero-balance root account(s)" ~: do - l <- readJournalWithOpts [] + j <- readJournal' (unlines ["2008/1/1 one" ," test:a 1" ," test:b" ]) - balanceReportAsText [] (balanceReport [] nullfilterspec l) `is` + balanceReportAsText [] (balanceReport [] nullfilterspec j) `is` unlines [" 1 test:a" ," -1 test:b" @@ -274,8 +274,8 @@ tests_Hledger_Cli = TestList -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"default year" ~: do - rl <- readJournal Nothing defaultyear_journal_str >>= either error' return - tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1 + j <- readJournal Nothing defaultyear_journal_str >>= either error' return + tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () ,"print report tests" ~: TestList @@ -285,9 +285,9 @@ tests_Hledger_Cli = TestList do let args = ["expenses"] opts = [] - l <- samplejournalwithopts opts args + j <- samplejournal t <- getCurrentLocalTime - showTransactions opts (optsToFilterSpec opts args t) l `is` unlines + showTransactions opts (optsToFilterSpec opts args t) j `is` unlines ["2008/06/03 * eat & shop" ," expenses:food $1" ," expenses:supplies $1" @@ -297,9 +297,9 @@ tests_Hledger_Cli = TestList , "print report with depth arg" ~: do - l <- samplejournal + j <- samplejournal t <- getCurrentLocalTime - showTransactions [] (optsToFilterSpec [Depth "2"] [] t) l `is` unlines + showTransactions [] (optsToFilterSpec [Depth "2"] [] t) j `is` unlines ["2008/01/01 income" ," income:salary $-1" ,"" @@ -326,8 +326,8 @@ tests_Hledger_Cli = TestList "register report with no args" ~: do - l <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + j <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) 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" @@ -344,8 +344,8 @@ tests_Hledger_Cli = TestList ,"register report with cleared option" ~: do let opts = [Cleared] - l <- readJournalWithOpts opts sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines + j <- readJournal' sample_journal_str + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" @@ -356,8 +356,8 @@ tests_Hledger_Cli = TestList ,"register report with uncleared option" ~: do let opts = [UnCleared] - l <- readJournalWithOpts opts sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines + j <- readJournal' sample_journal_str + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) 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" @@ -368,7 +368,7 @@ tests_Hledger_Cli = TestList ,"register report sorts by date" ~: do - l <- readJournalWithOpts [] $ unlines + j <- readJournal' $ unlines ["2008/02/02 a" ," b 1" ," c" @@ -377,27 +377,27 @@ tests_Hledger_Cli = TestList ," e 1" ," f" ] - registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"] + registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) j) `is` ["2008/01/01","2008/02/02"] ,"register report with account pattern" ~: do - l <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) l) `is` unlines + j <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"register report with account pattern, case insensitive" ~: do - l <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) l) `is` unlines + j <- samplejournal + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"register report with display expression" ~: do - l <- samplejournal + j <- samplejournal let gives displayexpr = - (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is`) + (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is`) where opts = [Display displayexpr] "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] @@ -407,10 +407,10 @@ tests_Hledger_Cli = TestList ,"register report with period expression" ~: do - l <- samplejournal + j <- samplejournal let periodexpr `gives` dates = do - l' <- samplejournalwithopts opts [] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l') `is` dates + j' <- samplejournal + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j') `is` dates where opts = [Period periodexpr] "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] @@ -419,7 +419,7 @@ tests_Hledger_Cli = TestList "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "yearly"] - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ," assets:cash $-2 $-1" ," expenses:food $1 0" @@ -429,17 +429,17 @@ tests_Hledger_Cli = TestList ," liabilities:debts $1 0" ] let opts = [Period "quarterly"] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "quarterly",Empty] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] , "register report with depth arg" ~: do - l <- samplejournal + j <- samplejournal let opts = [Depth "2"] - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines ["2008/01/01 income assets:bank $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank $1 $1" @@ -458,9 +458,9 @@ tests_Hledger_Cli = TestList ,"show hours" ~: show (hours 1) ~?= "1.0h" ,"unicode in balance layout" ~: do - l <- readJournalWithOpts [] + j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) j) `is` unlines [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" @@ -468,9 +468,9 @@ tests_Hledger_Cli = TestList ] ,"unicode in register layout" ~: do - l <- readJournalWithOpts [] + j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) j) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] @@ -487,8 +487,7 @@ tests_Hledger_Cli = TestList date1 = parsedate "2008/11/26" t1 = LocalTime date1 midday -samplejournal = readJournalWithOpts [] sample_journal_str -samplejournalwithopts opts _ = readJournalWithOpts opts sample_journal_str +samplejournal = readJournal' sample_journal_str sample_journal_str = unlines ["; A sample journal file." diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 7da328cd8..ff753be70 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -30,7 +30,7 @@ import qualified Data.Set as Set import Hledger.Cli.Options import Hledger.Cli.Register (registerReport, registerReportAsText) -import Hledger.Cli.Utils (readJournalWithOpts) +import Hledger.Cli.Utils import Hledger.Data import Hledger.Read.JournalReader (someamount) import Hledger.Utils @@ -219,8 +219,8 @@ appendToJournalFile f s = registerFromString :: String -> IO String registerFromString s = do now <- getCurrentLocalTime - l <- readJournalWithOpts [] s - return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) l + j <- readJournal' s + return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) j where opts = [Empty] -- | Return a similarity measure, from 0 to 1, for two strings. diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 885bb5715..668e766b0 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -110,6 +110,7 @@ import Data.Tree import Test.HUnit import Hledger.Cli.Options +import Hledger.Cli.Utils import Hledger.Data import Hledger.Utils import Prelude hiding (putStr) @@ -166,7 +167,7 @@ balanceReport opts filterspec j = (items, total) accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l total = sum $ map abalance $ ledgerTopAccounts l l = journalToLedger filterspec j' - j' = journalSelectingDate (whichDateFromOpts opts) j + j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j -- | Get data for one balance report line item. mkitem :: AccountName -> BalanceReportItem mkitem a = (a, adisplay, indent, abal) diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index ced8a5af8..337aab237 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -16,6 +16,7 @@ import Data.List import Data.Ord import Hledger.Cli.Options +import Hledger.Cli.Utils import Hledger.Data import Hledger.Utils import Prelude hiding (putStr) @@ -43,5 +44,6 @@ journalReportAsText opts _ items = concatMap (showTransactionForPrint effective) journalReport :: [Opt] -> FilterSpec -> Journal -> JournalReport journalReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j' - where j' = journalSelectingDate (whichDateFromOpts opts) j + where + j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 837654988..ca9bfcd55 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -26,6 +26,7 @@ import Text.ParserCombinators.Parsec import Text.Printf import Hledger.Cli.Options +import Hledger.Cli.Utils import Hledger.Data import Hledger.Utils import Prelude hiding (putStr) @@ -86,8 +87,10 @@ registerReport opts fspec j = getitems ps nullposting startbal (precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts) $ depthClipPostings depth $ journalPostings - $ filterJournalPostings fspec{depth=Nothing} j' - j' = journalSelectingDate (whichDateFromOpts opts) j + $ filterJournalPostings fspec{depth=Nothing} + $ journalSelectingDateFromOpts opts + $ journalSelectingAmountFromOpts opts + j startbal = sumPostings precedingps filterspan = datespan fspec (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 3c226429e..46186ddef 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -9,7 +9,9 @@ Hledger.Utils. module Hledger.Cli.Utils ( withJournalDo, - readJournalWithOpts, + readJournal', + journalSelectingDateFromOpts, + journalSelectingAmountFromOpts, journalReload, journalReloadIfChanged, journalFileIsNewer, @@ -36,7 +38,7 @@ import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff)) import Test.HUnit import Text.Printf -import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) +import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts,whichDateFromOpts) import Hledger.Data import Hledger.Read import Hledger.Utils @@ -49,17 +51,27 @@ withJournalDo opts args _ cmd = do -- 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 >>= either error' runcmd - where - costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id) - runcmd = cmd opts args . costify + journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either error' (cmd opts args) --- | Get a journal from the given string and options, or throw an error. -readJournalWithOpts :: [Opt] -> String -> IO Journal -readJournalWithOpts opts s = do - j <- readJournal Nothing s >>= either error' return - return $ (if cost then journalConvertAmountsToCost else id) j - where cost = CostBasis `elem` opts +-- -- | Get a journal from the given string and options, or throw an error. +-- readJournalWithOpts :: [Opt] -> 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 + +-- | Convert this journal's transactions' primary date to either the +-- actual or effective date, as per options. +journalSelectingDateFromOpts :: [Opt] -> Journal -> Journal +journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts) + +-- | Convert this journal's postings' amounts to the cost basis amounts if +-- specified by options. +journalSelectingAmountFromOpts :: [Opt] -> Journal -> Journal +journalSelectingAmountFromOpts opts + | CostBasis `elem` opts = journalConvertAmountsToCost + | otherwise = id -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal)