diff --git a/Hledger/Chart.hs b/Hledger/Chart.hs new file mode 100644 --- /dev/null +++ b/Hledger/Chart.hs @@ -0,0 +1,21 @@ +{-| +Re-export the modules of the hledger-chart program. +-} + +module Hledger.Chart ( + module Hledger.Chart.Main, + module Hledger.Chart.Options, + tests_Hledger_Chart + ) +where +import Test.HUnit + +import Hledger.Chart.Main +import Hledger.Chart.Options + +tests_Hledger_Chart :: Test +tests_Hledger_Chart = TestList + [ + -- tests_Hledger_Chart_Main + -- tests_Hledger_Chart_Options + ] diff --git a/Hledger/Chart/Main.hs b/Hledger/Chart/Main.hs --- a/Hledger/Chart/Main.hs +++ b/Hledger/Chart/Main.hs @@ -1,91 +1,66 @@ -{-# LANGUAGE CPP #-} {-| -hledger-web - a hledger add-on providing rudimentary pie chart generation. +hledger-chart - a hledger add-on providing rudimentary pie chart generation. Copyright (c) 2007-2011 Simon Michael Released under GPL version 3 or later. -} module Hledger.Chart.Main where -import Graphics.Rendering.Chart +import Control.Monad import Data.Colour import Data.Colour.Names import Data.Colour.RGBSpace import Data.Colour.RGBSpace.HSL (hsl) import Data.Colour.SRGB.Linear (rgb) import Data.List -import Safe (readDef) -import System.Console.GetOpt -import System.Exit (exitFailure) - -import Hledger.Cli.Options -import Hledger.Cli.Utils (withJournalDo) -import Hledger.Cli.Version (progversionstr, binaryfilename) -import Hledger.Data -import Prelude hiding (putStr, putStrLn) -import Hledger.Data.UTF8 (putStr, putStrLn) - - -progname_chart = progname_cli ++ "-chart" - -defchartoutput = "hledger.png" -defchartitems = 10 -defchartsize = "600x400" - -options_chart :: [OptDescr Opt] -options_chart = [ - Option "o" ["output"] (ReqArg ChartOutput "FILE") ("output filename (default: "++defchartoutput++")") - ,Option "" ["items"] (ReqArg ChartItems "N") ("number of accounts to show (default: "++show defchartitems++")") - ,Option "" ["size"] (ReqArg ChartSize "WIDTHxHEIGHT") ("image size (default: "++defchartsize++")") - ] - -usage_preamble_chart = - "Usage: hledger-chart [OPTIONS] [PATTERNS]\n" ++ - "\n" ++ - "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++ - "generates simple pie chart images.\n" ++ - "\n" +import Data.Maybe +import Data.Ord +import Data.Tree +import Graphics.Rendering.Chart +import System.Exit +import Text.Printf -usage_options_chart = usageInfo "hledger-chart options:" options_chart ++ "\n" +import Hledger +import Hledger.Cli hiding (progname,progversion) +import Prelude hiding (putStrLn) +import Hledger.Utils.UTF8 (putStrLn) -usage_chart = concat [ - usage_preamble_chart - ,usage_options_chart - ,usage_options_cli - ,usage_postscript_cli - ] +import Hledger.Chart.Options main :: IO () main = do - (opts, args) <- parseArgumentsWith $ options_cli++options_chart - run opts args + opts <- getHledgerChartOpts + when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) + runWith opts + +runWith :: ChartOpts -> IO () +runWith opts = run opts where - run opts args - | Help `elem` opts = putStr usage_chart - | Version `elem` opts = putStrLn $ progversionstr progname_chart - | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_chart - | otherwise = withJournalDo opts args "chart" chart + 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) + | otherwise = withJournalDo' opts chart +withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO () +withJournalDo' opts cmd = do + journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>= + either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts)) + -- | Generate an image with the pie chart and write it to a file -chart :: [Opt] -> [String] -> Journal -> IO () -chart opts args j = do - t <- getCurrentLocalTime +chart :: ChartOpts -> Journal -> IO () +chart opts j = do + d <- getCurrentDay if null $ jtxns j then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure else do - let chart = genPie opts (optsToFilterSpec opts args t) j + let chart = genPie opts (optsToFilterSpec ropts d) j renderableToPNGFile (toRenderable chart) w h filename return () where - filename = getOption opts ChartOutput defchartoutput - (w,h) = parseSize $ getOption opts ChartSize defchartsize - --- | Extract string option value from a list of options or use the default -getOption :: [Opt] -> (String->Opt) -> String -> String -getOption opts opt def = - case reverse $ optValuesForConstructor opt opts of - [] -> def - x:_ -> x + filename = chart_output_ opts + (w,h) = parseSize $ chart_size_ opts + ropts = reportopts_ $ cliopts_ opts -- | Parse image size from a command-line option parseSize :: String -> (Int,Int) @@ -95,26 +70,28 @@ (w,_:h) = splitAt x str -- | Generate pie chart -genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout +genPie :: ChartOpts -> FilterSpec -> Journal -> PieLayout genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white , pie_plot_ = pie_chart } where - pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems' + pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems , pie_start_angle_ = (-90) , pie_colors_ = mkColours hue , pie_label_style_ = defaultFontStyle{font_size_=12} } - chartitems' = debug "chart" $ top num samesignitems + chartitems = debug "chart" $ top num samesignitems (samesignitems, sign) = sameSignNonZero rawitems rawitems = debug "raw" $ flatten $ balances $ - ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j + ledgerAccountTree (fromMaybe 99999 $ depth_ ropts) $ journalToLedger filterspec j top n t = topn ++ [other] where (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t other = ("other", sum $ map snd rest) - num = readDef (fromIntegral defchartitems) (getOption opts ChartItems (show defchartitems)) + num = chart_items_ opts hue = if sign > 0 then red else green where (red, green) = (0, 110) - debug s = if Debug `elem` opts then ltrace s else id + debug s = if debug_ copts then ltrace s else id + copts = cliopts_ opts + ropts = reportopts_ copts -- | 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. @@ -129,7 +106,7 @@ -- | Convert all quantities of MixedAccount to a single commodity amountValue :: MixedAmount -> Double -amountValue = quantity . convertMixedAmountToSimilarCommodity unknown +amountValue = quantity . mixedAmountWithCommodity unknown -- | Generate a tree of account names together with their balances. -- The balance of account is decremented by the balance of its subaccounts diff --git a/Hledger/Chart/Options.hs b/Hledger/Chart/Options.hs new file mode 100644 --- /dev/null +++ b/Hledger/Chart/Options.hs @@ -0,0 +1,73 @@ +{-| + +-} + +module Hledger.Chart.Options +where +import Data.Maybe +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit + +import Hledger.Cli hiding (progname,progversion) +import qualified Hledger.Cli (progname) + +progname = Hledger.Cli.progname ++ "-chart" +progversion = progversionstr progname + +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." + ] + } + +-- hledger-chart options, used in hledger-chart and above +data ChartOpts = ChartOpts { + chart_output_ :: FilePath + ,chart_items_ :: Int + ,chart_size_ :: String + ,cliopts_ :: CliOpts + } deriving (Show) + +defchartopts = ChartOpts + def + def + def + def + +-- instance Default CliOpts where def = defcliopts + +toChartOpts :: RawOpts -> IO ChartOpts +toChartOpts rawopts = do + cliopts <- toCliOpts rawopts + return defchartopts { + chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts + ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts + ,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" rawopts + ,cliopts_ = cliopts + } + +checkChartOpts :: ChartOpts -> IO ChartOpts +checkChartOpts opts = do + checkCliOpts $ cliopts_ opts + return opts + +getHledgerChartOpts :: IO ChartOpts +getHledgerChartOpts = processArgs chartmode >>= return . decodeRawOpts >>= toChartOpts >>= checkChartOpts + diff --git a/hledger-chart.cabal b/hledger-chart.cabal --- a/hledger-chart.cabal +++ b/hledger-chart.cabal @@ -1,10 +1,14 @@ name: hledger-chart -version: 0.14 +version: 0.15 category: Finance -synopsis: A pie chart generator for the hledger accounting tool. +synopsis: A pie chart image generator for the hledger accounting tool. description: - hledger is a haskell port and friendly fork of John Wiegley's ledger accounting tool. - This package generates simple pie chart graphics showing relative account balances. + hledger is a library and set of user tools for working + with financial data (or anything that can be tracked in a + double-entry accounting ledger.) It is a haskell port and + friendly fork of John Wiegley's Ledger. hledger provides + command-line, curses and web interfaces, and aims to be a + reliable, practical tool for daily use. license: GPL license-file: LICENSE @@ -29,13 +33,16 @@ main-is: hledger-chart.hs ghc-options: -threaded -W other-modules: + Hledger.Chart Hledger.Chart.Main + Hledger.Chart.Options build-depends: - hledger == 0.14 - ,hledger-lib == 0.14 - -- ,HUnit + hledger == 0.15 + ,hledger-lib == 0.15 + ,HUnit ,base >= 3 && < 5 - -- ,containers + ,cmdargs >= 0.8 && < 0.9 + ,containers -- ,csv -- ,directory -- ,filepath @@ -47,7 +54,7 @@ -- ,regexpr >= 0.5.1 ,safe >= 0.2 -- ,split == 0.1.* - -- ,time + ,time -- ,utf8-string >= 0.3.5 && < 0.4 ,Chart >= 0.11 && < 0.15 ,colour diff --git a/hledger-chart.hs b/hledger-chart.hs --- a/hledger-chart.hs +++ b/hledger-chart.hs @@ -1,2 +1,2 @@ #!/usr/bin/env runhaskell -import Hledger.Chart.Main (main) +import Hledger.Chart (main)