1 {-| 
    2 
    3 Print a histogram report.
    4 
    5 -}
    6 
    7 module Commands.Histogram
    8 where
    9 import Prelude hiding (putStr)
   10 import qualified Data.Map as Map
   11 import Data.Map ((!))
   12 import Ledger
   13 import Options
   14 import System.IO.UTF8
   15 
   16 
   17 barchar = '*'
   18 
   19 -- | Print a histogram of some statistic per reporting interval, such as
   20 -- number of transactions per day.
   21 histogram :: [Opt] -> [String] -> Ledger -> IO ()
   22 histogram opts args l = putStr $ showHistogram opts args l
   23 
   24 showHistogram :: [Opt] -> [String] -> Ledger -> String
   25 showHistogram opts args l = concatMap (printDayWith countBar) daytxns
   26     where
   27       i = intervalFromOpts opts
   28       interval | i == NoInterval = Daily
   29                | otherwise = i
   30       fullspan = rawLedgerDateSpan $ rawledger l
   31       days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
   32       daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
   33       -- same as Register
   34       ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
   35       filterempties
   36           | Empty `elem` opts = id
   37           | otherwise = filter (not . isZeroMixedAmount . tamount)
   38       matchapats t = matchpats apats $ taccount t
   39       (apats,_) = parsePatternArgs args
   40       filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth)
   41                   | otherwise = id
   42       depth = depthFromOpts opts
   43 
   44 printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
   45 
   46 countBar ts = replicate (length ts) barchar
   47 
   48 total ts = show $ sumTransactions ts
   49 
   50 -- totalBar ts = replicate (sumTransactions ts) barchar