add histogram to web ui

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
 

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
   ," <a href=register>register</a>"
   ,"|"
   ," <a href=print>print</a>"
+  ,"|"
+  ," <a href=histogram>histogram</a>"
   ,"</div>"
   ,"<pre>%s</pre>"
   ])