From dee37efc1cd204c34524fbc42b8e594b09caee13 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 4 Apr 2009 11:19:51 +0000
Subject: [PATCH] histogram command, undocumented for now

---
 HistogramCommand.hs | 46 +++++++++++++++++++++++++++++++++++++++++++++
 hledger.hs          |  3 +++
 2 files changed, 49 insertions(+)
 create mode 100644 HistogramCommand.hs

diff --git a/HistogramCommand.hs b/HistogramCommand.hs
new file mode 100644
index 000000000..8e543b191
--- /dev/null
+++ b/HistogramCommand.hs
@@ -0,0 +1,46 @@
+{-| 
+
+Print a histogram report.
+
+-}
+
+module HistogramCommand
+where
+import qualified Data.Map as Map
+import Data.Map ((!))
+import Ledger
+import Options
+
+
+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
+    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]
+      -- same as RegisterCommand
+      ts = sortBy (comparing date) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l
+      filterempties
+          | Empty `elem` opts = id
+          | otherwise = filter (not . isZeroMixedAmount . amount)
+      matchapats t = matchpats apats $ account t
+      (apats,_) = parsePatternArgs args
+      filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ account t) <= depth)
+                  | otherwise = id
+      depth = depthFromOpts opts
+
+printDayWith f (DateSpan b _, ts) = putStrLn $ printf "%s %s" (show $ fromJust b) (f ts)
+
+countBar ts = replicate (length ts) barchar
+
+total ts = show $ sumTransactions ts
+
+-- totalBar ts = replicate (sumTransactions ts) barchar
\ No newline at end of file
diff --git a/hledger.hs b/hledger.hs
index 50b1702c2..a6f37add5 100644
--- a/hledger.hs
+++ b/hledger.hs
@@ -40,6 +40,7 @@ module Main (
              module BalanceCommand,
              module PrintCommand,
              module RegisterCommand,
+             module HistogramCommand,
 #ifdef VTY
              module UICommand,
 #endif
@@ -60,6 +61,7 @@ import Tests
 import BalanceCommand
 import PrintCommand
 import RegisterCommand
+import HistogramCommand
 #ifdef VTY
 import UICommand
 #endif
@@ -79,6 +81,7 @@ main = do
        | cmd `isPrefixOf` "balance"  = withLedgerDo opts args balance
        | cmd `isPrefixOf` "print"    = withLedgerDo opts args print'
        | cmd `isPrefixOf` "register" = withLedgerDo opts args register
+       | cmd `isPrefixOf` "histogram" = withLedgerDo opts args histogram
 #ifdef VTY
        | cmd `isPrefixOf` "ui"       = withLedgerDo opts args ui
 #endif