simplify api, optsToFilterSpec just needs a day not a time
This commit is contained in:
		
							parent
							
								
									e7c6ee3dc3
								
							
						
					
					
						commit
						c565b2606d
					
				@ -69,11 +69,11 @@ main = do
 | 
				
			|||||||
-- | Generate an image with the pie chart and write it to a file
 | 
					-- | Generate an image with the pie chart and write it to a file
 | 
				
			||||||
chart :: [Opt] -> [String] -> Journal -> IO ()
 | 
					chart :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
chart opts args j = do
 | 
					chart opts args j = do
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  if null $ jtxns j
 | 
					  if null $ jtxns j
 | 
				
			||||||
   then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure
 | 
					   then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure
 | 
				
			||||||
   else do
 | 
					   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
 | 
					     renderableToPNGFile (toRenderable chart) w h filename
 | 
				
			||||||
     return ()
 | 
					     return ()
 | 
				
			||||||
      where
 | 
					      where
 | 
				
			||||||
 | 
				
			|||||||
@ -10,7 +10,7 @@ module Hledger.Vty.Main where
 | 
				
			|||||||
import Control.Monad
 | 
					import Control.Monad
 | 
				
			||||||
import Data.List
 | 
					import Data.List
 | 
				
			||||||
import Data.Maybe
 | 
					import Data.Maybe
 | 
				
			||||||
import Data.Time.LocalTime
 | 
					import Data.Time.Calendar
 | 
				
			||||||
import Graphics.Vty
 | 
					import Graphics.Vty
 | 
				
			||||||
import Safe (headDef)
 | 
					import Safe (headDef)
 | 
				
			||||||
import System.Console.GetOpt
 | 
					import System.Console.GetOpt
 | 
				
			||||||
@ -95,8 +95,8 @@ vty opts args j = do
 | 
				
			|||||||
  v <- mkVty
 | 
					  v <- mkVty
 | 
				
			||||||
  DisplayRegion w h <- display_bounds $ terminal v
 | 
					  DisplayRegion w h <- display_bounds $ terminal v
 | 
				
			||||||
  let opts' = SubTotal:opts
 | 
					  let opts' = SubTotal:opts
 | 
				
			||||||
  t <-  getCurrentLocalTime
 | 
					  d <-  getCurrentDay
 | 
				
			||||||
  let a = enter t BalanceScreen args
 | 
					  let a = enter d BalanceScreen args
 | 
				
			||||||
          AppState {
 | 
					          AppState {
 | 
				
			||||||
                  av=v
 | 
					                  av=v
 | 
				
			||||||
                 ,aw=fromIntegral w
 | 
					                 ,aw=fromIntegral w
 | 
				
			||||||
@ -115,16 +115,16 @@ go :: AppState -> IO ()
 | 
				
			|||||||
go a@AppState{av=av,aopts=opts} = do
 | 
					go a@AppState{av=av,aopts=opts} = do
 | 
				
			||||||
  when (notElem DebugVty opts) $ update av (renderScreen a)
 | 
					  when (notElem DebugVty opts) $ update av (renderScreen a)
 | 
				
			||||||
  k <- next_event av
 | 
					  k <- next_event av
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  case k of 
 | 
					  case k of 
 | 
				
			||||||
    EvResize x y                -> go $ resize x y a
 | 
					    EvResize x y                -> go $ resize x y a
 | 
				
			||||||
    EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}
 | 
					    EvKey (KASCII 'l') [MCtrl]  -> refresh av >> go a{amsg=helpmsg}
 | 
				
			||||||
    EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter t BalanceScreen a
 | 
					    EvKey (KASCII 'b') []       -> go $ resetTrailAndEnter d BalanceScreen a
 | 
				
			||||||
    EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter t RegisterScreen a
 | 
					    EvKey (KASCII 'r') []       -> go $ resetTrailAndEnter d RegisterScreen a
 | 
				
			||||||
    EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter t PrintScreen a
 | 
					    EvKey (KASCII 'p') []       -> go $ resetTrailAndEnter d PrintScreen a
 | 
				
			||||||
    EvKey KRight []             -> go $ drilldown t a
 | 
					    EvKey KRight []             -> go $ drilldown d a
 | 
				
			||||||
    EvKey KEnter []             -> go $ drilldown t a
 | 
					    EvKey KEnter []             -> go $ drilldown d a
 | 
				
			||||||
    EvKey KLeft  []             -> go $ backout t a
 | 
					    EvKey KLeft  []             -> go $ backout d a
 | 
				
			||||||
    EvKey KUp    []             -> go $ moveUpAndPushEdge a
 | 
					    EvKey KUp    []             -> go $ moveUpAndPushEdge a
 | 
				
			||||||
    EvKey KDown  []             -> go $ moveDownAndPushEdge a
 | 
					    EvKey KDown  []             -> go $ moveDownAndPushEdge a
 | 
				
			||||||
    EvKey KHome  []             -> go $ moveToTop a
 | 
					    EvKey KHome  []             -> go $ moveToTop a
 | 
				
			||||||
@ -258,32 +258,32 @@ screen :: AppState -> Screen
 | 
				
			|||||||
screen a = scr where (Loc scr _ _ _) = loc a
 | 
					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 a new screen, with possibly new args, adding the new ui location to the stack.
 | 
				
			||||||
enter :: LocalTime -> Screen -> [String] -> AppState -> AppState
 | 
					enter :: Day -> Screen -> [String] -> AppState -> AppState
 | 
				
			||||||
enter t scr@BalanceScreen args a  = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a
 | 
					enter d scr@BalanceScreen args a  = updateData d $ 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 d scr@RegisterScreen args a = updateData d $ 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 d scr@PrintScreen args a    = updateData d $ pushLoc Loc{scr=scr,sy=0,cy=0,largs=args} a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
resetTrailAndEnter :: LocalTime -> Screen -> AppState -> AppState
 | 
					resetTrailAndEnter :: Day -> Screen -> AppState -> AppState
 | 
				
			||||||
resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a
 | 
					resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Regenerate the display data appropriate for the current screen.
 | 
					-- | Regenerate the display data appropriate for the current screen.
 | 
				
			||||||
updateData :: LocalTime -> AppState -> AppState
 | 
					updateData :: Day -> AppState -> AppState
 | 
				
			||||||
updateData t a@AppState{aopts=opts,ajournal=j} =
 | 
					updateData d a@AppState{aopts=opts,ajournal=j} =
 | 
				
			||||||
    case screen a of
 | 
					    case screen a of
 | 
				
			||||||
      BalanceScreen  -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j}
 | 
					      BalanceScreen  -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j}
 | 
				
			||||||
      RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j}
 | 
					      RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j}
 | 
				
			||||||
      PrintScreen    -> a{abuf=lines $ showTransactions 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 :: Day -> AppState -> AppState
 | 
				
			||||||
backout t a | screen a == BalanceScreen = a
 | 
					backout d a | screen a == BalanceScreen = a
 | 
				
			||||||
            | otherwise = updateData t $ popLoc a
 | 
					            | otherwise = updateData d $ popLoc a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
drilldown :: LocalTime -> AppState -> AppState
 | 
					drilldown :: Day -> AppState -> AppState
 | 
				
			||||||
drilldown t a =
 | 
					drilldown d a =
 | 
				
			||||||
    case screen a of
 | 
					    case screen a of
 | 
				
			||||||
      BalanceScreen  -> enter t RegisterScreen [currentAccountName a] a
 | 
					      BalanceScreen  -> enter d RegisterScreen [currentAccountName a] a
 | 
				
			||||||
      RegisterScreen -> scrollToTransaction e $ enter t PrintScreen (currentArgs a) a
 | 
					      RegisterScreen -> scrollToTransaction e $ enter d PrintScreen (currentArgs a) a
 | 
				
			||||||
      PrintScreen   -> a
 | 
					      PrintScreen   -> a
 | 
				
			||||||
    where e = currentTransaction a
 | 
					    where e = currentTransaction a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -19,7 +19,6 @@ where
 | 
				
			|||||||
import Control.Monad
 | 
					import Control.Monad
 | 
				
			||||||
import qualified Data.Map as Map
 | 
					import qualified Data.Map as Map
 | 
				
			||||||
import Data.Time.Calendar
 | 
					import Data.Time.Calendar
 | 
				
			||||||
import Data.Time.LocalTime
 | 
					 | 
				
			||||||
import System.Time (ClockTime(TOD))
 | 
					import System.Time (ClockTime(TOD))
 | 
				
			||||||
import Test.HUnit
 | 
					import Test.HUnit
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -97,8 +96,8 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
  ,"balance report tests" ~:
 | 
					  ,"balance report tests" ~:
 | 
				
			||||||
   let (opts,args) `gives` es = do 
 | 
					   let (opts,args) `gives` es = do 
 | 
				
			||||||
        j <- samplejournal
 | 
					        j <- samplejournal
 | 
				
			||||||
        t <- getCurrentLocalTime
 | 
					        d <- getCurrentDay
 | 
				
			||||||
        balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) j) `is` unlines es
 | 
					        balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args d) j) `is` unlines es
 | 
				
			||||||
   in TestList
 | 
					   in TestList
 | 
				
			||||||
   [
 | 
					   [
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -286,8 +285,8 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
    let args = ["expenses"]
 | 
					    let args = ["expenses"]
 | 
				
			||||||
        opts = []
 | 
					        opts = []
 | 
				
			||||||
    j <- samplejournal
 | 
					    j <- samplejournal
 | 
				
			||||||
    t <- getCurrentLocalTime
 | 
					    d <- getCurrentDay
 | 
				
			||||||
    showTransactions opts (optsToFilterSpec opts args t) j `is` unlines
 | 
					    showTransactions opts (optsToFilterSpec opts args d) j `is` unlines
 | 
				
			||||||
     ["2008/06/03 * eat & shop"
 | 
					     ["2008/06/03 * eat & shop"
 | 
				
			||||||
     ,"    expenses:food                $1"
 | 
					     ,"    expenses:food                $1"
 | 
				
			||||||
     ,"    expenses:supplies            $1"
 | 
					     ,"    expenses:supplies            $1"
 | 
				
			||||||
@ -298,8 +297,8 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
  , "print report with depth arg" ~:
 | 
					  , "print report with depth arg" ~:
 | 
				
			||||||
   do 
 | 
					   do 
 | 
				
			||||||
    j <- samplejournal
 | 
					    j <- samplejournal
 | 
				
			||||||
    t <- getCurrentLocalTime
 | 
					    d <- getCurrentDay
 | 
				
			||||||
    showTransactions [] (optsToFilterSpec [Depth "2"] [] t) j `is` unlines
 | 
					    showTransactions [] (optsToFilterSpec [Depth "2"] [] d) j `is` unlines
 | 
				
			||||||
      ["2008/01/01 income"
 | 
					      ["2008/01/01 income"
 | 
				
			||||||
      ,"    income:salary           $-1"
 | 
					      ,"    income:salary           $-1"
 | 
				
			||||||
      ,""
 | 
					      ,""
 | 
				
			||||||
@ -327,7 +326,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
   "register report with no args" ~:
 | 
					   "register report with no args" ~:
 | 
				
			||||||
   do 
 | 
					   do 
 | 
				
			||||||
    j <- samplejournal
 | 
					    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"
 | 
					     ["2008/01/01 income               assets:bank:checking             $1           $1"
 | 
				
			||||||
     ,"                                income:salary                   $-1            0"
 | 
					     ,"                                income:salary                   $-1            0"
 | 
				
			||||||
     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | 
					     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | 
				
			||||||
@ -345,7 +344,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
   do 
 | 
					   do 
 | 
				
			||||||
    let opts = [Cleared]
 | 
					    let opts = [Cleared]
 | 
				
			||||||
    j <- readJournal' sample_journal_str
 | 
					    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"
 | 
					     ["2008/06/03 eat & shop           expenses:food                    $1           $1"
 | 
				
			||||||
     ,"                                expenses:supplies                $1           $2"
 | 
					     ,"                                expenses:supplies                $1           $2"
 | 
				
			||||||
     ,"                                assets:cash                     $-2            0"
 | 
					     ,"                                assets:cash                     $-2            0"
 | 
				
			||||||
@ -357,7 +356,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
   do 
 | 
					   do 
 | 
				
			||||||
    let opts = [UnCleared]
 | 
					    let opts = [UnCleared]
 | 
				
			||||||
    j <- readJournal' sample_journal_str
 | 
					    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"
 | 
					     ["2008/01/01 income               assets:bank:checking             $1           $1"
 | 
				
			||||||
     ,"                                income:salary                   $-1            0"
 | 
					     ,"                                income:salary                   $-1            0"
 | 
				
			||||||
     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | 
					     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
 | 
				
			||||||
@ -377,19 +376,19 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
        ,"  e  1"
 | 
					        ,"  e  1"
 | 
				
			||||||
        ,"  f"
 | 
					        ,"  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" ~:
 | 
					  ,"register report with account pattern" ~:
 | 
				
			||||||
   do
 | 
					   do
 | 
				
			||||||
    j <- samplejournal
 | 
					    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"
 | 
					     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
 | 
				
			||||||
     ]
 | 
					     ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  ,"register report with account pattern, case insensitive" ~:
 | 
					  ,"register report with account pattern, case insensitive" ~:
 | 
				
			||||||
   do 
 | 
					   do 
 | 
				
			||||||
    j <- samplejournal
 | 
					    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"
 | 
					     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
 | 
				
			||||||
     ]
 | 
					     ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -397,7 +396,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
   do 
 | 
					   do 
 | 
				
			||||||
    j <- samplejournal
 | 
					    j <- samplejournal
 | 
				
			||||||
    let gives displayexpr = 
 | 
					    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]
 | 
					                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"]
 | 
				
			||||||
    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
 | 
					    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
 | 
				
			||||||
@ -410,7 +409,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
    j <- samplejournal
 | 
					    j <- samplejournal
 | 
				
			||||||
    let periodexpr `gives` dates = do
 | 
					    let periodexpr `gives` dates = do
 | 
				
			||||||
          j' <- samplejournal
 | 
					          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]
 | 
					              where opts = [Period periodexpr]
 | 
				
			||||||
    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
 | 
					    ""     `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"]
 | 
					    "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"]
 | 
					    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
 | 
				
			||||||
    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
 | 
					    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
 | 
				
			||||||
    let opts = [Period "yearly"]
 | 
					    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"
 | 
					     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"
 | 
				
			||||||
     ,"                                assets:cash                     $-2          $-1"
 | 
					     ,"                                assets:cash                     $-2          $-1"
 | 
				
			||||||
     ,"                                expenses:food                    $1            0"
 | 
					     ,"                                expenses:food                    $1            0"
 | 
				
			||||||
@ -429,9 +428,9 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
     ,"                                liabilities:debts                $1            0"
 | 
					     ,"                                liabilities:debts                $1            0"
 | 
				
			||||||
     ]
 | 
					     ]
 | 
				
			||||||
    let opts = [Period "quarterly"]
 | 
					    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]
 | 
					    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 
 | 
					   do 
 | 
				
			||||||
    j <- samplejournal
 | 
					    j <- samplejournal
 | 
				
			||||||
    let opts = [Depth "2"]
 | 
					    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"
 | 
					     ["2008/01/01 income               assets:bank                      $1           $1"
 | 
				
			||||||
     ,"                                income:salary                   $-1            0"
 | 
					     ,"                                income:salary                   $-1            0"
 | 
				
			||||||
     ,"2008/06/01 gift                 assets:bank                      $1           $1"
 | 
					     ,"2008/06/01 gift                 assets:bank                      $1           $1"
 | 
				
			||||||
@ -460,7 +459,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
  ,"unicode in balance layout" ~: do
 | 
					  ,"unicode in balance layout" ~: do
 | 
				
			||||||
    j <- readJournal'
 | 
					    j <- readJournal'
 | 
				
			||||||
      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
 | 
					      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
 | 
				
			||||||
    balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) j) `is` unlines
 | 
					    balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
 | 
				
			||||||
      ["                -100  актив:наличные"
 | 
					      ["                -100  актив:наличные"
 | 
				
			||||||
      ,"                 100  расходы:покупки"
 | 
					      ,"                 100  расходы:покупки"
 | 
				
			||||||
      ,"--------------------"
 | 
					      ,"--------------------"
 | 
				
			||||||
@ -470,7 +469,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
  ,"unicode in register layout" ~: do
 | 
					  ,"unicode in register layout" ~: do
 | 
				
			||||||
    j <- readJournal'
 | 
					    j <- readJournal'
 | 
				
			||||||
      "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
 | 
					      "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"
 | 
					      ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"
 | 
				
			||||||
      ,"                                актив:наличные                 -100            0"]
 | 
					      ,"                                актив:наличные                 -100            0"]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -485,7 +484,7 @@ tests_Hledger_Cli = TestList
 | 
				
			|||||||
-- fixtures/test data
 | 
					-- fixtures/test data
 | 
				
			||||||
 | 
					
 | 
				
			||||||
date1 = parsedate "2008/11/26"
 | 
					date1 = parsedate "2008/11/26"
 | 
				
			||||||
t1 = LocalTime date1 midday
 | 
					-- t1 = LocalTime date1 midday
 | 
				
			||||||
 | 
					
 | 
				
			||||||
samplejournal = readJournal' sample_journal_str
 | 
					samplejournal = readJournal' sample_journal_str
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -218,9 +218,9 @@ appendToJournalFile f s =
 | 
				
			|||||||
-- | Convert a string of journal data into a register report.
 | 
					-- | Convert a string of journal data into a register report.
 | 
				
			||||||
registerFromString :: String -> IO String
 | 
					registerFromString :: String -> IO String
 | 
				
			||||||
registerFromString s = do
 | 
					registerFromString s = do
 | 
				
			||||||
  now <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  j <- readJournal' s
 | 
					  j <- readJournal' s
 | 
				
			||||||
  return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) j
 | 
					  return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] d) j
 | 
				
			||||||
    where opts = [Empty]
 | 
					    where opts = [Empty]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Return a similarity measure, from 0 to 1, for two strings.
 | 
					-- | 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.
 | 
					-- | Print a balance report.
 | 
				
			||||||
balance :: [Opt] -> [String] -> Journal -> IO ()
 | 
					balance :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
balance opts args j = do
 | 
					balance opts args j = do
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j
 | 
					  putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args d) j
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Render a balance report as plain text suitable for console output.
 | 
					-- | Render a balance report as plain text suitable for console output.
 | 
				
			||||||
balanceReportAsText :: [Opt] -> BalanceReport -> String
 | 
					balanceReportAsText :: [Opt] -> BalanceReport -> String
 | 
				
			||||||
 | 
				
			|||||||
@ -14,7 +14,6 @@ import Text.Printf
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
import Hledger.Cli.Options
 | 
					import Hledger.Cli.Options
 | 
				
			||||||
import Hledger.Data
 | 
					import Hledger.Data
 | 
				
			||||||
import Hledger.Utils
 | 
					 | 
				
			||||||
import Prelude hiding (putStr)
 | 
					import Prelude hiding (putStr)
 | 
				
			||||||
import Hledger.Utils.UTF8 (putStr)
 | 
					import Hledger.Utils.UTF8 (putStr)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -25,8 +24,8 @@ barchar = '*'
 | 
				
			|||||||
-- number of postings per day.
 | 
					-- number of postings per day.
 | 
				
			||||||
histogram :: [Opt] -> [String] -> Journal -> IO ()
 | 
					histogram :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
histogram opts args j = do
 | 
					histogram opts args j = do
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  putStr $ showHistogram opts (optsToFilterSpec opts args t) j
 | 
					  putStr $ showHistogram opts (optsToFilterSpec opts args d) j
 | 
				
			||||||
 | 
					
 | 
				
			||||||
showHistogram :: [Opt] -> FilterSpec -> Journal -> String
 | 
					showHistogram :: [Opt] -> FilterSpec -> Journal -> String
 | 
				
			||||||
showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
 | 
					showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
 | 
				
			||||||
 | 
				
			|||||||
@ -8,7 +8,6 @@ import Data.Char (toLower)
 | 
				
			|||||||
import Data.List
 | 
					import Data.List
 | 
				
			||||||
import Data.Maybe
 | 
					import Data.Maybe
 | 
				
			||||||
import Data.Time.Calendar
 | 
					import Data.Time.Calendar
 | 
				
			||||||
import Data.Time.LocalTime
 | 
					 | 
				
			||||||
import System.Console.GetOpt
 | 
					import System.Console.GetOpt
 | 
				
			||||||
import System.Environment
 | 
					import System.Environment
 | 
				
			||||||
import Test.HUnit
 | 
					import Test.HUnit
 | 
				
			||||||
@ -292,9 +291,9 @@ parsePatternArgs args = (as, ds')
 | 
				
			|||||||
      ds' = map (drop (length descprefix)) ds
 | 
					      ds' = map (drop (length descprefix)) ds
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Convert application options to the library's generic filter specification.
 | 
					-- | Convert application options to the library's generic filter specification.
 | 
				
			||||||
optsToFilterSpec :: [Opt] -> [String] -> LocalTime -> FilterSpec
 | 
					optsToFilterSpec :: [Opt] -> [String] -> Day -> FilterSpec
 | 
				
			||||||
optsToFilterSpec opts args t = FilterSpec {
 | 
					optsToFilterSpec opts args d = FilterSpec {
 | 
				
			||||||
                                datespan=dateSpanFromOpts (localDay t) opts
 | 
					                                datespan=dateSpanFromOpts d opts
 | 
				
			||||||
                               ,cleared=clearedValueFromOpts opts
 | 
					                               ,cleared=clearedValueFromOpts opts
 | 
				
			||||||
                               ,real=Real `elem` opts
 | 
					                               ,real=Real `elem` opts
 | 
				
			||||||
                               ,empty=Empty `elem` opts
 | 
					                               ,empty=Empty `elem` opts
 | 
				
			||||||
 | 
				
			|||||||
@ -18,7 +18,6 @@ import Data.Ord
 | 
				
			|||||||
import Hledger.Cli.Options
 | 
					import Hledger.Cli.Options
 | 
				
			||||||
import Hledger.Cli.Utils
 | 
					import Hledger.Cli.Utils
 | 
				
			||||||
import Hledger.Data
 | 
					import Hledger.Data
 | 
				
			||||||
import Hledger.Utils
 | 
					 | 
				
			||||||
import Prelude hiding (putStr)
 | 
					import Prelude hiding (putStr)
 | 
				
			||||||
import Hledger.Utils.UTF8 (putStr)
 | 
					import Hledger.Utils.UTF8 (putStr)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -32,8 +31,8 @@ type JournalReportItem = Transaction
 | 
				
			|||||||
-- | Print journal transactions in standard format.
 | 
					-- | Print journal transactions in standard format.
 | 
				
			||||||
print' :: [Opt] -> [String] -> Journal -> IO ()
 | 
					print' :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
print' opts args j = do
 | 
					print' opts args j = do
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  putStr $ showTransactions opts (optsToFilterSpec opts args t) j
 | 
					  putStr $ showTransactions opts (optsToFilterSpec opts args d) j
 | 
				
			||||||
 | 
					
 | 
				
			||||||
showTransactions :: [Opt] -> FilterSpec -> Journal -> String
 | 
					showTransactions :: [Opt] -> FilterSpec -> Journal -> String
 | 
				
			||||||
showTransactions opts fspec j = journalReportAsText opts fspec $ journalReport opts fspec j
 | 
					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.
 | 
					-- | Print a register report.
 | 
				
			||||||
register :: [Opt] -> [String] -> Journal -> IO ()
 | 
					register :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
register opts args j = do
 | 
					register opts args j = do
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args t) j
 | 
					  putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args d) j
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Render a register report as plain text suitable for console output.
 | 
					-- | Render a register report as plain text suitable for console output.
 | 
				
			||||||
registerReportAsText :: [Opt] -> RegisterReport -> String
 | 
					registerReportAsText :: [Opt] -> RegisterReport -> String
 | 
				
			||||||
 | 
				
			|||||||
@ -16,7 +16,6 @@ import qualified Data.Map as Map
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
import Hledger.Cli.Options
 | 
					import Hledger.Cli.Options
 | 
				
			||||||
import Hledger.Data
 | 
					import Hledger.Data
 | 
				
			||||||
import Hledger.Utils
 | 
					 | 
				
			||||||
import Prelude hiding (putStr)
 | 
					import Prelude hiding (putStr)
 | 
				
			||||||
import Hledger.Utils.UTF8 (putStr)
 | 
					import Hledger.Utils.UTF8 (putStr)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -25,13 +24,12 @@ import Hledger.Utils.UTF8 (putStr)
 | 
				
			|||||||
-- | Print various statistics for the journal.
 | 
					-- | Print various statistics for the journal.
 | 
				
			||||||
stats :: [Opt] -> [String] -> Journal -> IO ()
 | 
					stats :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
stats opts args j = do
 | 
					stats opts args j = do
 | 
				
			||||||
  today <- getCurrentDay
 | 
					  d <- getCurrentDay
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  let filterspec = optsToFilterSpec opts args d
 | 
				
			||||||
  let filterspec = optsToFilterSpec opts args t
 | 
					 | 
				
			||||||
      l = journalToLedger filterspec j
 | 
					      l = journalToLedger filterspec j
 | 
				
			||||||
      reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)
 | 
					      reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)
 | 
				
			||||||
      intervalspans = splitSpan (intervalFromOpts opts) reportspan
 | 
					      intervalspans = splitSpan (intervalFromOpts opts) reportspan
 | 
				
			||||||
      showstats = showLedgerStats opts args l today
 | 
					      showstats = showLedgerStats opts args l d
 | 
				
			||||||
      s = intercalate "\n" $ map showstats intervalspans
 | 
					      s = intercalate "\n" $ map showstats intervalspans
 | 
				
			||||||
  putStr s
 | 
					  putStr s
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user