From c565b2606d900f450b86d213797b4bd80914a49a Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 13 Jun 2011 23:28:39 +0000 Subject: [PATCH] simplify api, optsToFilterSpec just needs a day not a time --- hledger-chart/Hledger/Chart/Main.hs | 4 +-- hledger-vty/Hledger/Vty/Main.hs | 52 ++++++++++++++--------------- hledger/Hledger/Cli.hs | 43 ++++++++++++------------ hledger/Hledger/Cli/Add.hs | 4 +-- hledger/Hledger/Cli/Balance.hs | 4 +-- hledger/Hledger/Cli/Histogram.hs | 5 ++- hledger/Hledger/Cli/Options.hs | 7 ++-- hledger/Hledger/Cli/Print.hs | 5 ++- hledger/Hledger/Cli/Register.hs | 4 +-- hledger/Hledger/Cli/Stats.hs | 8 ++--- 10 files changed, 65 insertions(+), 71 deletions(-) diff --git a/hledger-chart/Hledger/Chart/Main.hs b/hledger-chart/Hledger/Chart/Main.hs index d52aa9391..33fad1789 100644 --- a/hledger-chart/Hledger/Chart/Main.hs +++ b/hledger-chart/Hledger/Chart/Main.hs @@ -69,11 +69,11 @@ main = do -- | Generate an image with the pie chart and write it to a file chart :: [Opt] -> [String] -> Journal -> IO () chart opts args j = do - t <- getCurrentLocalTime + d <- getCurrentDay if null $ jtxns j then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure else do - let chart = genPie opts (optsToFilterSpec opts args t) j + let chart = genPie opts (optsToFilterSpec opts args d) j renderableToPNGFile (toRenderable chart) w h filename return () where diff --git a/hledger-vty/Hledger/Vty/Main.hs b/hledger-vty/Hledger/Vty/Main.hs index e04dce136..774593396 100644 --- a/hledger-vty/Hledger/Vty/Main.hs +++ b/hledger-vty/Hledger/Vty/Main.hs @@ -10,7 +10,7 @@ module Hledger.Vty.Main where import Control.Monad import Data.List import Data.Maybe -import Data.Time.LocalTime +import Data.Time.Calendar import Graphics.Vty import Safe (headDef) import System.Console.GetOpt @@ -95,8 +95,8 @@ vty opts args j = do v <- mkVty DisplayRegion w h <- display_bounds $ terminal v let opts' = SubTotal:opts - t <- getCurrentLocalTime - let a = enter t BalanceScreen args + d <- getCurrentDay + let a = enter d BalanceScreen args AppState { av=v ,aw=fromIntegral w @@ -115,16 +115,16 @@ go :: AppState -> IO () go a@AppState{av=av,aopts=opts} = do when (notElem DebugVty opts) $ update av (renderScreen a) k <- next_event av - t <- getCurrentLocalTime + d <- getCurrentDay case k of EvResize x y -> go $ resize x y a EvKey (KASCII 'l') [MCtrl] -> refresh av >> go a{amsg=helpmsg} - EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter t BalanceScreen a - EvKey (KASCII 'r') [] -> go $ resetTrailAndEnter t RegisterScreen a - EvKey (KASCII 'p') [] -> go $ resetTrailAndEnter t PrintScreen a - EvKey KRight [] -> go $ drilldown t a - EvKey KEnter [] -> go $ drilldown t a - EvKey KLeft [] -> go $ backout t a + EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter d BalanceScreen a + EvKey (KASCII 'r') [] -> go $ resetTrailAndEnter d RegisterScreen a + EvKey (KASCII 'p') [] -> go $ resetTrailAndEnter d PrintScreen a + EvKey KRight [] -> go $ drilldown d a + EvKey KEnter [] -> go $ drilldown d a + EvKey KLeft [] -> go $ backout d a EvKey KUp [] -> go $ moveUpAndPushEdge a EvKey KDown [] -> go $ moveDownAndPushEdge a EvKey KHome [] -> go $ moveToTop a @@ -258,32 +258,32 @@ screen :: AppState -> Screen screen a = scr where (Loc scr _ _ _) = loc a -- | Enter a new screen, with possibly new args, adding the new ui location to the stack. -enter :: LocalTime -> Screen -> [String] -> AppState -> AppState -enter t scr@BalanceScreen args a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a -enter t scr@RegisterScreen args a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a -enter t scr@PrintScreen args a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a +enter :: Day -> Screen -> [String] -> AppState -> AppState +enter d scr@BalanceScreen args a = updateData d $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a +enter d scr@RegisterScreen args a = updateData d $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a +enter d scr@PrintScreen args a = updateData d $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a -resetTrailAndEnter :: LocalTime -> Screen -> AppState -> AppState -resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a +resetTrailAndEnter :: Day -> Screen -> AppState -> AppState +resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a -- | Regenerate the display data appropriate for the current screen. -updateData :: LocalTime -> AppState -> AppState -updateData t a@AppState{aopts=opts,ajournal=j} = +updateData :: Day -> AppState -> AppState +updateData d a@AppState{aopts=opts,ajournal=j} = case screen a of BalanceScreen -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j} RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j} PrintScreen -> a{abuf=lines $ showTransactions opts fspec j} - where fspec = optsToFilterSpec opts (currentArgs a) t + where fspec = optsToFilterSpec opts (currentArgs a) d -backout :: LocalTime -> AppState -> AppState -backout t a | screen a == BalanceScreen = a - | otherwise = updateData t $ popLoc a +backout :: Day -> AppState -> AppState +backout d a | screen a == BalanceScreen = a + | otherwise = updateData d $ popLoc a -drilldown :: LocalTime -> AppState -> AppState -drilldown t a = +drilldown :: Day -> AppState -> AppState +drilldown d a = case screen a of - BalanceScreen -> enter t RegisterScreen [currentAccountName a] a - RegisterScreen -> scrollToTransaction e $ enter t PrintScreen (currentArgs a) a + BalanceScreen -> enter d RegisterScreen [currentAccountName a] a + RegisterScreen -> scrollToTransaction e $ enter d PrintScreen (currentArgs a) a PrintScreen -> a where e = currentTransaction a diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 84dc73207..75d720b87 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -19,7 +19,6 @@ where import Control.Monad import qualified Data.Map as Map import Data.Time.Calendar -import Data.Time.LocalTime import System.Time (ClockTime(TOD)) import Test.HUnit @@ -97,8 +96,8 @@ tests_Hledger_Cli = TestList ,"balance report tests" ~: let (opts,args) `gives` es = do j <- samplejournal - t <- getCurrentLocalTime - balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) j) `is` unlines es + d <- getCurrentDay + balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args d) j) `is` unlines es in TestList [ @@ -286,8 +285,8 @@ tests_Hledger_Cli = TestList let args = ["expenses"] opts = [] j <- samplejournal - t <- getCurrentLocalTime - showTransactions opts (optsToFilterSpec opts args t) j `is` unlines + d <- getCurrentDay + showTransactions opts (optsToFilterSpec opts args d) j `is` unlines ["2008/06/03 * eat & shop" ," expenses:food $1" ," expenses:supplies $1" @@ -298,8 +297,8 @@ tests_Hledger_Cli = TestList , "print report with depth arg" ~: do j <- samplejournal - t <- getCurrentLocalTime - showTransactions [] (optsToFilterSpec [Depth "2"] [] t) j `is` unlines + d <- getCurrentDay + showTransactions [] (optsToFilterSpec [Depth "2"] [] d) j `is` unlines ["2008/01/01 income" ," income:salary $-1" ,"" @@ -327,7 +326,7 @@ tests_Hledger_Cli = TestList "register report with no args" ~: do j <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) j) `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] 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" @@ -345,7 +344,7 @@ tests_Hledger_Cli = TestList do let opts = [Cleared] j <- readJournal' sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" @@ -357,7 +356,7 @@ tests_Hledger_Cli = TestList do let opts = [UnCleared] j <- readJournal' sample_journal_str - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines + (registerReportAsText opts $ registerReport 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" @@ -377,19 +376,19 @@ tests_Hledger_Cli = TestList ," e 1" ," f" ] - registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) j) `is` ["2008/01/01","2008/02/02"] + registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"] ,"register report with account pattern" ~: do j <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) j) `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"register report with account pattern, case insensitive" ~: do j <- samplejournal - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) j) `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] @@ -397,7 +396,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let gives displayexpr = - (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is`) + (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) 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"] @@ -410,7 +409,7 @@ tests_Hledger_Cli = TestList j <- samplejournal let periodexpr `gives` dates = do j' <- samplejournal - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j') `is` dates + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) 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 +418,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) j) `is` unlines + (registerReportAsText opts $ registerReport 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" @@ -429,9 +428,9 @@ tests_Hledger_Cli = TestList ," liabilities:debts $1 0" ] let opts = [Period "quarterly"] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "quarterly",Empty] - registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] @@ -439,7 +438,7 @@ tests_Hledger_Cli = TestList do j <- samplejournal let opts = [Depth "2"] - (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) j) `is` unlines + (registerReportAsText opts $ registerReport 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" @@ -460,7 +459,7 @@ tests_Hledger_Cli = TestList ,"unicode in balance layout" ~: do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) j) `is` unlines + balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] date1) j) `is` unlines [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" @@ -470,7 +469,7 @@ tests_Hledger_Cli = TestList ,"unicode in register layout" ~: do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) j) `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] date1) j) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] @@ -485,7 +484,7 @@ tests_Hledger_Cli = TestList -- fixtures/test data date1 = parsedate "2008/11/26" -t1 = LocalTime date1 midday +-- t1 = LocalTime date1 midday samplejournal = readJournal' sample_journal_str diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index ff753be70..c54cca52b 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -218,9 +218,9 @@ appendToJournalFile f s = -- | Convert a string of journal data into a register report. registerFromString :: String -> IO String registerFromString s = do - now <- getCurrentLocalTime + d <- getCurrentDay j <- readJournal' s - return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) j + return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] d) 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 668e766b0..4c7f7e090 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -132,8 +132,8 @@ type BalanceReportItem = (AccountName -- full account name -- | Print a balance report. balance :: [Opt] -> [String] -> Journal -> IO () balance opts args j = do - t <- getCurrentLocalTime - putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j + d <- getCurrentDay + putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args d) j -- | Render a balance report as plain text suitable for console output. balanceReportAsText :: [Opt] -> BalanceReport -> String diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index 4d538ea1e..938e27bc1 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -14,7 +14,6 @@ import Text.Printf import Hledger.Cli.Options import Hledger.Data -import Hledger.Utils import Prelude hiding (putStr) import Hledger.Utils.UTF8 (putStr) @@ -25,8 +24,8 @@ barchar = '*' -- number of postings per day. histogram :: [Opt] -> [String] -> Journal -> IO () histogram opts args j = do - t <- getCurrentLocalTime - putStr $ showHistogram opts (optsToFilterSpec opts args t) j + d <- getCurrentDay + putStr $ showHistogram opts (optsToFilterSpec opts args d) j showHistogram :: [Opt] -> FilterSpec -> Journal -> String showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 4669b8e95..09cc6ecd6 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -8,7 +8,6 @@ import Data.Char (toLower) import Data.List import Data.Maybe import Data.Time.Calendar -import Data.Time.LocalTime import System.Console.GetOpt import System.Environment import Test.HUnit @@ -292,9 +291,9 @@ parsePatternArgs args = (as, ds') ds' = map (drop (length descprefix)) ds -- | Convert application options to the library's generic filter specification. -optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec -optsToFilterSpec opts args t = FilterSpec { - datespan=dateSpanFromOpts (localDay t) opts +optsToFilterSpec :: [Opt] -> [String] -> Day -> FilterSpec +optsToFilterSpec opts args d = FilterSpec { + datespan=dateSpanFromOpts d opts ,cleared=clearedValueFromOpts opts ,real=Real `elem` opts ,empty=Empty `elem` opts diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index 337aab237..00847f24c 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -18,7 +18,6 @@ import Data.Ord import Hledger.Cli.Options import Hledger.Cli.Utils import Hledger.Data -import Hledger.Utils import Prelude hiding (putStr) import Hledger.Utils.UTF8 (putStr) @@ -32,8 +31,8 @@ type JournalReportItem = Transaction -- | Print journal transactions in standard format. print' :: [Opt] -> [String] -> Journal -> IO () print' opts args j = do - t <- getCurrentLocalTime - putStr $ showTransactions opts (optsToFilterSpec opts args t) j + d <- getCurrentDay + putStr $ showTransactions opts (optsToFilterSpec opts args d) j showTransactions :: [Opt] -> FilterSpec -> Journal -> String showTransactions opts fspec j = journalReportAsText opts fspec $ journalReport opts fspec j diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index ca9bfcd55..0ace32254 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -47,8 +47,8 @@ type RegisterReportItem = (Maybe (Day, String) -- transaction date and descripti -- | Print a register report. register :: [Opt] -> [String] -> Journal -> IO () register opts args j = do - t <- getCurrentLocalTime - putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args t) j + d <- getCurrentDay + putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args d) j -- | Render a register report as plain text suitable for console output. registerReportAsText :: [Opt] -> RegisterReport -> String diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index 844df232e..cb0df288a 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -16,7 +16,6 @@ import qualified Data.Map as Map import Hledger.Cli.Options import Hledger.Data -import Hledger.Utils import Prelude hiding (putStr) import Hledger.Utils.UTF8 (putStr) @@ -25,13 +24,12 @@ import Hledger.Utils.UTF8 (putStr) -- | Print various statistics for the journal. stats :: [Opt] -> [String] -> Journal -> IO () stats opts args j = do - today <- getCurrentDay - t <- getCurrentLocalTime - let filterspec = optsToFilterSpec opts args t + d <- getCurrentDay + let filterspec = optsToFilterSpec opts args d l = journalToLedger filterspec j reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec) intervalspans = splitSpan (intervalFromOpts opts) reportspan - showstats = showLedgerStats opts args l today + showstats = showLedgerStats opts args l d s = intercalate "\n" $ map showstats intervalspans putStr s