a2b8faa4d6
We now do data filtering/massage as late as possible, not just once at startup. This should work better for multiple commands, as with web or ui. The basic benchmark seems at least as good as before thanks to laziness.
48 lines
1.5 KiB
Haskell
48 lines
1.5 KiB
Haskell
{-|
|
|
|
|
Print a histogram report.
|
|
|
|
-}
|
|
|
|
module Commands.Histogram
|
|
where
|
|
import Prelude hiding (putStr)
|
|
import Ledger
|
|
import Options
|
|
import System.IO.UTF8
|
|
|
|
|
|
barchar = '*'
|
|
|
|
-- | Print a histogram of some statistic per reporting interval, such as
|
|
-- number of postings per day.
|
|
histogram :: [Opt] -> [String] -> Ledger -> IO ()
|
|
histogram opts args l = do
|
|
t <- getCurrentLocalTime
|
|
putStr $ showHistogram opts (optsToFilterSpec opts args t) l
|
|
|
|
showHistogram :: [Opt] -> FilterSpec -> Ledger -> String
|
|
showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps
|
|
where
|
|
i = intervalFromOpts opts
|
|
interval | i == NoInterval = Daily
|
|
| otherwise = i
|
|
fullspan = journalDateSpan $ journal l
|
|
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
|
|
dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]
|
|
-- same as Register
|
|
-- should count transactions, not postings ?
|
|
ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ ledgerPostings l
|
|
filterempties
|
|
| Empty `elem` opts = id
|
|
| otherwise = filter (not . isZeroMixedAmount . pamount)
|
|
matchapats = matchpats apats . paccount
|
|
apats = acctpats filterspec
|
|
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
|
|
| otherwise = id
|
|
depth = fromMaybe 99999 $ depthFromOpts opts
|
|
|
|
printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
|
|
|
|
countBar ps = replicate (length ps) barchar
|