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

chart: fixes for latest hledger api, incomplete

Browse Source
This commit is contained in:
Simon Michael 2014-04-30 08:39:33 -07:00
parent 76d337df13
commit f9bb7bd7b9
2 changed files with 28 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/hledger-chart/Hledger/Chart/Main.hs
View File

@ -22,8 +22,6 @@ import Text.Printf
import Hledger import Hledger
import Hledger.Cli hiding (progname,progversion) import Hledger.Cli hiding (progname,progversion)
import Prelude hiding (putStrLn)
import Hledger.Utils.UTF8 (putStrLn)
import Hledger.Chart.Options import Hledger.Chart.Options
@ -37,9 +35,9 @@ runWith :: ChartOpts -> IO ()
runWith opts = run opts runWith opts = run opts
where where
run opts run opts
| "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess | "--help" `elem` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess
| "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess | "--version" `elem` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | "--binary-filename" `elem` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = withJournalDo' opts chart | otherwise = withJournalDo' opts chart
withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO () withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO ()
@ -54,7 +52,7 @@ chart opts j = do
if null $ jtxns j if null $ jtxns j
then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure
else do else do
let chart = genPie opts (optsToFilterSpec ropts d) j let chart = genPie opts (queryFromOpts d ropts) j
renderableToPNGFile (toRenderable chart) w h filename renderableToPNGFile (toRenderable chart) w h filename
return () return ()
where where
@ -70,8 +68,8 @@ parseSize str = (read w, read h)
(w,_:h) = splitAt x str (w,_:h) = splitAt x str
-- | Generate pie chart -- | Generate pie chart
genPie :: ChartOpts -> FilterSpec -> Journal -> PieLayout genPie :: ChartOpts -> Query -> Journal -> PieLayout
genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white genPie opts q j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
, pie_plot_ = pie_chart } , pie_plot_ = pie_chart }
where where
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems
@ -82,7 +80,7 @@ genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $
chartitems = debug "chart" $ top num samesignitems chartitems = debug "chart" $ top num samesignitems
(samesignitems, sign) = sameSignNonZero rawitems (samesignitems, sign) = sameSignNonZero rawitems
rawitems = debug "raw" $ flatten $ balances $ rawitems = debug "raw" $ flatten $ balances $
ledgerAccountTree (fromMaybe 99999 $ depth_ ropts) $ journalToLedger filterspec j ledgerAccountTree (fromMaybe 99999 $ depth_ ropts) $ ledgerFromJournal q j
top n t = topn ++ [other] top n t = topn ++ [other]
where where
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t
@ -116,7 +114,7 @@ balances (Node rootAcc subAccs) = Node newroot newsubs
where where
newroot = (aname rootAcc, newroot = (aname rootAcc,
amountValue $ amountValue $
abalance rootAcc - (sum . map (abalance . root)) subAccs) aibalance rootAcc - (sum . map (aibalance . root)) subAccs)
newsubs = map balances subAccs newsubs = map balances subAccs
-- | Build a single pie chart item -- | Build a single pie chart item

29
extra/hledger-chart/Hledger/Chart/Options.hs
View File

@ -6,37 +6,32 @@
module Hledger.Chart.Options module Hledger.Chart.Options
where where
import Data.Maybe import Data.Maybe
import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion)
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import Hledger.Cli hiding (progname,progversion) import Hledger.Cli hiding (progname)
import qualified Hledger.Cli (progname) --import qualified Hledger.Cli (progname)
progname = $(packageVariable (pkgName . package)) progname = "hledger-chart"
progversion = progname ++ " " ++ $(packageVariable (pkgVersion . package)) :: String progversion = progname ++ " dev"
defchartoutput = "hledger.png" defchartoutput = "hledger.png"
defchartitems = 10 defchartitems = 10
defchartsize = "600x400" defchartsize = "600x400"
chartflags = [ chartmode = (defCommandMode ["hledger-chart"]) {
modeArgs = ([], Just $ argsFlag "[PATTERNS] --add-posting \"ACCT AMTEXPR\" ...")
,modeHelp = "generate a pie chart image for the top account balances (of one sign only)"
,modeHelpSuffix=[]
,modeGroupFlags = Group {
groupNamed = [generalflagsgroup1]
,groupUnnamed = [
flagReq ["chart-output","o"] (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")") flagReq ["chart-output","o"] (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")")
,flagReq ["chart-items"] (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")") ,flagReq ["chart-items"] (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")")
,flagReq ["chart-size"] (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")") ,flagReq ["chart-size"] (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")")
] ]
chartmode = (mode "hledger-chart" [("command","chart")]
"generate a pie chart image for the top account balances (of one sign only)"
commandargsflag []){
modeGroupFlags = Group {
groupUnnamed = chartflags
,groupHidden = [] ,groupHidden = []
,groupNamed = [(generalflagstitle, generalflags1)]
} }
,modeHelpSuffix=[
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
]
} }
-- hledger-chart options, used in hledger-chart and above -- hledger-chart options, used in hledger-chart and above
@ -57,7 +52,7 @@ defchartopts = ChartOpts
toChartOpts :: RawOpts -> IO ChartOpts toChartOpts :: RawOpts -> IO ChartOpts
toChartOpts rawopts = do toChartOpts rawopts = do
cliopts <- toCliOpts rawopts cliopts <- rawOptsToCliOpts rawopts
return defchartopts { return defchartopts {
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts