stats: fix/improve --period support, now a reporting interval causes multiple reports
This commit is contained in:
		
							parent
							
								
									7f8a352c0c
								
							
						
					
					
						commit
						8df720d07e
					
				@ -9,26 +9,31 @@ module Hledger.Cli.Commands.Stats
 | 
				
			|||||||
where
 | 
					where
 | 
				
			||||||
import Hledger.Data
 | 
					import Hledger.Data
 | 
				
			||||||
import Hledger.Cli.Options
 | 
					import Hledger.Cli.Options
 | 
				
			||||||
 | 
					import qualified Data.Map as Map
 | 
				
			||||||
#if __GLASGOW_HASKELL__ <= 610
 | 
					#if __GLASGOW_HASKELL__ <= 610
 | 
				
			||||||
import Prelude hiding ( putStr )
 | 
					import Prelude hiding ( putStr )
 | 
				
			||||||
import System.IO.UTF8
 | 
					import System.IO.UTF8
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
import qualified Data.Map as Map
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- like Register.summarisePostings
 | 
				
			||||||
-- | Print various statistics for the ledger.
 | 
					-- | Print various statistics for the ledger.
 | 
				
			||||||
stats :: [Opt] -> [String] -> Journal -> IO ()
 | 
					stats :: [Opt] -> [String] -> Journal -> IO ()
 | 
				
			||||||
stats opts args j = do
 | 
					stats opts args j = do
 | 
				
			||||||
  today <- getCurrentDay
 | 
					  today <- getCurrentDay
 | 
				
			||||||
  t <- getCurrentLocalTime
 | 
					  t <- getCurrentLocalTime
 | 
				
			||||||
  let filterspec = optsToFilterSpec opts args t
 | 
					  let filterspec = optsToFilterSpec opts args t
 | 
				
			||||||
  putStr $ showStats opts args (journalToLedger filterspec j) today
 | 
					      l = journalToLedger filterspec j
 | 
				
			||||||
 | 
					      reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)
 | 
				
			||||||
 | 
					      intervalspans = splitSpan (intervalFromOpts opts) reportspan
 | 
				
			||||||
 | 
					      showstats = showLedgerStats opts args l today
 | 
				
			||||||
 | 
					      s = intercalate "\n" $ map showstats intervalspans
 | 
				
			||||||
 | 
					  putStr s
 | 
				
			||||||
 | 
					
 | 
				
			||||||
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
 | 
					showLedgerStats :: [Opt] -> [String] -> Ledger -> Day -> DateSpan -> String
 | 
				
			||||||
showStats _ _ l today =
 | 
					showLedgerStats _ _ l today span =
 | 
				
			||||||
    heading ++ unlines (map (uncurry (printf fmt)) stats)
 | 
					    unlines (map (uncurry (printf fmt)) stats)
 | 
				
			||||||
    where
 | 
					    where
 | 
				
			||||||
      heading = underline $ printf "Ledger statistics as of %s" (show today)
 | 
					 | 
				
			||||||
      fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"
 | 
					      fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"
 | 
				
			||||||
      w1 = maximum $ map (length . fst) stats
 | 
					      w1 = maximum $ map (length . fst) stats
 | 
				
			||||||
      w2 = maximum $ map (length . show . snd) stats
 | 
					      w2 = maximum $ map (length . show . snd) stats
 | 
				
			||||||
@ -41,14 +46,16 @@ showStats _ _ l today =
 | 
				
			|||||||
        ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
 | 
					        ,("Transactions last 7 days", printf "%d (%0.1f per day)" tnum7 txnrate7)
 | 
				
			||||||
        ,("Payees/descriptions", show $ length $ nub $ map tdescription ts)
 | 
					        ,("Payees/descriptions", show $ length $ nub $ map tdescription ts)
 | 
				
			||||||
        ,("Accounts", printf "%d (depth %d)" acctnum acctdepth)
 | 
					        ,("Accounts", printf "%d (depth %d)" acctnum acctdepth)
 | 
				
			||||||
        ,("Commodities", printf "%s (%s)" (show $ length $ cs) (intercalate ", " $ sort $ map symbol cs)) 
 | 
					        ,("Commodities", printf "%s (%s)" (show $ length cs) (intercalate ", " cs))
 | 
				
			||||||
      -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
 | 
					      -- Transactions this month     : %(monthtxns)s (last month in the same period: %(lastmonthtxns)s)
 | 
				
			||||||
      -- Uncleared transactions      : %(uncleared)s
 | 
					      -- Uncleared transactions      : %(uncleared)s
 | 
				
			||||||
      -- Days since reconciliation   : %(reconcileelapsed)s
 | 
					      -- Days since reconciliation   : %(reconcileelapsed)s
 | 
				
			||||||
      -- Days since last transaction : %(recentelapsed)s
 | 
					      -- Days since last transaction : %(recentelapsed)s
 | 
				
			||||||
       ]
 | 
					       ]
 | 
				
			||||||
           where
 | 
					           where
 | 
				
			||||||
             ts = sortBy (comparing tdate) $ jtxns $ journal l
 | 
					             ts = sortBy (comparing tdate) $ filter (spanContainsDate span . tdate) $ jtxns $ journal 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
 | 
					             lastdate | null ts = Nothing
 | 
				
			||||||
                      | otherwise = Just $ tdate $ last ts
 | 
					                      | otherwise = Just $ tdate $ last ts
 | 
				
			||||||
             lastelapsed = maybe Nothing (Just . diffDays today) lastdate
 | 
					             lastelapsed = maybe Nothing (Just . diffDays today) lastdate
 | 
				
			||||||
@ -58,7 +65,6 @@ showStats _ _ l today =
 | 
				
			|||||||
                                             direction | days >= 0 = "days ago"
 | 
					                                             direction | days >= 0 = "days ago"
 | 
				
			||||||
                                                       | otherwise = "days from now"
 | 
					                                                       | otherwise = "days from now"
 | 
				
			||||||
             tnum = length ts
 | 
					             tnum = length ts
 | 
				
			||||||
             span = rawdatespan l
 | 
					 | 
				
			||||||
             start (DateSpan (Just d) _) = show d
 | 
					             start (DateSpan (Just d) _) = show d
 | 
				
			||||||
             start _ = ""
 | 
					             start _ = ""
 | 
				
			||||||
             end (DateSpan _ (Just d)) = show d
 | 
					             end (DateSpan _ (Just d)) = show d
 | 
				
			||||||
@ -74,7 +80,5 @@ showStats _ _ l today =
 | 
				
			|||||||
             txnrate7 = fromIntegral tnum7 / 7 :: Double
 | 
					             txnrate7 = fromIntegral tnum7 / 7 :: Double
 | 
				
			||||||
             acctnum = length as
 | 
					             acctnum = length as
 | 
				
			||||||
             acctdepth | null as = 0
 | 
					             acctdepth | null as = 0
 | 
				
			||||||
                       | otherwise = maximum $ map (accountNameLevel.aname) as
 | 
					                       | otherwise = maximum $ map accountNameLevel as
 | 
				
			||||||
             as = accounts l
 | 
					 | 
				
			||||||
             cs = Map.elems $ commodities l
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user