chart: handle positive/negative balances better; tune defaults
Mixed positive and negative balances were confusing things. Now, the chart will omit any balances which do not match the sign of the first balance. Various other size/font/colour tweaks. Charts are now red for positive balances (like expense accounts) and green for negative balances (like income accounts). This is fun, but falls down for eg assets and liabilities.. better ideas welcome.
This commit is contained in:
parent
160f8dc5b8
commit
0734da2bbe
@ -32,8 +32,8 @@ chart opts args l = do
|
|||||||
let chart = genPie opts (optsToFilterSpec opts args t) l
|
let chart = genPie opts (optsToFilterSpec opts args t) l
|
||||||
renderableToPNGFile (toRenderable chart) w h filename
|
renderableToPNGFile (toRenderable chart) w h filename
|
||||||
where
|
where
|
||||||
filename = getOption opts ChartOutput "hledger.png"
|
filename = getOption opts ChartOutput chartoutput
|
||||||
(w,h) = parseSize $ getOption opts ChartSize "1024x1024"
|
(w,h) = parseSize $ getOption opts ChartSize chartsize
|
||||||
|
|
||||||
-- | Extract string option value from a list of options or use the default
|
-- | Extract string option value from a list of options or use the default
|
||||||
getOption :: [Opt] -> (String->Opt) -> String -> String
|
getOption :: [Opt] -> (String->Opt) -> String -> String
|
||||||
@ -51,19 +51,36 @@ parseSize str = (read w, read h)
|
|||||||
|
|
||||||
-- | Generate pie chart
|
-- | Generate pie chart
|
||||||
genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout
|
genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout
|
||||||
genPie opts filterspec l = defaultPieLayout
|
genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
|
||||||
{ pie_background_ = solidFillStyle $ opaque $ white
|
, pie_plot_ = pie_chart }
|
||||||
, pie_plot_ = pie_chart }
|
|
||||||
where
|
where
|
||||||
pie_chart = defaultPieChart { pie_data_ = items, pie_colors_ = mkColours}
|
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'
|
||||||
items = mapMaybe (uncurry accountPieItem) $
|
, pie_start_angle_ = (-90)
|
||||||
top num $
|
, pie_colors_ = mkColours hue
|
||||||
balances $
|
, pie_label_style_ = defaultFontStyle{font_size_=12}
|
||||||
ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ cacheLedger'' filterspec l
|
}
|
||||||
|
chartitems' = debug "chart" $ top num samesignitems
|
||||||
|
(samesignitems, sign) = sameSignNonZero rawitems
|
||||||
|
rawitems = debug "raw" $ flatten $ balances $
|
||||||
|
ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ cacheLedger'' filterspec l
|
||||||
top n t = topn ++ [other]
|
top n t = topn ++ [other]
|
||||||
where (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) $ flatten t
|
where
|
||||||
other = ("other", sum $ map snd rest)
|
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t
|
||||||
num = readDef 10 (getOption opts ChartItems "10")
|
other = ("other", sum $ map snd rest)
|
||||||
|
num = readDef (fromIntegral chartitems) (getOption opts ChartItems (show chartitems))
|
||||||
|
hue = if sign > 0 then red else green where (red, green) = (0, 110)
|
||||||
|
debug s = if Debug `elem` opts then ltrace s else id
|
||||||
|
|
||||||
|
-- | Select the nonzero items with same sign as the first, and make
|
||||||
|
-- them positive. Also return a 1 or -1 corresponding to the original sign.
|
||||||
|
sameSignNonZero :: [(AccountName, Double)] -> ([(AccountName, Double)], Int)
|
||||||
|
sameSignNonZero is | null nzs = ([], 1)
|
||||||
|
| otherwise = (map pos $ filter (test.snd) nzs, sign)
|
||||||
|
where
|
||||||
|
nzs = filter ((/=0).snd) is
|
||||||
|
pos (a,b) = (a, abs b)
|
||||||
|
sign = if snd (head nzs) >= 0 then 1 else (-1)
|
||||||
|
test = if sign > 0 then (>0) else (<0)
|
||||||
|
|
||||||
-- | Convert all quantities of MixedAccount to a single commodity
|
-- | Convert all quantities of MixedAccount to a single commodity
|
||||||
amountValue :: MixedAmount -> Double
|
amountValue :: MixedAmount -> Double
|
||||||
@ -81,16 +98,13 @@ balances (Node rootAcc subAccs) = Node newroot newsubs
|
|||||||
newsubs = map balances subAccs
|
newsubs = map balances subAccs
|
||||||
|
|
||||||
-- | Build a single pie chart item
|
-- | Build a single pie chart item
|
||||||
accountPieItem :: AccountName -> Double -> Maybe PieItem
|
accountPieItem :: AccountName -> Double -> PieItem
|
||||||
accountPieItem accname balance =
|
accountPieItem accname balance = PieItem accname offset balance where offset = 0
|
||||||
if balance == 0
|
|
||||||
then Nothing
|
|
||||||
else Just $ PieItem accname 0 balance
|
|
||||||
|
|
||||||
-- | Generate an infinite color list suitable for charts.
|
-- | Generate an infinite color list suitable for charts.
|
||||||
mkColours :: [AlphaColour Double]
|
mkColours :: Double -> [AlphaColour Double]
|
||||||
mkColours = cycle $ [opaque $ rgbToColour $ hsl h s l | (h,s,l) <- liftM3 (,,)
|
mkColours hue = cycle $ [opaque $ rgbToColour $ hsl h s l | (h,s,l) <- liftM3 (,,)
|
||||||
[100] [0.7] [0.2,0.3..0.6] ]
|
[hue] [0.7] [0.1,0.2..0.7] ]
|
||||||
|
|
||||||
rgbToColour :: (Fractional a) => RGB a -> Colour a
|
rgbToColour :: (Fractional a) => RGB a -> Colour a
|
||||||
rgbToColour (RGB r g b) = rgb r g b
|
rgbToColour (RGB r g b) = rgb r g b
|
||||||
|
|||||||
11
Options.hs
11
Options.hs
@ -16,6 +16,11 @@ import Control.Monad (liftM)
|
|||||||
|
|
||||||
progname = "hledger"
|
progname = "hledger"
|
||||||
timeprogname = "hours"
|
timeprogname = "hours"
|
||||||
|
#ifdef CHART
|
||||||
|
chartoutput = "hledger.png"
|
||||||
|
chartitems = 10
|
||||||
|
chartsize = "600x400"
|
||||||
|
#endif
|
||||||
|
|
||||||
usagehdr =
|
usagehdr =
|
||||||
"Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++
|
"Usage: hledger [OPTIONS] [COMMAND [PATTERNS]]\n" ++
|
||||||
@ -85,9 +90,9 @@ options = [
|
|||||||
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
|
,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose"
|
||||||
,Option "" ["debug-no-ui"] (NoArg DebugNoUI) "run ui commands with no output"
|
,Option "" ["debug-no-ui"] (NoArg DebugNoUI) "run ui commands with no output"
|
||||||
#ifdef CHART
|
#ifdef CHART
|
||||||
,Option "o" ["output"] (ReqArg ChartOutput "FILE") "chart: output filename (default: hledger.png)"
|
,Option "o" ["output"] (ReqArg ChartOutput "FILE") ("chart: output filename (default: "++chartoutput++")")
|
||||||
,Option "" ["items"] (ReqArg ChartItems "N") "chart: number of accounts to show (default: 10)"
|
,Option "" ["items"] (ReqArg ChartItems "N") ("chart: number of accounts to show (default: "++show chartitems++")")
|
||||||
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") "chart: image size (default: 1024x1024)"
|
,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("chart: image size (default: "++chartsize++")")
|
||||||
#endif
|
#endif
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user