diff --git a/HistogramCommand.hs b/HistogramCommand.hs index 3bf7f81c0..2bc45969e 100644 --- a/HistogramCommand.hs +++ b/HistogramCommand.hs @@ -19,8 +19,10 @@ barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as -- number of transactions per day. histogram :: [Opt] -> [String] -> Ledger -> IO () -histogram opts args l = - mapM_ (printDayWith countBar) daytxns +histogram opts args l = putStr $ showHistogram opts args l + +showHistogram :: [Opt] -> [String] -> Ledger -> String +showHistogram opts args l = concatMap (printDayWith countBar) daytxns where i = intervalFromOpts opts interval | i == NoInterval = Daily @@ -39,7 +41,7 @@ histogram opts args l = | otherwise = id depth = depthFromOpts opts -printDayWith f (DateSpan b _, ts) = putStrLn $ printf "%s %s" (show $ fromJust b) (f ts) +printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) countBar ts = replicate (length ts) barchar diff --git a/WebCommand.hs b/WebCommand.hs index f25da25ef..0ba797773 100644 --- a/WebCommand.hs +++ b/WebCommand.hs @@ -26,6 +26,7 @@ import Options import BalanceCommand import RegisterCommand import PrintCommand +import HistogramCommand tcpport = 5000 @@ -55,12 +56,17 @@ web opts args l = ,dir "register" $ templatise $ registerreport [] ,dir "balance" $ withDataFn (look "a") $ \a -> templatise $ balancereport [a] ,dir "balance" $ templatise $ balancereport [] + ,dir "histogram" $ withDataFn (look "a") $ \a -> templatise $ histogramreport [a] + ,dir "histogram" $ templatise $ histogramreport [] ] printreport apats = showLedgerTransactions opts (apats ++ args) l registerreport apats = showRegisterReport opts (apats ++ args) l balancereport [] = showBalanceReport opts args l balancereport apats = showBalanceReport opts (apats ++ args) l' where l' = cacheLedger apats (rawledger l) -- re-filter by account pattern each time + histogramreport [] = showHistogram opts args l + histogramreport apats = showHistogram opts (apats ++ args) l' + where l' = cacheLedger apats (rawledger l) -- re-filter by account pattern each time templatise :: String -> ServerPartT IO Response templatise s = do @@ -78,6 +84,8 @@ maintemplate r = printf (unlines ," register" ,"|" ," print" + ,"|" + ," histogram" ,"" ,"
%s" ])