mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 10:47:29 +03:00
simplify api, optsToFilterSpec just needs a day not a time
This commit is contained in:
Simon Michael
parent
e7c6ee3dc3
commit
c565b2606d
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user