From f9bb7bd7b9f7ad17fd4c6bfde55a3716028b24db Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 Apr 2014 08:39:33 -0700 Subject: [PATCH] chart: fixes for latest hledger api, incomplete --- extra/hledger-chart/Hledger/Chart/Main.hs | 20 ++++----- extra/hledger-chart/Hledger/Chart/Options.hs | 43 +++++++++----------- 2 files changed, 28 insertions(+), 35 deletions(-) diff --git a/extra/hledger-chart/Hledger/Chart/Main.hs b/extra/hledger-chart/Hledger/Chart/Main.hs index 9a83420f4..2516133b1 100644 --- a/extra/hledger-chart/Hledger/Chart/Main.hs +++ b/extra/hledger-chart/Hledger/Chart/Main.hs @@ -22,8 +22,6 @@ import Text.Printf import Hledger import Hledger.Cli hiding (progname,progversion) -import Prelude hiding (putStrLn) -import Hledger.Utils.UTF8 (putStrLn) import Hledger.Chart.Options @@ -37,9 +35,9 @@ runWith :: ChartOpts -> IO () runWith opts = run opts where run opts - | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess - | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess - | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) + | "--help" `elem` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess + | "--version" `elem` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess + | "--binary-filename" `elem` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | otherwise = withJournalDo' opts chart withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO () @@ -54,7 +52,7 @@ chart opts j = do if null $ jtxns j then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure else do - let chart = genPie opts (optsToFilterSpec ropts d) j + let chart = genPie opts (queryFromOpts d ropts) j renderableToPNGFile (toRenderable chart) w h filename return () where @@ -70,9 +68,9 @@ parseSize str = (read w, read h) (w,_:h) = splitAt x str -- | Generate pie chart -genPie :: ChartOpts -> FilterSpec -> Journal -> PieLayout -genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white - , pie_plot_ = pie_chart } +genPie :: ChartOpts -> Query -> Journal -> PieLayout +genPie opts q j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white + , pie_plot_ = pie_chart } where pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems , pie_start_angle_ = (-90) @@ -82,7 +80,7 @@ genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ chartitems = debug "chart" $ top num samesignitems (samesignitems, sign) = sameSignNonZero rawitems 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] where (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t @@ -116,7 +114,7 @@ balances (Node rootAcc subAccs) = Node newroot newsubs where newroot = (aname rootAcc, amountValue $ - abalance rootAcc - (sum . map (abalance . root)) subAccs) + aibalance rootAcc - (sum . map (aibalance . root)) subAccs) newsubs = map balances subAccs -- | Build a single pie chart item diff --git a/extra/hledger-chart/Hledger/Chart/Options.hs b/extra/hledger-chart/Hledger/Chart/Options.hs index cdcf3b3fc..a3ffd8ee0 100644 --- a/extra/hledger-chart/Hledger/Chart/Options.hs +++ b/extra/hledger-chart/Hledger/Chart/Options.hs @@ -6,38 +6,33 @@ module Hledger.Chart.Options where import Data.Maybe -import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion) import System.Console.CmdArgs import System.Console.CmdArgs.Explicit -import Hledger.Cli hiding (progname,progversion) -import qualified Hledger.Cli (progname) +import Hledger.Cli hiding (progname) +--import qualified Hledger.Cli (progname) -progname = $(packageVariable (pkgName . package)) -progversion = progname ++ " " ++ $(packageVariable (pkgVersion . package)) :: String +progname = "hledger-chart" +progversion = progname ++ " dev" defchartoutput = "hledger.png" defchartitems = 10 defchartsize = "600x400" -chartflags = [ - 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-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 = [] - ,groupNamed = [(generalflagstitle, generalflags1)] - } - ,modeHelpSuffix=[ - -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." - ] - } +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-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++")") + ] + ,groupHidden = [] + } + } -- hledger-chart options, used in hledger-chart and above data ChartOpts = ChartOpts { @@ -57,7 +52,7 @@ defchartopts = ChartOpts toChartOpts :: RawOpts -> IO ChartOpts toChartOpts rawopts = do - cliopts <- toCliOpts rawopts + cliopts <- rawOptsToCliOpts rawopts return defchartopts { chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts