mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
chart: fixes for latest hledger api, incomplete
This commit is contained in:
parent
76d337df13
commit
f9bb7bd7b9
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user