slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

add histogram to web ui

Browse Source
This commit is contained in:
Simon Michael 2009-04-04 19:13:53 +00:00
parent 7e6df61889
commit 69278d5a04
2 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
HistogramCommand.hs
View File

@ -19,8 +19,10 @@ barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as -- | Print a histogram of some statistic per reporting interval, such as
-- number of transactions per day. -- number of transactions per day.
histogram :: [Opt] -> [String] -> Ledger -> IO () histogram :: [Opt] -> [String] -> Ledger -> IO ()
histogram opts args l = histogram opts args l = putStr $ showHistogram opts args l
mapM_ (printDayWith countBar) daytxns
showHistogram :: [Opt] -> [String] -> Ledger -> String
showHistogram opts args l = concatMap (printDayWith countBar) daytxns
where where
i = intervalFromOpts opts i = intervalFromOpts opts
interval | i == NoInterval = Daily interval | i == NoInterval = Daily
@ -39,7 +41,7 @@ histogram opts args l =
| otherwise = id | otherwise = id
depth = depthFromOpts opts 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 countBar ts = replicate (length ts) barchar

8
WebCommand.hs
View File

@ -26,6 +26,7 @@ import Options
import BalanceCommand import BalanceCommand
import RegisterCommand import RegisterCommand
import PrintCommand import PrintCommand
import HistogramCommand
tcpport = 5000 tcpport = 5000
@ -55,12 +56,17 @@ web opts args l =
,dir "register" $ templatise $ registerreport [] ,dir "register" $ templatise $ registerreport []
,dir "balance" $ withDataFn (look "a") $ \a -> templatise $ balancereport [a] ,dir "balance" $ withDataFn (look "a") $ \a -> templatise $ balancereport [a]
,dir "balance" $ templatise $ balancereport [] ,dir "balance" $ templatise $ balancereport []
,dir "histogram" $ withDataFn (look "a") $ \a -> templatise $ histogramreport [a]
,dir "histogram" $ templatise $ histogramreport []
] ]
printreport apats = showLedgerTransactions opts (apats ++ args) l printreport apats = showLedgerTransactions opts (apats ++ args) l
registerreport apats = showRegisterReport opts (apats ++ args) l registerreport apats = showRegisterReport opts (apats ++ args) l
balancereport [] = showBalanceReport opts args l balancereport [] = showBalanceReport opts args l
balancereport apats = showBalanceReport opts (apats ++ args) l' balancereport apats = showBalanceReport opts (apats ++ args) l'
where l' = cacheLedger apats (rawledger l) -- re-filter by account pattern each time 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 :: String -> ServerPartT IO Response
templatise s = do templatise s = do
@ -78,6 +84,8 @@ maintemplate r = printf (unlines
," <a href=register>register</a>" ," <a href=register>register</a>"
,"|" ,"|"
," <a href=print>print</a>" ," <a href=print>print</a>"
,"|"
," <a href=histogram>histogram</a>"
,"</div>" ,"</div>"
,"<pre>%s</pre>" ,"<pre>%s</pre>"
]) ])