2009-04-04 15:19:51 +04:00
|
|
|
{-|
|
|
|
|
|
|
|
|
Print a histogram report.
|
|
|
|
|
|
|
|
-}
|
|
|
|
|
2009-06-02 22:29:01 +04:00
|
|
|
module Commands.Histogram
|
2009-04-04 15:19:51 +04:00
|
|
|
where
|
2009-05-15 00:44:06 +04:00
|
|
|
import Prelude hiding (putStr)
|
2009-04-04 15:19:51 +04:00
|
|
|
import Ledger
|
|
|
|
import Options
|
2009-05-15 00:44:06 +04:00
|
|
|
import System.IO.UTF8
|
2009-04-04 15:19:51 +04:00
|
|
|
|
|
|
|
|
|
|
|
barchar = '*'
|
|
|
|
|
|
|
|
-- | Print a histogram of some statistic per reporting interval, such as
|
|
|
|
-- number of transactions per day.
|
|
|
|
histogram :: [Opt] -> [String] -> Ledger -> IO ()
|
2009-09-22 19:56:59 +04:00
|
|
|
histogram opts args = putStr . showHistogram opts args
|
2009-04-04 23:13:53 +04:00
|
|
|
|
|
|
|
showHistogram :: [Opt] -> [String] -> Ledger -> String
|
|
|
|
showHistogram opts args l = concatMap (printDayWith countBar) daytxns
|
2009-04-04 15:19:51 +04:00
|
|
|
where
|
|
|
|
i = intervalFromOpts opts
|
|
|
|
interval | i == NoInterval = Daily
|
|
|
|
| otherwise = i
|
|
|
|
fullspan = rawLedgerDateSpan $ rawledger l
|
|
|
|
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
|
|
|
|
daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
|
2009-06-02 22:29:01 +04:00
|
|
|
-- same as Register
|
2009-04-05 01:26:55 +04:00
|
|
|
ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
|
2009-04-04 15:19:51 +04:00
|
|
|
filterempties
|
|
|
|
| Empty `elem` opts = id
|
2009-04-05 01:26:55 +04:00
|
|
|
| otherwise = filter (not . isZeroMixedAmount . tamount)
|
2009-09-22 19:56:59 +04:00
|
|
|
matchapats = matchpats apats . taccount
|
2009-04-04 15:19:51 +04:00
|
|
|
(apats,_) = parsePatternArgs args
|
2009-09-22 15:55:11 +04:00
|
|
|
filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
|
2009-04-04 15:19:51 +04:00
|
|
|
| otherwise = id
|
|
|
|
depth = depthFromOpts opts
|
|
|
|
|
2009-04-04 23:13:53 +04:00
|
|
|
printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
|
2009-04-04 15:19:51 +04:00
|
|
|
|
|
|
|
countBar ts = replicate (length ts) barchar
|
|
|
|
|
2009-09-22 19:56:59 +04:00
|
|
|
total = show . sumTransactions
|
2009-04-04 15:19:51 +04:00
|
|
|
|
2009-05-15 00:44:06 +04:00
|
|
|
-- totalBar ts = replicate (sumTransactions ts) barchar
|