diff --git a/hledger-chart/Hledger/Chart/Main.hs b/hledger-chart/Hledger/Chart/Main.hs index 38f04ce34..6bf2d93b6 100644 --- a/hledger-chart/Hledger/Chart/Main.hs +++ b/hledger-chart/Hledger/Chart/Main.hs @@ -18,78 +18,49 @@ import Data.Maybe import Data.Ord import Data.Tree import Graphics.Rendering.Chart -import Safe (readDef) -import System.Console.GetOpt import System.Exit (exitFailure) +import Text.Printf import Hledger -import Prelude hiding (putStr, putStrLn) -import Hledger.Utils.UTF8 (putStr, putStrLn) -import Hledger.Cli.Options -import Hledger.Cli.Utils (withJournalDo) -import Hledger.Cli.Version +import Hledger.Cli hiding (progname,progversion) +import Prelude hiding (putStrLn) +import Hledger.Utils.UTF8 (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" - -usage_options_chart = usageInfo "hledger-chart options:" options_chart ++ "\n" - -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) = printModeHelpAndExit chartmode + | "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 +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 d) 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) @@ -99,26 +70,28 @@ parseSize str = (read w, read h) (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. diff --git a/hledger-chart/Hledger/Chart/Options.hs b/hledger-chart/Hledger/Chart/Options.hs new file mode 100644 index 000000000..8967a690d --- /dev/null +++ b/hledger-chart/Hledger/Chart/Options.hs @@ -0,0 +1,68 @@ +{-| + +-} + +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 (chartflags++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/hledger-chart.cabal b/hledger-chart/hledger-chart.cabal index f870609fc..5117c94b6 100644 --- a/hledger-chart/hledger-chart.cabal +++ b/hledger-chart/hledger-chart.cabal @@ -35,6 +35,7 @@ executable hledger-chart ,hledger-lib == 0.15 -- ,HUnit ,base >= 3 && < 5 + ,cmdargs >= 0.7 && < 0.8 ,containers -- ,csv -- ,directory diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index bc3f5ef57..e879acd90 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -115,6 +115,9 @@ orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan) parsePeriodExpr refdate = parsewith (periodexpr refdate) +maybePeriod :: Day -> String -> Maybe (Interval,DateSpan) +maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate + -- | Show a DateSpan as a human-readable pseudo-period-expression string. dateSpanAsText :: DateSpan -> String dateSpanAsText (DateSpan Nothing Nothing) = "all" diff --git a/hledger-lib/Hledger/Data/Matching.hs b/hledger-lib/Hledger/Data/Matching.hs index 92b28a0d0..5d1da0f54 100644 --- a/hledger-lib/Hledger/Data/Matching.hs +++ b/hledger-lib/Hledger/Data/Matching.hs @@ -53,7 +53,7 @@ data Matcher = MatchAny -- ^ always match -- | A query option changes a query's/report's behaviour and output in some way. --- XXX could use regular cli Opts ? +-- XXX could use regular CliOpts ? data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register focussed on this account | QueryOptInAcct AccountName -- ^ as above but include sub-accounts in the account register -- | QueryOptCostBasis -- ^ show amounts converted to cost where possible diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 434e14e27..a924fe3cc 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -36,7 +36,7 @@ import Control.Monad.Error (ErrorT) import Data.Time.Calendar import Data.Time.LocalTime import Data.Tree -import Data.Typeable (Typeable) +import Data.Typeable import qualified Data.Map as Map import System.Time (ClockTime) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index a35c64415..97db3e240 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -15,6 +15,8 @@ module Hledger.Read ( myJournal, myTimelog, someamount, + journalenvvar, + journaldefaultfilename ) where import Control.Monad.Error diff --git a/hledger-vty/Hledger/Vty/Main.hs b/hledger-vty/Hledger/Vty/Main.hs index 46ed0d8b4..97c17d5c5 100644 --- a/hledger-vty/Hledger/Vty/Main.hs +++ b/hledger-vty/Hledger/Vty/Main.hs @@ -12,48 +12,34 @@ import Data.List import Data.Maybe import Data.Time.Calendar import Graphics.Vty -import Safe (headDef) -import System.Console.GetOpt +import Safe +import Text.Printf import Hledger -import Prelude hiding (putStr, putStrLn) -import Hledger.Utils.UTF8 (putStr, putStrLn) -import Hledger.Cli +import Hledger.Cli hiding (progname,progversion) +import Hledger.Vty.Options +import Prelude hiding (putStrLn) +import Hledger.Utils.UTF8 (putStrLn) -progname_vty = progname_cli ++ "-vty" - -options_vty :: [OptDescr Opt] -options_vty = [ - Option "" ["debug-vty"] (NoArg DebugVty) "run with no terminal output, showing console" - ] - -usage_preamble_vty = - "Usage: hledger-vty [OPTIONS] [PATTERNS]\n" ++ - "\n" ++ - "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++ - "starts the full-window curses ui.\n" ++ - "\n" - -usage_options_vty = usageInfo "hledger-vty options:" options_vty ++ "\n" - -usage_vty = concat [ - usage_preamble_vty - ,usage_options_vty - ,usage_options_cli - ,usage_postscript_cli - ] - main :: IO () main = do - (opts, args) <- parseArgumentsWith $ options_cli++options_vty - run opts args + opts <- getHledgerVtyOpts + when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) + runWith opts + +runWith :: VtyOpts -> IO () +runWith opts = run opts where - run opts args - | Help `elem` opts = putStr usage_vty - | Version `elem` opts = putStrLn $ progversionstr progname_vty - | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_vty - | otherwise = withJournalDo opts args "vty" vty + run opts + | "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit vtymode + | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) + | otherwise = withJournalDo' opts vty + +withJournalDo' :: VtyOpts -> (VtyOpts -> Journal -> IO ()) -> IO () +withJournalDo' opts cmd = do + journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>= + either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts)) helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit" @@ -62,10 +48,10 @@ instance Show Vty where show = const "a Vty" -- | The application state when running the vty command. data AppState = AppState { av :: Vty -- ^ the vty context - ,aw :: Int -- ^ window width - ,ah :: Int -- ^ window height + ,aw :: Int -- ^ window width + ,ah :: Int -- ^ window height ,amsg :: String -- ^ status message - ,aopts :: [Opt] -- ^ command-line opts + ,aopts :: VtyOpts -- ^ command-line opts ,aargs :: [String] -- ^ command-line args at startup ,ajournal :: Journal -- ^ parsed journal ,abuf :: [String] -- ^ lines of the current buffered view @@ -89,19 +75,19 @@ data Screen = BalanceScreen -- ^ like hledger balance, shows accounts deriving (Eq,Show) -- | Run the vty (curses-style) ui. -vty :: [Opt] -> [String] -> Journal -> IO () -vty opts args j = do +vty :: VtyOpts -> Journal -> IO () +vty opts j = do v <- mkVty DisplayRegion w h <- display_bounds $ terminal v d <- getCurrentDay - let a = enter d BalanceScreen args + let a = enter d BalanceScreen (patterns_ $ reportopts_ $ cliopts_ opts) AppState { av=v ,aw=fromIntegral w ,ah=fromIntegral h ,amsg=helpmsg ,aopts=opts - ,aargs=args + ,aargs=patterns_ $ reportopts_ $ cliopts_ opts ,ajournal=j ,abuf=[] ,alocs=[] @@ -111,7 +97,7 @@ vty opts args j = do -- | Update the screen, wait for the next event, repeat. go :: AppState -> IO () go a@AppState{av=av,aopts=opts} = do - when (notElem DebugVty opts) $ update av (renderScreen a) + when (not $ debug_vty_ opts) $ update av (renderScreen a) k <- next_event av d <- getCurrentDay case k of @@ -268,10 +254,11 @@ resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a updateData :: Day -> AppState -> AppState updateData d a@AppState{aopts=opts,ajournal=j} = case screen a of - BalanceScreen -> a{abuf=accountsReportAsText opts $ accountsReport opts fspec j} - RegisterScreen -> a{abuf=lines $ postingsReportAsText opts $ postingsReport opts fspec j} - PrintScreen -> a{abuf=lines $ showTransactions opts fspec j} - where fspec = optsToFilterSpec opts (currentArgs a) d + BalanceScreen -> a{abuf=accountsReportAsText ropts $ accountsReport ropts fspec j} + RegisterScreen -> a{abuf=lines $ postingsReportAsText ropts $ postingsReport ropts fspec j} + PrintScreen -> a{abuf=lines $ showTransactions ropts fspec j} + where fspec = optsToFilterSpec ropts{patterns_=currentArgs a} d + ropts = reportopts_ $ cliopts_ opts backout :: Day -> AppState -> AppState backout d a | screen a == BalanceScreen = a diff --git a/hledger-vty/Hledger/Vty/Options.hs b/hledger-vty/Hledger/Vty/Options.hs new file mode 100644 index 000000000..8093be94d --- /dev/null +++ b/hledger-vty/Hledger/Vty/Options.hs @@ -0,0 +1,55 @@ +{-| + +-} + +module Hledger.Vty.Options +where +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit + +import Hledger.Cli hiding (progname,progversion) +import qualified Hledger.Cli (progname) + +progname = Hledger.Cli.progname ++ "-vty" +progversion = progversionstr progname + +vtyflags = [ + flagNone ["debug-vty"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console" + ] + +vtymode = (mode "hledger-vty" [("command","vty")] + "browse accounts, postings and entries in a full-window curses interface" + commandargsflag (vtyflags++generalflags1)){ + modeHelpSuffix=[ + -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." + ] + } + +-- hledger-vty options, used in hledger-vty and above +data VtyOpts = VtyOpts { + debug_vty_ :: Bool + ,cliopts_ :: CliOpts + } deriving (Show) + +defvtyopts = VtyOpts + def + def + +-- instance Default CliOpts where def = defcliopts + +toVtyOpts :: RawOpts -> IO VtyOpts +toVtyOpts rawopts = do + cliopts <- toCliOpts rawopts + return defvtyopts { + debug_vty_ = boolopt "debug-vty" rawopts + ,cliopts_ = cliopts + } + +checkVtyOpts :: VtyOpts -> IO VtyOpts +checkVtyOpts opts = do + checkCliOpts $ cliopts_ opts + return opts + +getHledgerVtyOpts :: IO VtyOpts +getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts + diff --git a/hledger-vty/hledger-vty.cabal b/hledger-vty/hledger-vty.cabal index 7e51c8df8..4ba5c5f91 100644 --- a/hledger-vty/hledger-vty.cabal +++ b/hledger-vty/hledger-vty.cabal @@ -35,6 +35,7 @@ executable hledger-vty ,hledger-lib == 0.15 -- ,HUnit ,base >= 3 && < 5 + ,cmdargs >= 0.7 && < 0.8 -- ,containers -- ,csv -- ,directory diff --git a/hledger-web/Hledger/Web.hs b/hledger-web/Hledger/Web.hs index 6187226de..c3235352e 100644 --- a/hledger-web/Hledger/Web.hs +++ b/hledger-web/Hledger/Web.hs @@ -7,6 +7,7 @@ module Hledger.Web ( module Hledger.Web.AppRun, module Hledger.Web.EmbeddedFiles, module Hledger.Web.Handlers, + module Hledger.Web.Options, module Hledger.Web.Settings, module Hledger.Web.StaticFiles, tests_Hledger_Web @@ -18,6 +19,7 @@ import Hledger.Web.App import Hledger.Web.AppRun import Hledger.Web.EmbeddedFiles import Hledger.Web.Handlers +import Hledger.Web.Options import Hledger.Web.Settings import Hledger.Web.StaticFiles diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index 8794f5299..11e5fb36f 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-} module Hledger.Web.App ( App (..) , AppRoute (..) @@ -22,8 +21,8 @@ import Text.Hamlet hiding (hamletFile) import Yesod.Core import Yesod.Helpers.Static -import Hledger.Cli.Options import Hledger.Data +import Hledger.Web.Options import Hledger.Web.Settings import Hledger.Web.StaticFiles @@ -34,7 +33,7 @@ import Hledger.Web.StaticFiles data App = App {getStatic :: Static -- ^ Settings for static file serving. ,appRoot :: T.Text - ,appOpts :: [Opt] + ,appOpts :: WebOpts ,appArgs :: [String] ,appJournal :: Journal } diff --git a/hledger-web/Hledger/Web/AppRun.hs b/hledger-web/Hledger/Web/AppRun.hs index ac8070c50..34070e940 100644 --- a/hledger-web/Hledger/Web/AppRun.hs +++ b/hledger-web/Hledger/Web/AppRun.hs @@ -18,6 +18,7 @@ import Hledger import Hledger.Cli import Hledger.Web.App import Hledger.Web.Handlers +import Hledger.Web.Options import Hledger.Web.Settings -- This line actually creates our YesodSite instance. It is the second half @@ -38,7 +39,7 @@ withDevelApp = toDyn (withApp a :: (Application -> IO ()) -> IO ()) where a = App{ getStatic=static Hledger.Web.Settings.staticdir ,appRoot=Hledger.Web.Settings.defapproot - ,appOpts=[] + ,appOpts=defwebopts ,appArgs=[] ,appJournal=nulljournal } @@ -53,7 +54,7 @@ withWaiHandlerDevelApp func = do let a = App{ getStatic=static Hledger.Web.Settings.staticdir ,appRoot=Settings.defapproot - ,appOpts=[File f] + ,appOpts=defwebopts{cliopts_=defcliopts{file_=Just f}} ,appArgs=[] ,appJournal=j } diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index f91308d2d..4ff577525 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -29,6 +29,7 @@ import Yesod.Json import Hledger hiding (today) import Hledger.Cli import Hledger.Web.App +import Hledger.Web.Options import Hledger.Web.Settings @@ -60,7 +61,7 @@ getJournalR = do where andsubs = if subs then " (and subaccounts)" else "" where filter = if filtering then ", filtered" else "" - maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport opts j m + maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m defaultLayout $ do setTitle "hledger-web journal" addHamlet [$hamlet| @@ -93,7 +94,7 @@ getJournalEntriesR = do let sidecontent = sidebar vd title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String - maincontent = entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j + maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j defaultLayout $ do setTitle "hledger-web journal" addHamlet [$hamlet| @@ -117,7 +118,7 @@ getJournalOnlyR = do vd@VD{..} <- getViewData defaultLayout $ do setTitle "hledger-web journal only" - addHamlet $ entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j + addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j ---------------------------------------------------------------------- @@ -133,7 +134,7 @@ getRegisterR = do (a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts andsubs = if subs then " (and subaccounts)" else "" filter = if filtering then ", filtered" else "" - maincontent = registerReportHtml opts vd $ accountTransactionsReport opts j m $ fromMaybe MatchAny $ inAccountMatcher qopts + maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountMatcher qopts defaultLayout $ do setTitle "hledger-web register" addHamlet [$hamlet| @@ -158,8 +159,8 @@ getRegisterOnlyR = do defaultLayout $ do setTitle "hledger-web register only" addHamlet $ - case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport opts j m m' - Nothing -> registerReportHtml opts vd $ journalTransactionsReport opts j m + case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m' + Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m ---------------------------------------------------------------------- @@ -171,7 +172,7 @@ getAccountsR = do let j' = filterJournalPostings2 m j html = do setTitle "hledger-web accounts" - addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 opts am j' + addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j' json = jsonMap [("accounts", toJSON $ journalAccountNames j')] defaultLayoutJson html json @@ -187,10 +188,10 @@ getAccountsJsonR = do -- | Render the sidebar used on most views. sidebar :: ViewData -> Hamlet AppRoute -sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 opts am j +sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j -- | Render a "AccountsReport" as HTML. -accountsReportAsHtml :: [Opt] -> ViewData -> AccountsReport -> Hamlet AppRoute +accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> Hamlet AppRoute accountsReportAsHtml _ vd@VD{..} (items',total) = [$hamlet| ViewData -> EntriesReport -> Hamlet AppRoute +entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> Hamlet AppRoute entriesReportAsHtml _ vd items = [$hamlet| $forall i <- numbered items @@ -289,7 +290,7 @@ entriesReportAsHtml _ vd items = [$hamlet| txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse -- | Render an "TransactionsReport" as HTML for the formatted journal view. -journalTransactionsReportAsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute +journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute journalTransactionsReportAsHtml _ vd (_,items) = [$hamlet| ViewData -> TransactionsReport -> Hamlet AppRoute +registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute registerReportHtml opts vd r@(_,items) = [$hamlet| ^{registerChartHtml items} ^{registerItemsHtml opts vd r} |] -- Generate html for a transaction list from an "TransactionsReport". -registerItemsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute +registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute registerItemsHtml _ vd (balancelabel,items) = [$hamlet| Handler (Journal, Maybe String) + getCurrentJournal :: CliOpts -> Handler (Journal, Maybe String) getCurrentJournal opts = do j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" (jE, changed) <- liftIO $ journalReloadIfChanged opts j diff --git a/hledger-web/Hledger/Web/Options.hs b/hledger-web/Hledger/Web/Options.hs new file mode 100644 index 000000000..ddf611392 --- /dev/null +++ b/hledger-web/Hledger/Web/Options.hs @@ -0,0 +1,66 @@ +{-| + +-} + +module Hledger.Web.Options +where +import Data.Maybe +import Data.Text (unpack) +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit + +import Hledger.Cli hiding (progname,progversion) +import qualified Hledger.Cli (progname) + +import Hledger.Web.Settings + +progname = Hledger.Cli.progname ++ "-web" +progversion = progversionstr progname + +defbaseurl = unpack defapproot +defbaseurl' = (reverse $ drop 4 $ reverse defbaseurl) ++ "PORT" + +webflags = [ + flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurl'++")") + ,flagReq ["port"] (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this tcp port (default: "++show defport++")") + ] + +webmode = (mode "hledger-web" [("command","web")] + "start serving the hledger web interface" + commandargsflag (webflags++generalflags1)){ + modeHelpSuffix=[ + -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." + ] + } + +-- hledger-web options, used in hledger-web and above +data WebOpts = WebOpts { + base_url_ :: String + ,port_ :: Int + ,cliopts_ :: CliOpts + } deriving (Show) + +defwebopts = WebOpts + def + def + def + +-- instance Default WebOpts where def = defwebopts + +toWebOpts :: RawOpts -> IO WebOpts +toWebOpts rawopts = do + cliopts <- toCliOpts rawopts + return defwebopts { + base_url_ = fromMaybe defbaseurl $ maybestringopt "base-url" rawopts + ,port_ = fromMaybe defport $ maybeintopt "port" rawopts + ,cliopts_ = cliopts + } + +checkWebOpts :: WebOpts -> IO WebOpts +checkWebOpts opts = do + checkCliOpts $ cliopts_ opts + return opts + +getHledgerWebOpts :: IO WebOpts +getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= toWebOpts >>= checkWebOpts + diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index fb8515eb9..df8f3f7d9 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -64,6 +64,7 @@ executable hledger-web ,HUnit ,base >= 4 && < 5 ,bytestring + ,cmdargs >= 0.7 && < 0.8 -- ,containers -- ,csv ,directory diff --git a/hledger-web/hledger-web.hs b/hledger-web/hledger-web.hs index 70b6df056..95c2d8aa0 100644 --- a/hledger-web/hledger-web.hs +++ b/hledger-web/hledger-web.hs @@ -9,6 +9,7 @@ module Main where -- import Control.Concurrent (forkIO, threadDelay) +import Control.Monad import Data.Maybe import Data.Text(pack) import Network.Wai.Handler.Warp (run) @@ -16,58 +17,41 @@ import Network.Wai.Handler.Warp (run) #else import Network.Wai.Middleware.Debug (debug) #endif -import System.Console.GetOpt import System.Exit (exitFailure) import System.IO.Storage (withStore, putValue) import Text.Printf import Yesod.Helpers.Static -import Hledger.Cli -import Hledger.Cli.Tests (runTestsOrExit) -import Hledger.Data -import Prelude hiding (putStr, putStrLn) -import Hledger.Utils.UTF8 (putStr, putStrLn) +import Hledger +import Hledger.Cli hiding (progname,progversion) +import Hledger.Cli.Tests +import Prelude hiding (putStrLn) +import Hledger.Utils.UTF8 (putStrLn) import Hledger.Web -progname_web = progname_cli ++ "-web" - -options_web :: [OptDescr Opt] -options_web = [ - Option "" ["base-url"] (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)" - ,Option "" ["port"] (ReqArg Port "N") "serve on tcp port N (default 5000)" - ] - -usage_preamble_web = - "Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++ - "\n" ++ - "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++ - "starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++ - "\n" - -usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n" - -usage_web = concat [ - usage_preamble_web - ,usage_options_web - ,usage_options_cli - ,usage_postscript_cli - ] - main :: IO () main = do - (opts, args) <- parseArgumentsWith $ options_cli++options_web - run opts args + opts <- getHledgerWebOpts + when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) + runWith opts + +runWith :: WebOpts -> IO () +runWith opts = run opts where - run opts args - | Help `elem` opts = putStr usage_web - | Version `elem` opts = putStrLn $ progversionstr progname_web - | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_web - | otherwise = withJournalDo opts args "web" web + run opts + | "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit webmode + | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) + | otherwise = withJournalDo' opts web + +withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO () +withJournalDo' opts cmd = do + journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>= + either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts)) -- | The web command. -web :: [Opt] -> [String] -> Journal -> IO () -web opts args j = do +web :: WebOpts -> Journal -> IO () +web opts j = do created <- createFilesIfMissing if created then do @@ -75,13 +59,10 @@ web opts args j = do exitFailure else do putStrLn $ "Running self-tests..." - runTestsOrExit opts args + runTestsOrExit $ cliopts_ opts putStrLn $ "Using support files in "++datadir - let host = defhost - port = fromMaybe defport $ portFromOpts opts - baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts - -- unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return () - server baseurl port opts args j + -- unless (debug_ $ cliopts_ opts) $ forkIO (browser baseurl) >> return () + server (base_url_ opts) (port_ opts) opts j -- browser :: String -> IO () -- browser baseurl = do @@ -89,17 +70,18 @@ web opts args j = do -- putStrLn "Attempting to start a web browser" -- openBrowserOn baseurl >> return () -server :: String -> Int -> [Opt] -> [String] -> Journal -> IO () -server baseurl port opts args j = do +server :: String -> Int -> WebOpts -> Journal -> IO () +server baseurl port opts j = do printf "Starting http server on port %d with base url %s\n" port baseurl let a = App{getStatic=static staticdir ,appRoot=pack baseurl ,appOpts=opts - ,appArgs=args + ,appArgs=patterns_ $ reportopts_ $ cliopts_ opts ,appJournal=j } withStore "hledger" $ do putValue "hledger" "journal" j + return () #if PRODUCTION withApp a (run port) #else diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index cf4c85199..7cc1acb3b 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -37,7 +37,6 @@ import Hledger.Cli.Options import Hledger.Cli.Utils import Hledger.Cli.Version - -- | hledger and hledger-lib's unit tests aggregated from all modules -- plus some more which are easier to define here for now. tests_Hledger_Cli :: Test @@ -108,15 +107,14 @@ tests_Hledger_Cli = TestList "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] ,"balance report tests" ~: - let (opts,args) `gives` es = do + let opts `gives` es = do j <- samplejournal d <- getCurrentDay - accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts args d) j) `is` es + accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts d) j) `is` es in TestList [ - "balance report with no args" ~: - ([], []) `gives` + defreportopts `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" @@ -132,7 +130,7 @@ tests_Hledger_Cli = TestList ] ,"balance report can be limited with --depth" ~: - ([Depth "1"], []) `gives` + defreportopts{depth_=Just 1} `gives` [" $-1 assets" ," $2 expenses" ," $-2 income" @@ -142,7 +140,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with account pattern o" ~: - ([], ["o"]) `gives` + defreportopts{patterns_=["o"]} `gives` [" $1 expenses:food" ," $-2 income" ," $-1 gifts" @@ -152,7 +150,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with account pattern o and --depth 1" ~: - ([Depth "1"], ["o"]) `gives` + defreportopts{patterns_=["o"],depth_=Just 1} `gives` [" $1 expenses" ," $-2 income" ,"--------------------" @@ -160,7 +158,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with account pattern a" ~: - ([], ["a"]) `gives` + defreportopts{patterns_=["a"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" @@ -171,7 +169,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with account pattern e" ~: - ([], ["e"]) `gives` + defreportopts{patterns_=["e"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" @@ -187,7 +185,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with unmatched parent of two matched subaccounts" ~: - ([], ["cash","saving"]) `gives` + defreportopts{patterns_=["cash","saving"]} `gives` [" $-1 assets" ," $1 bank:saving" ," $-2 cash" @@ -196,14 +194,14 @@ tests_Hledger_Cli = TestList ] ,"balance report with multi-part account name" ~: - ([], ["expenses:food"]) `gives` + defreportopts{patterns_=["expenses:food"]} `gives` [" $1 expenses:food" ,"--------------------" ," $1" ] ,"balance report with negative account pattern" ~: - ([], ["not:assets"]) `gives` + defreportopts{patterns_=["not:assets"]} `gives` [" $2 expenses" ," $1 food" ," $1 supplies" @@ -216,20 +214,20 @@ tests_Hledger_Cli = TestList ] ,"balance report negative account pattern always matches full name" ~: - ([], ["not:e"]) `gives` + defreportopts{patterns_=["not:e"]} `gives` ["--------------------" ," 0" ] ,"balance report negative patterns affect totals" ~: - ([], ["expenses","not:food"]) `gives` + defreportopts{patterns_=["expenses","not:food"]} `gives` [" $1 expenses:supplies" ,"--------------------" ," $1" ] ,"balance report with -E shows zero-balance accounts" ~: - ([Empty], ["assets"]) `gives` + defreportopts{patterns_=["assets"],empty_=True} `gives` [" $-1 assets" ," $1 bank" ," 0 checking" @@ -247,7 +245,7 @@ tests_Hledger_Cli = TestList ," c:d " ]) >>= either error' return let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment - accountsReportAsText [] (accountsReport [] nullfilterspec j') `is` + accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j') `is` [" $500 a:b" ," $-500 c:d" ,"--------------------" @@ -261,7 +259,7 @@ tests_Hledger_Cli = TestList ," test:a 1" ," test:b" ]) - accountsReportAsText [] (accountsReport [] nullfilterspec j) `is` + accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j) `is` [" 1 test:a" ," -1 test:b" ,"--------------------" @@ -294,11 +292,10 @@ tests_Hledger_Cli = TestList "print expenses" ~: do - let args = ["expenses"] - opts = [] + let opts = defreportopts{patterns_=["expenses"]} j <- samplejournal d <- getCurrentDay - showTransactions opts (optsToFilterSpec opts args d) j `is` unlines + showTransactions opts (optsToFilterSpec opts d) j `is` unlines ["2008/06/03 * eat & shop" ," expenses:food $1" ," expenses:supplies $1" @@ -308,9 +305,10 @@ tests_Hledger_Cli = TestList , "print report with depth arg" ~: do + let opts = defreportopts{depth_=Just 2} j <- samplejournal d <- getCurrentDay - showTransactions [] (optsToFilterSpec [Depth "2"] [] d) j `is` unlines + showTransactions opts (optsToFilterSpec opts d) j `is` unlines ["2008/01/01 income" ," income:salary $-1" ,"" @@ -338,7 +336,8 @@ tests_Hledger_Cli = TestList "register report with no args" ~: do j <- samplejournal - (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines + let opts = defreportopts + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -354,9 +353,9 @@ tests_Hledger_Cli = TestList ,"register report with cleared option" ~: do - let opts = [Cleared] + let opts = defreportopts{cleared_=True} j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" @@ -366,9 +365,9 @@ tests_Hledger_Cli = TestList ,"register report with uncleared option" ~: do - let opts = [UnCleared] + let opts = defreportopts{uncleared_=True} j <- readJournal' sample_journal_str - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -388,19 +387,22 @@ tests_Hledger_Cli = TestList ," e 1" ," f" ] - registerdates (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"] + let opts = defreportopts + registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/02/02"] ,"register report with account pattern" ~: do j <- samplejournal - (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines + let opts = defreportopts{patterns_=["cash"]} + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"register report with account pattern, case insensitive" ~: do j <- samplejournal - (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines + let opts = defreportopts{patterns_=["cAsH"]} + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] @@ -408,8 +410,8 @@ tests_Hledger_Cli = TestList do j <- samplejournal let gives displayexpr = - (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is`) - where opts = [Display displayexpr] + (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is`) + where opts = defreportopts{display_=Just displayexpr} "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] "d=[2008/6/2]" `gives` ["2008/06/02"] @@ -421,16 +423,16 @@ tests_Hledger_Cli = TestList j <- samplejournal let periodexpr `gives` dates = do j' <- samplejournal - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j') `is` dates - where opts = [Period periodexpr] + registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j') `is` dates + where opts = defreportopts{period_=maybePeriod date1 periodexpr} "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2007" `gives` [] "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"] "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] - let opts = [Period "yearly"] - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines + let opts = defreportopts{period_=maybePeriod date1 "yearly"} + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ," assets:cash $-2 $-1" ," expenses:food $1 0" @@ -439,18 +441,18 @@ tests_Hledger_Cli = TestList ," income:salary $-1 $-1" ," liabilities:debts $1 0" ] - let opts = [Period "quarterly"] - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] - let opts = [Period "quarterly",Empty] - registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + let opts = defreportopts{period_=maybePeriod date1 "quarterly"} + registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"] + let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True} + registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] , "register report with depth arg" ~: do j <- samplejournal - let opts = [Depth "2"] - (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines + let opts = defreportopts{depth_=Just 2} + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2008/01/01 income assets:bank $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank $1 $1" @@ -471,7 +473,8 @@ tests_Hledger_Cli = TestList ,"unicode in balance layout" ~: do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - accountsReportAsText [] (accountsReport [] (optsToFilterSpec [] [] date1) j) `is` + let opts = defreportopts + accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts date1) j) `is` [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" @@ -481,7 +484,8 @@ tests_Hledger_Cli = TestList ,"unicode in register layout" ~: do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines + let opts = defreportopts + (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] @@ -921,4 +925,3 @@ journalWithAmounts as = [] (TOD 0 0) where parse = fromparse . parseWithCtx nullctx someamount - diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 54f555f6f..6a90edd8a 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -49,8 +49,8 @@ data PostingState = PostingState { -- | Read transactions from the terminal, prompting for each field, -- and append them to the journal file. If the journal came from stdin, this -- command has no effect. -add :: [Opt] -> [String] -> Journal -> IO () -add opts args j +add :: CliOpts -> Journal -> IO () +add opts j | f == "-" = return () | otherwise = do hPutStrLn stderr $ @@ -58,7 +58,7 @@ add opts args j ++"To complete a transaction, enter . when prompted for an account.\n" ++"To quit, press control-d or control-c." today <- getCurrentDay - getAndAddTransactions j opts args today + getAndAddTransactions j opts today `catch` (\e -> unless (isEOFError e) $ ioError e) where f = journalFilePath j @@ -66,29 +66,29 @@ add opts args j -- validating, displaying and appending them to the journal file, until -- end of input (then raise an EOF exception). Any command-line arguments -- are used as the first transaction's description. -getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO () -getAndAddTransactions j opts args defaultDate = do - (t, d) <- getTransaction j opts args defaultDate +getAndAddTransactions :: Journal -> CliOpts -> Day -> IO () +getAndAddTransactions j opts defaultDate = do + (t, d) <- getTransaction j opts defaultDate j <- journalAddTransaction j opts t - getAndAddTransactions j opts args d + getAndAddTransactions j opts d -- | Read a transaction from the command line, with history-aware prompting. -getTransaction :: Journal -> [Opt] -> [String] -> Day +getTransaction :: Journal -> CliOpts -> Day -> IO (Transaction,Day) -getTransaction j opts args defaultDate = do +getTransaction j opts defaultDate = do today <- getCurrentDay datestr <- runInteractionDefault $ askFor "date" (Just $ showDate defaultDate) (Just $ \s -> null s || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s)) description <- runInteractionDefault $ askFor "description" (Just "") Nothing - let historymatches = transactionsSimilarTo j args description + let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr accept x = x == "." || (not . null) x && - if NoNewAccts `elem` opts + if no_new_accounts_ opts then isJust $ Foldable.find (== x) ant else True where (ant,_,_,_) = groupPostings $ journalPostings j @@ -190,11 +190,11 @@ askFor prompt def validator = do -- | Append this transaction to the journal's file, and to the journal's -- transaction list. -journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal +journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal journalAddTransaction j@Journal{jtxns=ts} opts t = do let f = journalFilePath j appendToJournalFile f $ showTransaction t - when (Debug `elem` opts) $ do + when (debug_ opts) $ do putStrLn $ printf "\nAdded transaction to %s:" f putStrLn =<< registerFromString (show t) return j{jtxns=ts++[t]} @@ -219,8 +219,8 @@ registerFromString :: String -> IO String registerFromString s = do d <- getCurrentDay j <- readJournal' s - return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] d) j - where opts = [Empty] + return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts d) j + where opts = defreportopts{empty_=True} -- | Return a similarity measure, from 0 to 1, for two strings. -- This is Simon White's letter pairs algorithm from diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 29734cb73..c60b88517 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -115,26 +115,27 @@ import Hledger.Cli.Reports -- | Print a balance report. -balance :: [Opt] -> [String] -> Journal -> IO () -balance opts args j = do +balance :: CliOpts -> Journal -> IO () +balance CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - let lines = case parseFormatFromOpts opts of + let lines = case formatFromOpts ropts of Left err -> [err] - Right _ -> accountsReportAsText opts $ accountsReport opts (optsToFilterSpec opts args d) j + Right _ -> accountsReportAsText ropts $ accountsReport ropts (optsToFilterSpec ropts d) j putStr $ unlines lines -- | Render a balance report as plain text suitable for console output. -accountsReportAsText :: [Opt] -> AccountsReport -> [String] +accountsReportAsText :: ReportOpts -> AccountsReport -> [String] accountsReportAsText opts (items, total) = concat lines ++ t where - lines = map (accountsReportItemAsText opts format) items - format = formatFromOpts opts - t = if NoTotal `elem` opts - then [] - else ["--------------------" - -- TODO: This must use the format somehow - , padleft 20 $ showMixedAmountWithoutPrice total - ] + lines = case formatFromOpts opts of + Right f -> map (accountsReportItemAsText opts f) items + Left err -> [[err]] + t = if no_total_ opts + then [] + else ["--------------------" + -- TODO: This must use the format somehow + ,padleft 20 $ showMixedAmountWithoutPrice total + ] {- This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -147,7 +148,7 @@ This implementation turned out to be a bit convoluted but implements the followi b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line. -} -- | Render one balance report line item as plain text. -accountsReportItemAsText :: [Opt] -> [FormatString] -> AccountsReportItem -> [String] +accountsReportItemAsText :: ReportOpts -> [FormatString] -> AccountsReportItem -> [String] accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) = case amounts of [] -> [] @@ -159,7 +160,7 @@ accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) = asText [a] = [formatAccountsReportItem opts (Just accountName) depth a format] asText (a:as) = (formatAccountsReportItem opts Nothing depth a format) : asText as -formatAccountsReportItem :: [Opt] -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String +formatAccountsReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String formatAccountsReportItem _ _ _ _ [] = "" formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAccountsReportItem opts accountName depth amount fs) where @@ -167,7 +168,7 @@ formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAcco FormatLiteral l -> l FormatField leftJustified min max field -> formatAccount opts accountName depth amount leftJustified min max field -formatAccount :: [Opt] -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String +formatAccount :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String formatAccount opts accountName depth balance leftJustified min max field = case field of Format.Account -> formatValue leftJustified min max a DepthSpacer -> case min of @@ -176,7 +177,7 @@ formatAccount opts accountName depth balance leftJustified min max field = case Total -> formatValue leftJustified min max $ showAmountWithoutPrice balance _ -> "" where - a = maybe "" (accountNameDrop (dropFromOpts opts)) accountName + a = maybe "" (accountNameDrop (drop_ opts)) accountName tests_Hledger_Cli_Balance = TestList [ diff --git a/hledger/Hledger/Cli/Convert.hs b/hledger/Hledger/Cli/Convert.hs index a31104871..192dba93f 100644 --- a/hledger/Hledger/Cli/Convert.hs +++ b/hledger/Hledger/Cli/Convert.hs @@ -8,8 +8,7 @@ import Prelude hiding (getContents) import Control.Monad (when, guard, liftM) import Data.Maybe import Data.Time.Format (parseTime) -import Safe (atDef, atMay, maximumDef) -import Safe (readDef, readMay) +import Safe import System.Directory (doesFileExist) import System.Exit (exitFailure) import System.FilePath (takeBaseName, replaceExtension) @@ -23,13 +22,14 @@ import Text.Printf (hPrintf) import Hledger.Cli.Format import qualified Hledger.Cli.Format as Format import Hledger.Cli.Version -import Hledger.Cli.Options (Opt(Debug), progname_cli, rulesFileFromOpts) +import Hledger.Cli.Options +import Hledger.Cli.Reports import Hledger.Data.Amount (nullmixedamt, costOfMixedAmount) import Hledger.Data.Dates (firstJust, showDate, parsedate) import Hledger.Data (Journal,AccountName,Transaction(..),Posting(..),PostingType(..)) import Hledger.Data.Journal (nullctx) import Hledger.Read.JournalReader (someamount,ledgeraccountname) -import Hledger.Utils (choice', strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error', regexMatchesCI, regexReplaceCI) +import Hledger.Utils import Hledger.Utils.UTF8 (getContents) {- | @@ -84,20 +84,19 @@ type CsvRecord = [String] -- | Read the CSV file named as an argument and print equivalent journal transactions, -- using/creating a .rules file. -convert :: [Opt] -> [String] -> Journal -> IO () -convert opts args _ = do - when (null args) $ error' "please specify a csv data file." - let csvfile = head args +convert :: CliOpts -> Journal -> IO () +convert opts _ = do + let csvfile = headDef "" $ patterns_ $ reportopts_ opts + when (null csvfile) $ error' "please specify a csv data file." let - rulesFileSpecified = isJust $ rulesFileFromOpts opts + rulesFileSpecified = isJust $ rules_file_ opts + rulesfile = rulesFileFor opts csvfile usingStdin = csvfile == "-" when (usingStdin && (not rulesFileSpecified)) $ error' "please specify a files file when converting stdin" csvparse <- parseCsv csvfile let records = case csvparse of Left e -> error' $ show e Right rs -> reverse $ filter (/= [""]) rs - let debug = Debug `elem` opts - rulesfile = rulesFileFor opts csvfile exists <- doesFileExist rulesfile if (not exists) then do hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile @@ -106,12 +105,12 @@ convert opts args _ = do hPrintf stderr "using conversion rules file %s\n" rulesfile rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile let invalid = validateRules rules - when debug $ hPrintf stderr "rules: %s\n" (show rules) + when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules) when (isJust invalid) $ error (fromJust invalid) let requiredfields = max 2 (maxFieldIndex rules + 1) badrecords = take 1 $ filter ((< requiredfields).length) records if null badrecords - then mapM_ (printTxn debug rules) records + then mapM_ (printTxn (debug_ opts) rules) records else do hPrintf stderr (unlines [ "Warning, at least one CSV record does not contain a field referenced by the" @@ -142,17 +141,13 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [ ,effectiveDateField r ] -rulesFileFor :: [Opt] -> FilePath -> FilePath -rulesFileFor opts csvfile = - case opt of - Just path -> path - Nothing -> replaceExtension csvfile ".rules" - where - opt = rulesFileFromOpts opts +rulesFileFor :: CliOpts -> FilePath -> FilePath +rulesFileFor CliOpts{rules_file_=Just f} _ = f +rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules" initialRulesFileContent :: String initialRulesFileContent = - "# csv conversion rules file generated by "++(progversionstr progname_cli)++"\n" ++ + "# csv conversion rules file generated by "++(progversionstr progname)++"\n" ++ "# Add rules to this file for more accurate conversion, see\n"++ "# http://hledger.org/MANUAL.html#convert\n" ++ "\n" ++ diff --git a/hledger/Hledger/Cli/Histogram.hs b/hledger/Hledger/Cli/Histogram.hs index 938e27bc1..f4f78ce00 100644 --- a/hledger/Hledger/Cli/Histogram.hs +++ b/hledger/Hledger/Cli/Histogram.hs @@ -13,6 +13,7 @@ import Data.Ord import Text.Printf import Hledger.Cli.Options +import Hledger.Cli.Reports import Hledger.Data import Prelude hiding (putStr) import Hledger.Utils.UTF8 (putStr) @@ -22,12 +23,12 @@ barchar = '*' -- | Print a histogram of some statistic per reporting interval, such as -- number of postings per day. -histogram :: [Opt] -> [String] -> Journal -> IO () -histogram opts args j = do +histogram :: CliOpts -> Journal -> IO () +histogram CliOpts{reportopts_=reportopts_} j = do d <- getCurrentDay - putStr $ showHistogram opts (optsToFilterSpec opts args d) j + putStr $ showHistogram reportopts_ (optsToFilterSpec reportopts_ d) j -showHistogram :: [Opt] -> FilterSpec -> Journal -> String +showHistogram :: ReportOpts -> FilterSpec -> Journal -> String showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps where i = intervalFromOpts opts @@ -40,13 +41,13 @@ showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps -- should count transactions, not postings ? ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j filterempties - | Empty `elem` opts = id + | empty_ opts = id | otherwise = filter (not . isZeroMixedAmount . pamount) matchapats = matchpats apats . paccount apats = acctpats filterspec filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth) | otherwise = id - depth = fromMaybe 99999 $ depthFromOpts opts + depth = fromMaybe 99999 $ depth_ opts printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index ab02069f8..f22283b03 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -39,7 +39,9 @@ See "Hledger.Data.Ledger" for more examples. module Hledger.Cli.Main where +import Control.Monad import Data.List +import Text.Printf import Hledger.Cli.Add import Hledger.Cli.Balance @@ -52,38 +54,49 @@ import Hledger.Cli.Options import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version -import Hledger.Utils -import Prelude hiding (putStr, putStrLn) -import Hledger.Utils.UTF8 (putStr, putStrLn) main :: IO () main = do - (opts, args) <- parseArgumentsWith options_cli - case validateOpts opts of - Just err -> error' err - Nothing -> run opts args + opts <- getHledgerOpts + when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) + runWith opts -run opts args = - run opts args - where - run opts _ - | Help `elem` opts = putStr usage_cli - | Version `elem` opts = putStrLn $ progversionstr progname_cli - | BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_cli - run _ [] = argsError "a command is required." - run opts (cmd:args) - | cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance - | cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert - | cmd `isPrefixOf` "print" = withJournalDo opts args cmd print' - | cmd `isPrefixOf` "register" = withJournalDo opts args cmd register - | cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram - | cmd `isPrefixOf` "add" = withJournalDo opts args cmd add - | cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats - | cmd `isPrefixOf` "test" = runtests opts args >> return () - | otherwise = argsError $ "command "++cmd++" is unrecognized." +runWith :: CliOpts -> IO () +runWith opts = run' opts + where + cmd = command_ opts + run' opts + | null cmd = printModeHelpAndExit mainmode + | any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance + | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram + | cmd `isPrefixOf` "add" = showModeHelpOr addmode $ withJournalDo opts add + | cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ withJournalDo opts convert + | any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print' + | any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register + | cmd `isPrefixOf` "stats" = showModeHelpOr statsmode $ withJournalDo opts stats + | cmd `isPrefixOf` "test" = showModeHelpOr testmode $ runtests opts >> return () + | cmd `isPrefixOf` "binaryfilename" = showModeHelpOr binaryfilenamemode $ putStrLn $ binaryfilename progname + | otherwise = showModeHelpOr mainmode $ optserror $ "command "++cmd++" is not recognized" + showModeHelpOr mode f = do + when ("help" `in_` (rawopts_ opts)) $ printModeHelpAndExit mode + when ("version" `in_` (rawopts_ opts)) $ printVersionAndExit + f -validateOpts :: [Opt] -> Maybe String -validateOpts opts = - case parseFormatFromOpts opts of - Left err -> Just $ unlines ["Invalid format", err] - Right _ -> Nothing +{- tests: + +hledger -> main help +hledger --help -> main help +hledger --help command -> command help +hledger command --help -> command help +hledger badcommand -> unrecognized command, try --help (non-zero exit) +hledger badcommand --help -> main help +hledger --help badcommand -> main help +hledger --mainflag command -> works +hledger command --mainflag -> works +hledger command --commandflag -> works +hledger command --mainflag --commandflag -> works +XX hledger --mainflag command --commandflag -> works +XX hledger --commandflag command -> works +XX hledger --commandflag command --mainflag -> works + +-} \ No newline at end of file diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 109aec333..99fa1d3ea 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -1,234 +1,401 @@ {-| -Command-line options for the application. + +Command-line options for the hledger program, and option-parsing utilities. + -} module Hledger.Cli.Options where -import Data.Char (toLower) import Data.List import Data.Maybe import Data.Time.Calendar -import System.Console.GetOpt +import Safe +import System.Console.CmdArgs +import System.Console.CmdArgs.Explicit +import System.Console.CmdArgs.Text import System.Environment +import System.Exit import Test.HUnit -import Hledger.Data import Hledger.Cli.Format as Format -import Hledger.Read (myJournalPath, myTimelogPath) +import Hledger.Cli.Reports +import Hledger.Cli.Version +import Hledger.Data +import Hledger.Read import Hledger.Utils -progname_cli = "hledger" +progname = "hledger" +progversion = progversionstr progname --- | The program name which, if we are invoked as (via symlink or --- renaming), causes us to default to reading the user's time log instead --- of their journal. -progname_cli_time = "hours" +-- 1. cmdargs mode and flag definitions, for the main and subcommand modes. +-- Flag values are parsed initially to simple RawOpts to permit reuse. -usage_preamble_cli = - "Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++ - " hledger [OPTIONS] convert CSVFILE\n" ++ - "\n" ++ - "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++ - "runs the specified command (may be abbreviated):\n" ++ - "\n" ++ - " add - prompt for new transactions and add them to the journal\n" ++ - " balance - show accounts, with balances\n" ++ - " convert - show the specified CSV file as a hledger journal\n" ++ - " histogram - show a barchart of transactions per day or other interval\n" ++ - " print - show transactions in journal format\n" ++ - " register - show transactions as a register with running balance\n" ++ - " stats - show various statistics for a journal\n" ++ - " test - run self-tests\n" ++ - "\n" +type RawOpts = [(String,String)] -usage_options_cli = usageInfo "hledger options:" options_cli +defmode :: Mode RawOpts +defmode = Mode { + modeNames = [] + ,modeHelp = "" + ,modeHelpSuffix = [] + ,modeValue = [] + ,modeCheck = Right + ,modeReform = const Nothing + ,modeGroupFlags = toGroup [] + ,modeArgs = Nothing + ,modeGroupModes = toGroup [] + } -usage_postscript_cli = - "\n" ++ - "DATES can be y/m/d or smart dates like \"last month\". PATTERNS are regular\n" ++ - "expressions which filter by account name. Prefix a pattern with desc: to\n" ++ - "filter by transaction description instead, prefix with not: to negate it.\n" ++ - "When using both, not: comes last.\n" +mainmode = defmode { + modeNames = [progname] + ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. When mixing general and command-specific flags, put them all after COMMAND." + ,modeHelpSuffix = help_postscript + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + ,modeArgs = Just mainargsflag + ,modeGroupModes = Group { + groupUnnamed = [ + ] + ,groupHidden = [ + binaryfilenamemode + ] + ,groupNamed = [ + ("Misc commands", [ + addmode + ,convertmode + ,testmode + ]) + ,("\nReport commands", [ + accountsmode + ,entriesmode + ,postingsmode + -- ,transactionsmode + ,activitymode + ,statsmode + ]) + ] + } + } -usage_cli = concat [ - usage_preamble_cli - ,usage_options_cli - ,usage_postscript_cli - ] - --- | Command-line options we accept. -options_cli :: [OptDescr Opt] -options_cli = [ - Option "f" ["file"] (ReqArg File "FILE") "use a different journal/timelog file; - means stdin" - ,Option "b" ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date" - ,Option "e" ["end"] (ReqArg End "DATE") "report on transactions before this date" - ,Option "p" ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ - "and/or with the specified reporting interval\n") - ,Option "C" ["cleared"] (NoArg Cleared) "report only on cleared transactions" - ,Option "U" ["uncleared"] (NoArg UnCleared) "report only on uncleared transactions" - ,Option "B" ["cost","basis"] (NoArg CostBasis) "report cost of commodities" - ,Option "" ["alias"] (ReqArg Alias "ACCT=ALIAS") "display ACCT's name as ALIAS in reports" - ,Option "" ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this" - ,Option "d" ["display"] (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++ - "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)") - ,Option "" ["effective"] (NoArg Effective) "use transactions' effective dates, if any" - ,Option "E" ["empty"] (NoArg Empty) "show empty/zero things which are normally elided" - ,Option "" ["no-elide"] (NoArg NoElide) "no eliding at all, stronger than -E (eg for balance report)" - ,Option "R" ["real"] (NoArg Real) "report only on real (non-virtual) transactions" - ,Option "" ["flat"] (NoArg Flat) "balance: show full account names, unindented" - ,Option "" ["drop"] (ReqArg Drop "N") "balance: with --flat, elide first N account name components" - ,Option "" ["no-total"] (NoArg NoTotal) "balance: hide the final total" - ,Option "D" ["daily"] (NoArg DailyOpt) "register, stats: report by day" - ,Option "W" ["weekly"] (NoArg WeeklyOpt) "register, stats: report by week" - ,Option "M" ["monthly"] (NoArg MonthlyOpt) "register, stats: report by month" - ,Option "Q" ["quarterly"] (NoArg QuarterlyOpt) "register, stats: report by quarter" - ,Option "Y" ["yearly"] (NoArg YearlyOpt) "register, stats: report by year" - ,Option "" ["no-new-accounts"] (NoArg NoNewAccts) "add: don't allow creating new accounts" - ,Option "r" ["rules"] (ReqArg RulesFile "FILE") "convert: rules file to use (default:JOURNAL.rules)" - ,Option "F" ["format"] (ReqArg ReportFormat "STR") "use STR as the format" - ,Option "v" ["verbose"] (NoArg Verbose) "show more verbose output" - ,Option "" ["debug"] (NoArg Debug) "show extra debug output; implies verbose" - ,Option "" ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build" - ,Option "V" ["version"] (NoArg Version) "show version information" - ,Option "h" ["help"] (NoArg Help) "show command-line usage" +help_postscript = [ + -- "DATES can be Y/M/D or smart dates like \"last month\"." + -- ,"PATTERNS are regular" + -- ,"expressions which filter by account name. Prefix a pattern with desc: to" + -- ,"filter by transaction description instead, prefix with not: to negate it." + -- ,"When using both, not: comes last." ] --- | An option value from a command-line flag. -data Opt = - File {value::String} - | NoNewAccts - | Begin {value::String} - | End {value::String} - | Period {value::String} - | Cleared - | UnCleared - | CostBasis - | Alias {value::String} - | Depth {value::String} - | Display {value::String} - | Effective - | Empty - | NoElide - | Real - | Flat - | Drop {value::String} - | NoTotal - | DailyOpt - | WeeklyOpt - | MonthlyOpt - | QuarterlyOpt - | YearlyOpt - | RulesFile {value::String} - | ReportFormat {value::String} - | Help - | Verbose - | Version - | BinaryFilename - | Debug - -- XXX add-on options, must be defined here for now - -- vty - | DebugVty - -- web - | BaseUrl {value::String} - | Port {value::String} - -- chart - | ChartOutput {value::String} - | ChartItems {value::String} - | ChartSize {value::String} - deriving (Show,Eq) +generalflagstitle = "\nGeneral flags" +generalflags1 = fileflags ++ reportflags ++ helpflags +generalflags2 = fileflags ++ helpflags +generalflags3 = helpflags --- these make me nervous -optsWithConstructor f opts = concatMap get opts - where get o = [o | f v == o] where v = value o +fileflags = [ + flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin" + ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports" + ] -optsWithConstructors fs opts = concatMap get opts - where get o = [o | any (== o) fs] +reportflags = [ + flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date" + ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date" + ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXPR" "report on transactions during the specified period and/or with the specified reporting interval" + ,flagNone ["daily","D"] (\opts -> setboolopt "daily" opts) "report by day" + ,flagNone ["weekly","W"] (\opts -> setboolopt "weekly" opts) "report by week" + ,flagNone ["monthly","M"] (\opts -> setboolopt "monthly" opts) "report by month" + ,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter" + ,flagNone ["yearly","Y"] (\opts -> setboolopt "yearly" opts) "report by year" + ,flagNone ["cleared","C"] (\opts -> setboolopt "cleared" opts) "report only on cleared transactions" + ,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions" + ,flagNone ["cost","B"] (\opts -> setboolopt "cost" opts) "report cost of commodities" + ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this" + ,flagReq ["display","d"] (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXPR" "show only transactions matching the expr, which is 'dOP[DATE]' where OP is <, <=, =, >=, >" + ,flagNone ["effective"] (\opts -> setboolopt "effective" opts) "use transactions' effective dates, if any" + ,flagNone ["empty","E"] (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided" + ,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions" + ] -optValuesForConstructor f opts = concatMap get opts - where get o = [v | f v == o] where v = value o +helpflags = [ + flagHelpSimple (setboolopt "help") + ,flagNone ["debug"] (setboolopt "debug") "Show extra debug output" + ,flagVersion (setboolopt "version") + ] -optValuesForConstructors fs opts = concatMap get opts - where get o = [v | any (\f -> f v == o) fs] where v = value o +mainargsflag = flagArg f "" + where f s opts = let as = words' s + cmd = headDef "" as + args = drop (length cmd + 1) s + in Right $ setopt "command" cmd $ setopt "args" args opts --- | Parse the command-line arguments into options and arguments using the --- specified option descriptors. Any smart dates in the options are --- converted to explicit YYYY/MM/DD format based on the current time. If --- parsing fails, raise an error, displaying the problem along with the --- provided usage string. -parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String]) -parseArgumentsWith options = do - rawargs <- map fromPlatformString `fmap` getArgs - parseArgumentsWith' options rawargs +commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]" -parseArgumentsWith' options rawargs = do - let (opts,args,errs) = getOpt Permute options rawargs - opts' <- fixOptDates opts - let opts'' = if Debug `elem` opts' then Verbose:opts' else opts' - if null errs - then return (opts'',args) - else argsError (concat errs) >> return ([],[]) +commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]} -argsError :: String -> IO () -argsError = ioError . userError' . (++ " Run with --help to see usage.") +addmode = (commandmode ["add"]) { + modeHelp = "prompt for new transactions and append them to the journal" + ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."] + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [ + flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts" + ] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags2)] + } + } --- | Convert any fuzzy dates within these option values to explicit ones, --- based on today's date. -fixOptDates :: [Opt] -> IO [Opt] -fixOptDates opts = do +convertmode = (commandmode ["convert"]) { + modeValue = [("command","convert")] + ,modeHelp = "show the specified CSV file as hledger journal entries" + ,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "CSVFILE" + ,modeGroupFlags = Group { + groupUnnamed = [ + flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)" + ] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags3)] + } + } + +testmode = (commandmode ["test"]) { + modeHelp = "run self-tests, or just the ones matching REGEXPS" + ,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]" + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags3)] + } + } + +accountsmode = (commandmode ["accounts","balance"]) { + modeHelp = "(or balance) show matched accounts and their balances" + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [ + flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented" + ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components" + ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format" + ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty" + ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total" + ] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +entriesmode = (commandmode ["entries","print"]) { + modeHelp = "(or print) show matched journal entries" + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +postingsmode = (commandmode ["postings","register"]) { + modeHelp = "(or register) show matched postings and running total" + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +transactionsmode = (commandmode ["transactions"]) { + modeHelp = "show matched transactions and balance in some account(s)" + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +activitymode = (commandmode ["activity","histogram"]) { + modeHelp = "show a barchart of transactions per interval" + ,modeHelpSuffix = ["The default interval is daily."] + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +statsmode = (commandmode ["stats"]) { + modeHelp = "show quick statistics for a journal (or part of it)" + ,modeArgs = Just commandargsflag + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + } + +binaryfilenamemode = (commandmode ["binaryfilename"]) { + modeHelp = "show the download filename for this hledger build, and exit" + ,modeArgs = Nothing + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags3)] + } + } + +-- 2. ADT holding options used in this package and above, parsed from RawOpts. +-- This represents the command-line options that were provided, with all +-- parsing completed, but before adding defaults or derived values (XXX add) + +-- cli options, used in hledger and above +data CliOpts = CliOpts { + rawopts_ :: RawOpts + ,command_ :: String + ,file_ :: Maybe FilePath + ,alias_ :: [String] + ,debug_ :: Bool + ,no_new_accounts_ :: Bool -- add + ,rules_file_ :: Maybe FilePath -- convert + ,reportopts_ :: ReportOpts + } deriving (Show) + +defcliopts = CliOpts + def + def + def + def + def + def + def + def + +instance Default CliOpts where def = defcliopts + +-- | Parse raw option string values to the desired final data types. +-- Any relative smart dates will be converted to fixed dates based on +-- today's date. Parsing failures will raise an error. +toCliOpts :: RawOpts -> IO CliOpts +toCliOpts rawopts = do d <- getCurrentDay - return $ map (fixopt d) opts - where - fixopt d (Begin s) = Begin $ fixSmartDateStr d s - fixopt d (End s) = End $ fixSmartDateStr d s - fixopt d (Display s) = -- hacky - Display $ regexReplaceBy "\\[.+?\\]" fixbracketeddatestr s - where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]" - fixopt _ o = o + return defcliopts { + rawopts_ = rawopts + ,command_ = stringopt "command" rawopts + ,file_ = maybestringopt "file" rawopts + ,alias_ = listofstringopt "alias" rawopts + ,debug_ = boolopt "debug" rawopts + ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add + ,rules_file_ = maybestringopt "rules-file" rawopts -- convert + ,reportopts_ = defreportopts { + begin_ = maybesmartdateopt d "begin" rawopts + ,end_ = maybesmartdateopt d "end" rawopts + ,period_ = maybeperiodopt d rawopts + ,cleared_ = boolopt "cleared" rawopts + ,uncleared_ = boolopt "uncleared" rawopts + ,cost_ = boolopt "cost" rawopts + ,depth_ = maybeintopt "depth" rawopts + ,display_ = maybedisplayopt d rawopts + ,effective_ = boolopt "effective" rawopts + ,empty_ = boolopt "empty" rawopts + ,no_elide_ = boolopt "no-elide" rawopts + ,real_ = boolopt "real" rawopts + ,flat_ = boolopt "flat" rawopts -- balance + ,drop_ = intopt "drop" rawopts -- balance + ,no_total_ = boolopt "no-total" rawopts -- balance + ,daily_ = boolopt "daily" rawopts + ,weekly_ = boolopt "weekly" rawopts + ,monthly_ = boolopt "monthly" rawopts + ,quarterly_ = boolopt "quarterly" rawopts + ,yearly_ = boolopt "yearly" rawopts + ,format_ = maybestringopt "format" rawopts + ,patterns_ = words'' prefixes $ singleQuoteIfNeeded $ stringopt "args" rawopts + } + } --- | Figure out the overall date span we should report on, based on any --- begin/end/period options provided. If there is a period option, the --- others are ignored. -dateSpanFromOpts :: Day -> [Opt] -> DateSpan -dateSpanFromOpts refdate opts - | not (null popts) = case parsePeriodExpr refdate $ last popts of - Right (_, s) -> s - Left e -> parseerror e - | otherwise = DateSpan lastb laste +-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457 +-- just handles commonest cases +moveFlagsAfterCommand ("-f":f:cmd:rest) = cmd:"-f":f:rest +moveFlagsAfterCommand (first:cmd:rest) | "-f" `isPrefixOf` first = cmd:first:rest +moveFlagsAfterCommand as = as + +-- | Convert possibly encoded option values to regular unicode strings. +decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val)) + +-- | Get all command-line options, failing on any parse errors. +getHledgerOpts :: IO CliOpts +-- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts +getHledgerOpts = do + args <- getArgs + toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts + +-- utils + +optserror = error' . (++ " (run with --help for usage)") + +setopt name val = (++ [(name,singleQuoteIfNeeded val)]) + +setboolopt name = (++ [(name,"")]) + +in_ :: String -> RawOpts -> Bool +in_ name = isJust . lookup name + +boolopt = in_ + +maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name + +stringopt name = fromMaybe "" . maybestringopt name + +listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name] + +maybeintopt :: String -> RawOpts -> Maybe Int +maybeintopt name rawopts = + let ms = maybestringopt name rawopts in + case ms of Nothing -> Nothing + Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s + +intopt name = fromMaybe 0 . maybeintopt name + +maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day +maybesmartdateopt d name rawopts = + case maybestringopt name rawopts of + Nothing -> Nothing + Just s -> either + (\e -> optserror $ "could not parse "++name++" date: "++show e) + Just + $ fixSmartDateStrEither' d s + +maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExpr +maybedisplayopt d rawopts = + maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts where - popts = optValuesForConstructor Period opts - bopts = optValuesForConstructor Begin opts - eopts = optValuesForConstructor End opts - lastb = listtomaybeday bopts - laste = listtomaybeday eopts - listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs - where parse = parsedate . fixSmartDateStr refdate + fixbracketeddatestr "" = "" + fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]" --- | Figure out the reporting interval, if any, specified by the options. --- If there is a period option, the others are ignored. -intervalFromOpts :: [Opt] -> Interval -intervalFromOpts opts = - case (periodopts, intervalopts) of - ((p:_), _) -> case parsePeriodExpr (parsedate "0001/01/01") p of - Right (i, _) -> i - Left e -> parseerror e - (_, (DailyOpt:_)) -> Days 1 - (_, (WeeklyOpt:_)) -> Weeks 1 - (_, (MonthlyOpt:_)) -> Months 1 - (_, (QuarterlyOpt:_)) -> Quarters 1 - (_, (YearlyOpt:_)) -> Years 1 - (_, _) -> NoInterval - where - periodopts = reverse $ optValuesForConstructor Period opts - intervalopts = reverse $ filter (`elem` [DailyOpt,WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts +maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan) +maybeperiodopt d rawopts = + case maybestringopt "period" rawopts of + Nothing -> Nothing + Just s -> either + (\e -> optserror $ "could not parse period option: "++show e) + Just + $ parsePeriodExpr d s -rulesFileFromOpts :: [Opt] -> Maybe FilePath -rulesFileFromOpts opts = listtomaybe $ optValuesForConstructor RulesFile opts - where - listtomaybe [] = Nothing - listtomaybe vs = Just $ head vs +-- | Do final validation of processed opts, raising an error if there is trouble. +checkCliOpts :: CliOpts -> IO CliOpts -- or pure.. +checkCliOpts opts@CliOpts{reportopts_=ropts} = do + case formatFromOpts ropts of + Left err -> optserror $ "could not parse format option: "++err + Right _ -> return () + return opts --- | Default balance format string: "%20(total) %2(depth_spacer)%-(account)" +-- | Parse any format option provided, possibly raising an error, or get +-- the default value. +formatFromOpts :: ReportOpts -> Either String [FormatString] +formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_ + +-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" defaultBalanceFormatString :: [FormatString] defaultBalanceFormatString = [ FormatField False (Just 20) Nothing Total @@ -237,81 +404,14 @@ defaultBalanceFormatString = [ , FormatField True Nothing Nothing Format.Account ] --- | Parses the --format string to either an error message or a format string. -parseFormatFromOpts :: [Opt] -> Either String [FormatString] -parseFormatFromOpts opts = listtomaybe $ optValuesForConstructor ReportFormat opts - where - listtomaybe :: [String] -> Either String [FormatString] - listtomaybe [] = Right defaultBalanceFormatString - listtomaybe vs = parseFormatString $ head vs - --- | Returns the format string. If the string can't be parsed it fails with error'. -formatFromOpts :: [Opt] -> [FormatString] -formatFromOpts opts = case parseFormatFromOpts opts of - Left err -> error' err - Right format -> format - --- | Get the value of the (last) depth option, if any. -depthFromOpts :: [Opt] -> Maybe Int -depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts - where - listtomaybeint [] = Nothing - listtomaybeint vs = Just $ read $ last vs - --- | Get the value of the (last) drop option, if any, otherwise 0. -dropFromOpts :: [Opt] -> Int -dropFromOpts opts = fromMaybe 0 $ listtomaybeint $ optValuesForConstructor Drop opts - where - listtomaybeint [] = Nothing - listtomaybeint vs = Just $ read $ last vs - --- | Get the value of the (last) display option, if any. -displayExprFromOpts :: [Opt] -> Maybe String -displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts - where - listtomaybe [] = Nothing - listtomaybe vs = Just $ last vs - --- | Get the value of the (last) baseurl option, if any. -baseUrlFromOpts :: [Opt] -> Maybe String -baseUrlFromOpts opts = listtomaybe $ optValuesForConstructor BaseUrl opts - where - listtomaybe [] = Nothing - listtomaybe vs = Just $ last vs - --- | Get the value of the (last) port option, if any. -portFromOpts :: [Opt] -> Maybe Int -portFromOpts opts = listtomaybeint $ optValuesForConstructor Port opts - where - listtomaybeint [] = Nothing - listtomaybeint vs = Just $ read $ last vs - - --- | Get a maybe boolean representing the last cleared/uncleared option if any. -clearedValueFromOpts opts | null os = Nothing - | last os == Cleared = Just True - | otherwise = Just False - where os = optsWithConstructors [Cleared,UnCleared] opts - --- | Detect which date we will report on, based on --effective. -whichDateFromOpts :: [Opt] -> WhichDate -whichDateFromOpts opts = if Effective `elem` opts then EffectiveDate else ActualDate - --- | Were we invoked as \"hours\" ? -usingTimeProgramName :: IO Bool -usingTimeProgramName = do - progname <- getProgName - return $ map toLower progname == progname_cli_time - -- | Get the journal file path from options, an environment variable, or a default -journalFilePathFromOpts :: [Opt] -> IO String +journalFilePathFromOpts :: CliOpts -> IO String journalFilePathFromOpts opts = do - istimequery <- usingTimeProgramName - f <- if istimequery then myTimelogPath else myJournalPath - return $ last $ f : optValuesForConstructor File opts + f <- myJournalPath + return $ fromMaybe f $ file_ opts -aliasesFromOpts :: [Opt] -> [(AccountName,AccountName)] -aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts +aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)] +aliasesFromOpts = map parseAlias . alias_ where -- similar to ledgerAlias parseAlias :: String -> (AccountName,AccountName) @@ -322,57 +422,11 @@ aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts alias' = case alias of ('=':rest) -> rest _ -> orig --- | Gather filter pattern arguments into a list of account patterns and a --- list of description patterns. We interpret pattern arguments as --- follows: those prefixed with "desc:" are description patterns, all --- others are account patterns; also patterns prefixed with "not:" are --- negated. not: should come after desc: if both are used. -parsePatternArgs :: [String] -> ([String],[String]) -parsePatternArgs args = (as, ds') - where - descprefix = "desc:" - (ds, as) = partition (descprefix `isPrefixOf`) args - ds' = map (drop (length descprefix)) ds +printModeHelpAndExit mode = putStrLn progversion >> putStr help >> exitSuccess + where help = showText defaultWrap $ helpText HelpFormatDefault mode --- | Convert application options to the library's generic filter specification. -optsToFilterSpec :: [Opt] -> [String] -> Day -> FilterSpec -optsToFilterSpec opts args d = FilterSpec { - datespan=dateSpanFromOpts d opts - ,cleared=clearedValueFromOpts opts - ,real=Real `elem` opts - ,empty=Empty `elem` opts - ,acctpats=apats - ,descpats=dpats - ,depth = depthFromOpts opts - } - where (apats,dpats) = parsePatternArgs args - --- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts --- where --- listtomaybe [] = Nothing --- listtomaybe vs = Just $ last vs +printVersionAndExit = putStrLn progversion >> exitSuccess tests_Hledger_Cli_Options = TestList [ - "dateSpanFromOpts" ~: do - let todaysdate = parsedate "2008/11/26" - let gives = is . show . dateSpanFromOpts todaysdate - [] `gives` "DateSpan Nothing Nothing" - [Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)" - [Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)" - [Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)" - - ,"intervalFromOpts" ~: do - let gives = is . intervalFromOpts - [] `gives` NoInterval - [DailyOpt] `gives` Days 1 - [WeeklyOpt] `gives` Weeks 1 - [MonthlyOpt] `gives` Months 1 - [QuarterlyOpt] `gives` Quarters 1 - [YearlyOpt] `gives` Years 1 - [Period "weekly"] `gives` Weeks 1 - [Period "monthly"] `gives` Months 1 - [Period "quarterly"] `gives` Quarters 1 - [WeeklyOpt, Period "yearly"] `gives` Years 1 - ] diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index 52975d024..779cba675 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -18,15 +18,14 @@ import Hledger.Cli.Options import Hledger.Cli.Reports -- | Print journal transactions in standard format. -print' :: [Opt] -> [String] -> Journal -> IO () -print' opts args j = do +print' :: CliOpts -> Journal -> IO () +print' CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ showTransactions opts (optsToFilterSpec opts args d) j + putStr $ showTransactions ropts (optsToFilterSpec ropts d) j -showTransactions :: [Opt] -> FilterSpec -> Journal -> String +showTransactions :: ReportOpts -> FilterSpec -> Journal -> String showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j -entriesReportAsText :: [Opt] -> FilterSpec -> EntriesReport -> String -entriesReportAsText opts _ items = concatMap (showTransactionForPrint effective) items - where effective = Effective `elem` opts +entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String +entriesReportAsText opts _ items = concatMap (showTransactionForPrint (effective_ opts)) items diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 809f40d41..5619a43bc 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -25,13 +25,13 @@ import Hledger.Cli.Reports -- | Print a (posting) register report. -register :: [Opt] -> [String] -> Journal -> IO () -register opts args j = do +register :: CliOpts -> Journal -> IO () +register CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts args d) j + putStr $ postingsReportAsText ropts $ postingsReport ropts (optsToFilterSpec ropts d) j -- | Render a register report as plain text suitable for console output. -postingsReportAsText :: [Opt] -> PostingsReport -> String +postingsReportAsText :: ReportOpts -> PostingsReport -> String postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd -- | Render one register report line item as plain text. Eg: @@ -41,7 +41,7 @@ postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd -- ^ displayed for first postings^ -- only, otherwise blank -- @ -postingsReportItemAsText :: [Opt] -> PostingsReportItem -> String +postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal] where datedesc = case dd of Nothing -> replicate datedescwidth ' ' @@ -57,7 +57,7 @@ postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) -- XXX -showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText [] $ mkpostingsReportItem showtxninfo p b +showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b tests_Hledger_Cli_Register :: Test tests_Hledger_Cli_Register = TestList diff --git a/hledger/Hledger/Cli/Reports.hs b/hledger/Hledger/Cli/Reports.hs index 2dfebc1bc..1357db854 100644 --- a/hledger/Hledger/Cli/Reports.hs +++ b/hledger/Hledger/Cli/Reports.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-| Generate several common kinds of report from a journal, as \"*Report\" - @@ -9,6 +10,17 @@ on the command-line options, should move to hledger-lib later. -} module Hledger.Cli.Reports ( + ReportOpts(..), + DisplayExpr, + FormatStr, + defreportopts, + dateSpanFromOpts, + intervalFromOpts, + clearedValueFromOpts, + whichDateFromOpts, + journalSelectingDateFromOpts, + journalSelectingAmountFromOpts, + optsToFilterSpec, -- * Entries report EntriesReport, EntriesReportItem, @@ -42,14 +54,138 @@ import Data.Ord import Data.Time.Calendar import Data.Tree import Safe (headMay, lastMay) +import System.Console.CmdArgs -- for defaults support import Test.HUnit import Text.ParserCombinators.Parsec import Text.Printf import Hledger.Data import Hledger.Utils -import Hledger.Cli.Options -import Hledger.Cli.Utils +-- import Hledger.Cli.Utils + +-- report options, used in hledger-lib and above +data ReportOpts = ReportOpts { + begin_ :: Maybe Day + ,end_ :: Maybe Day + ,period_ :: Maybe (Interval,DateSpan) + ,cleared_ :: Bool + ,uncleared_ :: Bool + ,cost_ :: Bool + ,depth_ :: Maybe Int + ,display_ :: Maybe DisplayExpr + ,effective_ :: Bool + ,empty_ :: Bool + ,no_elide_ :: Bool + ,real_ :: Bool + ,flat_ :: Bool -- balance + ,drop_ :: Int -- balance + ,no_total_ :: Bool -- balance + ,daily_ :: Bool + ,weekly_ :: Bool + ,monthly_ :: Bool + ,quarterly_ :: Bool + ,yearly_ :: Bool + ,format_ :: Maybe FormatStr + ,patterns_ :: [String] + } deriving (Show) + +type DisplayExpr = String +type FormatStr = String + +defreportopts = ReportOpts + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + def + +instance Default ReportOpts where def = defreportopts + +-- | Figure out the date span we should report on, based on any +-- begin/end/period options provided. A period option will cause begin and +-- end options to be ignored. +dateSpanFromOpts :: Day -> ReportOpts -> DateSpan +dateSpanFromOpts _ ReportOpts{..} = + case period_ of Just (_,span) -> span + Nothing -> DateSpan begin_ end_ + +-- | Figure out the reporting interval, if any, specified by the options. +-- --period overrides --daily overrides --weekly overrides --monthly etc. +intervalFromOpts :: ReportOpts -> Interval +intervalFromOpts ReportOpts{..} = + case period_ of + Just (interval,_) -> interval + Nothing -> i + where i | daily_ = Days 1 + | weekly_ = Weeks 1 + | monthly_ = Months 1 + | quarterly_ = Quarters 1 + | yearly_ = Years 1 + | otherwise = NoInterval + +-- | Get a maybe boolean representing the last cleared/uncleared option if any. +clearedValueFromOpts :: ReportOpts -> Maybe Bool +clearedValueFromOpts ReportOpts{..} | cleared_ = Just True + | uncleared_ = Just False + | otherwise = Nothing + +-- | Detect which date we will report on, based on --effective. +whichDateFromOpts :: ReportOpts -> WhichDate +whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate + +-- | Convert this journal's transactions' primary date to either the +-- actual or effective date, as per options. +journalSelectingDateFromOpts :: ReportOpts -> Journal -> Journal +journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts) + +-- | Convert this journal's postings' amounts to the cost basis amounts if +-- specified by options. +journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal +journalSelectingAmountFromOpts opts + | cost_ opts = journalConvertAmountsToCost + | otherwise = id + +-- | Convert application options to the library's generic filter specification. +optsToFilterSpec :: ReportOpts -> Day -> FilterSpec +optsToFilterSpec opts@ReportOpts{..} d = FilterSpec { + datespan=dateSpanFromOpts d opts + ,cleared= clearedValueFromOpts opts + ,real=real_ + ,empty=empty_ + ,acctpats=apats + ,descpats=dpats + ,depth = depth_ + } + where (apats,dpats) = parsePatternArgs patterns_ + +-- | Gather filter pattern arguments into a list of account patterns and a +-- list of description patterns. We interpret pattern arguments as +-- follows: those prefixed with "desc:" are description patterns, all +-- others are account patterns; also patterns prefixed with "not:" are +-- negated. not: should come after desc: if both are used. +parsePatternArgs :: [String] -> ([String],[String]) +parsePatternArgs args = (as, ds') + where + descprefix = "desc:" + (ds, as) = partition (descprefix `isPrefixOf`) args + ds' = map (drop (length descprefix)) ds ------------------------------------------------------------------------------- @@ -60,7 +196,7 @@ type EntriesReport = [EntriesReportItem] type EntriesReportItem = Transaction -- | Select transactions for an entries report. -entriesReport :: [Opt] -> FilterSpec -> Journal -> EntriesReport +entriesReport :: ReportOpts -> FilterSpec -> Journal -> EntriesReport entriesReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j' where j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j @@ -79,12 +215,12 @@ type PostingsReportItem = (Maybe (Day, String) -- transaction date and descripti -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. -postingsReport :: [Opt] -> FilterSpec -> Journal -> PostingsReport +postingsReport :: ReportOpts -> FilterSpec -> Journal -> PostingsReport postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting startbal (+)) where ps | interval == NoInterval = displayableps | otherwise = summarisePostingsByInterval interval depth empty filterspan displayableps - (precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts) + (precedingps, displayableps, _) = postingsMatchingDisplayExpr (display_ opts) $ depthClipPostings depth $ journalPostings $ filterJournalPostings fspec{depth=Nothing} @@ -93,7 +229,7 @@ postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting st j startbal = sumPostings precedingps filterspan = datespan fspec - (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) + (interval, depth, empty) = (intervalFromOpts opts, depth_ opts, empty_ opts) totallabel = "Total" balancelabel = "Balance" @@ -238,7 +374,7 @@ triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0" -- "postingsReport" except it uses matchers and transaction-based report -- items and the items are most recent first. Used by eg hledger-web's -- journal view. -journalTransactionsReport :: [Opt] -> Journal -> Matcher -> TransactionsReport +journalTransactionsReport :: ReportOpts -> Journal -> Matcher -> TransactionsReport journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) where ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts @@ -261,16 +397,16 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items) -- Currently, reporting intervals are not supported, and report items are -- most recent first. Used by eg hledger-web's account register view. -- -accountTransactionsReport :: [Opt] -> Journal -> Matcher -> Matcher -> TransactionsReport +accountTransactionsReport :: ReportOpts -> Journal -> Matcher -> Matcher -> TransactionsReport accountTransactionsReport opts j m thisacctmatcher = (label, items) where -- transactions affecting this account, in date order ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctmatcher) $ jtxns j -- starting balance: if we are filtering by a start date and nothing else, -- the sum of postings to this account before that date; otherwise zero. - (startbal,label) | matcherIsNull m = (nullmixedamt, balancelabel) - | matcherIsStartDateOnly effective m = (sumPostings priorps, balancelabel) - | otherwise = (nullmixedamt, totallabel) + (startbal,label) | matcherIsNull m = (nullmixedamt, balancelabel) + | matcherIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel) + | otherwise = (nullmixedamt, totallabel) where priorps = -- ltrace "priorps" $ filter (matchesPosting @@ -278,8 +414,7 @@ accountTransactionsReport opts j m thisacctmatcher = (label, items) MatchAnd [thisacctmatcher, tostartdatematcher])) $ transactionsPostings ts tostartdatematcher = MatchDate True (DateSpan Nothing startdate) - startdate = matcherStartDate effective m - effective = Effective `elem` opts + startdate = matcherStartDate (effective_ opts) m items = reverse $ accountTransactionsReportItems m (Just thisacctmatcher) startbal negate ts -- | Generate transactions report items from a list of transactions, @@ -344,25 +479,25 @@ type AccountsReportItem = (AccountName -- full account name -- | Select accounts, and get their balances at the end of the selected -- period, and misc. display information, for an accounts report. Used by -- eg hledger's balance command. -accountsReport :: [Opt] -> FilterSpec -> Journal -> AccountsReport +accountsReport :: ReportOpts -> FilterSpec -> Journal -> AccountsReport accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filterspec) -- | Select accounts, and get their balances at the end of the selected -- period, and misc. display information, for an accounts report. Like -- "accountsReport" but uses the new matchers. Used by eg hledger-web's -- accounts sidebar. -accountsReport2 :: [Opt] -> Matcher -> Journal -> AccountsReport +accountsReport2 :: ReportOpts -> Matcher -> Journal -> AccountsReport accountsReport2 opts matcher j = accountsReport' opts j (journalToLedger2 matcher) -- Accounts report helper. -accountsReport' :: [Opt] -> Journal -> (Journal -> Ledger) -> AccountsReport +accountsReport' :: ReportOpts -> Journal -> (Journal -> Ledger) -> AccountsReport accountsReport' opts j jtol = (items, total) where items = map mkitem interestingaccts - interestingaccts | NoElide `elem` opts = acctnames + interestingaccts | no_elide_ opts = acctnames | otherwise = filter (isInteresting opts l) acctnames acctnames = sort $ tail $ flatten $ treemap aname accttree - accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l + accttree = ledgerAccountTree (fromMaybe 99999 $ depth_ opts) l total = sum $ map abalance $ ledgerTopAccounts l l = jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j @@ -370,14 +505,14 @@ accountsReport' opts j jtol = (items, total) mkitem :: AccountName -> AccountsReportItem mkitem a = (a, adisplay, indent, abal) where - adisplay | Flat `elem` opts = a + adisplay | flat_ opts = a | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a] where ps = takeWhile boring parents where boring = not . (`elem` interestingparents) - indent | Flat `elem` opts = 0 + indent | flat_ opts = 0 | otherwise = length interestingparents interestingparents = filter (`elem` interestingaccts) parents parents = parentAccountNames a - abal | Flat `elem` opts = exclusiveBalance acct + abal | flat_ opts = exclusiveBalance acct | otherwise = abalance acct where acct = ledgerAccount l a @@ -386,24 +521,24 @@ exclusiveBalance = sumPostings . apostings -- | Is the named account considered interesting for this ledger's accounts report, -- following the eliding style of ledger's balance command ? -isInteresting :: [Opt] -> Ledger -> AccountName -> Bool -isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a +isInteresting :: ReportOpts -> Ledger -> AccountName -> Bool +isInteresting opts l a | flat_ opts = isInterestingFlat opts l a | otherwise = isInterestingIndented opts l a -isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool +isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool isInterestingFlat opts l a = notempty || emptyflag where acct = ledgerAccount l a notempty = not $ isZeroMixedAmount $ exclusiveBalance acct - emptyflag = Empty `elem` opts + emptyflag = empty_ opts -isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool +isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool isInterestingIndented opts l a | numinterestingsubs==1 && not atmaxdepth = notlikesub | otherwise = notzero || emptyflag where - atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts - emptyflag = Empty `elem` opts + atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depth_ opts + emptyflag = empty_ opts acct = ledgerAccount l a notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct diff --git a/hledger/Hledger/Cli/Stats.hs b/hledger/Hledger/Cli/Stats.hs index cb0df288a..adf742581 100644 --- a/hledger/Hledger/Cli/Stats.hs +++ b/hledger/Hledger/Cli/Stats.hs @@ -15,6 +15,7 @@ import Text.Printf import qualified Data.Map as Map import Hledger.Cli.Options +import Hledger.Cli.Reports import Hledger.Data import Prelude hiding (putStr) import Hledger.Utils.UTF8 (putStr) @@ -22,19 +23,19 @@ import Hledger.Utils.UTF8 (putStr) -- like Register.summarisePostings -- | Print various statistics for the journal. -stats :: [Opt] -> [String] -> Journal -> IO () -stats opts args j = do +stats :: CliOpts -> Journal -> IO () +stats CliOpts{reportopts_=reportopts_} j = do d <- getCurrentDay - let filterspec = optsToFilterSpec opts args d + let filterspec = optsToFilterSpec reportopts_ d l = journalToLedger filterspec j reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec) - intervalspans = splitSpan (intervalFromOpts opts) reportspan - showstats = showLedgerStats opts args l d + intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan + showstats = showLedgerStats l d s = intercalate "\n" $ map showstats intervalspans putStr s -showLedgerStats :: [Opt] -> [String] -> Ledger -> Day -> DateSpan -> String -showLedgerStats _ _ l today span = +showLedgerStats :: Ledger -> Day -> DateSpan -> String +showLedgerStats l today span = unlines (map (uncurry (printf fmt)) stats) where fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s" diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index 96adbc028..306ab296e 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -38,22 +38,22 @@ import Hledger.Utils -- | Run unit tests and exit with success or failure. -runtests :: [Opt] -> [String] -> IO () -runtests opts args = do - (hunitcounts,_) <- runtests' opts args +runtests :: CliOpts -> IO () +runtests opts = do + (hunitcounts,_) <- runtests' opts if errors hunitcounts > 0 || (failures hunitcounts > 0) then exitFailure else exitWith ExitSuccess -- | Run unit tests and exit on failure. -runTestsOrExit :: [Opt] -> [String] -> IO () -runTestsOrExit opts args = do - (hunitcounts,_) <- runtests' opts args +runTestsOrExit :: CliOpts -> IO () +runTestsOrExit opts = do + (hunitcounts,_) <- runtests' opts when (errors hunitcounts > 0 || (failures hunitcounts > 0)) $ exitFailure -runtests' :: Num b => t -> [String] -> IO (Counts, b) -runtests' _ args = liftM (flip (,) 0) $ runTestTT ts +runtests' :: Num b => CliOpts -> IO (Counts, b) +runtests' opts = liftM (flip (,) 0) $ runTestTT ts where ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli -- show flat test names -- ts = tfilter matchname $ TestList tests -- show hierarchical test names - matchname = matchpats args . tname + matchname = matchpats (patterns_ $ reportopts_ opts) . tname diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 8ac8585a3..28b607471 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -10,8 +10,6 @@ module Hledger.Cli.Utils ( withJournalDo, readJournal', - journalSelectingDateFromOpts, - journalSelectingAmountFromOpts, journalReload, journalReloadIfChanged, journalFileIsNewer, @@ -25,10 +23,10 @@ module Hledger.Cli.Utils ) where import Control.Exception -import Control.Monad import Data.List import Data.Maybe import Safe (readMay) +import System.Console.CmdArgs import System.Directory (getModificationTime, getDirectoryContents, copyFile) import System.Exit import System.FilePath ((), splitFileName, takeDirectory) @@ -46,34 +44,22 @@ import Hledger.Utils -- | Parse the user's specified journal file and run a hledger command on -- it, or throw an error. -withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO () -withJournalDo opts args _ cmd = do +withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO () +withJournalDo opts cmd = do -- We kludgily read the file before parsing to grab the full text, unless -- it's stdin, or it doesn't exist and we are adding. We read it strictly -- to let the add command work. journalFilePathFromOpts opts >>= readJournalFile Nothing >>= - either error' (cmd opts args . journalApplyAliases (aliasesFromOpts opts)) + either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts)) -- -- | Get a journal from the given string and options, or throw an error. --- readJournalWithOpts :: [Opt] -> String -> IO Journal +-- readJournalWithOpts :: CliOpts -> String -> IO Journal -- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return -- | Get a journal from the given string, or throw an error. readJournal' :: String -> IO Journal readJournal' s = readJournal Nothing s >>= either error' return --- | Convert this journal's transactions' primary date to either the --- actual or effective date, as per options. -journalSelectingDateFromOpts :: [Opt] -> Journal -> Journal -journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts) - --- | Convert this journal's postings' amounts to the cost basis amounts if --- specified by options. -journalSelectingAmountFromOpts :: [Opt] -> Journal -> Journal -journalSelectingAmountFromOpts opts - | CostBasis `elem` opts = journalConvertAmountsToCost - | otherwise = id - -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal) journalReload j = readJournalFile Nothing $ journalFilePath j @@ -83,14 +69,14 @@ journalReload j = readJournalFile Nothing $ journalFilePath j -- stdin). The provided options are mostly ignored. Return a journal or -- the error message while reading it, and a flag indicating whether it -- was re-read or not. -journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool) -journalReloadIfChanged opts j = do +journalReloadIfChanged :: CliOpts -> Journal -> IO (Either String Journal, Bool) +journalReloadIfChanged _ j = do let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f return $ if newer then Just f else Nothing changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j) if not $ null changedfiles then do - when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles) + whenLoud $ printf "%s has changed, reloading\n" (head changedfiles) jE <- journalReload j return (jE, True) else diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 9d5180af6..c4054c2bd 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -60,6 +60,7 @@ library hledger-lib == 0.15 ,base >= 3 && < 5 ,containers + ,cmdargs >= 0.7 && < 0.8 ,csv ,directory ,filepath @@ -110,6 +111,7 @@ executable hledger hledger-lib == 0.15 ,base >= 3 && < 5 ,containers + ,cmdargs >= 0.7 && < 0.8 ,csv ,directory ,filepath diff --git a/tests/convert-with-in-and-out-fields.test b/tests/convert-with-in-and-out-fields.test index e336afc70..8ee5a258c 100644 --- a/tests/convert-with-in-and-out-fields.test +++ b/tests/convert-with-in-and-out-fields.test @@ -1,5 +1,5 @@ # Conversion from CSV to Ledger with in-field and out-field -rm -rf unused.journal$$ convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert --rules convert.rules$$ - ; rm -rf *$$ +rm -rf convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; bin/hledger convert --rules-file convert.rules$$ - ; rm -rf *$$ <<< 10/2009/09,Flubber Co,50, 11/2009/09,Flubber Co,,50 diff --git a/tests/convert.test b/tests/convert.test index fac3b79b6..3e2a3e9d9 100644 --- a/tests/convert.test +++ b/tests/convert.test @@ -1,5 +1,5 @@ # Conversion from CSV to Ledger -rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert input.csv$$ ; rm -rf input.rules *$$ +rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; bin/hledger convert input.csv$$ ; rm -rf input.rules *$$ >>> 2009/09/10 Flubber Co income:unknown $-50 diff --git a/tests/prices.test b/tests/prices.test index a8e4d125e..10fc6ac85 100644 --- a/tests/prices.test +++ b/tests/prices.test @@ -12,8 +12,8 @@ bin/hledger -f- print >>>=0 -# 2. convert to cost basis -bin/hledger -f- print -B +# 2. convert to cost +bin/hledger -f- print --cost <<< 2011/01/01 expenses:foreign currency €100 @ $1.35 @@ -135,7 +135,7 @@ bin/hledger -f - balance -B 0 >>>=0 # 10. transaction in two commodities should balance out properly -bin/hledger -f - balance --basis +bin/hledger -f - balance --cost <<< 2011/01/01 x a 10£ @@ 16$